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 EmployeesAfterPost(DataSet: TDataSet);
    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.Edit;
    EmployeesDEPT_NO.AsString := Dept_No;
    try
      Employees.Post;
    except
      Employees.Cancel;
      raise;
    end;
  end;
end;

procedure TForm1.EmployeesAfterPost(DataSet: TDataSet);
begin
  Employees.Refresh
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 > 0 then
     (DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE < :BeforeDate');
  if AfterDate.Date > 0 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 > 0 then
     (DataSet as TIBParserDataSet).ParamByName('BeforeDate').AsDateTime := BeforeDate.Date;
  if AfterDate.Date > 0 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:	143
Committed:	Fri Feb 23 12:11:21 2018 UTC (6 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	11164 byte(s)
Log Message:	Fixes 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 EmployeesAfterPost(DataSet: TDataSet);
116	procedure JobGradeDBComboBoxCloseUp(Sender: TObject);
117	procedure SelectDeptExecute(Sender: TObject);
118	procedure AddEmployeeExecute(Sender: TObject);
119	procedure BeforeDateChange(Sender: TObject);
120	procedure CancelChangesExecute(Sender: TObject);
121	procedure DeleteEmployeeExecute(Sender: TObject);
122	procedure EditEmployeeUpdate(Sender: TObject);
123	procedure EmployeesAfterInsert(DataSet: TDataSet);
124	procedure EmployeesAfterOpen(DataSet: TDataSet);
125	procedure EmployeesBeforeClose(DataSet: TDataSet);
126	procedure EmployeesBeforeOpen(DataSet: TDataSet);
127	procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
128	procedure FormShow(Sender: TObject);
129	procedure EmployeesAfterDelete(DataSet: TDataSet);
130	procedure EmployeesAfterTransactionEnd(Sender: TObject);
131	procedure EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
132	var DataAction: TDataAction);
133	procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
134	DisplayText: Boolean);
135	procedure SaveChangesExecute(Sender: TObject);
136	procedure SaveChangesUpdate(Sender: TObject);
137	procedure TotalsQueryTOTALSALARIESGetText(Sender: TField;
138	var aText: string; DisplayText: Boolean);
139	private
140	{ private declarations }
141	FDirty: boolean;
142	FClosing: boolean;
143	procedure Reopen(Data: PtrInt);
144	public
145	{ public declarations }
146	end;
147
148	var
149	Form1: TForm1;
150
151	implementation
152
153	{$R *.lfm}
154
155	uses IB, Unit2, Unit4, Unit5;
156
157	const sNoName = '<no name>';
158
159	function ExtractDBException(msg: string): string;
160	var Lines: TStringList;
161	begin
162	Lines := TStringList.Create;
163	try
164	Lines.Text := msg;
165	if pos('exception',Lines[0]) = 1 then
166	Result := Lines[2]
167	else
168	Result := msg
169	finally
170	Lines.Free
171	end;
172	end;
173
174	{ TForm1 }
175
176	procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
177	DisplayText: Boolean);
178	begin
179	if DisplayText then
180	begin
181	if Sender.IsNUll then
182	aText := ''
183	else
184	aText := FormatFloat('$#,##0.00',Sender.AsFloat)
185	end
186	else
187	aText := Sender.AsString
188	end;
189
190	procedure TForm1.SaveChangesExecute(Sender: TObject);
191	begin
192	Employees.Transaction.Commit
193	end;
194
195	procedure TForm1.SaveChangesUpdate(Sender: TObject);
196	begin
197	(Sender as TAction).Enabled := FDirty
198	end;
199
200	procedure TForm1.TotalsQueryTOTALSALARIESGetText(Sender: TField;
201	var aText: string; DisplayText: Boolean);
202	begin
203	if DisplayText then
204	begin
205	if Sender.IsNUll then
206	aText := ''
207	else
208	aText := FormatFloat('Total Salary Bill = $#,##0.00',Sender.AsFloat)
209	end
210	else
211	aText := Sender.AsString
212	end;
213
214	procedure TForm1.Reopen(Data: PtrInt);
215	begin
216	with IBTransaction1 do
217	if not InTransaction then StartTransaction;
218	Employees.Active := true;
219	end;
220
221	procedure TForm1.AddEmployeeExecute(Sender: TObject);
222	begin
223	Employees.Append;
224	DBControlGrid1.SetFocus;
225	end;
226
227	procedure TForm1.SelectDeptExecute(Sender: TObject);
228	var Dept_No: string;
229	begin
230	if SelectDeptDlg.ShowModal(EmployeesDEPT_KEY_PATH.AsString,Dept_No) = mrOK then
231	begin
232	Employees.Edit;
233	EmployeesDEPT_NO.AsString := Dept_No;
234	try
235	Employees.Post;
236	except
237	Employees.Cancel;
238	raise;
239	end;
240	end;
241	end;
242
243	procedure TForm1.EmployeesAfterPost(DataSet: TDataSet);
244	begin
245	Employees.Refresh
246	end;
247
248	procedure TForm1.EditJobCodeActionUpdate(Sender: TObject);
249	begin
250	(Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0 )
251	end;
252
253	procedure TForm1.EditLocationActionExecute(Sender: TObject);
254	var Country: string;
255	begin
256	Country := EmployeesJOB_COUNTRY.AsString;
257	if EditLocation.ShowModal(EmployeesJOB_GRADE.AsInteger, EmployeesJOB_CODE.AsString,
258	Country) = mrOK then
259	begin
260	Employees.Edit;
261	try
262	EmployeesJOB_COUNTRY.AsString := Country;
263	Employees.Post;
264	except
265	Employees.Cancel;
266	raise
267	end;
268	end;
269	end;
270
271	procedure TForm1.EditJobCodeActionExecute(Sender: TObject);
272	var JobCode: string;
273	begin
274	JobCode := EmployeesJOB_CODE.AsString;
275	if EditJobCode.ShowModal(EmployeesJOB_GRADE.AsInteger,EmployeesJOB_COUNTRY.AsString,
276	JobCode) = mrOK then
277	begin
278	Employees.Edit;
279	try
280	EmployeesJOB_CODE.AsString := JobCode;
281	Employees.Post;
282	except
283	Employees.Cancel;
284	raise
285	end;
286	end;
287	end;
288
289	procedure TForm1.JobGradeDBComboBoxCloseUp(Sender: TObject);
290	begin
291	JobGradeDBComboBox.EditingDone; //See http://bugs.freepascal.org/view.php?id=27186
292	end;
293
294	procedure TForm1.BeforeDateChange(Sender: TObject);
295	begin
296	Employees.Active := false;
297	Employees.Active := true
298	end;
299
300	procedure TForm1.CancelChangesExecute(Sender: TObject);
301	begin
302	Employees.Transaction.Rollback
303	end;
304
305	procedure TForm1.DeleteEmployeeExecute(Sender: TObject);
306	begin
307	if MessageDlg(
308	Format('Remove %s from Employee List?',[Employees.FieldByName('Full_Name').AsString]),
309	mtConfirmation,[mbYes,mbNo],0) = mrYes then
310	Employees.Delete;
311	DBControlGrid1.SetFocus;
312	end;
313
314	procedure TForm1.EditEmployeeUpdate(Sender: TObject);
315	begin
316	(Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0)
317	end;
318
319	procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet);
320	begin
321	EmployeesJOB_COUNTRY.AsString := 'USA';
322	EmployeesJOB_CODE.AsString := 'SRep';
323	EmployeesJOB_GRADE.AsInteger := 4;
324	EmployeesSALARY.AsCurrency := 20000;
325	EmployeesFIRST_NAME.AsString := sNoName;
326	EmployeesLAST_NAME.AsString := sNoName;
327	EmployeesHIRE_DATE.AsDateTime := now;
328	EmployeesDEPT_NO.AsString := '000';
329	FDirty := true;
330	end;
331
332	procedure TForm1.EmployeesAfterOpen(DataSet: TDataSet);
333	begin
334	TotalsQuery.Active := true;
335	DBControlGrid1.SetFocus;
336	end;
337
338	procedure TForm1.EmployeesBeforeClose(DataSet: TDataSet);
339	begin
340	TotalsQuery.Active := false
341	end;
342
343	procedure TForm1.EmployeesBeforeOpen(DataSet: TDataSet);
344	begin
345	if BeforeDate.Date > 0 then
346	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE < :BeforeDate');
347	if AfterDate.Date > 0 then
348	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE > :AfterDate');
349
350	case SalaryRange.ItemIndex of
351	1:
352	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary < 40000');
353	2:
354	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 40000 and Salary < 100000');
355	3:
356	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 100000');
357	end;
358
359
360
361	{Parameter value must be set after all SQL changes have been made}
362	if BeforeDate.Date > 0 then
363	(DataSet as TIBParserDataSet).ParamByName('BeforeDate').AsDateTime := BeforeDate.Date;
364	if AfterDate.Date > 0 then
365	(DataSet as TIBParserDataSet).ParamByName('AfterDate').AsDateTime := AfterDate.Date;
366
367	end;
368
369	procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
370	begin
371	FClosing := true;
372	if IBTransaction1.InTransaction then
373	IBTransaction1.Commit;
374	end;
375
376	procedure TForm1.FormShow(Sender: TObject);
377	begin
378	repeat
379	try
380	IBDatabase1.Connected := true;
381	except
382	on E:EIBClientError do
383	begin
384	Close;
385	Exit
386	end;
387	On E:Exception do
388	MessageDlg(E.Message,mtError,[mbOK],0);
389	end;
390	until IBDatabase1.Connected;
391	Application.QueueAsyncCall(@Reopen,0);
392	end;
393
394	procedure TForm1.EmployeesAfterDelete(DataSet: TDataSet);
395	begin
396	FDirty := true
397	end;
398
399	procedure TForm1.EmployeesAfterTransactionEnd(Sender: TObject);
400	begin
401	FDirty := false;
402	if not FClosing then
403	Application.QueueAsyncCall(@Reopen,0)
404	end;
405
406	procedure TForm1.EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
407	var DataAction: TDataAction);
408	begin
409	if E is EIBError then
410	begin
411	MessageDlg(ExtractDBException(EIBError(E).message),mtError,[mbOK],0);
412	DataSet.Cancel;
413	DataAction := daAbort
414	end;
415	end;
416
417	end.
418