Difference between revisions of "TSqlite3 Master Detail Example"

From Lazarus wiki
Jump to navigationJump to search
Line 33: Line 33:
  
 
[[Image:Screenshot-Select Item Number.png]]
 
[[Image:Screenshot-Select Item Number.png]]
 +
 +
 +
===Example Code===
 +
unit uMain
 +
unit uMain;
 +
 +
{$mode objfpc}{$H+}
 +
 +
interface
 +
 +
uses
 +
  Classes, SysUtils, db, sqlite3ds, FileUtil, LResources, Forms, Controls,
 +
  Graphics, Dialogs, ComCtrls, ExtCtrls, Menus, DbCtrls, StdCtrls, DBGrids;
 +
 +
type
 +
 +
  { TfMain }
 +
 +
  TfMain = class(TForm)
 +
    btnSelCust: TButton;
 +
    btnAddSale: TButton;
 +
    btnSaveEntry: TButton;
 +
    btnDelEntry: TButton;
 +
    DBNavigator3: TDBNavigator;
 +
    dsCust: TDatasource;
 +
    dsSales: TDatasource;
 +
    dsStock: TDatasource;
 +
    DBEdit1: TDBEdit;
 +
    DBEdit10: TDBEdit;
 +
    DBEdit12: TDBEdit;
 +
    DBEdit13: TDBEdit;
 +
    DBEdit14: TDBEdit;
 +
    DBEdit15: TDBEdit;
 +
    DBEdit3: TDBEdit;
 +
    DBEdit4: TDBEdit;
 +
    DBEdit5: TDBEdit;
 +
    DBEdit6: TDBEdit;
 +
    DBEdit7: TDBEdit;
 +
    DBEdit8: TDBEdit;
 +
    DBEdit9: TDBEdit;
 +
    dgSales: TDBGrid;
 +
    DBNavigator1: TDBNavigator;
 +
    DBNavigator2: TDBNavigator;
 +
    Label1: TLabel;
 +
    Label10: TLabel;
 +
    Label11: TLabel;
 +
    Label2: TLabel;
 +
    Label3: TLabel;
 +
    Label4: TLabel;
 +
    Label5: TLabel;
 +
    Label7: TLabel;
 +
    Label8: TLabel;
 +
    Label9: TLabel;
 +
    miClose: TMenuItem;
 +
    miFile: TMenuItem;
 +
    mmMain: TMainMenu;
 +
    nbMain: TNotebook;
 +
    Panel1: TPanel;
 +
    pnlSales: TPanel;
 +
    pnlStock: TPanel;
 +
    pnlCustomer: TPanel;
 +
    pnlSelectCust: TPanel;
 +
    pStock: TPage;
 +
    pCustomer: TPage;
 +
    pSales: TPage;
 +
    sbMain: TStatusBar;
 +
    TCustAddr: TStringField;
 +
    TCustCustName: TStringField;
 +
    TCustcustState: TStringField;
 +
    TCustID: TAutoIncField;
 +
    TCustpostCode: TStringField;
 +
    TCustSuburb: TStringField;
 +
    TSalescustID: TLongintField;
 +
    TSalesID: TAutoIncField;
 +
    TSalesitem: TStringField;
 +
    TSalesitemNum: TStringField;
 +
    TSalesprice: TFloatField;
 +
    TSalessaleDate: TDateField;
 +
    TSalesshipDate: TDateField;
 +
    TStock: TSqlite3Dataset;
 +
    TSales: TSqlite3Dataset;
 +
    TCust: TSqlite3Dataset;
 +
    TStockID: TAutoIncField;
 +
    TStockitem: TStringField;
 +
    TStockitemNum: TStringField;
 +
    TStockprice: TFloatField;
 +
    procedure btnAddSaleClick(Sender: TObject);
 +
    procedure btnDelEntryClick(Sender: TObject);
 +
    procedure btnSaveEntryClick(Sender: TObject);
 +
    procedure btnSelCustClick(Sender: TObject);
 +
    procedure dgSalesEditButtonClick(Sender: TObject);
 +
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
 +
    procedure FormCreate(Sender: TObject);
 +
    procedure FormDestroy(Sender: TObject);
 +
    procedure FormShow(Sender: TObject);
 +
    procedure miCloseClick(Sender: TObject);
 +
    private
 +
    { private declarations }
 +
  public
 +
    { public declarations }
 +
  end;
 +
 +
var
 +
  fMain: TfMain;
 +
 +
implementation
 +
uses uCust, uSales;
 +
{ TfMain }
 +
 +
procedure TfMain.miCloseClick(Sender: TObject);
 +
begin
 +
  Close;
 +
end;
 +
 +
procedure TfMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
 +
begin
 +
  CanClose := MessageDlg('Are You Sure ?',mtConfirmation,[mbYes,mbNo],0)=mrYes;
 +
end;
 +
 +
procedure TfMain.FormCreate(Sender: TObject);
 +
var
 +
n:integer;
 +
c:TComponent;
 +
FName:string;
 +
begin
 +
    fName := ExtractFilePath(ParamStr(0)) +'data/md.db3';
 +
for n := 0 to ComponentCount -1 do
 +
    begin
 +
    c := Components[n];
 +
    if c is TSqlite3Dataset then
 +
    TSqlite3Dataset(c).FileName:= fName;
 +
    end;
 +
for n := 0 to ComponentCount -1 do
 +
    begin
 +
    c := Components[n];
 +
    if c is TSqlite3Dataset then
 +
    TSqlite3Dataset(c).Open;
 +
    end;
 +
end;
 +
 +
procedure TfMain.FormDestroy(Sender: TObject);
 +
var
 +
n:integer;
 +
c:TComponent;
 +
begin
 +
  for n := 0 to ComponentCount -1 do
 +
    begin
 +
    c := Components[n];
 +
    if c is TSqlite3Dataset then
 +
    TSqlite3Dataset(c).Close;
 +
    end;
 +
end;
 +
 +
procedure TfMain.FormShow(Sender: TObject);
 +
begin
 +
  nbMain.PageIndex:=0;
 +
end;
 +
 +
procedure TfMain.dgSalesEditButtonClick(Sender: TObject);
 +
begin
 +
  if SearchDlg.ShowModalParts =mrOk then
 +
    begin
 +
      TSales.Edit;
 +
      TSalesItemNum.Value := SearchDlg.PartNum;
 +
      TSalesItem.Value := TStockitem.Value;
 +
      TSalesPRICE.Value:= TStockPrice.Value;
 +
    end;
 +
end;
 +
 +
procedure TfMain.btnSelCustClick(Sender: TObject);
 +
begin
 +
  custDlg.CustName := TCustCUSTNAME.Value ;
 +
    if CustDlg.ShowModalCust =mrOk then
 +
    begin
 +
      TCust.Edit;
 +
      TCustCUSTNAME.Value := custDlg.CustName;
 +
    end;
 +
end;
 +
 +
procedure TfMain.btnAddSaleClick(Sender: TObject);
 +
begin
 +
  TSales.Append;
 +
end;
 +
 +
procedure TfMain.btnDelEntryClick(Sender: TObject);
 +
begin
 +
  TSales.Delete;
 +
end;
 +
 +
procedure TfMain.btnSaveEntryClick(Sender: TObject);
 +
begin
 +
  TSales.ApplyUpdates;
 +
end;
 +
 +
initialization
 +
  {$I uMain.lrs}
 +
 +
end. 
 +
 +
unit uCust
 +
 +
unit uCust;
 +
 +
{$mode objfpc}{$H+}
 +
 +
interface
 +
 +
uses
 +
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
 +
  StdCtrls, ExtCtrls, Buttons, DBGrids,DB;
 +
 +
type
 +
 +
  { TcustDlg }
 +
 +
  TcustDlg = class(TForm)
 +
    cancelBtn: TButton;
 +
    dgCust: TDBGrid;
 +
    edSearch: TEdit;
 +
    Label1: TLabel;
 +
    okBtn: TButton;
 +
    pnlCust: TPanel;
 +
    sbSearch: TSpeedButton;
 +
    procedure dgCustDblClick(Sender: TObject);
 +
    procedure edSearchChange(Sender: TObject);
 +
    procedure sbSearchClick(Sender: TObject);
 +
  private
 +
    function GetCust: String;
 +
    procedure SetCust(const AValue: String);
 +
    { private declarations }
 +
  public
 +
    { public declarations }
 +
    property CustName: String Read GetCust Write SetCust;
 +
    function ShowModalCust:integer;
 +
  end;
 +
 +
var
 +
  custDlg: TcustDlg;
 +
 +
implementation
 +
uses uMain;
 +
{ TcustDlg }
 +
 +
procedure TcustDlg.edSearchChange(Sender: TObject);
 +
begin
 +
  sbSearch.Enabled:=edSearch.Text<>'';
 +
end;
 +
 +
procedure TcustDlg.dgCustDblClick(Sender: TObject);
 +
begin
 +
  ModalResult := mrOk;
 +
end;
 +
 +
procedure TcustDlg.sbSearchClick(Sender: TObject);
 +
begin
 +
  if not fMain.TCust.Locate('CustName', edSearch.Text,[loCaseInsensitive, loPartialKey])
 +
  then
 +
      MessageDlg('No matching record found.', mtInformation, [mbOK], 0);
 +
      edSearch.Color:=clRed;
 +
end;
 +
 +
function TcustDlg.GetCust: String;
 +
begin
 +
  Result := fMain.TCustCustName.Value;
 +
end;
 +
 +
procedure TcustDlg.SetCust(const AValue: String);
 +
begin
 +
  fMain.TCust.Locate('CustName',AValue,[loPartialKey,loCaseInsensitive]);
 +
end;
 +
 +
function TcustDlg.ShowModalCust: integer;
 +
begin
 +
  Caption:='Select Customer Name';
 +
  Result := ShowModal;
 +
end;
 +
 +
initialization
 +
  {$I uCust.lrs}
 +
 +
end.
 +
 +
unit USales
 +
 +
unit uSales;
 +
 +
{$mode objfpc}{$H+}
 +
 +
interface
 +
 +
uses
 +
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
 +
  StdCtrls, ExtCtrls, Buttons, DBGrids, DB;
 +
 +
type
 +
 +
  { TsearchDlg }
 +
 +
  TsearchDlg = class(TForm)
 +
    cancelBtn: TButton;
 +
    dgParts: TDBGrid;
 +
    edSearch: TEdit;
 +
    Label1: TLabel;
 +
    okBtn: TButton;
 +
    pnlParts: TPanel;
 +
    sbSearch: TSpeedButton;
 +
    procedure dgPartsDblClick(Sender: TObject);
 +
    procedure edSearchChange(Sender: TObject);
 +
    procedure sbSearchClick(Sender: TObject);
 +
  private
 +
    function GetPartNum: String;
 +
    procedure SetPartNum(const AValue: String);
 +
    { private declarations }
 +
  public
 +
    { public declarations }
 +
    property PartNum:String Read GetPartNum Write SetPartNum;
 +
    function ShowModalParts: Integer;
 +
  end;
 +
 +
var
 +
  searchDlg: TsearchDlg;
 +
 +
implementation
 +
uses uMain;
 +
{ TsearchDlg }
 +
 +
procedure TsearchDlg.edSearchChange(Sender: TObject);
 +
begin
 +
  sbSearch.Enabled:=edSearch.Text<>'';
 +
end;
 +
 +
procedure TsearchDlg.dgPartsDblClick(Sender: TObject);
 +
begin
 +
  ModalResult := mrOk;
 +
end;
 +
 +
procedure TsearchDlg.sbSearchClick(Sender: TObject);
 +
begin
 +
  if not fMain.TStock.Locate('itemNum', edSearch.Text,[loCaseInsensitive, loPartialKey])
 +
  then
 +
      MessageDlg('No matching record found.', mtInformation, [mbOK], 0);
 +
      edSearch.Color:=clRed;
 +
end;
 +
 +
function TsearchDlg.GetPartNum: String;
 +
begin
 +
  Result := fMain.TStockitemNum.Value;
 +
end;
 +
 +
procedure TsearchDlg.SetPartNum(const AValue: String);
 +
begin
 +
  fMain.TStock.Locate('itemNum',AValue,[loPartialKey,loCaseInsensitive]);
 +
end;
 +
 +
function TsearchDlg.ShowModalParts: Integer;
 +
begin
 +
  Caption:='Select Item Number';
 +
  Result := ShowModal;
 +
end;
 +
 +
initialization
 +
  {$I uSales.lrs}
 +
 +
end.

Revision as of 01:40, 20 September 2009

TSqlite3 Master Detail Example

About Demo

This demo is a working example of how to use the TSqlite3 component in a master detail relationship.


Author

David Stewart .. davesimplewear at yahoo dot com


Components Used

  • TSqlite3
  • Standard Lazarus database components

Licence

  • Free to use as you will


Download

The TSQLite3 example can be downloaded from The Lazarus -ccr sf download location.


Screen shots of Example Program

Screenshot-Master Detail Example - SQLLite3.png

Screenshot-Master Detail Example - SQLLite3-1.png

Screenshot-Master Detail Example - SQLLite3-2.png

Screenshot-Select Customer Name.png

Screenshot-Select Item Number.png


Example Code

unit uMain unit uMain;

{$mode objfpc}{$H+}

interface

uses

 Classes, SysUtils, db, sqlite3ds, FileUtil, LResources, Forms, Controls,
 Graphics, Dialogs, ComCtrls, ExtCtrls, Menus, DbCtrls, StdCtrls, DBGrids;

type

 { TfMain }
 TfMain = class(TForm)
   btnSelCust: TButton;
   btnAddSale: TButton;
   btnSaveEntry: TButton;
   btnDelEntry: TButton;
   DBNavigator3: TDBNavigator;
   dsCust: TDatasource;
   dsSales: TDatasource;
   dsStock: TDatasource;
   DBEdit1: TDBEdit;
   DBEdit10: TDBEdit;
   DBEdit12: TDBEdit;
   DBEdit13: TDBEdit;
   DBEdit14: TDBEdit;
   DBEdit15: TDBEdit;
   DBEdit3: TDBEdit;
   DBEdit4: TDBEdit;
   DBEdit5: TDBEdit;
   DBEdit6: TDBEdit;
   DBEdit7: TDBEdit;
   DBEdit8: TDBEdit;
   DBEdit9: TDBEdit;
   dgSales: TDBGrid;
   DBNavigator1: TDBNavigator;
   DBNavigator2: TDBNavigator;
   Label1: TLabel;
   Label10: TLabel;
   Label11: TLabel;
   Label2: TLabel;
   Label3: TLabel;
   Label4: TLabel;
   Label5: TLabel;
   Label7: TLabel;
   Label8: TLabel;
   Label9: TLabel;
   miClose: TMenuItem;
   miFile: TMenuItem;
   mmMain: TMainMenu;
   nbMain: TNotebook;
   Panel1: TPanel;
   pnlSales: TPanel;
   pnlStock: TPanel;
   pnlCustomer: TPanel;
   pnlSelectCust: TPanel;
   pStock: TPage;
   pCustomer: TPage;
   pSales: TPage;
   sbMain: TStatusBar;
   TCustAddr: TStringField;
   TCustCustName: TStringField;
   TCustcustState: TStringField;
   TCustID: TAutoIncField;
   TCustpostCode: TStringField;
   TCustSuburb: TStringField;
   TSalescustID: TLongintField;
   TSalesID: TAutoIncField;
   TSalesitem: TStringField;
   TSalesitemNum: TStringField;
   TSalesprice: TFloatField;
   TSalessaleDate: TDateField;
   TSalesshipDate: TDateField;
   TStock: TSqlite3Dataset;
   TSales: TSqlite3Dataset;
   TCust: TSqlite3Dataset;
   TStockID: TAutoIncField;
   TStockitem: TStringField;
   TStockitemNum: TStringField;
   TStockprice: TFloatField;
   procedure btnAddSaleClick(Sender: TObject);
   procedure btnDelEntryClick(Sender: TObject);
   procedure btnSaveEntryClick(Sender: TObject);
   procedure btnSelCustClick(Sender: TObject);
   procedure dgSalesEditButtonClick(Sender: TObject);
   procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure FormShow(Sender: TObject);
   procedure miCloseClick(Sender: TObject);
   private
   { private declarations }
 public
   { public declarations }
 end; 

var

 fMain: TfMain;

implementation uses uCust, uSales; { TfMain }

procedure TfMain.miCloseClick(Sender: TObject); begin

 Close;

end;

procedure TfMain.FormCloseQuery(Sender: TObject; var CanClose: boolean); begin

  CanClose := MessageDlg('Are You Sure ?',mtConfirmation,[mbYes,mbNo],0)=mrYes;

end;

procedure TfMain.FormCreate(Sender: TObject); var n:integer; c:TComponent; FName:string; begin

   fName := ExtractFilePath(ParamStr(0)) +'data/md.db3';

for n := 0 to ComponentCount -1 do

   begin
    c := Components[n];
    if c is TSqlite3Dataset then
    TSqlite3Dataset(c).FileName:= fName;
   end;
for n := 0 to ComponentCount -1 do
   begin
    c := Components[n];
    if c is TSqlite3Dataset then
    TSqlite3Dataset(c).Open;
   end;

end;

procedure TfMain.FormDestroy(Sender: TObject); var n:integer; c:TComponent; begin

 for n := 0 to ComponentCount -1 do
   begin
    c := Components[n];
    if c is TSqlite3Dataset then
    TSqlite3Dataset(c).Close;
   end;

end;

procedure TfMain.FormShow(Sender: TObject); begin

 nbMain.PageIndex:=0;

end;

procedure TfMain.dgSalesEditButtonClick(Sender: TObject); begin

 if SearchDlg.ShowModalParts =mrOk then
    begin
      TSales.Edit;
      TSalesItemNum.Value := SearchDlg.PartNum;
      TSalesItem.Value := TStockitem.Value;
      TSalesPRICE.Value:= TStockPrice.Value;
    end;

end;

procedure TfMain.btnSelCustClick(Sender: TObject); begin

 custDlg.CustName := TCustCUSTNAME.Value ;
    if CustDlg.ShowModalCust =mrOk then
    begin
      TCust.Edit;
      TCustCUSTNAME.Value := custDlg.CustName;
   end;

end;

procedure TfMain.btnAddSaleClick(Sender: TObject); begin

 TSales.Append;

end;

procedure TfMain.btnDelEntryClick(Sender: TObject); begin

 TSales.Delete;

end;

procedure TfMain.btnSaveEntryClick(Sender: TObject); begin

 TSales.ApplyUpdates;

end;

initialization

 {$I uMain.lrs}

end.

unit uCust

unit uCust;

{$mode objfpc}{$H+}

interface

uses

 Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
 StdCtrls, ExtCtrls, Buttons, DBGrids,DB;

type

 { TcustDlg }
 TcustDlg = class(TForm)
   cancelBtn: TButton;
   dgCust: TDBGrid;
   edSearch: TEdit;
   Label1: TLabel;
   okBtn: TButton;
   pnlCust: TPanel;
   sbSearch: TSpeedButton;
   procedure dgCustDblClick(Sender: TObject);
   procedure edSearchChange(Sender: TObject);
   procedure sbSearchClick(Sender: TObject);
 private
   function GetCust: String;
   procedure SetCust(const AValue: String);
   { private declarations }
 public
   { public declarations }
   property CustName: String Read GetCust Write SetCust;
   function ShowModalCust:integer;
 end; 

var

 custDlg: TcustDlg;

implementation uses uMain; { TcustDlg }

procedure TcustDlg.edSearchChange(Sender: TObject); begin

 sbSearch.Enabled:=edSearch.Text<>;

end;

procedure TcustDlg.dgCustDblClick(Sender: TObject); begin

 ModalResult := mrOk;

end;

procedure TcustDlg.sbSearchClick(Sender: TObject); begin

 if not fMain.TCust.Locate('CustName', edSearch.Text,[loCaseInsensitive, loPartialKey])
  then
     MessageDlg('No matching record found.', mtInformation, [mbOK], 0);
     edSearch.Color:=clRed;

end;

function TcustDlg.GetCust: String; begin

 Result := fMain.TCustCustName.Value;

end;

procedure TcustDlg.SetCust(const AValue: String); begin

 fMain.TCust.Locate('CustName',AValue,[loPartialKey,loCaseInsensitive]);

end;

function TcustDlg.ShowModalCust: integer; begin

 Caption:='Select Customer Name';
 Result := ShowModal;

end;

initialization

 {$I uCust.lrs}

end.

unit USales

unit uSales;

{$mode objfpc}{$H+}

interface

uses

 Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
 StdCtrls, ExtCtrls, Buttons, DBGrids, DB;

type

 { TsearchDlg }
 TsearchDlg = class(TForm)
   cancelBtn: TButton;
   dgParts: TDBGrid;
   edSearch: TEdit;
   Label1: TLabel;
   okBtn: TButton;
   pnlParts: TPanel;
   sbSearch: TSpeedButton;
   procedure dgPartsDblClick(Sender: TObject);
   procedure edSearchChange(Sender: TObject);
   procedure sbSearchClick(Sender: TObject);
 private
   function GetPartNum: String;
   procedure SetPartNum(const AValue: String);
   { private declarations }
 public
   { public declarations }
   property PartNum:String Read GetPartNum Write SetPartNum;
   function ShowModalParts: Integer;
 end; 

var

 searchDlg: TsearchDlg;

implementation uses uMain; { TsearchDlg }

procedure TsearchDlg.edSearchChange(Sender: TObject); begin

 sbSearch.Enabled:=edSearch.Text<>;

end;

procedure TsearchDlg.dgPartsDblClick(Sender: TObject); begin

 ModalResult := mrOk;

end;

procedure TsearchDlg.sbSearchClick(Sender: TObject); begin

 if not fMain.TStock.Locate('itemNum', edSearch.Text,[loCaseInsensitive, loPartialKey])
  then
     MessageDlg('No matching record found.', mtInformation, [mbOK], 0);
     edSearch.Color:=clRed;

end;

function TsearchDlg.GetPartNum: String; begin

 Result := fMain.TStockitemNum.Value;

end;

procedure TsearchDlg.SetPartNum(const AValue: String); begin

 fMain.TStock.Locate('itemNum',AValue,[loPartialKey,loCaseInsensitive]);

end;

function TsearchDlg.ShowModalParts: Integer; begin

 Caption:='Select Item Number';
 Result := ShowModal;

end;

initialization

 {$I uSales.lrs}

end.