examples/dbcontrolgrid/unit1.pas

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;

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