1 |
tony |
17 |
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 |
|
|
|