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 66 by tony, Wed Aug 23 08:23:42 2017 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;
23 <    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 >    EmployeesTEst: TStringField;
22 >    IBLookupComboEditBox1: TIBLookupComboEditBox;
23 >    IBLookupComboEditBox2: TIBLookupComboEditBox;
24      IBQuery1DEPT_NO: TIBStringField;
25      IBQuery1EMP_NO: TSmallintField;
26      IBQuery1FIRST_NAME: TIBStringField;
# Line 40 | Line 32 | type
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 DBGrid1DblClick(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 IBDatabase1AfterConnect(Sender: TObject);
125 <    procedure IBDatabase1BeforeDisconnect(Sender: TObject);
126 <    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;
124 >    procedure EmployeesAfterDelete(DataSet: TDataSet);
125 >    procedure EmployeesAfterTransactionEnd(Sender: TObject);
126 >    procedure EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
127        var DataAction: TDataAction);
128 <    procedure IBQuery1SALARYGetText(Sender: TField; var aText: string;
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;
69 –    FLastEmp_no: integer;
137      procedure Reopen(Data: PtrInt);
138    public
139      { public declarations }
# Line 79 | Line 146 | implementation
146  
147   {$R *.lfm}
148  
149 < uses Unit2, Unit3, IB;
149 > uses IB, Unit2;
150 >
151 > const
152 >  sNoName = '<no name>';
153  
154   function ExtractDBException(msg: string): string;
155   var Lines: TStringList;
# Line 98 | Line 168 | end;
168  
169   { TForm1 }
170  
171 < procedure TForm1.IBQuery1SALARYGetText(Sender: TField; var aText: string;
171 > procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
172    DisplayText: Boolean);
173   begin
174    if DisplayText then
# Line 112 | Line 182 | begin
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 <  IBQuery1.Transaction.Commit
193 >  Employees.Transaction.Commit
194   end;
195  
196   procedure TForm1.SaveChangesUpdate(Sender: TObject);
# Line 126 | Line 202 | procedure TForm1.Reopen(Data: PtrInt);
202   begin
203    with IBTransaction1 do
204      if not InTransaction then StartTransaction;
205 <  IBQuery1.Active := true
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);
133 – var NewEmpNo: integer;
212   begin
213 <  if AddEmployeeDlg.ShowModal(NewEmpNo) = mrOK then
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 <    FDirty := true;
222 <    IBQuery1.Active := false;
223 <    FLastEmp_no := NewEmpNo;
224 <    IBQuery1.Active := true
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 <  IBQuery1.Transaction.Rollback
274 >  Employees.Transaction.Rollback
275   end;
276  
277 < procedure TForm1.DBGrid1DblClick(Sender: TObject);
277 > procedure TForm1.CountriesBeforeOpen(DataSet: TDataSet);
278   begin
279 <  if IBQuery1.Active and (IBQuery1.RecordCount > 0) then
280 <    EditEmployeeExecute(nil)
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?',[IBQuery1.FieldByName('Full_Name').AsString]),
286 >    Format('Remove %s from Employee List?',[Employees.FieldByName('Full_Name').AsString]),
287      mtConfirmation,[mbYes,mbNo],0) = mrYes then
288 <    IBQuery1.Delete
288 >    Employees.Delete
289   end;
290  
291   procedure TForm1.EditEmployeeExecute(Sender: TObject);
292   begin
293 <  if EditEmployeeDlg.ShowModal(IBQuery1.FieldByName('Emp_No').AsInteger) = mrOK then
166 <  begin
167 <    FDirty := true;
168 <    IBQuery1.Refresh
169 <  end;
293 >  IBDynamicGrid1.ShowEditorPanel;
294   end;
295  
296   procedure TForm1.EditEmployeeUpdate(Sender: TObject);
297   begin
298 <  (Sender as TAction).Enabled := IBQuery1.Active and (IBQuery1.RecordCount > 0)
298 >  (Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0)
299   end;
300  
301 < procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
301 > procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet);
302   begin
303 <  FClosing := true
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.FormShow(Sender: TObject);
314 > procedure TForm1.EmployeesAfterOpen(DataSet: TDataSet);
315   begin
316 <  FLastEmp_no := -1;
317 <  IBQuery1.Active := true
316 >  TotalsQuery.Active := true;
317 >  IBDynamicGrid1.SetFocus;
318   end;
319  
320 < procedure TForm1.IBDatabase1AfterConnect(Sender: TObject);
320 > procedure TForm1.EmployeesAfterScroll(DataSet: TDataSet);
321   begin
322 <  with IBTransaction1 do
191 <    if not InTransaction then StartTransaction
322 >  JobGradeChangeTimer.Interval := 200;
323   end;
324  
325 < procedure TForm1.IBDatabase1BeforeDisconnect(Sender: TObject);
325 > procedure TForm1.EmployeesBeforeClose(DataSet: TDataSet);
326   begin
327 <  FClosing := true
327 >  TotalsQuery.Active := false
328   end;
329  
330 < procedure TForm1.IBQuery1AfterDelete(DataSet: TDataSet);
330 > procedure TForm1.EmployeesBeforeOpen(DataSet: TDataSet);
331   begin
332 <  FDirty := true
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.IBQuery1AfterOpen(DataSet: TDataSet);
356 > procedure TForm1.EmployeesJOB_CODEChange(Sender: TField);
357   begin
358 <  if FLastEmp_no <> -1 then
207 <    DataSet.Locate('EMP_NO',FLastEmp_no,[])
358 >  JobCodeChangeTimer.Interval := 200;
359   end;
360  
361 < procedure TForm1.IBQuery1AfterTransactionEnd(Sender: TObject);
361 > procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
362   begin
363 <  FDirty := false;
213 <  if not FClosing then
214 <    Application.QueueAsyncCall(@Reopen,0)
363 >  JobGradeChangeTimer.Interval := 200;
364   end;
365  
366 < procedure TForm1.IBQuery1BeforeClose(DataSet: TDataSet);
366 > procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
367   begin
368 <  FLastEmp_no := DataSet.FieldByName('Emp_no').AsInteger
368 >  FClosing := true;
369 >  if IBTransaction1.InTransaction then
370 >    IBTransaction1.Commit;
371   end;
372  
373 < procedure TForm1.IBQuery1BeforeOpen(DataSet: TDataSet);
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.IBQuery1PostError(DataSet: TDataSet; E: EDatabaseError;
403 > procedure TForm1.EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
404    var DataAction: TDataAction);
405   begin
406    if E is EIBError then

Diff Legend

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