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 17 by tony, Sat Dec 28 19:22:24 2013 UTC vs.
Revision 27 by tony, Tue Apr 14 13:10:23 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 +    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 DBGrid1DblClick(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 IBDatabase1AfterConnect(Sender: TObject);
120 <    procedure IBDatabase1BeforeDisconnect(Sender: TObject);
121 <    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;
119 >    procedure EmployeesAfterDelete(DataSet: TDataSet);
120 >    procedure EmployeesAfterTransactionEnd(Sender: TObject);
121 >    procedure EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
122        var DataAction: TDataAction);
123 <    procedure IBQuery1SALARYGetText(Sender: TField; var aText: string;
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;
69 –    FLastEmp_no: integer;
132      procedure Reopen(Data: PtrInt);
133    public
134      { public declarations }
# Line 79 | Line 141 | implementation
141  
142   {$R *.lfm}
143  
144 < uses Unit2, Unit3, IB;
144 > uses IB, Unit2;
145 >
146 > const
147 >  sNoName = '<no name>';
148  
149   function ExtractDBException(msg: string): string;
150   var Lines: TStringList;
# Line 98 | Line 163 | end;
163  
164   { TForm1 }
165  
166 < procedure TForm1.IBQuery1SALARYGetText(Sender: TField; var aText: string;
166 > procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
167    DisplayText: Boolean);
168   begin
169    if DisplayText then
# Line 112 | Line 177 | begin
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 <  IBQuery1.Transaction.Commit
188 >  Employees.Transaction.Commit
189   end;
190  
191   procedure TForm1.SaveChangesUpdate(Sender: TObject);
# Line 126 | Line 197 | procedure TForm1.Reopen(Data: PtrInt);
197   begin
198    with IBTransaction1 do
199      if not InTransaction then StartTransaction;
200 <  IBQuery1.Active := true
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);
133 – var NewEmpNo: integer;
207   begin
208 <  if AddEmployeeDlg.ShowModal(NewEmpNo) = mrOK then
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 <    FDirty := true;
217 <    IBQuery1.Active := false;
218 <    FLastEmp_no := NewEmpNo;
219 <    IBQuery1.Active := true
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 <  IBQuery1.Transaction.Rollback
253 >  Employees.Transaction.Rollback
254   end;
255  
256 < procedure TForm1.DBGrid1DblClick(Sender: TObject);
256 > procedure TForm1.CountriesBeforeOpen(DataSet: TDataSet);
257   begin
258 <  if IBQuery1.Active and (IBQuery1.RecordCount > 0) then
259 <    EditEmployeeExecute(nil)
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?',[IBQuery1.FieldByName('Full_Name').AsString]),
265 >    Format('Remove %s from Employee List?',[Employees.FieldByName('Full_Name').AsString]),
266      mtConfirmation,[mbYes,mbNo],0) = mrYes then
267 <    IBQuery1.Delete
267 >    Employees.Delete
268   end;
269  
270   procedure TForm1.EditEmployeeExecute(Sender: TObject);
271   begin
272 <  if EditEmployeeDlg.ShowModal(IBQuery1.FieldByName('Emp_No').AsInteger) = mrOK then
166 <  begin
167 <    FDirty := true;
168 <    IBQuery1.Refresh
169 <  end;
272 >  IBDynamicGrid1.ShowEditorPanel;
273   end;
274  
275   procedure TForm1.EditEmployeeUpdate(Sender: TObject);
276   begin
277 <  (Sender as TAction).Enabled := IBQuery1.Active and (IBQuery1.RecordCount > 0)
277 >  (Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0)
278   end;
279  
280 < procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
280 > procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet);
281   begin
282 <  FClosing := true
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.FormShow(Sender: TObject);
293 > procedure TForm1.EmployeesAfterOpen(DataSet: TDataSet);
294   begin
295 <  FLastEmp_no := -1;
296 <  IBQuery1.Active := true
295 >  TotalsQuery.Active := true;
296 >  IBDynamicGrid1.SetFocus;
297   end;
298  
299 < procedure TForm1.IBDatabase1AfterConnect(Sender: TObject);
299 > procedure TForm1.EmployeesAfterScroll(DataSet: TDataSet);
300   begin
301 <  with IBTransaction1 do
302 <    if not InTransaction then StartTransaction
301 >  Countries.Active := false;
302 >  JobCodes.Active := false;
303 >  Countries.Active := true;
304 >  JobCodes.Active := true;
305   end;
306  
307 < procedure TForm1.IBDatabase1BeforeDisconnect(Sender: TObject);
307 > procedure TForm1.EmployeesBeforeClose(DataSet: TDataSet);
308   begin
309 <  FClosing := true
309 >  TotalsQuery.Active := false
310   end;
311  
312 < procedure TForm1.IBQuery1AfterDelete(DataSet: TDataSet);
312 > procedure TForm1.EmployeesBeforeOpen(DataSet: TDataSet);
313   begin
314 <  FDirty := true
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.IBQuery1AfterOpen(DataSet: TDataSet);
338 > procedure TForm1.EmployeesJOB_CODEChange(Sender: TField);
339   begin
340 <  if FLastEmp_no <> -1 then
341 <    DataSet.Locate('EMP_NO',FLastEmp_no,[])
340 >  Countries.Active := false;
341 >  Countries.Active := true;
342   end;
343  
344 < procedure TForm1.IBQuery1AfterTransactionEnd(Sender: TObject);
344 > procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
345   begin
346 <  FDirty := false;
347 <  if not FClosing then
348 <    Application.QueueAsyncCall(@Reopen,0)
346 >  Countries.Active := false;
347 >  JobCodes.Active := false;
348 >  Countries.Active := true;
349 >  JobCodes.Active := true;
350   end;
351  
352 < procedure TForm1.IBQuery1BeforeClose(DataSet: TDataSet);
352 > procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
353   begin
354 <  FLastEmp_no := DataSet.FieldByName('Emp_no').AsInteger
354 >  FClosing := true;
355 >  if IBTransaction1.InTransaction then
356 >    IBTransaction1.Commit;
357   end;
358  
359 < procedure TForm1.IBQuery1BeforeOpen(DataSet: TDataSet);
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.IBQuery1PostError(DataSet: TDataSet; E: EDatabaseError;
389 > procedure TForm1.EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
390    var DataAction: TDataAction);
391   begin
392    if E is EIBError then

Diff Legend

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