examples/lookupcombobox/Unit1.pas

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2015 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*) 
            
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, DbCtrls, EditBtn, Buttons, db, IBDatabase, IBCustomDataSet,
  IBLookupComboEditBox,  IBQuery, DBExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    ApplicationProperties1: TApplicationProperties;
    DBEdit5: TDBEdit;
    DeleteBtn: TButton;
    CountriesSource: TDataSource;
    EmployeesDEPT_KEY_PATH: TIBStringField;
    EmployeesDEPT_PATH: TIBStringField;
    IBDateEdit1: TDBDateEdit;
    IBLookupComboEditBox2: TIBLookupComboEditBox;
    IBLookupComboEditBox3: TIBLookupComboEditBox;
    JobCodeSource: TDataSource;
    DBComboBox1: TDBComboBox;
    DBEdit4: TDBEdit;
    Countries: TIBQuery;
    JobCodes: TIBQuery;
    Label10: TLabel;
    Label11: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    SaveBtn: TButton;
    CancelBtn: TButton;
    EmployeeSource: TDataSource;
    DBEdit1: TDBEdit;
    DBEdit2: TDBEdit;
    DBEdit3: TDBEdit;
    EmployeesDEPT_NO: TIBStringField;
    EmployeesEMP_NO: TSmallintField;
    EmployeesFIRST_NAME: TIBStringField;
    EmployeesFULL_NAME: TIBStringField;
    EmployeesHIRE_DATE: TDateTimeField;
    EmployeesJOB_CODE: TIBStringField;
    EmployeesJOB_COUNTRY: TIBStringField;
    EmployeesJOB_GRADE: TSmallintField;
    EmployeesLAST_NAME: TIBStringField;
    EmployeesPHONE_EXT: TIBStringField;
    EmployeesSALARY: TIBBCDField;
    IBDatabase1: TIBDatabase;
    Employees: TIBDataSet;
    IBLookupComboEditBox1: TIBLookupComboEditBox;
    IBTransaction1: TIBTransaction;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
    procedure CancelBtnClick(Sender: TObject);
    procedure CountriesBeforeOpen(DataSet: TDataSet);
    procedure EmployeeSourceDataChange(Sender: TObject; Field: TField);
    procedure DBComboBox1CloseUp(Sender: TObject);
    procedure DeleteBtnClick(Sender: TObject);
    procedure EmployeesAfterDelete(DataSet: TDataSet);
    procedure EmployeesAfterInsert(DataSet: TDataSet);
    procedure EmployeesAfterPost(DataSet: TDataSet);
    procedure EmployeesAfterTransactionEnd(Sender: TObject);
    procedure EmployeesFULL_NAMEChange(Sender: TField);
    procedure EmployeesJOB_CODEChange(Sender: TField);
    procedure EmployeesJOB_GRADEChange(Sender: TField);
    procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
      DisplayText: Boolean);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure IBLookupComboEditBox1CanAutoInsert(Sender: TObject;
      aText: string; var Accept: boolean);
    procedure JobCodesBeforeOpen(DataSet: TDataSet);
    procedure SaveBtnClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { private declarations }
    FDirty: boolean;
    FClosing: boolean;
    FLastJobGrade: integer;
    FLastJobCode: string;
    procedure OpenDataSets(Data: PtrInt);
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2, IB;

{$R *.lfm}

{ TForm1 }

procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
  DisplayText: Boolean);
begin
  if not Sender.IsNull and DisplayText then
    aText := FormatFloat('$#,##0.00',Sender.AsFloat)
  else
    aText := Sender.AsString
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  FClosing := true;
  if IBTransaction1.InTransaction then
    IBTransaction1.Commit
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  FClosing := false;
  repeat
    try
      IBDatabase1.Connected := true;
    except
     on E:EIBClientError do
      begin
        Close;
        Exit
      end;
    On E:Exception do
     MessageDlg(E.Message,mtError,[mbOK],0);
    end;
  until IBDatabase1.Connected;
  OpenDataSets(0)
end;

procedure TForm1.IBLookupComboEditBox1CanAutoInsert(Sender: TObject;
  aText: string; var Accept: boolean);
begin
  Accept := MessageDlg(Format('Insert a new Employee record for ''%s''?',
              [aText]),mtConfirmation,[mbYes,mbNo],0) = mrYes
end;

procedure TForm1.JobCodesBeforeOpen(DataSet: TDataSet);
begin
  JobCodes.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
  FLastJobGrade :=  EmployeesJOB_GRADE.AsInteger;
end;

procedure TForm1.SaveBtnClick(Sender: TObject);
begin
  IBTransaction1.Commit
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var DeptNo: string;
begin
  if SelectDeptDlg.ShowModal(EmployeesDEPT_KEY_PATH.AsString,DeptNo) = mrOK then
  begin
    Employees.Edit;
    EmployeesDEPT_NO.AsString := DeptNo;
    try
      Employees.Post;
    except
      Employees.Cancel;
      raise;
    end;
  end;
end;

procedure TForm1.OpenDataSets(Data: PtrInt);
begin
  FDirty := false;
  IBTransaction1.StartTransaction;
  JobCodes.Active := true;
  Countries.Active := true;
  Employees.Active := true;
end;

procedure TForm1.ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
begin
  SaveBtn.Enabled := FDirty;
  CancelBtn.Enabled := FDirty;
  DeleteBtn.Enabled := Employees.Active and (Employees.RecordCount > 0)
end;

procedure TForm1.CancelBtnClick(Sender: TObject);
begin
  if Employees.State in [dsInsert,dsEdit] then
    Employees.Cancel;
  IBTransaction1.Rollback
end;

procedure TForm1.CountriesBeforeOpen(DataSet: TDataSet);
begin
  Countries.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
  Countries.ParamByName('JOB_CODE').AsString := EmployeesJOB_CODE.AsString;
  FLastJobGrade :=  EmployeesJOB_GRADE.AsInteger;
  FLastJobCode := EmployeesJOB_CODE.AsString;
end;

procedure TForm1.EmployeeSourceDataChange(Sender: TObject; Field: TField);
begin
  if FLastJobGrade <>  EmployeesJOB_GRADE.AsInteger then
  begin
    JobCodes.Active := false;
    JobCodes.Active := true;
    Countries.Active := false;
    Countries.Active := true;
  end
  else
  if FLastJobCode <> EmployeesJOB_CODE.AsString then
  begin
    Countries.Active := false;
    Countries.Active := true;
  end;
end;

procedure TForm1.DBComboBox1CloseUp(Sender: TObject);
begin
  (Sender as TCustomDBComboBox).EditingDone
end;

procedure TForm1.DeleteBtnClick(Sender: TObject);
begin
  if MessageDlg(Format('Do you really want to delete ''%s''?',
                           [EmployeesFULL_NAME.AsString]),
                           mtConfirmation,[mbYes,mbNo],0) = mrYes then
    Employees.Delete
end;

procedure TForm1.EmployeesAfterDelete(DataSet: TDataSet);
begin
  FDirty := true
end;

procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet);
begin
  FDirty := true;
  EmployeesJOB_COUNTRY.AsString := 'USA';
  EmployeesJOB_CODE.AsString := 'SRep';
  EmployeesJOB_GRADE.AsInteger := 4;
  EmployeesSALARY.AsCurrency := 20000;
  EmployeesFIRST_NAME.AsString := 'John';
  EmployeesLAST_NAME.AsString := 'Doe';
  EmployeesHIRE_DATE.AsDateTime := now;
  EmployeesDEPT_NO.AsString := '000';
end;

procedure TForm1.EmployeesAfterPost(DataSet: TDataSet);
begin
  Employees.Refresh;
end;

procedure TForm1.EmployeesAfterTransactionEnd(Sender: TObject);
begin
  if not FClosing then
    Application.QueueAsyncCall(@OpenDataSets,0)
end;

procedure TForm1.EmployeesFULL_NAMEChange(Sender: TField);
var I: integer;
    aText: string;
begin
  aText := Sender.AsString;
  I := Pos(',',aText);
  Employees.Edit;
  if I > 0 then
  begin
    EmployeesLAST_NAME.AsString := system.copy(aText,1,I-1);
    EmployeesFIRST_NAME.AsString := Trim(system.copy(aText,I+1,Length(aText) - I));
  end
  else
  begin
    EmployeesLAST_NAME.AsString := aText;
    EmployeesFIRST_NAME.AsString := '!!unknown!!';
  end;
end;

procedure TForm1.EmployeesJOB_CODEChange(Sender: TField);
begin
  Countries.Active := false;
  Countries.Active := true;
end;

procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
begin
  JobCodes.Active := false;
  JobCodes.Active := true;
  Countries.Active := false;
  Countries.Active := true;
end;

end.

Revision:	143
Committed:	Fri Feb 23 12:11:21 2018 UTC (6 years, 2 months ago) by tony
Content type:	text/x-pascal
File size:	8974 byte(s)
Log Message:	Fixes Merged
#	User	Rev	Content
1	tony	143	(*
2			* IBX For Lazarus (Firebird Express)
3			*
4			* The contents of this file are subject to the Initial Developer's
5			* Public License Version 1.0 (the "License"); you may not use this
6			* file except in compliance with the License. You may obtain a copy
7			* of the License here:
8			*
9			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
10			*
11			* Software distributed under the License is distributed on an "AS
12			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13			* implied. See the License for the specific language governing rights
14			* and limitations under the License.
15			*
16			* The Initial Developer of the Original Code is Tony Whyman.
17			*
18			* The Original Code is (C) 2015 Tony Whyman, MWA Software
19			* (http://www.mwasoftware.co.uk).
20			*
21			* All Rights Reserved.
22			*
23			* Contributor(s): ______________________________________.
24			*
25			*)
26
27	tony	21	unit Unit1;
28
29			{$mode objfpc}{$H+}
30
31			interface
32
33			uses
34			Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
35			ExtCtrls, DbCtrls, EditBtn, Buttons, db, IBDatabase, IBCustomDataSet,
36			IBLookupComboEditBox, IBQuery, DBExtCtrls;
37
38			type
39
40			{ TForm1 }
41
42			TForm1 = class(TForm)
43			ApplicationProperties1: TApplicationProperties;
44			DBEdit5: TDBEdit;
45			DeleteBtn: TButton;
46			CountriesSource: TDataSource;
47			EmployeesDEPT_KEY_PATH: TIBStringField;
48			EmployeesDEPT_PATH: TIBStringField;
49	tony	27	IBDateEdit1: TDBDateEdit;
50	tony	21	IBLookupComboEditBox2: TIBLookupComboEditBox;
51			IBLookupComboEditBox3: TIBLookupComboEditBox;
52			JobCodeSource: TDataSource;
53			DBComboBox1: TDBComboBox;
54			DBEdit4: TDBEdit;
55			Countries: TIBQuery;
56			JobCodes: TIBQuery;
57			Label10: TLabel;
58			Label11: TLabel;
59			Label6: TLabel;
60			Label7: TLabel;
61			Label8: TLabel;
62			Label9: TLabel;
63			SaveBtn: TButton;
64			CancelBtn: TButton;
65			EmployeeSource: TDataSource;
66			DBEdit1: TDBEdit;
67			DBEdit2: TDBEdit;
68			DBEdit3: TDBEdit;
69			EmployeesDEPT_NO: TIBStringField;
70			EmployeesEMP_NO: TSmallintField;
71			EmployeesFIRST_NAME: TIBStringField;
72			EmployeesFULL_NAME: TIBStringField;
73			EmployeesHIRE_DATE: TDateTimeField;
74			EmployeesJOB_CODE: TIBStringField;
75			EmployeesJOB_COUNTRY: TIBStringField;
76			EmployeesJOB_GRADE: TSmallintField;
77			EmployeesLAST_NAME: TIBStringField;
78			EmployeesPHONE_EXT: TIBStringField;
79			EmployeesSALARY: TIBBCDField;
80			IBDatabase1: TIBDatabase;
81			Employees: TIBDataSet;
82			IBLookupComboEditBox1: TIBLookupComboEditBox;
83			IBTransaction1: TIBTransaction;
84			Label1: TLabel;
85			Label2: TLabel;
86			Label3: TLabel;
87			Label4: TLabel;
88			Label5: TLabel;
89			Panel1: TPanel;
90			SpeedButton1: TSpeedButton;
91			procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
92			procedure CancelBtnClick(Sender: TObject);
93			procedure CountriesBeforeOpen(DataSet: TDataSet);
94			procedure EmployeeSourceDataChange(Sender: TObject; Field: TField);
95			procedure DBComboBox1CloseUp(Sender: TObject);
96			procedure DeleteBtnClick(Sender: TObject);
97			procedure EmployeesAfterDelete(DataSet: TDataSet);
98			procedure EmployeesAfterInsert(DataSet: TDataSet);
99			procedure EmployeesAfterPost(DataSet: TDataSet);
100			procedure EmployeesAfterTransactionEnd(Sender: TObject);
101			procedure EmployeesFULL_NAMEChange(Sender: TField);
102			procedure EmployeesJOB_CODEChange(Sender: TField);
103			procedure EmployeesJOB_GRADEChange(Sender: TField);
104			procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
105			DisplayText: Boolean);
106			procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
107			procedure FormShow(Sender: TObject);
108			procedure IBLookupComboEditBox1CanAutoInsert(Sender: TObject;
109			aText: string; var Accept: boolean);
110			procedure JobCodesBeforeOpen(DataSet: TDataSet);
111			procedure SaveBtnClick(Sender: TObject);
112			procedure SpeedButton1Click(Sender: TObject);
113			private
114			{ private declarations }
115			FDirty: boolean;
116			FClosing: boolean;
117			FLastJobGrade: integer;
118			FLastJobCode: string;
119			procedure OpenDataSets(Data: PtrInt);
120			public
121			{ public declarations }
122			end;
123
124			var
125			Form1: TForm1;
126
127			implementation
128
129			uses Unit2, IB;
130
131			{$R *.lfm}
132
133			{ TForm1 }
134
135			procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
136			DisplayText: Boolean);
137			begin
138			if not Sender.IsNull and DisplayText then
139			aText := FormatFloat('$#,##0.00',Sender.AsFloat)
140			else
141			aText := Sender.AsString
142			end;
143
144			procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
145			begin
146			FClosing := true;
147			if IBTransaction1.InTransaction then
148			IBTransaction1.Commit
149			end;
150
151			procedure TForm1.FormShow(Sender: TObject);
152			begin
153			FClosing := false;
154			repeat
155			try
156			IBDatabase1.Connected := true;
157			except
158			on E:EIBClientError do
159			begin
160			Close;
161			Exit
162			end;
163			On E:Exception do
164			MessageDlg(E.Message,mtError,[mbOK],0);
165			end;
166			until IBDatabase1.Connected;
167			OpenDataSets(0)
168			end;
169
170			procedure TForm1.IBLookupComboEditBox1CanAutoInsert(Sender: TObject;
171			aText: string; var Accept: boolean);
172			begin
173			Accept := MessageDlg(Format('Insert a new Employee record for ''%s''?',
174			[aText]),mtConfirmation,[mbYes,mbNo],0) = mrYes
175			end;
176
177			procedure TForm1.JobCodesBeforeOpen(DataSet: TDataSet);
178			begin
179			JobCodes.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
180			FLastJobGrade := EmployeesJOB_GRADE.AsInteger;
181			end;
182
183			procedure TForm1.SaveBtnClick(Sender: TObject);
184			begin
185			IBTransaction1.Commit
186			end;
187
188			procedure TForm1.SpeedButton1Click(Sender: TObject);
189			var DeptNo: string;
190			begin
191			if SelectDeptDlg.ShowModal(EmployeesDEPT_KEY_PATH.AsString,DeptNo) = mrOK then
192			begin
193			Employees.Edit;
194			EmployeesDEPT_NO.AsString := DeptNo;
195			try
196			Employees.Post;
197			except
198			Employees.Cancel;
199			raise;
200			end;
201			end;
202			end;
203
204			procedure TForm1.OpenDataSets(Data: PtrInt);
205			begin
206			FDirty := false;
207			IBTransaction1.StartTransaction;
208			JobCodes.Active := true;
209			Countries.Active := true;
210			Employees.Active := true;
211			end;
212
213			procedure TForm1.ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
214			begin
215			SaveBtn.Enabled := FDirty;
216			CancelBtn.Enabled := FDirty;
217			DeleteBtn.Enabled := Employees.Active and (Employees.RecordCount > 0)
218			end;
219
220			procedure TForm1.CancelBtnClick(Sender: TObject);
221			begin
222			if Employees.State in [dsInsert,dsEdit] then
223			Employees.Cancel;
224			IBTransaction1.Rollback
225			end;
226
227			procedure TForm1.CountriesBeforeOpen(DataSet: TDataSet);
228			begin
229			Countries.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
230			Countries.ParamByName('JOB_CODE').AsString := EmployeesJOB_CODE.AsString;
231			FLastJobGrade := EmployeesJOB_GRADE.AsInteger;
232			FLastJobCode := EmployeesJOB_CODE.AsString;
233			end;
234
235			procedure TForm1.EmployeeSourceDataChange(Sender: TObject; Field: TField);
236			begin
237			if FLastJobGrade <> EmployeesJOB_GRADE.AsInteger then
238			begin
239			JobCodes.Active := false;
240			JobCodes.Active := true;
241			Countries.Active := false;
242			Countries.Active := true;
243			end
244			else
245			if FLastJobCode <> EmployeesJOB_CODE.AsString then
246			begin
247			Countries.Active := false;
248			Countries.Active := true;
249			end;
250			end;
251
252			procedure TForm1.DBComboBox1CloseUp(Sender: TObject);
253			begin
254			(Sender as TCustomDBComboBox).EditingDone
255			end;
256
257			procedure TForm1.DeleteBtnClick(Sender: TObject);
258			begin
259			if MessageDlg(Format('Do you really want to delete ''%s''?',
260			[EmployeesFULL_NAME.AsString]),
261			mtConfirmation,[mbYes,mbNo],0) = mrYes then
262			Employees.Delete
263			end;
264
265			procedure TForm1.EmployeesAfterDelete(DataSet: TDataSet);
266			begin
267			FDirty := true
268			end;
269
270			procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet);
271			begin
272			FDirty := true;
273			EmployeesJOB_COUNTRY.AsString := 'USA';
274			EmployeesJOB_CODE.AsString := 'SRep';
275			EmployeesJOB_GRADE.AsInteger := 4;
276			EmployeesSALARY.AsCurrency := 20000;
277			EmployeesFIRST_NAME.AsString := 'John';
278			EmployeesLAST_NAME.AsString := 'Doe';
279			EmployeesHIRE_DATE.AsDateTime := now;
280			EmployeesDEPT_NO.AsString := '000';
281			end;
282
283			procedure TForm1.EmployeesAfterPost(DataSet: TDataSet);
284			begin
285			Employees.Refresh;
286			end;
287
288			procedure TForm1.EmployeesAfterTransactionEnd(Sender: TObject);
289			begin
290			if not FClosing then
291			Application.QueueAsyncCall(@OpenDataSets,0)
292			end;
293
294			procedure TForm1.EmployeesFULL_NAMEChange(Sender: TField);
295			var I: integer;
296			aText: string;
297			begin
298			aText := Sender.AsString;
299			I := Pos(',',aText);
300			Employees.Edit;
301			if I > 0 then
302			begin
303			EmployeesLAST_NAME.AsString := system.copy(aText,1,I-1);
304			EmployeesFIRST_NAME.AsString := Trim(system.copy(aText,I+1,Length(aText) - I));
305			end
306			else
307			begin
308			EmployeesLAST_NAME.AsString := aText;
309			EmployeesFIRST_NAME.AsString := '!!unknown!!';
310			end;
311			end;
312
313			procedure TForm1.EmployeesJOB_CODEChange(Sender: TField);
314			begin
315			Countries.Active := false;
316			Countries.Active := true;
317			end;
318
319			procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
320			begin
321			JobCodes.Active := false;
322			JobCodes.Active := true;
323			Countries.Active := false;
324			Countries.Active := true;
325			end;
326
327			end.
328