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
#	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 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	tony	27	const sNoName = '<no name>';
158
159	tony	23	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	tony	27	EmployeesFIRST_NAME.AsString := sNoName;
326			EmployeesLAST_NAME.AsString := sNoName;
327	tony	23	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	tony	45	Application.QueueAsyncCall(@Reopen,0);
392	tony	23	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