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;
    JobGradeChangeTimer: TTimer;
    JobCodeChangeTimer: TTimer;
    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 JobCodeChangeTimerTimer(Sender: TObject);
    procedure JobGradeChangeTimerTimer(Sender: TObject);
    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.JobCodeChangeTimerTimer(Sender: TObject);
begin
  Countries.Active := false;
  Countries.Active := true;
  JobCodeChangeTimer.Interval := 0;
end;

procedure TForm1.JobGradeChangeTimerTimer(Sender: TObject);
begin
  Countries.Active := false;
  JobCodes.Active := false;
  Countries.Active := true;
  JobCodes.Active := true;
  JobGradeChangeTimer.Interval := 0;
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
  JobGradeChangeTimer.Interval := 200;
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
  JobCodeChangeTimer.Interval := 200;
end;

procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
begin
  JobGradeChangeTimer.Interval := 200;
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:	33
Committed:	Sat Jul 18 12:30:52 2015 UTC (8 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	11231 byte(s)
Log Message:	Committing updates for Release R1-3-1
#	Content
1	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;
12
13	type
14
15	{ TForm1 }
16
17	TForm1 = class(TForm)
18	DBEdit6: TDBEdit;
19	EmployeesDEPT_KEY_PATH: TIBStringField;
20	EmployeesDEPT_PATH: TIBStringField;
21	IBLookupComboEditBox1: TIBLookupComboEditBox;
22	IBLookupComboEditBox2: TIBLookupComboEditBox;
23	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	SelectDept: TAction;
35	Button4: TButton;
36	Button5: TButton;
37	CancelChanges: TAction;
38	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	JobGradeChangeTimer: TTimer;
84	JobCodeChangeTimer: TTimer;
85	TotalsQueryTOTALSALARIES: TIBBCDField;
86	TotalsSource: TDataSource;
87	TotalsQuery: TIBQuery;
88	Label1: TLabel;
89	Label2: TLabel;
90	SaveChanges: TAction;
91	DeleteEmployee: TAction;
92	EditEmployee: TAction;
93	AddEmployee: TAction;
94	ActionList1: TActionList;
95	Button1: TButton;
96	Button2: TButton;
97	Button3: TButton;
98	EmployeeSource: TDataSource;
99	IBDatabase1: TIBDatabase;
100	IBTransaction1: TIBTransaction;
101	procedure EmployeesAfterPost(DataSet: TDataSet);
102	procedure EmployeesValidatePost(Sender: TObject; var CancelPost: boolean);
103	procedure JobCodeChangeTimerTimer(Sender: TObject);
104	procedure JobGradeChangeTimerTimer(Sender: TObject);
105	procedure JobGradeDBComboBoxCloseUp(Sender: TObject);
106	procedure SelectDeptExecute(Sender: TObject);
107	procedure AddEmployeeExecute(Sender: TObject);
108	procedure BeforeDateChange(Sender: TObject);
109	procedure CancelChangesExecute(Sender: TObject);
110	procedure CountriesBeforeOpen(DataSet: TDataSet);
111	procedure DeleteEmployeeExecute(Sender: TObject);
112	procedure EditEmployeeExecute(Sender: TObject);
113	procedure EditEmployeeUpdate(Sender: TObject);
114	procedure EmployeesAfterInsert(DataSet: TDataSet);
115	procedure EmployeesAfterOpen(DataSet: TDataSet);
116	procedure EmployeesAfterScroll(DataSet: TDataSet);
117	procedure EmployeesBeforeClose(DataSet: TDataSet);
118	procedure EmployeesBeforeOpen(DataSet: TDataSet);
119	procedure EmployeesJOB_CODEChange(Sender: TField);
120	procedure EmployeesJOB_GRADEChange(Sender: TField);
121	procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
122	procedure FormShow(Sender: TObject);
123	procedure EmployeesAfterDelete(DataSet: TDataSet);
124	procedure EmployeesAfterTransactionEnd(Sender: TObject);
125	procedure EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
126	var DataAction: TDataAction);
127	procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
128	DisplayText: Boolean);
129	procedure JobCodesBeforeOpen(DataSet: TDataSet);
130	procedure SaveChangesExecute(Sender: TObject);
131	procedure SaveChangesUpdate(Sender: TObject);
132	private
133	{ private declarations }
134	FDirty: boolean;
135	FClosing: boolean;
136	procedure Reopen(Data: PtrInt);
137	public
138	{ public declarations }
139	end;
140
141	var
142	Form1: TForm1;
143
144	implementation
145
146	{$R *.lfm}
147
148	uses IB, Unit2;
149
150	const
151	sNoName = '<no name>';
152
153	function ExtractDBException(msg: string): string;
154	var Lines: TStringList;
155	begin
156	Lines := TStringList.Create;
157	try
158	Lines.Text := msg;
159	if pos('exception',Lines[0]) = 1 then
160	Result := Lines[2]
161	else
162	Result := msg
163	finally
164	Lines.Free
165	end;
166	end;
167
168	{ TForm1 }
169
170	procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
171	DisplayText: Boolean);
172	begin
173	if DisplayText then
174	begin
175	if Sender.IsNUll then
176	aText := ''
177	else
178	aText := FormatFloat('$#,##0.00',Sender.AsFloat)
179	end
180	else
181	aText := Sender.AsString
182	end;
183
184	procedure TForm1.JobCodesBeforeOpen(DataSet: TDataSet);
185	begin
186	JobCodes.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
187	JobCodes.ParamByName('JOB_COUNTRY').AsString := EmployeesJOB_COUNTRY.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.Reopen(Data: PtrInt);
201	begin
202	with IBTransaction1 do
203	if not InTransaction then StartTransaction;
204	Countries.Active := true;
205	Employees.Active := true;
206	JobCodes.Active := true;
207	Depts.Active := true;
208	end;
209
210	procedure TForm1.AddEmployeeExecute(Sender: TObject);
211	begin
212	Employees.Append
213	end;
214
215	procedure TForm1.SelectDeptExecute(Sender: TObject);
216	var Dept_No: string;
217	begin
218	if SelectDeptDlg.ShowModal(EmployeesDEPT_KEY_PATH.AsString,Dept_No) = mrOK then
219	begin
220	Employees.Edit;
221	EmployeesDEPT_NO.AsString := Dept_No;
222	try
223	Employees.Post;
224	except
225	Employees.Cancel;
226	raise;
227	end;
228	IBDynamicGrid1.ShowEditorPanel;
229	end;
230	end;
231
232	procedure TForm1.EmployeesAfterPost(DataSet: TDataSet);
233	begin
234	Employees.Refresh
235	end;
236
237	procedure TForm1.EmployeesValidatePost(Sender: TObject; var CancelPost: boolean
238	);
239	begin
240	{Cancel if no name entered}
241	CancelPost := (EmployeesLAST_NAME.AsString = sNoName) and (EmployeesFIRST_NAME.AsString = sNoName);
242	end;
243
244	procedure TForm1.JobCodeChangeTimerTimer(Sender: TObject);
245	begin
246	Countries.Active := false;
247	Countries.Active := true;
248	JobCodeChangeTimer.Interval := 0;
249	end;
250
251	procedure TForm1.JobGradeChangeTimerTimer(Sender: TObject);
252	begin
253	Countries.Active := false;
254	JobCodes.Active := false;
255	Countries.Active := true;
256	JobCodes.Active := true;
257	JobGradeChangeTimer.Interval := 0;
258	end;
259
260	procedure TForm1.JobGradeDBComboBoxCloseUp(Sender: TObject);
261	begin
262	JobGradeDBComboBox.EditingDone; //See http://bugs.freepascal.org/view.php?id=27186
263	end;
264
265	procedure TForm1.BeforeDateChange(Sender: TObject);
266	begin
267	Employees.Active := false;
268	Employees.Active := true
269	end;
270
271	procedure TForm1.CancelChangesExecute(Sender: TObject);
272	begin
273	Employees.Transaction.Rollback
274	end;
275
276	procedure TForm1.CountriesBeforeOpen(DataSet: TDataSet);
277	begin
278	Countries.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
279	Countries.ParamByName('JOB_CODE').AsString := EmployeesJOB_CODE.AsString
280	end;
281
282	procedure TForm1.DeleteEmployeeExecute(Sender: TObject);
283	begin
284	if MessageDlg(
285	Format('Remove %s from Employee List?',[Employees.FieldByName('Full_Name').AsString]),
286	mtConfirmation,[mbYes,mbNo],0) = mrYes then
287	Employees.Delete
288	end;
289
290	procedure TForm1.EditEmployeeExecute(Sender: TObject);
291	begin
292	IBDynamicGrid1.ShowEditorPanel;
293	end;
294
295	procedure TForm1.EditEmployeeUpdate(Sender: TObject);
296	begin
297	(Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0)
298	end;
299
300	procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet);
301	begin
302	EmployeesJOB_COUNTRY.AsString := 'USA';
303	EmployeesJOB_CODE.AsString := 'SRep';
304	EmployeesJOB_GRADE.AsInteger := 4;
305	EmployeesSALARY.AsCurrency := 20000;
306	EmployeesFIRST_NAME.AsString := sNoName;
307	EmployeesLAST_NAME.AsString := sNoName;
308	EmployeesHIRE_DATE.AsDateTime := now;
309	EmployeesDEPT_NO.AsString := '000';
310	FDirty := true;
311	end;
312
313	procedure TForm1.EmployeesAfterOpen(DataSet: TDataSet);
314	begin
315	TotalsQuery.Active := true;
316	IBDynamicGrid1.SetFocus;
317	end;
318
319	procedure TForm1.EmployeesAfterScroll(DataSet: TDataSet);
320	begin
321	JobGradeChangeTimer.Interval := 200;
322	end;
323
324	procedure TForm1.EmployeesBeforeClose(DataSet: TDataSet);
325	begin
326	TotalsQuery.Active := false
327	end;
328
329	procedure TForm1.EmployeesBeforeOpen(DataSet: TDataSet);
330	begin
331	if BeforeDate.Date > 0 then
332	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE < :BeforeDate');
333	if AfterDate.Date > 0 then
334	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE > :AfterDate');
335
336	case SalaryRange.ItemIndex of
337	1:
338	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary < 40000');
339	2:
340	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 40000 and Salary < 100000');
341	3:
342	(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 100000');
343	end;
344
345
346
347	{Parameter value must be set after all SQL changes have been made}
348	if BeforeDate.Date > 0 then
349	(DataSet as TIBParserDataSet).ParamByName('BeforeDate').AsDateTime := BeforeDate.Date;
350	if AfterDate.Date > 0 then
351	(DataSet as TIBParserDataSet).ParamByName('AfterDate').AsDateTime := AfterDate.Date;
352
353	end;
354
355	procedure TForm1.EmployeesJOB_CODEChange(Sender: TField);
356	begin
357	JobCodeChangeTimer.Interval := 200;
358	end;
359
360	procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
361	begin
362	JobGradeChangeTimer.Interval := 200;
363	end;
364
365	procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
366	begin
367	FClosing := true;
368	if IBTransaction1.InTransaction then
369	IBTransaction1.Commit;
370	end;
371
372	procedure TForm1.FormShow(Sender: TObject);
373	begin
374	repeat
375	try
376	IBDatabase1.Connected := true;
377	except
378	on E:EIBClientError do
379	begin
380	Close;
381	Exit
382	end;
383	On E:Exception do
384	MessageDlg(E.Message,mtError,[mbOK],0);
385	end;
386	until IBDatabase1.Connected;
387	Reopen(0);
388	end;
389
390	procedure TForm1.EmployeesAfterDelete(DataSet: TDataSet);
391	begin
392	FDirty := true
393	end;
394
395	procedure TForm1.EmployeesAfterTransactionEnd(Sender: TObject);
396	begin
397	FDirty := false;
398	if not FClosing then
399	Application.QueueAsyncCall(@Reopen,0)
400	end;
401
402	procedure TForm1.EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
403	var DataAction: TDataAction);
404	begin
405	if E is EIBError then
406	begin
407	MessageDlg(ExtractDBException(EIBError(E).message),mtError,[mbOK],0);
408	DataSet.Cancel;
409	DataAction := daAbort
410	end;
411	end;
412
413	end.
414