ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/examples/employee/unit1.pas

Comparing ibx/trunk/examples/employee/unit1.pas (file contents):
Revision 21 by tony, Thu Feb 26 10:33:34 2015 UTC vs.
Revision 66 by tony, Wed Aug 23 08:23:42 2017 UTC

#	Line 1 | Line 1
1	<	unit Unit1;
2	<
3	<	{$mode objfpc}{$H+}
4	<
5	<	interface
6	<
7	<	uses
8	<	Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, DBGrids,
9	<	StdCtrls, ActnList, EditBtn, DbCtrls, ExtCtrls, Buttons, IBDatabase, IBQuery,
10	<	IBCustomDataSet, IBUpdateSQL, IBDynamicGrid, IBLookupComboEditBox,
11	<	db, DBExtCtrls;
12	<
13	<	type
14	<
15	<	{ TForm1 }
16	<
17	<	TForm1 = class(TForm)
18	<	DBEdit6: TDBEdit;
19	<	EmployeesDEPT_KEY_PATH: TIBStringField;
20	<	EmployeesDEPT_PATH: TIBStringField;
21	<	IBLookupComboEditBox1: TIBLookupComboEditBox;
22	<	IBLookupComboEditBox2: TIBLookupComboEditBox;
23	<	SelectDept: TAction;
24	<	Button4: TButton;
25	<	Button5: TButton;
26	<	CancelChanges: TAction;
27	<	SalaryRange: TComboBox;
28	<	CountrySource: TDataSource;
29	<	BeforeDate: TDateEdit;
30	<	AfterDate: TDateEdit;
31	<	DeptsSource: TDataSource;
32	<	Depts: TIBQuery;
33	<	JobCodeSource: TDataSource;
34	<	DBEdit1: TDBEdit;
35	<	DBEdit2: TDBEdit;
36	<	DBEdit3: TDBEdit;
37	<	DBEdit4: TDBEdit;
38	<	DBEdit5: TDBEdit;
39	<	DBText1: TDBText;
40	<	Employees: TIBDataSet;
41	<	EmployeesDEPT_NO: TIBStringField;
42	<	EmployeesEMP_NO: TSmallintField;
43	<	EmployeesFIRST_NAME: TIBStringField;
44	<	EmployeesFULL_NAME: TIBStringField;
45	<	EmployeesHIRE_DATE: TDateTimeField;
46	<	EmployeesJOB_CODE: TIBStringField;
47	<	EmployeesJOB_COUNTRY: TIBStringField;
48	<	EmployeesJOB_GRADE: TSmallintField;
49	<	EmployeesLAST_NAME: TIBStringField;
50	<	EmployeesPHONE_EXT: TIBStringField;
51	<	EmployeesSALARY: TIBBCDField;
52	<	IBDateEdit1: TDBDateEdit;
53	<	IBDynamicGrid1: TIBDynamicGrid;
54	<	Countries: TIBQuery;
55	<	JobCodes: TIBQuery;
56	<	JobGradeDBComboBox: TDBComboBox;
57	<	Label10: TLabel;
58	<	Label11: TLabel;
59	<	Label12: TLabel;
60	<	Label13: TLabel;
61	<	Label3: TLabel;
62	<	Label4: TLabel;
63	<	Label5: TLabel;
64	<	Label6: TLabel;
65	<	Label7: TLabel;
66	<	Label8: TLabel;
67	<	Label9: TLabel;
68	<	Panel1: TPanel;
69	<	Panel2: TPanel;
70	<	EmployeeEditorPanel: TPanel;
71	<	SpeedButton1: TSpeedButton;
72	<	TotalsQueryTOTALSALARIES: TIBBCDField;
73	<	TotalsSource: TDataSource;
74	<	TotalsQuery: TIBQuery;
75	<	Label1: TLabel;
76	<	Label2: TLabel;
77	<	SaveChanges: TAction;
78	<	DeleteEmployee: TAction;
79	<	EditEmployee: TAction;
80	<	AddEmployee: TAction;
81	<	ActionList1: TActionList;
82	<	Button1: TButton;
83	<	Button2: TButton;
84	<	Button3: TButton;
85	<	EmployeeSource: TDataSource;
86	<	IBDatabase1: TIBDatabase;
87	<	IBTransaction1: TIBTransaction;
88	<	procedure EmployeesAfterPost(DataSet: TDataSet);
89	<	procedure JobGradeDBComboBoxCloseUp(Sender: TObject);
90	<	procedure SelectDeptExecute(Sender: TObject);
91	<	procedure AddEmployeeExecute(Sender: TObject);
92	<	procedure BeforeDateChange(Sender: TObject);
93	<	procedure CancelChangesExecute(Sender: TObject);
94	<	procedure CountriesBeforeOpen(DataSet: TDataSet);
95	<	procedure DeleteEmployeeExecute(Sender: TObject);
96	<	procedure EditEmployeeExecute(Sender: TObject);
97	<	procedure EditEmployeeUpdate(Sender: TObject);
98	<	procedure EmployeesAfterInsert(DataSet: TDataSet);
99	<	procedure EmployeesAfterOpen(DataSet: TDataSet);
100	<	procedure EmployeesAfterScroll(DataSet: TDataSet);
101	<	procedure EmployeesBeforeClose(DataSet: TDataSet);
102	<	procedure EmployeesBeforeOpen(DataSet: TDataSet);
103	<	procedure EmployeesJOB_CODEChange(Sender: TField);
104	<	procedure EmployeesJOB_GRADEChange(Sender: TField);
105	<	procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
106	<	procedure FormShow(Sender: TObject);
107	<	procedure EmployeesAfterDelete(DataSet: TDataSet);
108	<	procedure EmployeesAfterTransactionEnd(Sender: TObject);
109	<	procedure EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
110	<	var DataAction: TDataAction);
111	<	procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
112	<	DisplayText: Boolean);
113	<	procedure JobCodesBeforeOpen(DataSet: TDataSet);
114	<	procedure SaveChangesExecute(Sender: TObject);
115	<	procedure SaveChangesUpdate(Sender: TObject);
116	<	private
117	<	{ private declarations }
118	<	FDirty: boolean;
119	<	FClosing: boolean;
120	<	procedure Reopen(Data: PtrInt);
121	<	public
122	<	{ public declarations }
123	<	end;
124	<
125	<	var
126	<	Form1: TForm1;
127	<
128	<	implementation
129	<
130	<	{$R *.lfm}
131	<
132	<	uses IB, Unit2;
133	<
134	<	function ExtractDBException(msg: string): string;
135	<	var Lines: TStringList;
136	<	begin
137	<	Lines := TStringList.Create;
138	<	try
139	<	Lines.Text := msg;
140	<	if pos('exception',Lines[0]) = 1 then
141	<	Result := Lines[2]
142	<	else
143	<	Result := msg
144	<	finally
145	<	Lines.Free
146	<	end;
147	<	end;
148	<
149	<	{ TForm1 }
150	<
151	<	procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
152	<	DisplayText: Boolean);
153	<	begin
154	<	if DisplayText then
155	<	begin
156	<	if Sender.IsNUll then
157	<	aText := ''
158	<	else
159	<	aText := FormatFloat('$#,##0.00',Sender.AsFloat)
160	<	end
161	<	else
162	<	aText := Sender.AsString
163	<	end;
164	<
165	<	procedure TForm1.JobCodesBeforeOpen(DataSet: TDataSet);
166	<	begin
167	<	JobCodes.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
168	<	JobCodes.ParamByName('JOB_COUNTRY').AsString := EmployeesJOB_COUNTRY.AsString
169	<	end;
170	<
171	<	procedure TForm1.SaveChangesExecute(Sender: TObject);
172	<	begin
173	<	Employees.Transaction.Commit
174	<	end;
175	<
176	<	procedure TForm1.SaveChangesUpdate(Sender: TObject);
177	<	begin
178	<	(Sender as TAction).Enabled := FDirty
179	<	end;
180	<
181	<	procedure TForm1.Reopen(Data: PtrInt);
182	<	begin
183	<	with IBTransaction1 do
184	<	if not InTransaction then StartTransaction;
185	<	Countries.Active := true;
186	<	Employees.Active := true;
187	<	JobCodes.Active := true;
188	<	Depts.Active := true;
189	<	end;
190	<
191	<	procedure TForm1.AddEmployeeExecute(Sender: TObject);
192	<	begin
193	<	Employees.Append
194	<	end;
195	<
196	<	procedure TForm1.SelectDeptExecute(Sender: TObject);
197	<	var Dept_No: string;
198	<	begin
199	<	if SelectDeptDlg.ShowModal(EmployeesDEPT_KEY_PATH.AsString,Dept_No) = mrOK then
200	<	begin
201	<	Employees.Edit;
202	<	EmployeesDEPT_NO.AsString := Dept_No;
203	<	try
204	<	Employees.Post;
205	<	except
206	<	Employees.Cancel;
207	<	raise;
208	<	end;
209	<	IBDynamicGrid1.ShowEditorPanel;
210	<	end;
211	<	end;
212	<
213	<	procedure TForm1.EmployeesAfterPost(DataSet: TDataSet);
214	<	begin
215	<	Employees.Refresh
216	<	end;
217	<
218	<	procedure TForm1.JobGradeDBComboBoxCloseUp(Sender: TObject);
219	<	begin
220	<	JobGradeDBComboBox.EditingDone; //See http://bugs.freepascal.org/view.php?id=27186
221	<	end;
222	<
223	<	procedure TForm1.BeforeDateChange(Sender: TObject);
224	<	begin
225	<	Employees.Active := false;
226	<	Employees.Active := true
227	<	end;
228	<
229	<	procedure TForm1.CancelChangesExecute(Sender: TObject);
230	<	begin
231	<	Employees.Transaction.Rollback
232	<	end;
233	<
234	<	procedure TForm1.CountriesBeforeOpen(DataSet: TDataSet);
235	<	begin
236	<	Countries.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
237	<	Countries.ParamByName('JOB_CODE').AsString := EmployeesJOB_CODE.AsString
238	<	end;
239	<
240	<	procedure TForm1.DeleteEmployeeExecute(Sender: TObject);
241	<	begin
242	<	if MessageDlg(
243	<	Format('Remove %s from Employee List?',[Employees.FieldByName('Full_Name').AsString]),
244	<	mtConfirmation,[mbYes,mbNo],0) = mrYes then
245	<	Employees.Delete
246	<	end;
247	<
248	<	procedure TForm1.EditEmployeeExecute(Sender: TObject);
249	<	begin
250	<	IBDynamicGrid1.ShowEditorPanel;
251	<	end;
252	<
253	<	procedure TForm1.EditEmployeeUpdate(Sender: TObject);
254	<	begin
255	<	(Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0)
256	<	end;
257	<
258	<	procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet);
259	<	begin
260	<	EmployeesJOB_COUNTRY.AsString := 'USA';
261	<	EmployeesJOB_CODE.AsString := 'SRep';
262	<	EmployeesJOB_GRADE.AsInteger := 4;
263	<	EmployeesSALARY.AsCurrency := 20000;
264	<	EmployeesFIRST_NAME.AsString := '<no name>';
265	<	EmployeesLAST_NAME.AsString := '<no name>';
266	<	EmployeesHIRE_DATE.AsDateTime := now;
267	<	EmployeesDEPT_NO.AsString := '000';
268	<	FDirty := true;
269	<	end;
270	<
271	<	procedure TForm1.EmployeesAfterOpen(DataSet: TDataSet);
272	<	begin
273	<	TotalsQuery.Active := true
274	<	end;
275	<
276	<	procedure TForm1.EmployeesAfterScroll(DataSet: TDataSet);
277	<	begin
278	<	Countries.Active := false;
279	<	JobCodes.Active := false;
280	<	Countries.Active := true;
281	<	JobCodes.Active := true;
282	<	end;
283	<
284	<	procedure TForm1.EmployeesBeforeClose(DataSet: TDataSet);
285	<	begin
286	<	with DataSet do
287	<	if State in [dsInsert,dsEdit] then
288	<	try
289	<	Post;
290	<	except
291	<	Cancel;
292	<	raise;
293	<	end;
294	<	TotalsQuery.Active := false
295	<	end;
296	<
297	<	procedure TForm1.EmployeesBeforeOpen(DataSet: TDataSet);
298	<	begin
299	<	if BeforeDate.Date > 0 then
300	<	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE < :BeforeDate');
301	<	if AfterDate.Date > 0 then
302	<	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE > :AfterDate');
303	<
304	<	case SalaryRange.ItemIndex of
305	<	1:
306	<	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary < 40000');
307	<	2:
308	<	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 40000 and Salary < 100000');
309	<	3:
310	<	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 100000');
311	<	end;
312	<
313	<
314	<
315	<	{Parameter value must be set after all SQL changes have been made}
316	<	if BeforeDate.Date > 0 then
317	<	(DataSet as TIBParserDataSet).ParamByName('BeforeDate').AsDateTime := BeforeDate.Date;
318	<	if AfterDate.Date > 0 then
319	<	(DataSet as TIBParserDataSet).ParamByName('AfterDate').AsDateTime := AfterDate.Date;
320	<
321	<	end;
322	<
323	<	procedure TForm1.EmployeesJOB_CODEChange(Sender: TField);
324	<	begin
325	<	Countries.Active := false;
326	<	Countries.Active := true;
327	<	end;
328	<
329	<	procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
330	<	begin
331	<	Countries.Active := false;
332	<	JobCodes.Active := false;
333	<	Countries.Active := true;
334	<	JobCodes.Active := true;
335	<	end;
336	<
337	<	procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
338	<	begin
339	<	FClosing := true;
340	<	if IBTransaction1.InTransaction then
341	<	IBTransaction1.Commit;
342	<	end;
343	<
344	<	procedure TForm1.FormShow(Sender: TObject);
345	<	begin
346	<	repeat
347	<	try
348	<	IBDatabase1.Connected := true;
349	<	except
350	<	on E:EIBClientError do
351	<	begin
352	<	Close;
353	<	Exit
354	<	end;
355	<	On E:Exception do
356	<	MessageDlg(E.Message,mtError,[mbOK],0);
357	<	end;
358	<	until IBDatabase1.Connected;
359	<	Reopen(0);
360	<	end;
361	<
362	<	procedure TForm1.EmployeesAfterDelete(DataSet: TDataSet);
363	<	begin
364	<	FDirty := true
365	<	end;
366	<
367	<	procedure TForm1.EmployeesAfterTransactionEnd(Sender: TObject);
368	<	begin
369	<	FDirty := false;
370	<	if not FClosing then
371	<	Application.QueueAsyncCall(@Reopen,0)
372	<	end;
373	<
374	<	procedure TForm1.EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
375	<	var DataAction: TDataAction);
376	<	begin
377	<	if E is EIBError then
378	<	begin
379	<	MessageDlg(ExtractDBException(EIBError(E).message),mtError,[mbOK],0);
380	<	DataSet.Cancel;
381	<	DataAction  := daAbort
382	<	end;
383	<	end;
384	<
385	<	end.
386	<
1	>	unit Unit1;
2	>
3	>	{$mode objfpc}{$H+}
4	>
5	>	interface
6	>
7	>	uses
8	>	Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, DBGrids,
9	>	StdCtrls, ActnList, EditBtn, DbCtrls, ExtCtrls, Buttons, IBDatabase, IBQuery,
10	>	IBCustomDataSet, IBUpdateSQL, IBDynamicGrid, IBLookupComboEditBox,
11	>	db, DBExtCtrls;
12	>
13	>	type
14	>
15	>	{ TForm1 }
16	>
17	>	TForm1 = class(TForm)
18	>	DBEdit6: TDBEdit;
19	>	EmployeesDEPT_KEY_PATH: TIBStringField;
20	>	EmployeesDEPT_PATH: TIBStringField;
21	>	EmployeesTEst: TStringField;
22	>	IBLookupComboEditBox1: TIBLookupComboEditBox;
23	>	IBLookupComboEditBox2: TIBLookupComboEditBox;
24	>	IBQuery1DEPT_NO: TIBStringField;
25	>	IBQuery1EMP_NO: TSmallintField;
26	>	IBQuery1FIRST_NAME: TIBStringField;
27	>	IBQuery1FULL_NAME: TIBStringField;
28	>	IBQuery1HIRE_DATE: TDateTimeField;
29	>	IBQuery1JOB_CODE: TIBStringField;
30	>	IBQuery1JOB_COUNTRY: TIBStringField;
31	>	IBQuery1JOB_GRADE: TSmallintField;
32	>	IBQuery1LAST_NAME: TIBStringField;
33	>	IBQuery1PHONE_EXT: TIBStringField;
34	>	IBQuery1SALARY: TIBBCDField;
35	>	SelectDept: TAction;
36	>	Button4: TButton;
37	>	Button5: TButton;
38	>	CancelChanges: TAction;
39	>	SalaryRange: TComboBox;
40	>	CountrySource: TDataSource;
41	>	BeforeDate: TDateEdit;
42	>	AfterDate: TDateEdit;
43	>	DeptsSource: TDataSource;
44	>	Depts: TIBQuery;
45	>	JobCodeSource: TDataSource;
46	>	DBEdit1: TDBEdit;
47	>	DBEdit2: TDBEdit;
48	>	DBEdit3: TDBEdit;
49	>	DBEdit4: TDBEdit;
50	>	DBEdit5: TDBEdit;
51	>	DBText1: TDBText;
52	>	Employees: TIBDataSet;
53	>	EmployeesDEPT_NO: TIBStringField;
54	>	EmployeesEMP_NO: TSmallintField;
55	>	EmployeesFIRST_NAME: TIBStringField;
56	>	EmployeesFULL_NAME: TIBStringField;
57	>	EmployeesHIRE_DATE: TDateTimeField;
58	>	EmployeesJOB_CODE: TIBStringField;
59	>	EmployeesJOB_COUNTRY: TIBStringField;
60	>	EmployeesJOB_GRADE: TSmallintField;
61	>	EmployeesLAST_NAME: TIBStringField;
62	>	EmployeesPHONE_EXT: TIBStringField;
63	>	EmployeesSALARY: TIBBCDField;
64	>	IBDateEdit1: TDBDateEdit;
65	>	IBDynamicGrid1: TIBDynamicGrid;
66	>	Countries: TIBQuery;
67	>	JobCodes: TIBQuery;
68	>	JobGradeDBComboBox: TDBComboBox;
69	>	Label10: TLabel;
70	>	Label11: TLabel;
71	>	Label12: TLabel;
72	>	Label13: TLabel;
73	>	Label3: TLabel;
74	>	Label4: TLabel;
75	>	Label5: TLabel;
76	>	Label6: TLabel;
77	>	Label7: TLabel;
78	>	Label8: TLabel;
79	>	Label9: TLabel;
80	>	Panel1: TPanel;
81	>	Panel2: TPanel;
82	>	EmployeeEditorPanel: TPanel;
83	>	SpeedButton1: TSpeedButton;
84	>	JobGradeChangeTimer: TTimer;
85	>	JobCodeChangeTimer: TTimer;
86	>	TotalsQueryTOTALSALARIES: TIBBCDField;
87	>	TotalsSource: TDataSource;
88	>	TotalsQuery: TIBQuery;
89	>	Label1: TLabel;
90	>	Label2: TLabel;
91	>	SaveChanges: TAction;
92	>	DeleteEmployee: TAction;
93	>	EditEmployee: TAction;
94	>	AddEmployee: TAction;
95	>	ActionList1: TActionList;
96	>	Button1: TButton;
97	>	Button2: TButton;
98	>	Button3: TButton;
99	>	EmployeeSource: TDataSource;
100	>	IBDatabase1: TIBDatabase;
101	>	IBTransaction1: TIBTransaction;
102	>	procedure EmployeesAfterPost(DataSet: TDataSet);
103	>	procedure EmployeesValidatePost(Sender: TObject; var CancelPost: boolean);
104	>	procedure JobCodeChangeTimerTimer(Sender: TObject);
105	>	procedure JobGradeChangeTimerTimer(Sender: TObject);
106	>	procedure JobGradeDBComboBoxCloseUp(Sender: TObject);
107	>	procedure SelectDeptExecute(Sender: TObject);
108	>	procedure AddEmployeeExecute(Sender: TObject);
109	>	procedure BeforeDateChange(Sender: TObject);
110	>	procedure CancelChangesExecute(Sender: TObject);
111	>	procedure CountriesBeforeOpen(DataSet: TDataSet);
112	>	procedure DeleteEmployeeExecute(Sender: TObject);
113	>	procedure EditEmployeeExecute(Sender: TObject);
114	>	procedure EditEmployeeUpdate(Sender: TObject);
115	>	procedure EmployeesAfterInsert(DataSet: TDataSet);
116	>	procedure EmployeesAfterOpen(DataSet: TDataSet);
117	>	procedure EmployeesAfterScroll(DataSet: TDataSet);
118	>	procedure EmployeesBeforeClose(DataSet: TDataSet);
119	>	procedure EmployeesBeforeOpen(DataSet: TDataSet);
120	>	procedure EmployeesJOB_CODEChange(Sender: TField);
121	>	procedure EmployeesJOB_GRADEChange(Sender: TField);
122	>	procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
123	>	procedure FormShow(Sender: TObject);
124	>	procedure EmployeesAfterDelete(DataSet: TDataSet);
125	>	procedure EmployeesAfterTransactionEnd(Sender: TObject);
126	>	procedure EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
127	>	var DataAction: TDataAction);
128	>	procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
129	>	DisplayText: Boolean);
130	>	procedure JobCodesBeforeOpen(DataSet: TDataSet);
131	>	procedure SaveChangesExecute(Sender: TObject);
132	>	procedure SaveChangesUpdate(Sender: TObject);
133	>	private
134	>	{ private declarations }
135	>	FDirty: boolean;
136	>	FClosing: boolean;
137	>	procedure Reopen(Data: PtrInt);
138	>	public
139	>	{ public declarations }
140	>	end;
141	>
142	>	var
143	>	Form1: TForm1;
144	>
145	>	implementation
146	>
147	>	{$R *.lfm}
148	>
149	>	uses IB, Unit2;
150	>
151	>	const
152	>	sNoName = '<no name>';
153	>
154	>	function ExtractDBException(msg: string): string;
155	>	var Lines: TStringList;
156	>	begin
157	>	Lines := TStringList.Create;
158	>	try
159	>	Lines.Text := msg;
160	>	if pos('exception',Lines[0]) = 1 then
161	>	Result := Lines[2]
162	>	else
163	>	Result := msg
164	>	finally
165	>	Lines.Free
166	>	end;
167	>	end;
168	>
169	>	{ TForm1 }
170	>
171	>	procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
172	>	DisplayText: Boolean);
173	>	begin
174	>	if DisplayText then
175	>	begin
176	>	if Sender.IsNUll then
177	>	aText := ''
178	>	else
179	>	aText := FormatFloat('$#,##0.00',Sender.AsFloat)
180	>	end
181	>	else
182	>	aText := Sender.AsString
183	>	end;
184	>
185	>	procedure TForm1.JobCodesBeforeOpen(DataSet: TDataSet);
186	>	begin
187	>	JobCodes.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
188	>	JobCodes.ParamByName('JOB_COUNTRY').AsString := EmployeesJOB_COUNTRY.AsString
189	>	end;
190	>
191	>	procedure TForm1.SaveChangesExecute(Sender: TObject);
192	>	begin
193	>	Employees.Transaction.Commit
194	>	end;
195	>
196	>	procedure TForm1.SaveChangesUpdate(Sender: TObject);
197	>	begin
198	>	(Sender as TAction).Enabled := FDirty
199	>	end;
200	>
201	>	procedure TForm1.Reopen(Data: PtrInt);
202	>	begin
203	>	with IBTransaction1 do
204	>	if not InTransaction then StartTransaction;
205	>	Countries.Active := true;
206	>	Employees.Active := true;
207	>	JobCodes.Active := true;
208	>	Depts.Active := true;
209	>	end;
210	>
211	>	procedure TForm1.AddEmployeeExecute(Sender: TObject);
212	>	begin
213	>	Employees.Append
214	>	end;
215	>
216	>	procedure TForm1.SelectDeptExecute(Sender: TObject);
217	>	var Dept_No: string;
218	>	begin
219	>	if SelectDeptDlg.ShowModal(EmployeesDEPT_KEY_PATH.AsString,Dept_No) = mrOK then
220	>	begin
221	>	Employees.Edit;
222	>	EmployeesDEPT_NO.AsString := Dept_No;
223	>	try
224	>	Employees.Post;
225	>	except
226	>	Employees.Cancel;
227	>	raise;
228	>	end;
229	>	IBDynamicGrid1.ShowEditorPanel;
230	>	end;
231	>	end;
232	>
233	>	procedure TForm1.EmployeesAfterPost(DataSet: TDataSet);
234	>	begin
235	>	Employees.Refresh
236	>	end;
237	>
238	>	procedure TForm1.EmployeesValidatePost(Sender: TObject; var CancelPost: boolean
239	>	);
240	>	begin
241	>	{Cancel if no name entered}
242	>	CancelPost := (EmployeesLAST_NAME.AsString = sNoName) and  (EmployeesFIRST_NAME.AsString = sNoName);
243	>	end;
244	>
245	>	procedure TForm1.JobCodeChangeTimerTimer(Sender: TObject);
246	>	begin
247	>	Countries.Active := false;
248	>	Countries.Active := true;
249	>	JobCodeChangeTimer.Interval := 0;
250	>	end;
251	>
252	>	procedure TForm1.JobGradeChangeTimerTimer(Sender: TObject);
253	>	begin
254	>	Countries.Active := false;
255	>	JobCodes.Active := false;
256	>	Countries.Active := true;
257	>	JobCodes.Active := true;
258	>	JobGradeChangeTimer.Interval := 0;
259	>	end;
260	>
261	>	procedure TForm1.JobGradeDBComboBoxCloseUp(Sender: TObject);
262	>	begin
263	>	JobGradeDBComboBox.EditingDone; //See http://bugs.freepascal.org/view.php?id=27186
264	>	end;
265	>
266	>	procedure TForm1.BeforeDateChange(Sender: TObject);
267	>	begin
268	>	Employees.Active := false;
269	>	Employees.Active := true
270	>	end;
271	>
272	>	procedure TForm1.CancelChangesExecute(Sender: TObject);
273	>	begin
274	>	Employees.Transaction.Rollback
275	>	end;
276	>
277	>	procedure TForm1.CountriesBeforeOpen(DataSet: TDataSet);
278	>	begin
279	>	Countries.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
280	>	Countries.ParamByName('JOB_CODE').AsString := EmployeesJOB_CODE.AsString
281	>	end;
282	>
283	>	procedure TForm1.DeleteEmployeeExecute(Sender: TObject);
284	>	begin
285	>	if MessageDlg(
286	>	Format('Remove %s from Employee List?',[Employees.FieldByName('Full_Name').AsString]),
287	>	mtConfirmation,[mbYes,mbNo],0) = mrYes then
288	>	Employees.Delete
289	>	end;
290	>
291	>	procedure TForm1.EditEmployeeExecute(Sender: TObject);
292	>	begin
293	>	IBDynamicGrid1.ShowEditorPanel;
294	>	end;
295	>
296	>	procedure TForm1.EditEmployeeUpdate(Sender: TObject);
297	>	begin
298	>	(Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0)
299	>	end;
300	>
301	>	procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet);
302	>	begin
303	>	EmployeesJOB_COUNTRY.AsString := 'USA';
304	>	EmployeesJOB_CODE.AsString := 'SRep';
305	>	EmployeesJOB_GRADE.AsInteger := 4;
306	>	EmployeesSALARY.AsCurrency := 20000;
307	>	EmployeesFIRST_NAME.AsString := sNoName;
308	>	EmployeesLAST_NAME.AsString := sNoName;
309	>	EmployeesHIRE_DATE.AsDateTime := now;
310	>	EmployeesDEPT_NO.AsString := '000';
311	>	FDirty := true;
312	>	end;
313	>
314	>	procedure TForm1.EmployeesAfterOpen(DataSet: TDataSet);
315	>	begin
316	>	TotalsQuery.Active := true;
317	>	IBDynamicGrid1.SetFocus;
318	>	end;
319	>
320	>	procedure TForm1.EmployeesAfterScroll(DataSet: TDataSet);
321	>	begin
322	>	JobGradeChangeTimer.Interval := 200;
323	>	end;
324	>
325	>	procedure TForm1.EmployeesBeforeClose(DataSet: TDataSet);
326	>	begin
327	>	TotalsQuery.Active := false
328	>	end;
329	>
330	>	procedure TForm1.EmployeesBeforeOpen(DataSet: TDataSet);
331	>	begin
332	>	if BeforeDate.Date > 0 then
333	>	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE < :BeforeDate');
334	>	if AfterDate.Date > 0 then
335	>	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE > :AfterDate');
336	>
337	>	case SalaryRange.ItemIndex of
338	>	1:
339	>	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary < 40000');
340	>	2:
341	>	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 40000 and Salary < 100000');
342	>	3:
343	>	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 100000');
344	>	end;
345	>
346	>
347	>
348	>	{Parameter value must be set after all SQL changes have been made}
349	>	if BeforeDate.Date > 0 then
350	>	(DataSet as TIBParserDataSet).ParamByName('BeforeDate').AsDateTime := BeforeDate.Date;
351	>	if AfterDate.Date > 0 then
352	>	(DataSet as TIBParserDataSet).ParamByName('AfterDate').AsDateTime := AfterDate.Date;
353	>
354	>	end;
355	>
356	>	procedure TForm1.EmployeesJOB_CODEChange(Sender: TField);
357	>	begin
358	>	JobCodeChangeTimer.Interval := 200;
359	>	end;
360	>
361	>	procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
362	>	begin
363	>	JobGradeChangeTimer.Interval := 200;
364	>	end;
365	>
366	>	procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
367	>	begin
368	>	FClosing := true;
369	>	if IBTransaction1.InTransaction then
370	>	IBTransaction1.Commit;
371	>	end;
372	>
373	>	procedure TForm1.FormShow(Sender: TObject);
374	>	begin
375	>	repeat
376	>	try
377	>	IBDatabase1.Connected := true;
378	>	except
379	>	on E:EIBClientError do
380	>	begin
381	>	Close;
382	>	Exit
383	>	end;
384	>	On E:Exception do
385	>	MessageDlg(E.Message,mtError,[mbOK],0);
386	>	end;
387	>	until IBDatabase1.Connected;
388	>	Reopen(0);
389	>	end;
390	>
391	>	procedure TForm1.EmployeesAfterDelete(DataSet: TDataSet);
392	>	begin
393	>	FDirty := true
394	>	end;
395	>
396	>	procedure TForm1.EmployeesAfterTransactionEnd(Sender: TObject);
397	>	begin
398	>	FDirty := false;
399	>	if not FClosing then
400	>	Application.QueueAsyncCall(@Reopen,0)
401	>	end;
402	>
403	>	procedure TForm1.EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
404	>	var DataAction: TDataAction);
405	>	begin
406	>	if E is EIBError then
407	>	begin
408	>	MessageDlg(ExtractDBException(EIBError(E).message),mtError,[mbOK],0);
409	>	DataSet.Cancel;
410	>	DataAction  := daAbort
411	>	end;
412	>	end;
413	>
414	>	end.
415	>

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines