unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Dialogs,
StdCtrls, Grids, ComCtrls, sqldb, DB,
pqconnection, LCLType, DBGrids;
type
{ TForm1 }
TForm1 = class(TForm)
DBGrid1: TDBGrid;
ListBox1: TListBox;
Memo1: TMemo;
StringGrid1: TStringGrid;
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure Memo1KeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
procedure show_data_in_list_view(rs: TSQLQuery; lv: TListView);
procedure run_sql(sql: string);
private
conn: TSQLConnection;
transaction: TSQLTransaction;
procedure show_data_in_dbgrid(rs: TSQLQuery; grid1: TDBGrid);
procedure show_data_in_string_grid(rs: TSQLQuery; grid1: TStringGrid);
procedure show_message(msg: String);
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
self.conn := TPQConnection.Create(self);
self.conn.DatabaseName := 'main_db';
self.conn.HostName := '127.0.0.1';
self.conn.UserName := 'user';
self.conn.Password := 'password';
self.conn.Connected := True;
self.transaction := TSQLTransaction.Create(self.conn);
self.conn.Transaction := self.transaction;
self.Memo1.Clear;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
conn.Close();
end;
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
begin
if (ssCtrl in shift) and (key = VK_E) then
begin
if (self.Memo1.Lines.Text.Length = 0) then
begin
ShowMessage('No SQL provided');
Exit;
end;
self.run_sql(self.Memo1.Lines.Text);
end;
end;
procedure TForm1.run_sql(sql: string);
var
rs: TSQLQuery;
error: string;
is_ok: boolean;
begin
try
self.show_message('Running sql...');
rs := TSQLQuery.Create(nil);
rs.DataBase := self.conn;
rs.SQL.Text := sql;
is_ok := True;
try
self.transaction.Active := True;
rs.Open;
rs.Last;
except
on A: EPQDatabaseError do
begin
error := A.Message;
is_ok := False;
self.transaction.Active := False;
end;
end;
self.show_message('Finished.');
if is_ok = False then
begin
ShowMessage('Error :' + error);
exit;
end;
self.show_data_in_string_grid(rs, self.StringGrid1);
self.show_data_in_dbgrid(rs, self.DBGrid1);
finally
rs.Free;
end;
end;
procedure TForm1.show_message(msg: String);
begin
self.ListBox1.AddItem(msg, nil);
self.ListBox1.Selected[self.ListBox1.Count-1] := True;
Application.ProcessMessages;
end;
procedure TForm1.show_data_in_list_view(rs: TSQLQuery; lv: TListView);
var
i, j: integer;
vNewItem: TListItem;
fc: integer;
begin
self.show_message('Displaying in Listview...');
lv.Clear;
lv.Columns.Clear;
fc := rs.FieldCount;
for i := 0 to fc - 1 do
begin
lv.Columns.Add;
lv.Columns[Lv.ColumnCount - 1].Caption := rs.Fields[i].FieldName;
lv.Columns[lv.ColumnCount - 1].AutoSize := True;
end;
rs.First;
while rs.EOF = False do
begin
vNewItem := lv.Items.Add;
vNewItem.Caption := rs.Fields[0].AsString;
for j := 1 to fc - 1 do
begin
vNewItem.SubItems.Add(rs.Fields[j].AsString);
end;
rs.Next;
end;
self.show_message('Finished...');
self.show_message('Record Found : ' + IntToStr(lv.Items.Count));
end;
procedure TForm1.show_data_in_string_grid(rs: TSQLQuery; grid1: TStringGrid);
var
i, j: integer;
fc: integer;
begin
self.show_message('started...');
grid1.FixedCols := 0;
grid1.RowCount := rs.RecordCount + 1;
fc := rs.FieldCount;
for j := 0 to fc-1 do
begin
grid1.Columns.Add;
grid1.Columns[j].Title.Caption := rs.Fields[j].DisplayName;
end;
grid1.BeginUpdate;
i := 1;
rs.First;
while rs.EOF = False do
begin
grid1.Row := i;
for j := 0 to fc-1 do
begin
grid1.Cells[j, i] := rs.Fields[j].AsString;
end;
rs.Next;
i := i + 1;
end;
grid1.AutoSizeColumns;
grid1.Row := 1;
grid1.EndUpdate();
self.show_message('Record Found : ' + IntToStr(rs.RecordCount));
end;
procedure TForm1.show_data_in_dbgrid(rs: TSQLQuery; grid1: TDBGrid);
var
ds: TDataSource;
begin
self.show_message('started...');
self.show_message('Record Found : ' + IntToStr(rs.RecordCount));
ds := TDataSource.Create(self);
ds.DataSet := rs;
grid1.DataSource := ds;
ds.Enabled := True;
end;
end.