ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/examples/employee/unit1.pas

Comparing ibx/trunk/examples/employee/unit1.pas (file contents):
Revision 7 by tony, Sun Aug 5 18:28:19 2012 UTC vs.
Revision 17 by tony, Sat Dec 28 19:22:24 2013 UTC

#	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