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 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 27 by tony, Tue Apr 14 13:10:23 2015 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 <    IBUpdateSQL1: TIBUpdateSQL;
18 <    SaveChanges: TAction;
19 <    DeleteEmployee: TAction;
20 <    EditEmployee: TAction;
21 <    AddEmployee: TAction;
22 <    ActionList1: TActionList;
23 <    Button1: TButton;
24 <    Button2: TButton;
25 <    Button3: TButton;
26 <    Button4: TButton;
27 <    Button5: TButton;
28 <    Datasource1: TDatasource;
29 <    DBGrid1: TDBGrid;
30 <    IBDatabase1: TIBDatabase;
31 <    IBQuery1: TIBQuery;
32 <    IBQuery1DEPT_NO: TIBStringField;
33 <    IBQuery1EMP_NO: TSmallintField;
34 <    IBQuery1FIRST_NAME: TIBStringField;
35 <    IBQuery1FULL_NAME: TIBStringField;
36 <    IBQuery1HIRE_DATE: TDateTimeField;
37 <    IBQuery1JOB_CODE: TIBStringField;
38 <    IBQuery1JOB_COUNTRY: TIBStringField;
39 <    IBQuery1JOB_GRADE: TSmallintField;
40 <    IBQuery1LAST_NAME: TIBStringField;
41 <    IBQuery1PHONE_EXT: TIBStringField;
42 <    IBQuery1SALARY: TIBBCDField;
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 IBQuery1BeforeOpen(DataSet: TDataSet);
59 <    procedure IBQuery1PostError(DataSet: TDataSet; E: EDatabaseError;
60 <      var DataAction: TDataAction);
61 <    procedure IBQuery1SALARYGetText(Sender: TField; var aText: string;
62 <      DisplayText: Boolean);
63 <    procedure SaveChangesExecute(Sender: TObject);
64 <    procedure SaveChangesUpdate(Sender: TObject);
65 <  private
66 <    { private declarations }
67 <    FDirty: boolean;
68 <    FClosing: boolean;
69 <    FLastEmp_no: integer;
70 <    procedure Reopen(Data: PtrInt);
71 <  public
72 <    { public declarations }
73 <  end;
74 <
75 < var
76 <  Form1: TForm1;
77 <
78 < implementation
79 <
80 < {$R *.lfm}
81 <
82 < uses Unit2, Unit3, IB;
83 <
84 < function ExtractDBException(msg: string): string;
85 < var Lines: TStringList;
86 < begin
87 <     Lines := TStringList.Create;
88 <     try
89 <       Lines.Text := msg;
90 <       if pos('exception',Lines[0]) = 1 then
91 <         Result := Lines[2]
92 <       else
93 <         Result := msg
94 <     finally
95 <       Lines.Free
96 <     end;
97 < end;
98 <
99 < { TForm1 }
100 <
101 < procedure TForm1.IBQuery1SALARYGetText(Sender: TField; var aText: string;
102 <  DisplayText: Boolean);
103 < begin
104 <  if DisplayText then
105 <  begin
106 <    if Sender.IsNUll then
107 <      aText := ''
108 <    else
109 <      aText := FormatFloat('$#,##0.00',Sender.AsFloat)
110 <  end
111 <  else
112 <    aText := Sender.AsString
113 < end;
114 <
115 < procedure TForm1.SaveChangesExecute(Sender: TObject);
116 < begin
117 <  IBQuery1.Transaction.Commit
118 < end;
119 <
120 < procedure TForm1.SaveChangesUpdate(Sender: TObject);
121 < begin
122 <  (Sender as TAction).Enabled := FDirty
123 < end;
124 <
125 < procedure TForm1.Reopen(Data: PtrInt);
126 < begin
127 <  with IBTransaction1 do
128 <    if not InTransaction then StartTransaction;
129 <  IBQuery1.Active := true
130 < end;
131 <
132 < procedure TForm1.AddEmployeeExecute(Sender: TObject);
133 < var NewEmpNo: integer;
134 < begin
135 <  if AddEmployeeDlg.ShowModal(NewEmpNo) = mrOK then
136 <  begin
137 <    FDirty := true;
138 <    IBQuery1.Active := false;
139 <    FLastEmp_no := NewEmpNo;
140 <    IBQuery1.Active := true
141 <  end;
142 < end;
143 <
144 < procedure TForm1.CancelChangesExecute(Sender: TObject);
145 < begin
146 <  IBQuery1.Transaction.Rollback
147 < end;
148 <
149 < procedure TForm1.DBGrid1DblClick(Sender: TObject);
150 < begin
151 <  if IBQuery1.Active and (IBQuery1.RecordCount > 0) then
152 <    EditEmployeeExecute(nil)
153 < end;
154 <
155 < procedure TForm1.DeleteEmployeeExecute(Sender: TObject);
156 < begin
157 <  if MessageDlg(
158 <    Format('Remove %s from Employee List?',[IBQuery1.FieldByName('Full_Name').AsString]),
159 <    mtConfirmation,[mbYes,mbNo],0) = mrYes then
160 <    IBQuery1.Delete
161 < end;
162 <
163 < procedure TForm1.EditEmployeeExecute(Sender: TObject);
164 < begin
165 <  if EditEmployeeDlg.ShowModal(IBQuery1.FieldByName('Emp_No').AsInteger) = mrOK then
166 <  begin
167 <    FDirty := true;
168 <    IBQuery1.Refresh
169 <  end;
170 < end;
171 <
172 < procedure TForm1.EditEmployeeUpdate(Sender: TObject);
173 < begin
174 <  (Sender as TAction).Enabled := IBQuery1.Active and (IBQuery1.RecordCount > 0)
175 < end;
176 <
177 < procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
178 < begin
179 <  FClosing := true
180 < end;
181 <
182 < procedure TForm1.FormShow(Sender: TObject);
183 < begin
184 <  FLastEmp_no := -1;
185 <  IBQuery1.Active := true
186 < end;
187 <
188 < procedure TForm1.IBDatabase1AfterConnect(Sender: TObject);
189 < begin
190 <  with IBTransaction1 do
191 <    if not InTransaction then StartTransaction
192 < end;
193 <
194 < procedure TForm1.IBDatabase1BeforeDisconnect(Sender: TObject);
195 < begin
196 <  FClosing := true
197 < end;
198 <
199 < procedure TForm1.IBQuery1AfterDelete(DataSet: TDataSet);
200 < begin
201 <  FDirty := true
202 < end;
203 <
204 < procedure TForm1.IBQuery1AfterOpen(DataSet: TDataSet);
205 < begin
206 <  if FLastEmp_no <> -1 then
207 <    DataSet.Locate('EMP_NO',FLastEmp_no,[])
208 < end;
209 <
210 < procedure TForm1.IBQuery1AfterTransactionEnd(Sender: TObject);
211 < begin
212 <  FDirty := false;
213 <  if not FClosing then
214 <    Application.QueueAsyncCall(@Reopen,0)
215 < end;
216 <
217 < procedure TForm1.IBQuery1BeforeClose(DataSet: TDataSet);
218 < begin
219 <  FLastEmp_no := DataSet.FieldByName('Emp_no').AsInteger
220 < end;
221 <
222 < procedure TForm1.IBQuery1BeforeOpen(DataSet: TDataSet);
223 < begin
224 < end;
225 <
226 < procedure TForm1.IBQuery1PostError(DataSet: TDataSet; E: EDatabaseError;
227 <  var DataAction: TDataAction);
228 < begin
229 <  if E is EIBError then
230 <   begin
231 <       MessageDlg(ExtractDBException(EIBError(E).message),mtError,[mbOK],0);
232 <       DataSet.Cancel;
233 <       DataAction  := daAbort
234 <   end;
235 < end;
236 <
237 < end.
238 <
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 >    TotalsQueryTOTALSALARIES: TIBBCDField;
84 >    TotalsSource: TDataSource;
85 >    TotalsQuery: TIBQuery;
86 >    Label1: TLabel;
87 >    Label2: TLabel;
88 >    SaveChanges: TAction;
89 >    DeleteEmployee: TAction;
90 >    EditEmployee: TAction;
91 >    AddEmployee: TAction;
92 >    ActionList1: TActionList;
93 >    Button1: TButton;
94 >    Button2: TButton;
95 >    Button3: TButton;
96 >    EmployeeSource: TDataSource;
97 >    IBDatabase1: TIBDatabase;
98 >    IBTransaction1: TIBTransaction;
99 >    procedure EmployeesAfterPost(DataSet: TDataSet);
100 >    procedure EmployeesValidatePost(Sender: TObject; var CancelPost: boolean);
101 >    procedure JobGradeDBComboBoxCloseUp(Sender: TObject);
102 >    procedure SelectDeptExecute(Sender: TObject);
103 >    procedure AddEmployeeExecute(Sender: TObject);
104 >    procedure BeforeDateChange(Sender: TObject);
105 >    procedure CancelChangesExecute(Sender: TObject);
106 >    procedure CountriesBeforeOpen(DataSet: TDataSet);
107 >    procedure DeleteEmployeeExecute(Sender: TObject);
108 >    procedure EditEmployeeExecute(Sender: TObject);
109 >    procedure EditEmployeeUpdate(Sender: TObject);
110 >    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 >    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
118 >    procedure FormShow(Sender: TObject);
119 >    procedure EmployeesAfterDelete(DataSet: TDataSet);
120 >    procedure EmployeesAfterTransactionEnd(Sender: TObject);
121 >    procedure EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
122 >      var DataAction: TDataAction);
123 >    procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
124 >      DisplayText: Boolean);
125 >    procedure JobCodesBeforeOpen(DataSet: TDataSet);
126 >    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 > uses IB, Unit2;
145 >
146 > const
147 >  sNoName = '<no name>';
148 >
149 > 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 > procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
167 >  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 > 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 > procedure TForm1.SaveChangesExecute(Sender: TObject);
187 > begin
188 >  Employees.Transaction.Commit
189 > 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 >  Countries.Active := true;
201 >  Employees.Active := true;
202 >  JobCodes.Active := true;
203 >  Depts.Active := true;
204 > end;
205 >
206 > procedure TForm1.AddEmployeeExecute(Sender: TObject);
207 > begin
208 >  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 >  begin
216 >    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 >  end;
226 > end;
227 >
228 > procedure TForm1.EmployeesAfterPost(DataSet: TDataSet);
229 > begin
230 >  Employees.Refresh
231 > end;
232 >
233 > 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 > 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 > procedure TForm1.CancelChangesExecute(Sender: TObject);
252 > begin
253 >  Employees.Transaction.Rollback
254 > end;
255 >
256 > procedure TForm1.CountriesBeforeOpen(DataSet: TDataSet);
257 > begin
258 >  Countries.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
259 >  Countries.ParamByName('JOB_CODE').AsString := EmployeesJOB_CODE.AsString
260 > end;
261 >
262 > procedure TForm1.DeleteEmployeeExecute(Sender: TObject);
263 > begin
264 >  if MessageDlg(
265 >    Format('Remove %s from Employee List?',[Employees.FieldByName('Full_Name').AsString]),
266 >    mtConfirmation,[mbYes,mbNo],0) = mrYes then
267 >    Employees.Delete
268 > end;
269 >
270 > procedure TForm1.EditEmployeeExecute(Sender: TObject);
271 > begin
272 >  IBDynamicGrid1.ShowEditorPanel;
273 > end;
274 >
275 > procedure TForm1.EditEmployeeUpdate(Sender: TObject);
276 > begin
277 >  (Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0)
278 > end;
279 >
280 > procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet);
281 > begin
282 >  EmployeesJOB_COUNTRY.AsString := 'USA';
283 >  EmployeesJOB_CODE.AsString := 'SRep';
284 >  EmployeesJOB_GRADE.AsInteger := 4;
285 >  EmployeesSALARY.AsCurrency := 20000;
286 >  EmployeesFIRST_NAME.AsString := sNoName;
287 >  EmployeesLAST_NAME.AsString := sNoName;
288 >  EmployeesHIRE_DATE.AsDateTime := now;
289 >  EmployeesDEPT_NO.AsString := '000';
290 >  FDirty := true;
291 > end;
292 >
293 > procedure TForm1.EmployeesAfterOpen(DataSet: TDataSet);
294 > begin
295 >  TotalsQuery.Active := true;
296 >  IBDynamicGrid1.SetFocus;
297 > end;
298 >
299 > procedure TForm1.EmployeesAfterScroll(DataSet: TDataSet);
300 > begin
301 >  Countries.Active := false;
302 >  JobCodes.Active := false;
303 >  Countries.Active := true;
304 >  JobCodes.Active := true;
305 > end;
306 >
307 > procedure TForm1.EmployeesBeforeClose(DataSet: TDataSet);
308 > begin
309 >  TotalsQuery.Active := false
310 > end;
311 >
312 > procedure TForm1.EmployeesBeforeOpen(DataSet: TDataSet);
313 > begin
314 >  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 > end;
337 >
338 > procedure TForm1.EmployeesJOB_CODEChange(Sender: TField);
339 > begin
340 >  Countries.Active := false;
341 >  Countries.Active := true;
342 > end;
343 >
344 > procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
345 > begin
346 >  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 >  FDirty := false;
385 >  if not FClosing then
386 >    Application.QueueAsyncCall(@Reopen,0)
387 > end;
388 >
389 > procedure TForm1.EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
390 >  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 >

Diff Legend

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