unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, SQLite3Conn, SQLDB;
type
{ TForm1 }
TForm1 = class(TForm)
btnCreate: TButton;
btnUse: TButton;
btnShow: TButton;
btnShowBack: TButton;
btnExact: TButton;
btnPartial: TButton;
btnAdd: TButton;
btnAddBack: TButton;
btnSave: TButton;
btnDelete: TButton;
edtProductID: TEdit;
edtProductName: TEdit;
edtProductPrice: TEdit;
lblProductID: TLabel;
lblProductName: TLabel;
lblProductPrice: TLabel;
mmoAllData: TMemo;
pnlAdd: TPanel;
pnlHome: TPanel;
pnlShow: TPanel;
procedure FormCreate(Sender: TObject);
procedure btnCreateClick(Sender: TObject);
procedure btnUseClick(Sender: TObject);
procedure btnShowClick(Sender: TObject);
procedure btnExactClick(Sender: TObject);
procedure btnPartialClick(Sender: TObject);
procedure btnAddClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure btnAddBackClick(Sender: TObject);
procedure btnShowBackClick(Sender: TObject);
procedure edtProductIDExit(Sender: TObject);
procedure edtProductPriceExit(Sender: TObject);
procedure edtProductNameExit(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
private
FActiveDatabaseFile: string;
function NoActiveDatabase: Boolean;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
const
Mono1 = 'Liberation Mono';
Mono2 = 'FreeMono';
Mono3 = 'Courier New';
var
S: string;
begin
FActiveDatabaseFile := '';
Caption := '';
Color := clGreen;
Height := 256;
Width := 320;
pnlHome.BevelOuter := bvNone;
pnlHome.Caption := '';
pnlHome.Color := $FFFFDD;
pnlShow.Caption := '';
pnlShow.Color := $DDFFDD;
pnlAdd.Caption := '';
pnlAdd.Color := $DDFFFF;
mmoAllData.ScrollBars := ssAutoBoth;
// Find an available monospaced font
S := 'default';
if Screen.Fonts.IndexOf(Mono1) >= 0 then
S := Mono1
else
if Screen.Fonts.IndexOf(Mono2) >= 0 then
S := Mono2
else
if Screen.Fonts.IndexOf(Mono3) >= 0 then
S := Mono3;
mmoAllData.Font.Name := S;
end;
procedure TForm1.btnCreateClick(Sender: TObject);
var
Connection: TSQLite3Connection;
NewFile: TSaveDialog;
S: string;
begin
// Ask for the filename
NewFile := TSaveDialog.Create(nil);
case NewFile.Execute of
True:
begin
S := NewFile.FileName;
NewFile.Free;
end;
False:
begin
NewFile.Free;
Exit;
end;
end;
if (ExtractFileExt(S)) = '' then
S := S + '.sqlite';
if FileExists(S) then
begin
ShowMessage('File already exists, process aborted.');
Exit;
end;
FActiveDatabaseFile := S;
Caption := ExtractFileName(S);
// Create the database and tblProduct
Connection := TSQLite3Connection.Create(nil);
Connection.DatabaseName := FActiveDatabaseFile;
try
Connection.CreateDB;
Connection.Transaction := TSQLTransaction.Create(nil);
Connection.StartTransaction;
try
Connection.ExecuteDirect(
'CREATE TABLE TBLPRODUCT ' +
'(' +
' PRODUCTID INTEGER PRIMARY KEY,' +
' NAME CHAR(16) NOT NULL,' +
' PRICE REAL NOT NULL' +
');'
);
Connection.Transaction.Commit;
finally
Connection.Transaction.Free;
end;
finally
Connection.Free;
end;
end;
procedure TForm1.btnUseClick(Sender: TObject);
var
UseFile: TOpenDialog;
S: string;
begin
UseFile := TOpenDialog.Create(nil);
case UseFile.Execute of
True:
begin
S := UseFile.FileName;
UseFile.Free;
end;
False:
begin
UseFile.Free;
Exit;
end;
end;
if not(ExtractFileExt(S) = '.sqlite') then
begin
ShowMessage('Only .sqlite files are supported.');
Exit;
end;
FActiveDatabaseFile := S;
Caption := ExtractFileName(S);
end;
procedure TForm1.btnShowClick(Sender: TObject);
var
Connection: TSQLite3Connection;
Query: TSQLQuery;
S: string;
i: Integer;
begin
if NoActiveDatabase then Exit;
mmoAllData.Clear;
for i := 260 downto 8 do
begin
pnlShow.Top := i;
if Odd(i) then Sleep(1);
Application.ProcessMessages;
end;
// Read, format and show the data
Connection := TSQLite3Connection.Create(nil);
Connection.DatabaseName := FActiveDatabaseFile;
Connection.Transaction := TSQLTransaction.Create(nil);
Connection.Open;
Connection.StartTransaction;
Query := TSQLQuery.Create(nil);
Query.Database := Connection;
Query.SQL.Text := 'SELECT * FROM TBLPRODUCT;';
try
Query.Open;
while not(Query.EOF) do
begin
S := Format('%0:4D %1:-17S %2:7.2F',
[Query.FieldByName('PRODUCTID').AsInteger,
Query.FieldByName('NAME').AsString,
Query.FieldByName('PRICE').AsFloat]);
mmoAllData.Lines.Add(S);
Query.Next;
end;
Query.Close;
Connection.Transaction.Commit;
finally
Query.Free;
Connection.Transaction.Free;
Connection.Free;
end;
end;
procedure TForm1.btnExactClick(Sender: TObject);
var
Connection: TSQLite3Connection;
Query: TSQLQuery;
S: string;
begin
if NoActiveDatabase then Exit;
if not(InputQuery('Exact match search', 'Product ID', S)) then Exit;
// Do exact match search
Connection := TSQLite3Connection.Create(nil);
Connection.DatabaseName := FActiveDatabaseFile;
Connection.Transaction := TSQLTransaction.Create(nil);
Connection.Open;
Connection.StartTransaction;
Query := TSQLQuery.Create(nil);
Query.Database := Connection;
Query.SQL.Text := 'SELECT * FROM TBLPRODUCT WHERE PRODUCTID = ''' + S + ''';';
S := '';
try
Query.Open;
S := 'ProductID = ' + Query.FieldByName('PRODUCTID').AsString + LineEnding +
'Name = ' + Query.FieldByName('NAME').AsString + LineEnding +
'Price = ' + Format('%.2F', [Query.FieldByName('PRICE').AsFloat]);
if Query.RecordCount <= 0 then
S := 'No result.';
Query.Close;
Connection.Transaction.Commit;
finally
Query.Free;
Connection.Transaction.Free;
Connection.Free;
end;
if not(S.IsEmpty) then
ShowMessage(S);
end;
procedure TForm1.btnPartialClick(Sender: TObject);
var
Connection: TSQLite3Connection;
Query: TSQLQuery;
S: string;
i: Integer;
begin
if NoActiveDatabase then Exit;
if not(InputQuery('Exact match search', 'Name', S)) then Exit;
mmoAllData.Clear;
for i := 260 downto 8 do
begin
pnlShow.Top := i;
if Odd(i) then Sleep(1);
Application.ProcessMessages;
end;
// Do partial match search
Connection := TSQLite3Connection.Create(nil);
Connection.DatabaseName := FActiveDatabaseFile;
Connection.Transaction := TSQLTransaction.Create(nil);
Connection.Open;
Connection.StartTransaction;
Query := TSQLQuery.Create(nil);
Query.Database := Connection;
Query.SQL.Text := 'SELECT * FROM TBLPRODUCT WHERE NAME LIKE ' + LineEnding +
'''%' + S + '%'';';
try
Query.Open;
while not(Query.EOF) do
begin
S := Format('%0:4D %1:-17S %2:7.2F',
[Query.FieldByName('PRODUCTID').AsInteger,
Query.FieldByName('NAME').AsString,
Query.FieldByName('PRICE').AsFloat]);
mmoAllData.Lines.Add(S);
Query.Next;
end;
Query.Close;
Connection.Transaction.Commit;
finally
Query.Free;
Connection.Transaction.Free;
Connection.Free;
end;
end;
procedure TForm1.btnAddClick(Sender: TObject);
var
i: Integer;
begin
if NoActiveDatabase then Exit;
edtProductID.Text := '';
edtProductName.Text := '';
edtProductPrice.Text := '';
for i := 330 downto 8 do
begin
pnlAdd.Left := i;
if Odd(i) then Sleep(1);
Application.ProcessMessages;
end;
end;
procedure TForm1.btnDeleteClick(Sender: TObject);
var
Connection: TSQLite3Connection;
Query: TSQLQuery;
S: string;
Found: Boolean;
begin
if NoActiveDatabase then Exit;
if not(InputQuery('Delete a record', 'Product ID', S)) then Exit;
Connection := TSQLite3Connection.Create(nil);
Connection.DatabaseName := FActiveDatabaseFile;
Connection.Transaction := TSQLTransaction.Create(nil);
Connection.Open;
Connection.StartTransaction;
Query := TSQLQuery.Create(nil);
Query.Database := Connection;
// Check existence of the record
Query.SQL.Text := 'SELECT * FROM TBLPRODUCT WHERE PRODUCTID = ''' + S + ''';';
Found := False;
try
Query.Open;
if Query.RecordCount > 0 then
Found := True;
Query.Close;
Connection.Transaction.Commit;
case Found of
True: // Delete the record
begin
Connection.ExecuteDirect('DELETE FROM TBLPRODUCT WHERE PRODUCTID = ' +
'''' + S + ''';');
Connection.Transaction.Commit;
end;
False:
ShowMessage('Item not found.');
end;
finally
Query.Free;
Connection.Transaction.Free;
Connection.Free;
end;
end;
procedure TForm1.btnAddBackClick(Sender: TObject);
var
i: Integer;
begin
for i := 8 to 330 do
begin
pnlAdd.Left := i;
if Odd(i) then Sleep(1);
Application.ProcessMessages;
end;
end;
procedure TForm1.btnShowBackClick(Sender: TObject);
var
i: Integer;
begin
for i := 8 to 260 do
begin
pnlShow.Top := i;
if Odd(i) then Sleep(1);
Application.ProcessMessages;
end;
end;
procedure TForm1.btnSaveClick(Sender: TObject);
var
Connection: TSQLConnection;
i: Integer;
r: Real;
begin
// Validate ProductID
if Length(edtProductID.Text) <= 0 then
begin
ShowMessage('ProductID cannot be empty.');
Exit;
end;
if not(TryStrToInt(edtProductID.Text, i)) then
begin
ShowMessage('Product ID must be number only.');
Exit;
end;
if (i < 1) or (i > 9999) then
begin
ShowMessage('Product ID must be >= 1 and <= 9999.');
Exit;
end;
// Validate ProductName
if Length(edtProductName.Text) <= 0 then
begin
ShowMessage('Name cannot be empty.');
Exit;
end;
if Length(edtProductName.Text) > 16 then
begin
ShowMessage('Name can have maximum 16 characters.');
Exit;
end;
// Validate ProductPrice
if not(TryStrToFloat(edtProductPrice.Text, r)) then
begin
ShowMessage('Price is not valid.');
Exit;
end;
if (r < 0) or (r > 9999) then
begin
ShowMessage('Price must be >= 0 and <= 9999.');
Exit;
end;
// Save the data
Connection := TSQLite3Connection.Create(nil);
Connection.DatabaseName := FActiveDatabaseFile;
Connection.Transaction := TSQLTransaction.Create(nil);
Connection.Open;
Connection.StartTransaction;
try
Connection.ExecuteDirect(
'INSERT INTO TBLPRODUCT ' +
'(PRODUCTID, NAME, PRICE) ' +
'VALUES (' +
'''' + edtProductID.Text + ''', ' +
'''' + edtProductName.Text + ''', ' +
'''' + edtProductPrice.Text + ''');'
);
Connection.Transaction.Commit;
finally
Connection.Transaction.Free;
Connection.Free;
end;
edtProductID.Text := '';
edtProductName.Text := '';
edtProductPrice.Text := '';
end;
procedure TForm1.edtProductIDExit(Sender: TObject);
begin
edtProductID.Text := Trim(edtProductID.Text);
end;
procedure TForm1.edtProductPriceExit(Sender: TObject);
var
Price: Real;
begin
if not(TryStrToFloat(edtProductPrice.Text, Price)) then Exit;
edtProductPrice.Text := Format('%.2F', [Price]);
end;
procedure TForm1.edtProductNameExit(Sender: TObject);
begin
edtProductName.Text := Trim(edtProductName.Text);
end;
function TForm1.NoActiveDatabase: Boolean;
begin
Result := False;
if not(FActiveDatabaseFile.IsEmpty) then Exit;
ShowMessage('No active database.' + LineEnding +
'Please create a new database or use an existing one.');
Result := True;
end;
end.
Recent
