examples/employee/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;

type

  { TForm1 }

  TForm1 = class(TForm)
    DBEdit6: TDBEdit;
    EmployeesDEPT_KEY_PATH: TIBStringField;
    EmployeesDEPT_PATH: TIBStringField;
    IBLookupComboEditBox1: TIBLookupComboEditBox;
    IBLookupComboEditBox2: TIBLookupComboEditBox;
    SelectDept: TAction;
    Button4: TButton;
    Button5: TButton;
    CancelChanges: TAction;
    SalaryRange: TComboBox;
    CountrySource: TDataSource;
    BeforeDate: TDateEdit;
    AfterDate: TDateEdit;
    DeptsSource: TDataSource;
    Depts: TIBQuery;
    JobCodeSource: TDataSource;
    DBEdit1: TDBEdit;
    DBEdit2: TDBEdit;
    DBEdit3: TDBEdit;
    DBEdit4: TDBEdit;
    DBEdit5: TDBEdit;
    DBText1: TDBText;
    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;
    IBDynamicGrid1: TIBDynamicGrid;
    Countries: TIBQuery;
    JobCodes: TIBQuery;
    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;
    TotalsQueryTOTALSALARIES: TIBBCDField;
    TotalsSource: TDataSource;
    TotalsQuery: TIBQuery;
    Label1: TLabel;
    Label2: TLabel;
    SaveChanges: TAction;
    DeleteEmployee: TAction;
    EditEmployee: TAction;
    AddEmployee: TAction;
    ActionList1: TActionList;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    EmployeeSource: TDataSource;
    IBDatabase1: TIBDatabase;
    IBTransaction1: TIBTransaction;
    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 CountriesBeforeOpen(DataSet: TDataSet);
    procedure DeleteEmployeeExecute(Sender: TObject);
    procedure EditEmployeeExecute(Sender: TObject);
    procedure EditEmployeeUpdate(Sender: TObject);
    procedure EmployeesAfterInsert(DataSet: TDataSet);
    procedure EmployeesAfterOpen(DataSet: TDataSet);
    procedure EmployeesAfterScroll(DataSet: TDataSet);
    procedure EmployeesBeforeClose(DataSet: TDataSet);
    procedure EmployeesBeforeOpen(DataSet: TDataSet);
    procedure EmployeesJOB_CODEChange(Sender: TField);
    procedure EmployeesJOB_GRADEChange(Sender: TField);
    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 JobCodesBeforeOpen(DataSet: TDataSet);
    procedure SaveChangesExecute(Sender: TObject);
    procedure SaveChangesUpdate(Sender: TObject);
  private
    { private declarations }
    FDirty: boolean;
    FClosing: boolean;
    procedure Reopen(Data: PtrInt);
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

{$R *.lfm}

uses IB, Unit2;

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.JobCodesBeforeOpen(DataSet: TDataSet);
begin
  JobCodes.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
  JobCodes.ParamByName('JOB_COUNTRY').AsString := EmployeesJOB_COUNTRY.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.Reopen(Data: PtrInt);
begin
  with IBTransaction1 do
    if not InTransaction then StartTransaction;
  Countries.Active := true;
  Employees.Active := true;
  JobCodes.Active := true;
  Depts.Active := true;
end;

procedure TForm1.AddEmployeeExecute(Sender: TObject);
begin
  Employees.Append
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;
    IBDynamicGrid1.ShowEditorPanel;
  end;
end;

procedure TForm1.EmployeesAfterPost(DataSet: TDataSet);
begin
  Employees.Refresh
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.CountriesBeforeOpen(DataSet: TDataSet);
begin
  Countries.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
  Countries.ParamByName('JOB_CODE').AsString := EmployeesJOB_CODE.AsString
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
end;

procedure TForm1.EditEmployeeExecute(Sender: TObject);
begin
  IBDynamicGrid1.ShowEditorPanel;
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
end;

procedure TForm1.EmployeesAfterScroll(DataSet: TDataSet);
begin
  Countries.Active := false;
  JobCodes.Active := false;
  Countries.Active := true;
  JobCodes.Active := true;
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.EmployeesJOB_CODEChange(Sender: TField);
begin
  Countries.Active := false;
  Countries.Active := true;
end;

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