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
#	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	23	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	tony	27	const sNoName = '<no name>';
157
158	tony	23	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	tony	410	Employees.DisableControls;
232			try
233	tony	23	Employees.Edit;
234			EmployeesDEPT_NO.AsString := Dept_No;
235			try
236			Employees.Post;
237			except
238			Employees.Cancel;
239			raise;
240			end;
241	tony	410	finally
242			Employees.EnableControls
243			end;
244	tony	23	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	tony	27	EmployeesFIRST_NAME.AsString := sNoName;
325			EmployeesLAST_NAME.AsString := sNoName;
326	tony	23	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	tony	421	if BeforeDate.Date <> NullDate then
345	tony	23	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE < :BeforeDate');
346	tony	421	if AfterDate.Date <> NullDate then
347	tony	23	(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	tony	421	if BeforeDate.Date <> NullDate then
362	tony	23	(DataSet as TIBParserDataSet).ParamByName('BeforeDate').AsDateTime := BeforeDate.Date;
363	tony	421	if AfterDate.Date <> NullDate then
364	tony	23	(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	tony	45	Application.QueueAsyncCall(@Reopen,0);
391	tony	23	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