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, 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 |
> |
EmployeesTEst: TStringField; |
22 |
> |
IBLookupComboEditBox1: TIBLookupComboEditBox; |
23 |
> |
IBLookupComboEditBox2: TIBLookupComboEditBox; |
24 |
> |
IBQuery1DEPT_NO: TIBStringField; |
25 |
> |
IBQuery1EMP_NO: TSmallintField; |
26 |
> |
IBQuery1FIRST_NAME: TIBStringField; |
27 |
> |
IBQuery1FULL_NAME: TIBStringField; |
28 |
> |
IBQuery1HIRE_DATE: TDateTimeField; |
29 |
> |
IBQuery1JOB_CODE: TIBStringField; |
30 |
> |
IBQuery1JOB_COUNTRY: TIBStringField; |
31 |
> |
IBQuery1JOB_GRADE: TSmallintField; |
32 |
> |
IBQuery1LAST_NAME: TIBStringField; |
33 |
> |
IBQuery1PHONE_EXT: TIBStringField; |
34 |
> |
IBQuery1SALARY: TIBBCDField; |
35 |
> |
SelectDept: TAction; |
36 |
> |
Button4: TButton; |
37 |
> |
Button5: TButton; |
38 |
> |
CancelChanges: TAction; |
39 |
> |
SalaryRange: TComboBox; |
40 |
> |
CountrySource: TDataSource; |
41 |
> |
BeforeDate: TDateEdit; |
42 |
> |
AfterDate: TDateEdit; |
43 |
> |
DeptsSource: TDataSource; |
44 |
> |
Depts: TIBQuery; |
45 |
> |
JobCodeSource: TDataSource; |
46 |
> |
DBEdit1: TDBEdit; |
47 |
> |
DBEdit2: TDBEdit; |
48 |
> |
DBEdit3: TDBEdit; |
49 |
> |
DBEdit4: TDBEdit; |
50 |
> |
DBEdit5: TDBEdit; |
51 |
> |
DBText1: TDBText; |
52 |
> |
Employees: TIBDataSet; |
53 |
> |
EmployeesDEPT_NO: TIBStringField; |
54 |
> |
EmployeesEMP_NO: TSmallintField; |
55 |
> |
EmployeesFIRST_NAME: TIBStringField; |
56 |
> |
EmployeesFULL_NAME: TIBStringField; |
57 |
> |
EmployeesHIRE_DATE: TDateTimeField; |
58 |
> |
EmployeesJOB_CODE: TIBStringField; |
59 |
> |
EmployeesJOB_COUNTRY: TIBStringField; |
60 |
> |
EmployeesJOB_GRADE: TSmallintField; |
61 |
> |
EmployeesLAST_NAME: TIBStringField; |
62 |
> |
EmployeesPHONE_EXT: TIBStringField; |
63 |
> |
EmployeesSALARY: TIBBCDField; |
64 |
> |
IBDateEdit1: TDBDateEdit; |
65 |
> |
IBDynamicGrid1: TIBDynamicGrid; |
66 |
> |
Countries: TIBQuery; |
67 |
> |
JobCodes: TIBQuery; |
68 |
> |
JobGradeDBComboBox: TDBComboBox; |
69 |
> |
Label10: TLabel; |
70 |
> |
Label11: TLabel; |
71 |
> |
Label12: TLabel; |
72 |
> |
Label13: TLabel; |
73 |
> |
Label3: TLabel; |
74 |
> |
Label4: TLabel; |
75 |
> |
Label5: TLabel; |
76 |
> |
Label6: TLabel; |
77 |
> |
Label7: TLabel; |
78 |
> |
Label8: TLabel; |
79 |
> |
Label9: TLabel; |
80 |
> |
Panel1: TPanel; |
81 |
> |
Panel2: TPanel; |
82 |
> |
EmployeeEditorPanel: TPanel; |
83 |
> |
SpeedButton1: TSpeedButton; |
84 |
> |
JobGradeChangeTimer: TTimer; |
85 |
> |
JobCodeChangeTimer: TTimer; |
86 |
> |
TotalsQueryTOTALSALARIES: TIBBCDField; |
87 |
> |
TotalsSource: TDataSource; |
88 |
> |
TotalsQuery: TIBQuery; |
89 |
> |
Label1: TLabel; |
90 |
> |
Label2: TLabel; |
91 |
> |
SaveChanges: TAction; |
92 |
> |
DeleteEmployee: TAction; |
93 |
> |
EditEmployee: TAction; |
94 |
> |
AddEmployee: TAction; |
95 |
> |
ActionList1: TActionList; |
96 |
> |
Button1: TButton; |
97 |
> |
Button2: TButton; |
98 |
> |
Button3: TButton; |
99 |
> |
EmployeeSource: TDataSource; |
100 |
> |
IBDatabase1: TIBDatabase; |
101 |
> |
IBTransaction1: TIBTransaction; |
102 |
> |
procedure EmployeesAfterPost(DataSet: TDataSet); |
103 |
> |
procedure EmployeesValidatePost(Sender: TObject; var CancelPost: boolean); |
104 |
> |
procedure JobCodeChangeTimerTimer(Sender: TObject); |
105 |
> |
procedure JobGradeChangeTimerTimer(Sender: TObject); |
106 |
> |
procedure JobGradeDBComboBoxCloseUp(Sender: TObject); |
107 |
> |
procedure SelectDeptExecute(Sender: TObject); |
108 |
> |
procedure AddEmployeeExecute(Sender: TObject); |
109 |
> |
procedure BeforeDateChange(Sender: TObject); |
110 |
> |
procedure CancelChangesExecute(Sender: TObject); |
111 |
> |
procedure CountriesBeforeOpen(DataSet: TDataSet); |
112 |
> |
procedure DeleteEmployeeExecute(Sender: TObject); |
113 |
> |
procedure EditEmployeeExecute(Sender: TObject); |
114 |
> |
procedure EditEmployeeUpdate(Sender: TObject); |
115 |
> |
procedure EmployeesAfterInsert(DataSet: TDataSet); |
116 |
> |
procedure EmployeesAfterOpen(DataSet: TDataSet); |
117 |
> |
procedure EmployeesAfterScroll(DataSet: TDataSet); |
118 |
> |
procedure EmployeesBeforeClose(DataSet: TDataSet); |
119 |
> |
procedure EmployeesBeforeOpen(DataSet: TDataSet); |
120 |
> |
procedure EmployeesJOB_CODEChange(Sender: TField); |
121 |
> |
procedure EmployeesJOB_GRADEChange(Sender: TField); |
122 |
> |
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); |
123 |
> |
procedure FormShow(Sender: TObject); |
124 |
> |
procedure EmployeesAfterDelete(DataSet: TDataSet); |
125 |
> |
procedure EmployeesAfterTransactionEnd(Sender: TObject); |
126 |
> |
procedure EmployeesPostError(DataSet: TDataSet; E: EDatabaseError; |
127 |
> |
var DataAction: TDataAction); |
128 |
> |
procedure EmployeesSALARYGetText(Sender: TField; var aText: string; |
129 |
> |
DisplayText: Boolean); |
130 |
> |
procedure JobCodesBeforeOpen(DataSet: TDataSet); |
131 |
> |
procedure SaveChangesExecute(Sender: TObject); |
132 |
> |
procedure SaveChangesUpdate(Sender: TObject); |
133 |
> |
private |
134 |
> |
{ private declarations } |
135 |
> |
FDirty: boolean; |
136 |
> |
FClosing: boolean; |
137 |
> |
procedure Reopen(Data: PtrInt); |
138 |
> |
public |
139 |
> |
{ public declarations } |
140 |
> |
end; |
141 |
> |
|
142 |
> |
var |
143 |
> |
Form1: TForm1; |
144 |
> |
|
145 |
> |
implementation |
146 |
> |
|
147 |
> |
{$R *.lfm} |
148 |
> |
|
149 |
> |
uses IB, Unit2; |
150 |
> |
|
151 |
> |
const |
152 |
> |
sNoName = '<no name>'; |
153 |
> |
|
154 |
> |
function ExtractDBException(msg: string): string; |
155 |
> |
var Lines: TStringList; |
156 |
> |
begin |
157 |
> |
Lines := TStringList.Create; |
158 |
> |
try |
159 |
> |
Lines.Text := msg; |
160 |
> |
if pos('exception',Lines[0]) = 1 then |
161 |
> |
Result := Lines[2] |
162 |
> |
else |
163 |
> |
Result := msg |
164 |
> |
finally |
165 |
> |
Lines.Free |
166 |
> |
end; |
167 |
> |
end; |
168 |
> |
|
169 |
> |
{ TForm1 } |
170 |
> |
|
171 |
> |
procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string; |
172 |
> |
DisplayText: Boolean); |
173 |
> |
begin |
174 |
> |
if DisplayText then |
175 |
> |
begin |
176 |
> |
if Sender.IsNUll then |
177 |
> |
aText := '' |
178 |
> |
else |
179 |
> |
aText := FormatFloat('$#,##0.00',Sender.AsFloat) |
180 |
> |
end |
181 |
> |
else |
182 |
> |
aText := Sender.AsString |
183 |
> |
end; |
184 |
> |
|
185 |
> |
procedure TForm1.JobCodesBeforeOpen(DataSet: TDataSet); |
186 |
> |
begin |
187 |
> |
JobCodes.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger; |
188 |
> |
JobCodes.ParamByName('JOB_COUNTRY').AsString := EmployeesJOB_COUNTRY.AsString |
189 |
> |
end; |
190 |
> |
|
191 |
> |
procedure TForm1.SaveChangesExecute(Sender: TObject); |
192 |
> |
begin |
193 |
> |
Employees.Transaction.Commit |
194 |
> |
end; |
195 |
> |
|
196 |
> |
procedure TForm1.SaveChangesUpdate(Sender: TObject); |
197 |
> |
begin |
198 |
> |
(Sender as TAction).Enabled := FDirty |
199 |
> |
end; |
200 |
> |
|
201 |
> |
procedure TForm1.Reopen(Data: PtrInt); |
202 |
> |
begin |
203 |
> |
with IBTransaction1 do |
204 |
> |
if not InTransaction then StartTransaction; |
205 |
> |
Countries.Active := true; |
206 |
> |
Employees.Active := true; |
207 |
> |
JobCodes.Active := true; |
208 |
> |
Depts.Active := true; |
209 |
> |
end; |
210 |
> |
|
211 |
> |
procedure TForm1.AddEmployeeExecute(Sender: TObject); |
212 |
> |
begin |
213 |
> |
Employees.Append |
214 |
> |
end; |
215 |
> |
|
216 |
> |
procedure TForm1.SelectDeptExecute(Sender: TObject); |
217 |
> |
var Dept_No: string; |
218 |
> |
begin |
219 |
> |
if SelectDeptDlg.ShowModal(EmployeesDEPT_KEY_PATH.AsString,Dept_No) = mrOK then |
220 |
> |
begin |
221 |
> |
Employees.Edit; |
222 |
> |
EmployeesDEPT_NO.AsString := Dept_No; |
223 |
> |
try |
224 |
> |
Employees.Post; |
225 |
> |
except |
226 |
> |
Employees.Cancel; |
227 |
> |
raise; |
228 |
> |
end; |
229 |
> |
IBDynamicGrid1.ShowEditorPanel; |
230 |
> |
end; |
231 |
> |
end; |
232 |
> |
|
233 |
> |
procedure TForm1.EmployeesAfterPost(DataSet: TDataSet); |
234 |
> |
begin |
235 |
> |
Employees.Refresh |
236 |
> |
end; |
237 |
> |
|
238 |
> |
procedure TForm1.EmployeesValidatePost(Sender: TObject; var CancelPost: boolean |
239 |
> |
); |
240 |
> |
begin |
241 |
> |
{Cancel if no name entered} |
242 |
> |
CancelPost := (EmployeesLAST_NAME.AsString = sNoName) and (EmployeesFIRST_NAME.AsString = sNoName); |
243 |
> |
end; |
244 |
> |
|
245 |
> |
procedure TForm1.JobCodeChangeTimerTimer(Sender: TObject); |
246 |
> |
begin |
247 |
> |
Countries.Active := false; |
248 |
> |
Countries.Active := true; |
249 |
> |
JobCodeChangeTimer.Interval := 0; |
250 |
> |
end; |
251 |
> |
|
252 |
> |
procedure TForm1.JobGradeChangeTimerTimer(Sender: TObject); |
253 |
> |
begin |
254 |
> |
Countries.Active := false; |
255 |
> |
JobCodes.Active := false; |
256 |
> |
Countries.Active := true; |
257 |
> |
JobCodes.Active := true; |
258 |
> |
JobGradeChangeTimer.Interval := 0; |
259 |
> |
end; |
260 |
> |
|
261 |
> |
procedure TForm1.JobGradeDBComboBoxCloseUp(Sender: TObject); |
262 |
> |
begin |
263 |
> |
JobGradeDBComboBox.EditingDone; //See http://bugs.freepascal.org/view.php?id=27186 |
264 |
> |
end; |
265 |
> |
|
266 |
> |
procedure TForm1.BeforeDateChange(Sender: TObject); |
267 |
> |
begin |
268 |
> |
Employees.Active := false; |
269 |
> |
Employees.Active := true |
270 |
> |
end; |
271 |
> |
|
272 |
> |
procedure TForm1.CancelChangesExecute(Sender: TObject); |
273 |
> |
begin |
274 |
> |
Employees.Transaction.Rollback |
275 |
> |
end; |
276 |
> |
|
277 |
> |
procedure TForm1.CountriesBeforeOpen(DataSet: TDataSet); |
278 |
> |
begin |
279 |
> |
Countries.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger; |
280 |
> |
Countries.ParamByName('JOB_CODE').AsString := EmployeesJOB_CODE.AsString |
281 |
> |
end; |
282 |
> |
|
283 |
> |
procedure TForm1.DeleteEmployeeExecute(Sender: TObject); |
284 |
> |
begin |
285 |
> |
if MessageDlg( |
286 |
> |
Format('Remove %s from Employee List?',[Employees.FieldByName('Full_Name').AsString]), |
287 |
> |
mtConfirmation,[mbYes,mbNo],0) = mrYes then |
288 |
> |
Employees.Delete |
289 |
> |
end; |
290 |
> |
|
291 |
> |
procedure TForm1.EditEmployeeExecute(Sender: TObject); |
292 |
> |
begin |
293 |
> |
IBDynamicGrid1.ShowEditorPanel; |
294 |
> |
end; |
295 |
> |
|
296 |
> |
procedure TForm1.EditEmployeeUpdate(Sender: TObject); |
297 |
> |
begin |
298 |
> |
(Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0) |
299 |
> |
end; |
300 |
> |
|
301 |
> |
procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet); |
302 |
> |
begin |
303 |
> |
EmployeesJOB_COUNTRY.AsString := 'USA'; |
304 |
> |
EmployeesJOB_CODE.AsString := 'SRep'; |
305 |
> |
EmployeesJOB_GRADE.AsInteger := 4; |
306 |
> |
EmployeesSALARY.AsCurrency := 20000; |
307 |
> |
EmployeesFIRST_NAME.AsString := sNoName; |
308 |
> |
EmployeesLAST_NAME.AsString := sNoName; |
309 |
> |
EmployeesHIRE_DATE.AsDateTime := now; |
310 |
> |
EmployeesDEPT_NO.AsString := '000'; |
311 |
> |
FDirty := true; |
312 |
> |
end; |
313 |
> |
|
314 |
> |
procedure TForm1.EmployeesAfterOpen(DataSet: TDataSet); |
315 |
> |
begin |
316 |
> |
TotalsQuery.Active := true; |
317 |
> |
IBDynamicGrid1.SetFocus; |
318 |
> |
end; |
319 |
> |
|
320 |
> |
procedure TForm1.EmployeesAfterScroll(DataSet: TDataSet); |
321 |
> |
begin |
322 |
> |
JobGradeChangeTimer.Interval := 200; |
323 |
> |
end; |
324 |
> |
|
325 |
> |
procedure TForm1.EmployeesBeforeClose(DataSet: TDataSet); |
326 |
> |
begin |
327 |
> |
TotalsQuery.Active := false |
328 |
> |
end; |
329 |
> |
|
330 |
> |
procedure TForm1.EmployeesBeforeOpen(DataSet: TDataSet); |
331 |
> |
begin |
332 |
> |
if BeforeDate.Date > 0 then |
333 |
> |
(DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE < :BeforeDate'); |
334 |
> |
if AfterDate.Date > 0 then |
335 |
> |
(DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE > :AfterDate'); |
336 |
> |
|
337 |
> |
case SalaryRange.ItemIndex of |
338 |
> |
1: |
339 |
> |
(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary < 40000'); |
340 |
> |
2: |
341 |
> |
(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 40000 and Salary < 100000'); |
342 |
> |
3: |
343 |
> |
(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 100000'); |
344 |
> |
end; |
345 |
> |
|
346 |
> |
|
347 |
> |
|
348 |
> |
{Parameter value must be set after all SQL changes have been made} |
349 |
> |
if BeforeDate.Date > 0 then |
350 |
> |
(DataSet as TIBParserDataSet).ParamByName('BeforeDate').AsDateTime := BeforeDate.Date; |
351 |
> |
if AfterDate.Date > 0 then |
352 |
> |
(DataSet as TIBParserDataSet).ParamByName('AfterDate').AsDateTime := AfterDate.Date; |
353 |
> |
|
354 |
> |
end; |
355 |
> |
|
356 |
> |
procedure TForm1.EmployeesJOB_CODEChange(Sender: TField); |
357 |
> |
begin |
358 |
> |
JobCodeChangeTimer.Interval := 200; |
359 |
> |
end; |
360 |
> |
|
361 |
> |
procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField); |
362 |
> |
begin |
363 |
> |
JobGradeChangeTimer.Interval := 200; |
364 |
> |
end; |
365 |
> |
|
366 |
> |
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction); |
367 |
> |
begin |
368 |
> |
FClosing := true; |
369 |
> |
if IBTransaction1.InTransaction then |
370 |
> |
IBTransaction1.Commit; |
371 |
> |
end; |
372 |
> |
|
373 |
> |
procedure TForm1.FormShow(Sender: TObject); |
374 |
> |
begin |
375 |
> |
repeat |
376 |
> |
try |
377 |
> |
IBDatabase1.Connected := true; |
378 |
> |
except |
379 |
> |
on E:EIBClientError do |
380 |
> |
begin |
381 |
> |
Close; |
382 |
> |
Exit |
383 |
> |
end; |
384 |
> |
On E:Exception do |
385 |
> |
MessageDlg(E.Message,mtError,[mbOK],0); |
386 |
> |
end; |
387 |
> |
until IBDatabase1.Connected; |
388 |
> |
Reopen(0); |
389 |
> |
end; |
390 |
> |
|
391 |
> |
procedure TForm1.EmployeesAfterDelete(DataSet: TDataSet); |
392 |
> |
begin |
393 |
> |
FDirty := true |
394 |
> |
end; |
395 |
> |
|
396 |
> |
procedure TForm1.EmployeesAfterTransactionEnd(Sender: TObject); |
397 |
> |
begin |
398 |
> |
FDirty := false; |
399 |
> |
if not FClosing then |
400 |
> |
Application.QueueAsyncCall(@Reopen,0) |
401 |
> |
end; |
402 |
> |
|
403 |
> |
procedure TForm1.EmployeesPostError(DataSet: TDataSet; E: EDatabaseError; |
404 |
> |
var DataAction: TDataAction); |
405 |
> |
begin |
406 |
> |
if E is EIBError then |
407 |
> |
begin |
408 |
> |
MessageDlg(ExtractDBException(EIBError(E).message),mtError,[mbOK],0); |
409 |
> |
DataSet.Cancel; |
410 |
> |
DataAction := daAbort |
411 |
> |
end; |
412 |
> |
end; |
413 |
> |
|
414 |
> |
end. |
415 |
> |
|