Difference between revisions of "TSqlite3 Master Detail Example"
m |
|||
Line 1: | Line 1: | ||
− | + | TSqlite3 Master Detail Example | |
− | =About Demo= | + | == About Demo == |
This demo is a working example of how to use the TSqlite3 component in a master detail relationship. | This demo is a working example of how to use the TSqlite3 component in a master detail relationship. | ||
− | =Author= | + | == Author == |
[[User:Davesimplewear|David Stewart]] .. davesimplewear at yahoo dot com | [[User:Davesimplewear|David Stewart]] .. davesimplewear at yahoo dot com | ||
− | =Components Used= | + | == Components Used == |
*TSqlite3 | *TSqlite3 | ||
*Standard Lazarus database components | *Standard Lazarus database components | ||
− | =Licence= | + | == Licence == |
*Free to use as you will | *Free to use as you will | ||
− | =Download= | + | == Download == |
The TSQLite3 example can be downloaded from [http://sourceforge.net/projects/lazarus-ccr/files/Demos The Lazarus -ccr sf download location]. | The TSQLite3 example can be downloaded from [http://sourceforge.net/projects/lazarus-ccr/files/Demos The Lazarus -ccr sf download location]. | ||
− | ===Screen shots of Example Program=== | + | === Screen shots of Example Program === |
[[Image:Screenshot-Master Detail Example - SQLLite3.png]] | [[Image:Screenshot-Master Detail Example - SQLLite3.png]] | ||
Line 38: | Line 38: | ||
[[Image:Screenshot.png]] | [[Image:Screenshot.png]] | ||
− | ===Example Code=== | + | === Example Code === |
+ | <delphi> | ||
unit uMain; | unit uMain; | ||
Line 234: | Line 235: | ||
end. | end. | ||
+ | </delphi> | ||
uMain.lfm (edited) | uMain.lfm (edited) | ||
Line 1,116: | Line 1,118: | ||
end | end | ||
+ | <delphi> | ||
unit uCust; | unit uCust; | ||
Line 1,196: | Line 1,199: | ||
end. | end. | ||
+ | </delphi> | ||
+ | <delphi> | ||
unit uSales; | unit uSales; | ||
Line 1,277: | Line 1,282: | ||
end. | end. | ||
+ | </delphi> |
Revision as of 13:59, 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
This Screenshot shows the Table setting for master detail
Example Code
<delphi> 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. </delphi>
uMain.lfm (edited) object fMain: TfMain
Left = 395 Height = 332 Top = 218 Width = 534 ActiveControl = nbMain BorderIcons = [biSystemMenu, biMinimize] BorderStyle = bsSingle Caption = 'Master Detail Example - SQLLite3' ClientHeight = 305 ClientWidth = 534 Font.Height = -13 Font.Name = 'Sans' Menu = mmMain OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow Position = poScreenCenter LCLVersion = '0.9.27' object sbMain: TStatusBar Left = 0 Height = 19 Top = 286 Width = 534 AutoHint = True Panels = <> end object nbMain: TNotebook Left = 0 Height = 286 Top = 0 Width = 534 Align = alClient PageIndex = 0 TabOrder = 1 object pSales: TPage Caption = 'Sales' ClientWidth = 532 ClientHeight = 259 object Label3: TLabel Left = 0 Height = 18 Top = 241 Width = 532 Align = alBottom Caption = 'Select Customer First, then click in item number field to select item, then save' ParentColor = False end object pnlSelectCust: TPanel Left = 15 Height = 216 Top = 14 Width = 232 BevelInner = bvLowered BevelWidth = 2 ClientHeight = 216 ClientWidth = 232 TabOrder = 0 object Label1: TLabel Left = 4 Height = 18 Top = 4 Width = 224 Align = alTop Alignment = taCenter Caption = 'Customer Detail' Font.Height = -13 Font.Name = 'Sans' Font.Style = [fsBold, fsItalic] ParentColor = False ParentFont = False end object Label2: TLabel Left = 24 Height = 18 Top = 31 Width = 73 Caption = 'First Name' Font.Height = -13 Font.Name = 'Sans' Font.Style = [fsItalic] ParentColor = False ParentFont = False end object DBEdit1: TDBEdit Left = 24 Height = 23 Hint = 'Cust name' Top = 48 Width = 184 DataField = 'CustName' DataSource = dsCust ReadOnly = True MaxLength = 8192 ParentShowHint = False ShowHint = True TabOrder = 0 end object DBEdit3: TDBEdit Left = 24 Height = 23 Hint = 'Address' Top = 72 Width = 184 DataField = 'Addr' DataSource = dsCust ReadOnly = True MaxLength = 8192 ParentShowHint = False ShowHint = True TabOrder = 1 end object DBEdit4: TDBEdit Left = 24 Height = 23 Hint = 'Suburb/Town' Top = 96 Width = 184 DataField = 'Suburb' DataSource = dsCust ReadOnly = True MaxLength = 8192 ParentShowHint = False ShowHint = True TabOrder = 2 end object DBEdit5: TDBEdit Left = 24 Height = 23 Hint = 'Postal Code' Top = 120 Width = 80 DataField = 'postCode' DataSource = dsCust ReadOnly = True MaxLength = 8192 ParentShowHint = False ShowHint = True TabOrder = 3 end object DBEdit6: TDBEdit Left = 128 Height = 23 Hint = 'State' Top = 119 Width = 80 DataField = 'custState' DataSource = dsCust ReadOnly = True CharCase = ecUppercase MaxLength = 8192 ParentShowHint = False ShowHint = True TabOrder = 4 end object btnSelCust: TButton Left = 24 Height = 25 Hint = 'Click to select a Customer' Top = 176 Width = 184 Caption = 'Select Customer' OnClick = btnSelCustClick ParentShowHint = False ShowHint = True TabOrder = 5 end object DBNavigator3: TDBNavigator Left = 30 Height = 22 Top = 150 Width = 170 BevelOuter = bvNone ClientHeight = 22 ClientWidth = 170 DataSource = dsCust TabOrder = 6 VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast] end end object pnlSales: TPanel Left = 255 Height = 216 Top = 14 Width = 260 BevelInner = bvLowered BevelWidth = 2 ClientHeight = 216 ClientWidth = 260 TabOrder = 1 object Label4: TLabel Left = 4 Height = 18 Top = 4 Width = 252 Align = alTop Alignment = taCenter Caption = 'Sales Detail' Font.Height = -13 Font.Name = 'Sans' Font.Style = [fsBold, fsItalic] ParentColor = False ParentFont = False end object btnAddSale: TButton Left = 16 Height = 25 Hint = 'Add Another Sale' Top = 176 Width = 72 Caption = 'Add Sale' OnClick = btnAddSaleClick ParentShowHint = False ShowHint = True TabOrder = 0 end object Panel1: TPanel Left = 4 Height = 13 Top = 22 Width = 252 Align = alTop BevelOuter = bvNone TabOrder = 1 end object dgSales: TDBGrid Left = 4 Height = 125 Hint = 'Click Item Number Button to Select Item' Top = 35 Width = 252 Align = alTop Columns = < item ButtonStyle = cbsEllipsis Title.Caption = 'item Number' Width = 100 FieldName = 'itemNum' end item Width = 150 FieldName = 'item' end item FieldName = 'price' end item Title.Caption = 'sale Date' FieldName = 'saleDate' end item Title.Caption = 'ship Date' FieldName = 'shipDate' end> DataSource = dsSales ShowHint = True TabOrder = 2 TitleFont.Height = -13 TitleFont.Name = 'Sans' OnEditButtonClick = dgSalesEditButtonClick end object btnSaveEntry: TButton Left = 95 Height = 25 Hint = 'Save Entry' Top = 176 Width = 51 Caption = 'Save' OnClick = btnSaveEntryClick ParentShowHint = False ShowHint = True TabOrder = 3 end object btnDelEntry: TButton Left = 168 Height = 25 Hint = 'Delete Entry' Top = 176 Width = 75 Caption = 'Delete' OnClick = btnDelEntryClick ParentShowHint = False ShowHint = True TabOrder = 4 end end end object pCustomer: TPage Caption = 'Customer' ClientWidth = 532 ClientHeight = 259 object pnlCustomer: TPanel Left = 95 Height = 194 Top = 30 Width = 339 BevelInner = bvLowered BevelWidth = 2 ClientHeight = 194 ClientWidth = 339 TabOrder = 0 object Label5: TLabel Left = 72 Height = 18 Top = 31 Width = 73 Caption = 'First Name' Font.Height = -13 Font.Name = 'Sans' Font.Style = [fsItalic] ParentColor = False ParentFont = False end object Label7: TLabel Left = 4 Height = 18 Top = 4 Width = 331 Align = alTop Alignment = taCenter Caption = 'Customer Entry' Font.Height = -13 Font.Name = 'Sans' Font.Style = [fsBold, fsItalic] ParentColor = False ParentFont = False end object DBEdit10: TDBEdit Left = 72 Height = 23 Hint = 'Cust name' Top = 48 Width = 184 DataField = 'CustName' DataSource = dsCust MaxLength = 8192 ParentShowHint = False ShowHint = True TabOrder = 0 end object DBEdit12: TDBEdit Left = 72 Height = 23 Hint = 'Address' Top = 72 Width = 184 DataField = 'Addr' DataSource = dsCust MaxLength = 8192 ParentShowHint = False ShowHint = True TabOrder = 1 end object DBEdit13: TDBEdit Left = 72 Height = 23 Hint = 'Suburb/Town' Top = 96 Width = 184 DataField = 'Suburb' DataSource = dsCust MaxLength = 8192 ParentShowHint = False ShowHint = True TabOrder = 2 end object DBEdit14: TDBEdit Left = 72 Height = 23 Hint = 'Postal Code' Top = 120 Width = 80 DataField = 'postCode' DataSource = dsCust MaxLength = 8192 ParentShowHint = False ShowHint = True TabOrder = 3 end object DBEdit15: TDBEdit Left = 176 Height = 23 Hint = 'State' Top = 119 Width = 80 DataField = 'custState' DataSource = dsCust CharCase = ecUppercase MaxLength = 8192 ParentShowHint = False ShowHint = True TabOrder = 4 end object DBNavigator2: TDBNavigator Left = 45 Height = 25 Top = 154 Width = 241 BevelOuter = bvNone ClientHeight = 25 ClientWidth = 241 DataSource = dsCust TabOrder = 5 end end end object pStock: TPage Caption = 'Stock' ClientWidth = 532 ClientHeight = 259 object pnlStock: TPanel Left = 95 Height = 218 Top = 22 Width = 339 BevelInner = bvLowered BevelWidth = 2 ClientHeight = 218 ClientWidth = 339 TabOrder = 0 object Label8: TLabel Left = 4 Height = 18 Top = 4 Width = 331 Align = alTop Alignment = taCenter Caption = 'Stock Entry' Font.Height = -13 Font.Name = 'Sans' Font.Style = [fsBold, fsItalic] ParentColor = False ParentFont = False end object Label9: TLabel Left = 75 Height = 18 Top = 24 Width = 83 Caption = 'Part Number' Font.Height = -13 Font.Name = 'Sans' Font.Style = [fsItalic] ParentColor = False ParentFont = False end object Label10: TLabel Left = 75 Height = 18 Top = 72 Width = 75 Caption = 'Description' Font.Height = -13 Font.Name = 'Sans' Font.Style = [fsItalic] ParentColor = False ParentFont = False end object Label11: TLabel Left = 75 Height = 18 Top = 128 Width = 33 Caption = 'Price' Font.Height = -13 Font.Name = 'Sans' Font.Style = [fsItalic] ParentColor = False ParentFont = False end object DBEdit7: TDBEdit Left = 75 Height = 23 Top = 40 Width = 181 DataField = 'itemNum' DataSource = dsStock MaxLength = 8192 ParentShowHint = False ShowHint = True TabOrder = 0 end object DBEdit8: TDBEdit Left = 75 Height = 23 Top = 89 Width = 181 DataField = 'item' DataSource = dsStock MaxLength = 8192 ParentShowHint = False ShowHint = True TabOrder = 1 end object DBEdit9: TDBEdit Left = 75 Height = 23 Top = 145 Width = 181 DataField = 'price' DataSource = dsStock ParentShowHint = False ShowHint = True TabOrder = 2 end object DBNavigator1: TDBNavigator Left = 48 Height = 25 Top = 183 Width = 241 BevelOuter = bvNone ClientHeight = 25 ClientWidth = 241 DataSource = dsStock ParentShowHint = False ShowHint = True TabOrder = 3 end end end end object mmMain: TMainMenu left = 16 top = 277 object miFile: TMenuItem Caption = '&File' object miClose: TMenuItem Caption = '&Close' GlyphShowMode = gsmAlways Hint = 'Close Application' OnClick = miCloseClick end end end object dsCust: TDatasource DataSet = TCust left = 16 top = 53 end object dsSales: TDatasource DataSet = TSales left = 16 top = 141 end object dsStock: TDatasource DataSet = TStock left = 16 top = 214 end object TCust: TSqlite3Dataset AutoIncrementKey = True Options = [] PrimaryKey = 'ID' SaveOnClose = True SaveOnRefetch = True SQL = 'Select * from cust;' TableName = 'cust' FieldDefs = < item Name = 'ID' DataType = ftAutoInc Precision = -1 Size = 0 end item Name = 'CustName' DataType = ftString Precision = -1 Size = 8192 end item Name = 'Addr' DataType = ftString Precision = -1 Size = 8192 end item Name = 'Suburb' DataType = ftString Precision = -1 Size = 8192 end item Name = 'postCode' DataType = ftString Precision = -1 Size = 8192 end item Name = 'custState' DataType = ftString Precision = -1 Size = 8192 end> left = 66 top = 53 object TCustID: TAutoIncField DisplayWidth = 10 FieldKind = fkData FieldName = 'ID' Index = 0 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False end object TCustCustName: TStringField DisplayWidth = 8192 FieldKind = fkData FieldName = 'CustName' Index = 1 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False Size = 8192 end object TCustAddr: TStringField DisplayWidth = 8192 FieldKind = fkData FieldName = 'Addr' Index = 2 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False Size = 8192 end object TCustSuburb: TStringField DisplayWidth = 8192 FieldKind = fkData FieldName = 'Suburb' Index = 3 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False Size = 8192 end object TCustpostCode: TStringField DisplayWidth = 8192 FieldKind = fkData FieldName = 'postCode' Index = 4 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False Size = 8192 end object TCustcustState: TStringField DisplayWidth = 8192 FieldKind = fkData FieldName = 'custState' Index = 5 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False Size = 8192 end end object TSales: TSqlite3Dataset AutoIncrementKey = True IndexFieldNames = 'CustID' Options = [] PrimaryKey = 'ID' SaveOnClose = True SaveOnRefetch = True SQL = 'Select * from sales;' TableName = 'sales' MasterSource = dsCust MasterFields = 'ID' FieldDefs = < item Name = 'itemNum' DataType = ftString Precision = -1 Size = 8192 end item Name = 'ID' DataType = ftAutoInc Precision = -1 Size = 0 end item Name = 'custID' DataType = ftInteger Precision = -1 Size = 0 end item Name = 'saleDate' DataType = ftDate Precision = -1 Size = 0 end item Name = 'shipDate' DataType = ftDate Precision = -1 Size = 0 end item Name = 'item' DataType = ftString Precision = -1 Size = 8192 end item Name = 'price' DataType = ftFloat Precision = -1 Size = 0 end> left = 66 top = 141 object TSalesitemNum: TStringField DisplayWidth = 8192 FieldKind = fkData FieldName = 'itemNum' Index = 0 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False Size = 8192 end object TSalesID: TAutoIncField DisplayWidth = 10 FieldKind = fkData FieldName = 'ID' Index = 1 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False end object TSalescustID: TLongintField DisplayWidth = 10 FieldKind = fkData FieldName = 'custID' Index = 2 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False end object TSalessaleDate: TDateField DisplayWidth = 10 FieldKind = fkData FieldName = 'saleDate' Index = 3 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False end object TSalesshipDate: TDateField DisplayWidth = 10 FieldKind = fkData FieldName = 'shipDate' Index = 4 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False end object TSalesitem: TStringField DisplayWidth = 8192 FieldKind = fkData FieldName = 'item' Index = 5 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False Size = 8192 end object TSalesprice: TFloatField DisplayWidth = 10 FieldKind = fkData FieldName = 'price' Index = 6 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False Currency = True MaxValue = 0 MinValue = 0 Precision = -1 end end object TStock: TSqlite3Dataset AutoIncrementKey = True Options = [] PrimaryKey = 'ID' SaveOnClose = True SaveOnRefetch = True SQL = 'Select * from stock;' TableName = 'stock' FieldDefs = < item Name = 'ID' DataType = ftAutoInc Precision = -1 Size = 0 end item Name = 'item' DataType = ftString Precision = -1 Size = 8192 end item Name = 'price' DataType = ftFloat Precision = -1 Size = 0 end item Name = 'itemNum' DataType = ftString Precision = -1 Size = 8192 end> left = 66 top = 214 object TStockID: TAutoIncField DisplayWidth = 10 FieldKind = fkData FieldName = 'ID' Index = 0 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False end object TStockitem: TStringField DisplayWidth = 8192 FieldKind = fkData FieldName = 'item' Index = 1 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False Size = 8192 end object TStockprice: TFloatField DisplayWidth = 10 FieldKind = fkData FieldName = 'price' Index = 2 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False Currency = True MaxValue = 0 MinValue = 0 Precision = -1 end object TStockitemNum: TStringField DisplayWidth = 8192 FieldKind = fkData FieldName = 'itemNum' Index = 3 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False Size = 8192 end end
end
<delphi> 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. </delphi>
<delphi> 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. </delphi>