The next code...
File "fmain.pas"
unit fmain;
{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}
interface
uses
{$IFDEF WIN32}
Windows,
{$ELSE}
Libc,
{$ENDIF}
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
Buttons, StdCtrls, ExtCtrls,
DBGrids, DB,
sqlite3ds;
type
{ TfrmMain }
TfrmMain = class(TForm)
btnExecSQL: TButton;
btnShowTable: TButton;
dsTest: TDatasource;
grdTest: TDBGrid;
lstOld: TListBox;
edSQL: TMemo;
Panel1: TPanel;
Splitter1: TSplitter;
procedure btnExecSQLClick(Sender: TObject);
Procedure FormCreate(Sender: TObject);
Procedure FormDestroy(Sender: TObject);
Procedure btnShowTableClick(Sender: TObject);
Procedure lstOldDblClick(Sender: TObject);
private
{ private declarations }
qryTest: TSqlite3Dataset;
public
{ public declarations }
Procedure qryTestAfterOpen(DataSet: TDataSet);
end;
var
frmMain: TfrmMain;
implementation
{ TfrmMain }
procedure TfrmMain.btnExecSQLClick(Sender: TObject);
Var
i: Integer;
bExec: Boolean;
sSQL: String;
begin
sSQL := StringReplace(edSQL.Text, #10, ' ', [rfReplaceAll]);
sSQL := StringReplace(sSQL, #13, ' ', [rfReplaceAll]);
sSQL := StringReplace(sSQL, '', ' ', [rfReplaceAll]);
For i := 0 To lstOld.Items.Count - 1 Do
Begin // Delete all old same query's from list
If SameText(lstOld.Items.Strings[i], sSQL) Then
Begin
lstOld.Items.Delete(i);
Break;
End;
End;
bExec := Not(Pos('SELECT', UpperCase(sSQL)) = 1); // Query for Execution?
If bExec Then
lstOld.Items.Insert(0, 'Exec: ' + sSQL) // Log Query
Else lstOld.Items.Insert(0, sSQL);
qryTest.Close;
If bExec Then
qryTest.ExecSQL(sSQL) // Exec Query
Else Begin
qryTest.SQL := sSQL; // Open SELECT Query
qryTest.Open;
End;
end;
Procedure TfrmMain.FormCreate(Sender: TObject);
Begin
qryTest := TSqlite3Dataset.Create(Nil);
dsTest.DataSet := qryTest;
qryTest.FileName := 'Test.db';
qryTest.AfterOpen := @qryTestAfterOpen;
btnShowTableClick(Nil);
end;
Procedure TfrmMain.FormDestroy(Sender: TObject);
Begin
dsTest.DataSet := Nil;
qryTest.Free;
end;
Procedure TfrmMain.btnShowTableClick(Sender: TObject);
Begin
// Text for query all existing table names in database
edSQL.Text := 'SELECT tbl_name FROM (SELECT * FROM sqlite_master UNION ' +
'ALL SELECT * FROM sqlite_temp_master) WHERE type!=''meta''' +
'ORDER BY type DESC, name';
If Sender <> Nil Then
btnExecSQLClick(Nil);
end;
Procedure TfrmMain.lstOldDblClick(Sender: TObject);
Begin
If lstOld.ItemIndex < 0 Then Exit;
If lstOld.Items.Count <= 0 Then Exit;
edSQL.Text := lstOld.Items[lstOld.ItemIndex];
If Pos('Exec: ', edSQL.Text) = 1 Then
edSQL.Text := Copy(edSQL.Text, 7, Length(edSQL.Text) - 7);
end;
Procedure TfrmMain.qryTestAfterOpen(DataSet: TDataSet);
Var i: Integer;
Begin
For i := 0 To (DataSet.FieldCount - 1) Do
Begin // Set Displaywidth for String fields
If DataSet.Fields[i].DataType = ftString Then
Begin
// This is now a bug from FPC:
//DataSet.Fields[i].DisplayWidth := 15’;
End;
End;
End;
initialization
{$I fmain.lrs}
end.
Recent
