examples/dbcontrolgrid/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, DBControlGrid, types;

type

  { TForm1 }

  TForm1 = class(TForm)
    EditLocationAction: TAction;
    EditJobCodeAction: TAction;
    DBEdit6: TDBEdit;
    DBControlGrid1: TDBControlGrid;
    DBEdit7: TDBEdit;
    DBEdit8: TDBEdit;
    DBText1: TDBText;
    EmployeesDEPT_KEY_PATH: TIBStringField;
    EmployeesDEPT_PATH: TIBStringField;
    EmployeesJOB_TITLE: TIBStringField;
    SelectDept: TAction;
    Button4: TButton;
    Button5: TButton;
    CancelChanges: TAction;
    SalaryRange: TComboBox;
    BeforeDate: TDateEdit;
    AfterDate: TDateEdit;
    DBEdit1: TDBEdit;
    DBEdit2: TDBEdit;
    DBEdit3: TDBEdit;
    DBEdit4: TDBEdit;
    DBEdit5: TDBEdit;
    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;
    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;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    TotalsQuery: TIBQuery;
    TotalsQueryTOTALSALARIES: TIBBCDField;
    Label1: TLabel;
    Label2: TLabel;
    SaveChanges: TAction;
    DeleteEmployee: TAction;
    EditEmployee: TAction;
    AddEmployee: TAction;
    ActionList1: TActionList;
    Button1: TButton;
    Button3: TButton;
    EmployeeSource: TDataSource;
    IBDatabase1: TIBDatabase;
    IBTransaction1: TIBTransaction;
    TotalsSource: TDataSource;
    procedure EditJobCodeActionExecute(Sender: TObject);
    procedure EditJobCodeActionUpdate(Sender: TObject);
    procedure EditLocationActionExecute(Sender: TObject);
    procedure EmployeesAfterPost(DataSet: TDataSet);
    procedure JobGradeDBComboBoxCloseUp(Sender: TObject);
    procedure SelectDeptExecute(Sender: TObject);
    procedure AddEmployeeExecute(Sender: TObject);
    procedure BeforeDateChange(Sender: TObject);
    procedure CancelChangesExecute(Sender: TObject);
    procedure DeleteEmployeeExecute(Sender: TObject);
    procedure EditEmployeeUpdate(Sender: TObject);
    procedure EmployeesAfterInsert(DataSet: TDataSet);
    procedure EmployeesAfterOpen(DataSet: TDataSet);
    procedure EmployeesBeforeClose(DataSet: TDataSet);
    procedure EmployeesBeforeOpen(DataSet: TDataSet);
    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 SaveChangesExecute(Sender: TObject);
    procedure SaveChangesUpdate(Sender: TObject);
    procedure TotalsQueryTOTALSALARIESGetText(Sender: TField;
      var aText: string; DisplayText: Boolean);
  private
    { private declarations }
    FDirty: boolean;
    FClosing: boolean;
    procedure Reopen(Data: PtrInt);
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

{$R *.lfm}

uses IB, Unit2, Unit4, Unit5;

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.SaveChangesExecute(Sender: TObject);
begin
  Employees.Transaction.Commit
end;

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

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

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

procedure TForm1.AddEmployeeExecute(Sender: TObject);
begin
  Employees.Append;
  DBControlGrid1.SetFocus;
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;
  end;
end;

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

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

procedure TForm1.EditLocationActionExecute(Sender: TObject);
var Country: string;
begin
  Country := EmployeesJOB_COUNTRY.AsString;
  if EditLocation.ShowModal(EmployeesJOB_GRADE.AsInteger, EmployeesJOB_CODE.AsString,
     Country) = mrOK then
     begin
       Employees.Edit;
       try
         EmployeesJOB_COUNTRY.AsString := Country;
         Employees.Post;
       except
         Employees.Cancel;
         raise
       end;
     end;
end;

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