examples/employee/unit1.pas

unit Unit1; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, DBGrids,
  StdCtrls, ActnList, EditBtn, DbCtrls, ExtCtrls, Buttons, IBDatabase, IBQuery,
  IBCustomDataSet, IBUpdateSQL, IBDynamicGrid, IBLookupComboEditBox,
  db, DBExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    DBEdit6: TDBEdit;
    EmployeesDEPT_KEY_PATH: TIBStringField;
    EmployeesDEPT_PATH: TIBStringField;
    IBLookupComboEditBox1: TIBLookupComboEditBox;
    IBLookupComboEditBox2: TIBLookupComboEditBox;
    IBQuery1DEPT_NO: TIBStringField;
    IBQuery1EMP_NO: TSmallintField;
    IBQuery1FIRST_NAME: TIBStringField;
    IBQuery1FULL_NAME: TIBStringField;
    IBQuery1HIRE_DATE: TDateTimeField;
    IBQuery1JOB_CODE: TIBStringField;
    IBQuery1JOB_COUNTRY: TIBStringField;
    IBQuery1JOB_GRADE: TSmallintField;
    IBQuery1LAST_NAME: TIBStringField;
    IBQuery1PHONE_EXT: TIBStringField;
    IBQuery1SALARY: TIBBCDField;
    SelectDept: TAction;
    Button4: TButton;
    Button5: TButton;
    CancelChanges: TAction;
    SalaryRange: TComboBox;
    CountrySource: TDataSource;
    BeforeDate: TDateEdit;
    AfterDate: TDateEdit;
    DeptsSource: TDataSource;
    Depts: TIBQuery;
    JobCodeSource: TDataSource;
    DBEdit1: TDBEdit;
    DBEdit2: TDBEdit;
    DBEdit3: TDBEdit;
    DBEdit4: TDBEdit;
    DBEdit5: TDBEdit;
    DBText1: TDBText;
    Employees: TIBDataSet;
    EmployeesDEPT_NO: TIBStringField;
    EmployeesEMP_NO: TSmallintField;
    EmployeesFIRST_NAME: TIBStringField;
    EmployeesFULL_NAME: TIBStringField;
    EmployeesHIRE_DATE: TDateTimeField;
    EmployeesJOB_CODE: TIBStringField;
    EmployeesJOB_COUNTRY: TIBStringField;
    EmployeesJOB_GRADE: TSmallintField;
    EmployeesLAST_NAME: TIBStringField;
    EmployeesPHONE_EXT: TIBStringField;
    EmployeesSALARY: TIBBCDField;
    IBDateEdit1: TDBDateEdit;
    IBDynamicGrid1: TIBDynamicGrid;
    Countries: TIBQuery;
    JobCodes: TIBQuery;
    JobGradeDBComboBox: TDBComboBox;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Panel1: TPanel;
    Panel2: TPanel;
    EmployeeEditorPanel: TPanel;
    SpeedButton1: TSpeedButton;
    TotalsQueryTOTALSALARIES: TIBBCDField;
    TotalsSource: TDataSource;
    TotalsQuery: TIBQuery;
    Label1: TLabel;
    Label2: TLabel;
    SaveChanges: TAction;
    DeleteEmployee: TAction;
    EditEmployee: TAction;
    AddEmployee: TAction;
    ActionList1: TActionList;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    EmployeeSource: TDataSource;
    IBDatabase1: TIBDatabase;
    IBTransaction1: TIBTransaction;
    procedure EmployeesAfterPost(DataSet: TDataSet);
    procedure EmployeesValidatePost(Sender: TObject; var CancelPost: boolean);
    procedure JobGradeDBComboBoxCloseUp(Sender: TObject);
    procedure SelectDeptExecute(Sender: TObject);
    procedure AddEmployeeExecute(Sender: TObject);
    procedure BeforeDateChange(Sender: TObject);
    procedure CancelChangesExecute(Sender: TObject);
    procedure CountriesBeforeOpen(DataSet: TDataSet);
    procedure DeleteEmployeeExecute(Sender: TObject);
    procedure EditEmployeeExecute(Sender: TObject);
    procedure EditEmployeeUpdate(Sender: TObject);
    procedure EmployeesAfterInsert(DataSet: TDataSet);
    procedure EmployeesAfterOpen(DataSet: TDataSet);
    procedure EmployeesAfterScroll(DataSet: TDataSet);
    procedure EmployeesBeforeClose(DataSet: TDataSet);
    procedure EmployeesBeforeOpen(DataSet: TDataSet);
    procedure EmployeesJOB_CODEChange(Sender: TField);
    procedure EmployeesJOB_GRADEChange(Sender: TField);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure EmployeesAfterDelete(DataSet: TDataSet);
    procedure EmployeesAfterTransactionEnd(Sender: TObject);
    procedure EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
      var DataAction: TDataAction);
    procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
      DisplayText: Boolean);
    procedure JobCodesBeforeOpen(DataSet: TDataSet);
    procedure SaveChangesExecute(Sender: TObject);
    procedure SaveChangesUpdate(Sender: TObject);
  private
    { private declarations }
    FDirty: boolean;
    FClosing: boolean;
    procedure Reopen(Data: PtrInt);
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

{$R *.lfm}

uses IB, Unit2;

const
  sNoName = '<no name>';

function ExtractDBException(msg: string): string;
var Lines: TStringList;
begin
     Lines := TStringList.Create;
     try
       Lines.Text := msg;
       if pos('exception',Lines[0]) = 1 then
         Result := Lines[2]
       else
         Result := msg
     finally
       Lines.Free
     end;
end;

{ TForm1 }

procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
  DisplayText: Boolean);
begin
  if DisplayText then
  begin
    if Sender.IsNUll then
      aText := ''
    else
      aText := FormatFloat('$#,##0.00',Sender.AsFloat)
  end
  else
    aText := Sender.AsString
end;

procedure TForm1.JobCodesBeforeOpen(DataSet: TDataSet);
begin
  JobCodes.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
  JobCodes.ParamByName('JOB_COUNTRY').AsString := EmployeesJOB_COUNTRY.AsString
end;

procedure TForm1.SaveChangesExecute(Sender: TObject);
begin
  Employees.Transaction.Commit
end;

procedure TForm1.SaveChangesUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := FDirty
end;

procedure TForm1.Reopen(Data: PtrInt);
begin
  with IBTransaction1 do
    if not InTransaction then StartTransaction;
  Countries.Active := true;
  Employees.Active := true;
  JobCodes.Active := true;
  Depts.Active := true;
end;

procedure TForm1.AddEmployeeExecute(Sender: TObject);
begin
  Employees.Append
end;

procedure TForm1.SelectDeptExecute(Sender: TObject);
var Dept_No: string;
begin
  if SelectDeptDlg.ShowModal(EmployeesDEPT_KEY_PATH.AsString,Dept_No) = mrOK then
  begin
    Employees.Edit;
    EmployeesDEPT_NO.AsString := Dept_No;
    try
      Employees.Post;
    except
      Employees.Cancel;
      raise;
    end;
    IBDynamicGrid1.ShowEditorPanel;
  end;
end;

procedure TForm1.EmployeesAfterPost(DataSet: TDataSet);
begin
  Employees.Refresh
end;

procedure TForm1.EmployeesValidatePost(Sender: TObject; var CancelPost: boolean
  );
begin
  {Cancel if no name entered}
  CancelPost := (EmployeesLAST_NAME.AsString = sNoName) and  (EmployeesFIRST_NAME.AsString = sNoName);
end;

procedure TForm1.JobGradeDBComboBoxCloseUp(Sender: TObject);
begin
  JobGradeDBComboBox.EditingDone; //See http://bugs.freepascal.org/view.php?id=27186
end;

procedure TForm1.BeforeDateChange(Sender: TObject);
begin
  Employees.Active := false;
  Employees.Active := true
end;

procedure TForm1.CancelChangesExecute(Sender: TObject);
begin
  Employees.Transaction.Rollback
end;

procedure TForm1.CountriesBeforeOpen(DataSet: TDataSet);
begin
  Countries.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
  Countries.ParamByName('JOB_CODE').AsString := EmployeesJOB_CODE.AsString
end;

procedure TForm1.DeleteEmployeeExecute(Sender: TObject);
begin
  if MessageDlg(
    Format('Remove %s from Employee List?',[Employees.FieldByName('Full_Name').AsString]),
    mtConfirmation,[mbYes,mbNo],0) = mrYes then
    Employees.Delete
end;

procedure TForm1.EditEmployeeExecute(Sender: TObject);
begin
  IBDynamicGrid1.ShowEditorPanel;
end;

procedure TForm1.EditEmployeeUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0)
end;

procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet);
begin
  EmployeesJOB_COUNTRY.AsString := 'USA';
  EmployeesJOB_CODE.AsString := 'SRep';
  EmployeesJOB_GRADE.AsInteger := 4;
  EmployeesSALARY.AsCurrency := 20000;
  EmployeesFIRST_NAME.AsString := sNoName;
  EmployeesLAST_NAME.AsString := sNoName;
  EmployeesHIRE_DATE.AsDateTime := now;
  EmployeesDEPT_NO.AsString := '000';
  FDirty := true;
end;

procedure TForm1.EmployeesAfterOpen(DataSet: TDataSet);
begin
  TotalsQuery.Active := true;
  IBDynamicGrid1.SetFocus;
end;

procedure TForm1.EmployeesAfterScroll(DataSet: TDataSet);
begin
  Countries.Active := false;
  JobCodes.Active := false;
  Countries.Active := true;
  JobCodes.Active := true;
end;

procedure TForm1.EmployeesBeforeClose(DataSet: TDataSet);
begin
  TotalsQuery.Active := false
end;

procedure TForm1.EmployeesBeforeOpen(DataSet: TDataSet);
begin
  if BeforeDate.Date > 0 then
     (DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE < :BeforeDate');
  if AfterDate.Date > 0 then
     (DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE > :AfterDate');

  case SalaryRange.ItemIndex of
  1:
    (DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary < 40000');
  2:
    (DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 40000 and Salary < 100000');
  3:
    (DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 100000');
  end;


  {Parameter value must be set after all SQL changes have been made}
  if BeforeDate.Date > 0 then
     (DataSet as TIBParserDataSet).ParamByName('BeforeDate').AsDateTime := BeforeDate.Date;
  if AfterDate.Date > 0 then
   (DataSet as TIBParserDataSet).ParamByName('AfterDate').AsDateTime := AfterDate.Date;

end;

procedure TForm1.EmployeesJOB_CODEChange(Sender: TField);
begin
  Countries.Active := false;
  Countries.Active := true;
end;

procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
begin
  Countries.Active := false;
  JobCodes.Active := false;
  Countries.Active := true;
  JobCodes.Active := true;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  FClosing := true;
  if IBTransaction1.InTransaction then
    IBTransaction1.Commit;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  repeat
    try
      IBDatabase1.Connected := true;
    except
     on E:EIBClientError do
      begin
        Close;
        Exit
      end;
    On E:Exception do
     MessageDlg(E.Message,mtError,[mbOK],0);
    end;
  until IBDatabase1.Connected;
  Reopen(0);
end;

procedure TForm1.EmployeesAfterDelete(DataSet: TDataSet);
begin
  FDirty := true
end;

procedure TForm1.EmployeesAfterTransactionEnd(Sender: TObject);
begin
  FDirty := false;
  if not FClosing then
    Application.QueueAsyncCall(@Reopen,0)
end;

procedure TForm1.EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
  var DataAction: TDataAction);
begin
  if E is EIBError then
   begin
       MessageDlg(ExtractDBException(EIBError(E).message),mtError,[mbOK],0);
       DataSet.Cancel;
       DataAction  := daAbort
   end;
end;

end.

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