examples/dbcontrolgrid/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, DBGrids,
  StdCtrls, ActnList, EditBtn, DbCtrls, ExtCtrls, Buttons, IBDatabase, IBQuery,
  IBCustomDataSet, IBUpdateSQL, IBDynamicGrid, IBLookupComboEditBox,
  db, DBExtCtrls, DBControlGrid, types;

type

  { TForm1 }

  TForm1 = class(TForm)
    EditLocationAction: TAction;
    EditJobCodeAction: TAction;
    DBEdit6: TDBEdit;
    DBControlGrid1: TDBControlGrid;
    DBEdit7: TDBEdit;
    DBEdit8: TDBEdit;
    DBText1: TDBText;
    EmployeesDEPT_KEY_PATH: TIBStringField;
    EmployeesDEPT_PATH: TIBStringField;
    EmployeesJOB_TITLE: TIBStringField;
    SelectDept: TAction;
    Button4: TButton;
    Button5: TButton;
    CancelChanges: TAction;
    SalaryRange: TComboBox;
    BeforeDate: TDateEdit;
    AfterDate: TDateEdit;
    DBEdit1: TDBEdit;
    DBEdit2: TDBEdit;
    DBEdit3: TDBEdit;
    DBEdit4: TDBEdit;
    DBEdit5: TDBEdit;
    Employees: TIBDataSet;
    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;
    IBDateEdit1: TDBDateEdit;
    JobGradeDBComboBox: TDBComboBox;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Panel1: TPanel;
    Panel2: TPanel;
    EmployeeEditorPanel: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    TotalsQuery: TIBQuery;
    TotalsQueryTOTALSALARIES: TIBBCDField;
    Label1: TLabel;
    Label2: TLabel;
    SaveChanges: TAction;
    DeleteEmployee: TAction;
    EditEmployee: TAction;
    AddEmployee: TAction;
    ActionList1: TActionList;
    Button1: TButton;
    Button3: TButton;
    EmployeeSource: TDataSource;
    IBDatabase1: TIBDatabase;
    IBTransaction1: TIBTransaction;
    TotalsSource: TDataSource;
    procedure EditJobCodeActionExecute(Sender: TObject);
    procedure EditJobCodeActionUpdate(Sender: TObject);
    procedure EditLocationActionExecute(Sender: TObject);
    procedure JobGradeDBComboBoxCloseUp(Sender: TObject);
    procedure SelectDeptExecute(Sender: TObject);
    procedure AddEmployeeExecute(Sender: TObject);
    procedure BeforeDateChange(Sender: TObject);
    procedure CancelChangesExecute(Sender: TObject);
    procedure DeleteEmployeeExecute(Sender: TObject);
    procedure EditEmployeeUpdate(Sender: TObject);
    procedure EmployeesAfterInsert(DataSet: TDataSet);
    procedure EmployeesAfterOpen(DataSet: TDataSet);
    procedure EmployeesBeforeClose(DataSet: TDataSet);
    procedure EmployeesBeforeOpen(DataSet: TDataSet);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure EmployeesAfterDelete(DataSet: TDataSet);
    procedure EmployeesAfterTransactionEnd(Sender: TObject);
    procedure EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
      var DataAction: TDataAction);
    procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
      DisplayText: Boolean);
    procedure SaveChangesExecute(Sender: TObject);
    procedure SaveChangesUpdate(Sender: TObject);
    procedure TotalsQueryTOTALSALARIESGetText(Sender: TField;
      var aText: string; DisplayText: Boolean);
  private
    { private declarations }
    FDirty: boolean;
    FClosing: boolean;
    procedure Reopen(Data: PtrInt);
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

{$R *.lfm}

uses IB, Unit2, Unit4, Unit5;

const sNoName = '<no name>';

function ExtractDBException(msg: string): string;
var Lines: TStringList;
begin
     Lines := TStringList.Create;
     try
       Lines.Text := msg;
       if pos('exception',Lines[0]) = 1 then
         Result := Lines[2]
       else
         Result := msg
     finally
       Lines.Free
     end;
end;

{ TForm1 }

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

procedure TForm1.SaveChangesExecute(Sender: TObject);
begin
  Employees.Transaction.Commit
end;

procedure TForm1.SaveChangesUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := FDirty
end;

procedure TForm1.TotalsQueryTOTALSALARIESGetText(Sender: TField;
  var aText: string; DisplayText: Boolean);
begin
  if DisplayText then
  begin
    if Sender.IsNUll then
      aText := ''
    else
      aText := FormatFloat('Total Salary Bill = $#,##0.00',Sender.AsFloat)
  end
  else
    aText := Sender.AsString
end;

procedure TForm1.Reopen(Data: PtrInt);
begin
  with IBTransaction1 do
    if not InTransaction then StartTransaction;
  Employees.Active := true;
end;

procedure TForm1.AddEmployeeExecute(Sender: TObject);
begin
  Employees.Append;
  DBControlGrid1.SetFocus;
end;

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

procedure TForm1.EditJobCodeActionUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0 )
end;

procedure TForm1.EditLocationActionExecute(Sender: TObject);
var Country: string;
begin
  Country := EmployeesJOB_COUNTRY.AsString;
  if EditLocation.ShowModal(EmployeesJOB_GRADE.AsInteger, EmployeesJOB_CODE.AsString,
     Country) = mrOK then
     begin
       Employees.Edit;
       try
         EmployeesJOB_COUNTRY.AsString := Country;
         Employees.Post;
       except
         Employees.Cancel;
         raise
       end;
     end;
end;

procedure TForm1.EditJobCodeActionExecute(Sender: TObject);
var JobCode: string;
begin
  JobCode := EmployeesJOB_CODE.AsString;
  if EditJobCode.ShowModal(EmployeesJOB_GRADE.AsInteger,EmployeesJOB_COUNTRY.AsString,
    JobCode) = mrOK then
    begin
      Employees.Edit;
      try
        EmployeesJOB_CODE.AsString := JobCode;
        Employees.Post;
      except
        Employees.Cancel;
        raise
      end;
    end;
end;

procedure TForm1.JobGradeDBComboBoxCloseUp(Sender: TObject);
begin
  JobGradeDBComboBox.EditingDone; //See http://bugs.freepascal.org/view.php?id=27186
end;

procedure TForm1.BeforeDateChange(Sender: TObject);
begin
  Employees.Active := false;
  Employees.Active := true
end;

procedure TForm1.CancelChangesExecute(Sender: TObject);
begin
  Employees.Transaction.Rollback
end;

procedure TForm1.DeleteEmployeeExecute(Sender: TObject);
begin
  if MessageDlg(
    Format('Remove %s from Employee List?',[Employees.FieldByName('Full_Name').AsString]),
    mtConfirmation,[mbYes,mbNo],0) = mrYes then
    Employees.Delete;
    DBControlGrid1.SetFocus;
end;

procedure TForm1.EditEmployeeUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0)
end;

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

procedure TForm1.EmployeesAfterOpen(DataSet: TDataSet);
begin
  TotalsQuery.Active := true;
  DBControlGrid1.SetFocus;
end;

procedure TForm1.EmployeesBeforeClose(DataSet: TDataSet);
begin
  TotalsQuery.Active := false
end;

procedure TForm1.EmployeesBeforeOpen(DataSet: TDataSet);
begin
  if BeforeDate.Date <> NullDate then
     (DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE < :BeforeDate');
  if AfterDate.Date <> NullDate then
     (DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE > :AfterDate');

  case SalaryRange.ItemIndex of
  1:
    (DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary < 40000');
  2:
    (DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 40000 and Salary < 100000');
  3:
    (DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 100000');
  end;


  {Parameter value must be set after all SQL changes have been made}
  if BeforeDate.Date <> NullDate then
     (DataSet as TIBParserDataSet).ParamByName('BeforeDate').AsDateTime := BeforeDate.Date;
  if AfterDate.Date <> NullDate then
   (DataSet as TIBParserDataSet).ParamByName('AfterDate').AsDateTime := AfterDate.Date;

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
  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;
  Application.QueueAsyncCall(@Reopen,0);
end;

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

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

procedure TForm1.EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
  var DataAction: TDataAction);
begin
  if E is EIBError then
   begin
       MessageDlg(ExtractDBException(EIBError(E).message),mtError,[mbOK],0);
       DataSet.Cancel;
       DataAction  := daAbort
   end;
end;

end.

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