ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/employee/unit1.pas
Revision: 7
Committed: Sun Aug 5 18:28:19 2012 UTC (11 years, 7 months ago) by tony
Content type: text/x-pascal
File size: 5891 byte(s)
Log Message:
Committing updates for Release R1-0-0

File Contents

# User Rev Content
1 tony 7 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