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 33 by tony, Sat Jul 18 12:30:52 2015 UTC

# Line 6 | Line 6 | interface
6  
7   uses
8    Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, DBGrids,
9 <  StdCtrls, ActnList, IBDatabase, IBQuery, IBCustomDataSet, IBUpdateSQL, db;
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 <    CancelChanges: TAction;
19 <    IBUpdateSQL1: TIBUpdateSQL;
20 <    SaveChanges: TAction;
21 <    DeleteEmployee: TAction;
22 <    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;
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;
# Line 40 | Line 31 | type
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 DBGrid1DblClick(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 IBDatabase1AfterConnect(Sender: TObject);
124 <    procedure IBDatabase1BeforeDisconnect(Sender: TObject);
125 <    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;
123 >    procedure EmployeesAfterDelete(DataSet: TDataSet);
124 >    procedure EmployeesAfterTransactionEnd(Sender: TObject);
125 >    procedure EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
126        var DataAction: TDataAction);
127 <    procedure IBQuery1SALARYGetText(Sender: TField; var aText: string;
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;
69 –    FLastEmp_no: integer;
136      procedure Reopen(Data: PtrInt);
137    public
138      { public declarations }
# Line 79 | Line 145 | implementation
145  
146   {$R *.lfm}
147  
148 < uses Unit2, Unit3, IB;
148 > uses IB, Unit2;
149 >
150 > const
151 >  sNoName = '<no name>';
152  
153   function ExtractDBException(msg: string): string;
154   var Lines: TStringList;
# Line 98 | Line 167 | end;
167  
168   { TForm1 }
169  
170 < procedure TForm1.IBQuery1SALARYGetText(Sender: TField; var aText: string;
170 > procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
171    DisplayText: Boolean);
172   begin
173    if DisplayText then
# Line 112 | Line 181 | begin
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 <  IBQuery1.Transaction.Commit
192 >  Employees.Transaction.Commit
193   end;
194  
195   procedure TForm1.SaveChangesUpdate(Sender: TObject);
# Line 126 | Line 201 | procedure TForm1.Reopen(Data: PtrInt);
201   begin
202    with IBTransaction1 do
203      if not InTransaction then StartTransaction;
204 <  IBQuery1.Active := true
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);
133 – var NewEmpNo: integer;
211   begin
212 <  if AddEmployeeDlg.ShowModal(NewEmpNo) = mrOK then
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 <    FDirty := true;
221 <    IBQuery1.Active := false;
222 <    FLastEmp_no := NewEmpNo;
223 <    IBQuery1.Active := true
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 <  IBQuery1.Transaction.Rollback
273 >  Employees.Transaction.Rollback
274   end;
275  
276 < procedure TForm1.DBGrid1DblClick(Sender: TObject);
276 > procedure TForm1.CountriesBeforeOpen(DataSet: TDataSet);
277   begin
278 <  if IBQuery1.Active and (IBQuery1.RecordCount > 0) then
279 <    EditEmployeeExecute(nil)
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?',[IBQuery1.FieldByName('Full_Name').AsString]),
285 >    Format('Remove %s from Employee List?',[Employees.FieldByName('Full_Name').AsString]),
286      mtConfirmation,[mbYes,mbNo],0) = mrYes then
287 <    IBQuery1.Delete
287 >    Employees.Delete
288   end;
289  
290   procedure TForm1.EditEmployeeExecute(Sender: TObject);
291   begin
292 <  if EditEmployeeDlg.ShowModal(IBQuery1.FieldByName('Emp_No').AsInteger) = mrOK then
166 <  begin
167 <    FDirty := true;
168 <    IBQuery1.Refresh
169 <  end;
292 >  IBDynamicGrid1.ShowEditorPanel;
293   end;
294  
295   procedure TForm1.EditEmployeeUpdate(Sender: TObject);
296   begin
297 <  (Sender as TAction).Enabled := IBQuery1.Active and (IBQuery1.RecordCount > 0)
297 >  (Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0)
298   end;
299  
300 < procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
300 > procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet);
301   begin
302 <  FClosing := true
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.FormShow(Sender: TObject);
313 > procedure TForm1.EmployeesAfterOpen(DataSet: TDataSet);
314   begin
315 <  FLastEmp_no := -1;
316 <  IBQuery1.Active := true
315 >  TotalsQuery.Active := true;
316 >  IBDynamicGrid1.SetFocus;
317   end;
318  
319 < procedure TForm1.IBDatabase1AfterConnect(Sender: TObject);
319 > procedure TForm1.EmployeesAfterScroll(DataSet: TDataSet);
320   begin
321 <  with IBTransaction1 do
191 <    if not InTransaction then StartTransaction
321 >  JobGradeChangeTimer.Interval := 200;
322   end;
323  
324 < procedure TForm1.IBDatabase1BeforeDisconnect(Sender: TObject);
324 > procedure TForm1.EmployeesBeforeClose(DataSet: TDataSet);
325   begin
326 <  FClosing := true
326 >  TotalsQuery.Active := false
327   end;
328  
329 < procedure TForm1.IBQuery1AfterDelete(DataSet: TDataSet);
329 > procedure TForm1.EmployeesBeforeOpen(DataSet: TDataSet);
330   begin
331 <  FDirty := true
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.IBQuery1AfterOpen(DataSet: TDataSet);
355 > procedure TForm1.EmployeesJOB_CODEChange(Sender: TField);
356   begin
357 <  if FLastEmp_no <> -1 then
207 <    DataSet.Locate('EMP_NO',FLastEmp_no,[])
357 >  JobCodeChangeTimer.Interval := 200;
358   end;
359  
360 < procedure TForm1.IBQuery1AfterTransactionEnd(Sender: TObject);
360 > procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
361   begin
362 <  FDirty := false;
213 <  if not FClosing then
214 <    Application.QueueAsyncCall(@Reopen,0)
362 >  JobGradeChangeTimer.Interval := 200;
363   end;
364  
365 < procedure TForm1.IBQuery1BeforeClose(DataSet: TDataSet);
365 > procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
366   begin
367 <  FLastEmp_no := DataSet.FieldByName('Emp_no').AsInteger
367 >  FClosing := true;
368 >  if IBTransaction1.InTransaction then
369 >    IBTransaction1.Commit;
370   end;
371  
372 < procedure TForm1.IBQuery1BeforeOpen(DataSet: TDataSet);
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.IBQuery1PostError(DataSet: TDataSet; E: EDatabaseError;
402 > procedure TForm1.EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
403    var DataAction: TDataAction);
404   begin
405    if E is EIBError then

Diff Legend

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