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;
    IBQuery1DEPT_NO: TIBStringField;
    IBQuery1EMP_NO: TSmallintField;
    IBQuery1FIRST_NAME: TIBStringField;
    IBQuery1FULL_NAME: TIBStringField;
    IBQuery1HIRE_DATE: TDateTimeField;
    IBQuery1JOB_CODE: TIBStringField;
    IBQuery1JOB_COUNTRY: TIBStringField;
    IBQuery1JOB_GRADE: TSmallintField;
    IBQuery1LAST_NAME: TIBStringField;
    IBQuery1PHONE_EXT: TIBStringField;
    IBQuery1SALARY: TIBBCDField;
    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 EmployeesValidatePost(Sender: TObject; var CancelPost: boolean);
    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;

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