examples/lookupcombobox/Unit1.pas

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