ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/employee/unit1.pas
(Generate patch)
# Line 1 | Line 1
1 < 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 <
1 > 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 >

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines