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 |
|