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 20 by tony, Mon Jul 7 13:00:15 2014 UTC vs.
Revision 21 by tony, Thu Feb 26 10:33:34 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 +    DBEdit6: TDBEdit;
19 +    EmployeesDEPT_KEY_PATH: TIBStringField;
20 +    EmployeesDEPT_PATH: TIBStringField;
21 +    IBLookupComboEditBox1: TIBLookupComboEditBox;
22 +    IBLookupComboEditBox2: TIBLookupComboEditBox;
23 +    SelectDept: TAction;
24 +    Button4: TButton;
25 +    Button5: TButton;
26      CancelChanges: TAction;
27 <    IBQuery1SALARY: TIBBCDField;
28 <    IBUpdateSQL1: TIBUpdateSQL;
27 >    SalaryRange: TComboBox;
28 >    CountrySource: TDataSource;
29 >    BeforeDate: TDateEdit;
30 >    AfterDate: TDateEdit;
31 >    DeptsSource: TDataSource;
32 >    Depts: TIBQuery;
33 >    JobCodeSource: TDataSource;
34 >    DBEdit1: TDBEdit;
35 >    DBEdit2: TDBEdit;
36 >    DBEdit3: TDBEdit;
37 >    DBEdit4: TDBEdit;
38 >    DBEdit5: TDBEdit;
39 >    DBText1: TDBText;
40 >    Employees: TIBDataSet;
41 >    EmployeesDEPT_NO: TIBStringField;
42 >    EmployeesEMP_NO: TSmallintField;
43 >    EmployeesFIRST_NAME: TIBStringField;
44 >    EmployeesFULL_NAME: TIBStringField;
45 >    EmployeesHIRE_DATE: TDateTimeField;
46 >    EmployeesJOB_CODE: TIBStringField;
47 >    EmployeesJOB_COUNTRY: TIBStringField;
48 >    EmployeesJOB_GRADE: TSmallintField;
49 >    EmployeesLAST_NAME: TIBStringField;
50 >    EmployeesPHONE_EXT: TIBStringField;
51 >    EmployeesSALARY: TIBBCDField;
52 >    IBDateEdit1: TDBDateEdit;
53 >    IBDynamicGrid1: TIBDynamicGrid;
54 >    Countries: TIBQuery;
55 >    JobCodes: TIBQuery;
56 >    JobGradeDBComboBox: TDBComboBox;
57 >    Label10: TLabel;
58 >    Label11: TLabel;
59 >    Label12: TLabel;
60 >    Label13: TLabel;
61 >    Label3: TLabel;
62 >    Label4: TLabel;
63 >    Label5: TLabel;
64 >    Label6: TLabel;
65 >    Label7: TLabel;
66 >    Label8: TLabel;
67 >    Label9: TLabel;
68 >    Panel1: TPanel;
69 >    Panel2: TPanel;
70 >    EmployeeEditorPanel: TPanel;
71 >    SpeedButton1: TSpeedButton;
72 >    TotalsQueryTOTALSALARIES: TIBBCDField;
73 >    TotalsSource: TDataSource;
74 >    TotalsQuery: TIBQuery;
75 >    Label1: TLabel;
76 >    Label2: TLabel;
77      SaveChanges: TAction;
78      DeleteEmployee: TAction;
79      EditEmployee: TAction;
# Line 24 | Line 82 | type
82      Button1: TButton;
83      Button2: TButton;
84      Button3: TButton;
85 <    Button4: TButton;
28 <    Button5: TButton;
29 <    Datasource1: TDatasource;
30 <    DBGrid1: TDBGrid;
85 >    EmployeeSource: TDataSource;
86      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;
87      IBTransaction1: TIBTransaction;
88 +    procedure EmployeesAfterPost(DataSet: TDataSet);
89 +    procedure JobGradeDBComboBoxCloseUp(Sender: TObject);
90 +    procedure SelectDeptExecute(Sender: TObject);
91      procedure AddEmployeeExecute(Sender: TObject);
92 +    procedure BeforeDateChange(Sender: TObject);
93      procedure CancelChangesExecute(Sender: TObject);
94 <    procedure DBGrid1DblClick(Sender: TObject);
94 >    procedure CountriesBeforeOpen(DataSet: TDataSet);
95      procedure DeleteEmployeeExecute(Sender: TObject);
96      procedure EditEmployeeExecute(Sender: TObject);
97      procedure EditEmployeeUpdate(Sender: TObject);
98 +    procedure EmployeesAfterInsert(DataSet: TDataSet);
99 +    procedure EmployeesAfterOpen(DataSet: TDataSet);
100 +    procedure EmployeesAfterScroll(DataSet: TDataSet);
101 +    procedure EmployeesBeforeClose(DataSet: TDataSet);
102 +    procedure EmployeesBeforeOpen(DataSet: TDataSet);
103 +    procedure EmployeesJOB_CODEChange(Sender: TField);
104 +    procedure EmployeesJOB_GRADEChange(Sender: TField);
105      procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
106      procedure FormShow(Sender: TObject);
107 <    procedure IBDatabase1AfterConnect(Sender: TObject);
108 <    procedure IBDatabase1BeforeDisconnect(Sender: TObject);
109 <    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;
107 >    procedure EmployeesAfterDelete(DataSet: TDataSet);
108 >    procedure EmployeesAfterTransactionEnd(Sender: TObject);
109 >    procedure EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
110        var DataAction: TDataAction);
111 <    procedure IBQuery1SALARYGetText(Sender: TField; var aText: string;
111 >    procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
112        DisplayText: Boolean);
113 +    procedure JobCodesBeforeOpen(DataSet: TDataSet);
114      procedure SaveChangesExecute(Sender: TObject);
115      procedure SaveChangesUpdate(Sender: TObject);
116    private
117      { private declarations }
118      FDirty: boolean;
119      FClosing: boolean;
68 –    FLastEmp_no: integer;
120      procedure Reopen(Data: PtrInt);
121    public
122      { public declarations }
# Line 78 | Line 129 | implementation
129  
130   {$R *.lfm}
131  
132 < uses Unit2, Unit3, IB;
132 > uses IB, Unit2;
133  
134   function ExtractDBException(msg: string): string;
135   var Lines: TStringList;
# Line 97 | Line 148 | end;
148  
149   { TForm1 }
150  
151 < procedure TForm1.IBQuery1SALARYGetText(Sender: TField; var aText: string;
151 > procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
152    DisplayText: Boolean);
153   begin
154    if DisplayText then
# Line 111 | Line 162 | begin
162      aText := Sender.AsString
163   end;
164  
165 + procedure TForm1.JobCodesBeforeOpen(DataSet: TDataSet);
166 + begin
167 +  JobCodes.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
168 +  JobCodes.ParamByName('JOB_COUNTRY').AsString := EmployeesJOB_COUNTRY.AsString
169 + end;
170 +
171   procedure TForm1.SaveChangesExecute(Sender: TObject);
172   begin
173 <  IBQuery1.Transaction.Commit
173 >  Employees.Transaction.Commit
174   end;
175  
176   procedure TForm1.SaveChangesUpdate(Sender: TObject);
# Line 125 | Line 182 | procedure TForm1.Reopen(Data: PtrInt);
182   begin
183    with IBTransaction1 do
184      if not InTransaction then StartTransaction;
185 <  IBQuery1.Active := true
185 >  Countries.Active := true;
186 >  Employees.Active := true;
187 >  JobCodes.Active := true;
188 >  Depts.Active := true;
189   end;
190  
191   procedure TForm1.AddEmployeeExecute(Sender: TObject);
132 – var NewEmpNo: integer;
192   begin
193 <  if AddEmployeeDlg.ShowModal(NewEmpNo) = mrOK then
193 >  Employees.Append
194 > end;
195 >
196 > procedure TForm1.SelectDeptExecute(Sender: TObject);
197 > var Dept_No: string;
198 > begin
199 >  if SelectDeptDlg.ShowModal(EmployeesDEPT_KEY_PATH.AsString,Dept_No) = mrOK then
200    begin
201 <    FDirty := true;
202 <    IBQuery1.Active := false;
203 <    FLastEmp_no := NewEmpNo;
204 <    IBQuery1.Active := true
201 >    Employees.Edit;
202 >    EmployeesDEPT_NO.AsString := Dept_No;
203 >    try
204 >      Employees.Post;
205 >    except
206 >      Employees.Cancel;
207 >      raise;
208 >    end;
209 >    IBDynamicGrid1.ShowEditorPanel;
210    end;
211   end;
212  
213 + procedure TForm1.EmployeesAfterPost(DataSet: TDataSet);
214 + begin
215 +  Employees.Refresh
216 + end;
217 +
218 + procedure TForm1.JobGradeDBComboBoxCloseUp(Sender: TObject);
219 + begin
220 +  JobGradeDBComboBox.EditingDone; //See http://bugs.freepascal.org/view.php?id=27186
221 + end;
222 +
223 + procedure TForm1.BeforeDateChange(Sender: TObject);
224 + begin
225 +  Employees.Active := false;
226 +  Employees.Active := true
227 + end;
228 +
229   procedure TForm1.CancelChangesExecute(Sender: TObject);
230   begin
231 <  IBQuery1.Transaction.Rollback
231 >  Employees.Transaction.Rollback
232   end;
233  
234 < procedure TForm1.DBGrid1DblClick(Sender: TObject);
234 > procedure TForm1.CountriesBeforeOpen(DataSet: TDataSet);
235   begin
236 <  if IBQuery1.Active and (IBQuery1.RecordCount > 0) then
237 <    EditEmployeeExecute(nil)
236 >  Countries.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
237 >  Countries.ParamByName('JOB_CODE').AsString := EmployeesJOB_CODE.AsString
238   end;
239  
240   procedure TForm1.DeleteEmployeeExecute(Sender: TObject);
241   begin
242    if MessageDlg(
243 <    Format('Remove %s from Employee List?',[IBQuery1.FieldByName('Full_Name').AsString]),
243 >    Format('Remove %s from Employee List?',[Employees.FieldByName('Full_Name').AsString]),
244      mtConfirmation,[mbYes,mbNo],0) = mrYes then
245 <    IBQuery1.Delete
245 >    Employees.Delete
246   end;
247  
248   procedure TForm1.EditEmployeeExecute(Sender: TObject);
249   begin
250 <  if EditEmployeeDlg.ShowModal(IBQuery1.FieldByName('Emp_No').AsInteger) = mrOK then
165 <  begin
166 <    FDirty := true;
167 <    IBQuery1.Refresh
168 <  end;
250 >  IBDynamicGrid1.ShowEditorPanel;
251   end;
252  
253   procedure TForm1.EditEmployeeUpdate(Sender: TObject);
254   begin
255 <  (Sender as TAction).Enabled := IBQuery1.Active and (IBQuery1.RecordCount > 0)
255 >  (Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0)
256   end;
257  
258 < procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
258 > procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet);
259   begin
260 <  FClosing := true
260 >  EmployeesJOB_COUNTRY.AsString := 'USA';
261 >  EmployeesJOB_CODE.AsString := 'SRep';
262 >  EmployeesJOB_GRADE.AsInteger := 4;
263 >  EmployeesSALARY.AsCurrency := 20000;
264 >  EmployeesFIRST_NAME.AsString := '<no name>';
265 >  EmployeesLAST_NAME.AsString := '<no name>';
266 >  EmployeesHIRE_DATE.AsDateTime := now;
267 >  EmployeesDEPT_NO.AsString := '000';
268 >  FDirty := true;
269   end;
270  
271 < procedure TForm1.FormShow(Sender: TObject);
271 > procedure TForm1.EmployeesAfterOpen(DataSet: TDataSet);
272   begin
273 <  FLastEmp_no := -1;
184 <  IBQuery1.Active := true
273 >  TotalsQuery.Active := true
274   end;
275  
276 < procedure TForm1.IBDatabase1AfterConnect(Sender: TObject);
276 > procedure TForm1.EmployeesAfterScroll(DataSet: TDataSet);
277   begin
278 <  with IBTransaction1 do
279 <    if not InTransaction then StartTransaction
278 >  Countries.Active := false;
279 >  JobCodes.Active := false;
280 >  Countries.Active := true;
281 >  JobCodes.Active := true;
282   end;
283  
284 < procedure TForm1.IBDatabase1BeforeDisconnect(Sender: TObject);
284 > procedure TForm1.EmployeesBeforeClose(DataSet: TDataSet);
285   begin
286 <  FClosing := true
286 >  with DataSet do
287 >    if State in [dsInsert,dsEdit] then
288 >    try
289 >     Post;
290 >    except
291 >      Cancel;
292 >      raise;
293 >    end;
294 >  TotalsQuery.Active := false
295   end;
296  
297 < procedure TForm1.IBQuery1AfterDelete(DataSet: TDataSet);
297 > procedure TForm1.EmployeesBeforeOpen(DataSet: TDataSet);
298   begin
299 <  FDirty := true
299 >  if BeforeDate.Date > 0 then
300 >     (DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE < :BeforeDate');
301 >  if AfterDate.Date > 0 then
302 >     (DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE > :AfterDate');
303 >
304 >  case SalaryRange.ItemIndex of
305 >  1:
306 >    (DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary < 40000');
307 >  2:
308 >    (DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 40000 and Salary < 100000');
309 >  3:
310 >    (DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 100000');
311 >  end;
312 >
313 >
314 >
315 >  {Parameter value must be set after all SQL changes have been made}
316 >  if BeforeDate.Date > 0 then
317 >     (DataSet as TIBParserDataSet).ParamByName('BeforeDate').AsDateTime := BeforeDate.Date;
318 >  if AfterDate.Date > 0 then
319 >   (DataSet as TIBParserDataSet).ParamByName('AfterDate').AsDateTime := AfterDate.Date;
320 >
321   end;
322  
323 < procedure TForm1.IBQuery1AfterOpen(DataSet: TDataSet);
323 > procedure TForm1.EmployeesJOB_CODEChange(Sender: TField);
324   begin
325 <  if FLastEmp_no <> -1 then
326 <    DataSet.Locate('EMP_NO',FLastEmp_no,[])
325 >  Countries.Active := false;
326 >  Countries.Active := true;
327   end;
328  
329 < procedure TForm1.IBQuery1AfterTransactionEnd(Sender: TObject);
329 > procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
330   begin
331 <  FDirty := false;
332 <  if not FClosing then
333 <    Application.QueueAsyncCall(@Reopen,0)
331 >  Countries.Active := false;
332 >  JobCodes.Active := false;
333 >  Countries.Active := true;
334 >  JobCodes.Active := true;
335   end;
336  
337 < procedure TForm1.IBQuery1BeforeClose(DataSet: TDataSet);
337 > procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
338   begin
339 <  FLastEmp_no := DataSet.FieldByName('Emp_no').AsInteger
339 >  FClosing := true;
340 >  if IBTransaction1.InTransaction then
341 >    IBTransaction1.Commit;
342   end;
343  
344 < procedure TForm1.IBQuery1PostError(DataSet: TDataSet; E: EDatabaseError;
344 > procedure TForm1.FormShow(Sender: TObject);
345 > begin
346 >  repeat
347 >    try
348 >      IBDatabase1.Connected := true;
349 >    except
350 >     on E:EIBClientError do
351 >      begin
352 >        Close;
353 >        Exit
354 >      end;
355 >    On E:Exception do
356 >     MessageDlg(E.Message,mtError,[mbOK],0);
357 >    end;
358 >  until IBDatabase1.Connected;
359 >  Reopen(0);
360 > end;
361 >
362 > procedure TForm1.EmployeesAfterDelete(DataSet: TDataSet);
363 > begin
364 >  FDirty := true
365 > end;
366 >
367 > procedure TForm1.EmployeesAfterTransactionEnd(Sender: TObject);
368 > begin
369 >  FDirty := false;
370 >  if not FClosing then
371 >    Application.QueueAsyncCall(@Reopen,0)
372 > end;
373 >
374 > procedure TForm1.EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
375    var DataAction: TDataAction);
376   begin
377    if E is EIBError then
# Line 230 | Line 383 | begin
383   end;
384  
385   end.
386 <
386 >

Diff Legend

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