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;
    EmployeesTEst: TStringField;
    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;
    JobGradeChangeTimer: TTimer;
    JobCodeChangeTimer: TTimer;
    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 JobCodeChangeTimerTimer(Sender: TObject);
    procedure JobGradeChangeTimerTimer(Sender: TObject);
    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.JobCodeChangeTimerTimer(Sender: TObject);
begin
  Countries.Active := false;
  Countries.Active := true;
  JobCodeChangeTimer.Interval := 0;
end;

procedure TForm1.JobGradeChangeTimerTimer(Sender: TObject);
begin
  Countries.Active := false;
  JobCodes.Active := false;
  Countries.Active := true;
  JobCodes.Active := true;
  JobGradeChangeTimer.Interval := 0;
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
  JobGradeChangeTimer.Interval := 200;
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
  JobCodeChangeTimer.Interval := 200;
end;

procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
begin
  JobGradeChangeTimer.Interval := 200;
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:	66
Committed:	Wed Aug 23 08:23:42 2017 UTC (7 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	11264 byte(s)
Log Message:	IBCustomDataset: ensure that TIBStringField uses the field size reported by Firebird rather than recomputing it.
#	User	Rev	Content
1	tony	33	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	tony	66	EmployeesTEst: TStringField;
22	tony	33	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