ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/employee/unit1.pas
(Generate patch)

Comparing ibx/trunk/examples/employee/unit1.pas (file contents):
Revision 19 by tony, Mon Jul 7 13:00:15 2014 UTC vs.
Revision 66 by tony, Wed Aug 23 08:23:42 2017 UTC

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

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines