examples/employee/unit1.pas

(*
 *  IBX For Lazarus (Firebird Express)
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2015 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*) 
            
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 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, IBMessages;

const
  sNoName = '<no name>';

{ 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.EnableStatistics := 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.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;
  try
    if IBTransaction1.InTransaction then
      IBTransaction1.Commit;

  except on E: Exception do
    begin
      MessageDlg(E.Message,mtError,[mbOK],0);
      IBDatabase1.ForceClose;
    end;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  {Set IB Exceptions to only show text message - omit SQLCode and Engine Code}
  IBDatabase1.FirebirdAPI.GetStatus.SetIBDataBaseErrorMessages([ShowIBMessage]);
  Application.ExceptionDialog := aedOkMessageBox;
  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(EIBError(E).message,mtError,[mbOK],0);
       DataSet.Cancel;
       DataAction  := daAbort
   end;
end;

end.

Revision:	363
Committed:	Tue Dec 7 13:30:05 2021 UTC (2 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	12061 byte(s)
Log Message:	add fbintf
#	User	Rev	Content
1	tony	143	(*
2			* IBX For Lazarus (Firebird Express)
3			*
4			* The contents of this file are subject to the Initial Developer's
5			* Public License Version 1.0 (the "License"); you may not use this
6			* file except in compliance with the License. You may obtain a copy
7			* of the License here:
8			*
9			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
10			*
11			* Software distributed under the License is distributed on an "AS
12			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
13			* implied. See the License for the specific language governing rights
14			* and limitations under the License.
15			*
16			* The Initial Developer of the Original Code is Tony Whyman.
17			*
18			* The Original Code is (C) 2015 Tony Whyman, MWA Software
19			* (http://www.mwasoftware.co.uk).
20			*
21			* All Rights Reserved.
22			*
23			* Contributor(s): ______________________________________.
24			*
25			*)
26
27	tony	33	unit Unit1;
28
29			{$mode objfpc}{$H+}
30
31			interface
32
33			uses
34			Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, DBGrids,
35			StdCtrls, ActnList, EditBtn, DbCtrls, ExtCtrls, Buttons, IBDatabase, IBQuery,
36			IBCustomDataSet, IBUpdateSQL, IBDynamicGrid, IBLookupComboEditBox,
37			db, DBExtCtrls;
38
39			type
40
41			{ TForm1 }
42
43			TForm1 = class(TForm)
44			DBEdit6: TDBEdit;
45			EmployeesDEPT_KEY_PATH: TIBStringField;
46			EmployeesDEPT_PATH: TIBStringField;
47	tony	66	EmployeesTEst: TStringField;
48	tony	33	IBLookupComboEditBox1: TIBLookupComboEditBox;
49			IBLookupComboEditBox2: TIBLookupComboEditBox;
50			IBQuery1DEPT_NO: TIBStringField;
51			IBQuery1EMP_NO: TSmallintField;
52			IBQuery1FIRST_NAME: TIBStringField;
53			IBQuery1FULL_NAME: TIBStringField;
54			IBQuery1HIRE_DATE: TDateTimeField;
55			IBQuery1JOB_CODE: TIBStringField;
56			IBQuery1JOB_COUNTRY: TIBStringField;
57			IBQuery1JOB_GRADE: TSmallintField;
58			IBQuery1LAST_NAME: TIBStringField;
59			IBQuery1PHONE_EXT: TIBStringField;
60			IBQuery1SALARY: TIBBCDField;
61			SelectDept: TAction;
62			Button4: TButton;
63			Button5: TButton;
64			CancelChanges: TAction;
65			SalaryRange: TComboBox;
66			CountrySource: TDataSource;
67			BeforeDate: TDateEdit;
68			AfterDate: TDateEdit;
69			DeptsSource: TDataSource;
70			Depts: TIBQuery;
71			JobCodeSource: TDataSource;
72			DBEdit1: TDBEdit;
73			DBEdit2: TDBEdit;
74			DBEdit3: TDBEdit;
75			DBEdit4: TDBEdit;
76			DBEdit5: TDBEdit;
77			DBText1: TDBText;
78			Employees: TIBDataSet;
79			EmployeesDEPT_NO: TIBStringField;
80			EmployeesEMP_NO: TSmallintField;
81			EmployeesFIRST_NAME: TIBStringField;
82			EmployeesFULL_NAME: TIBStringField;
83			EmployeesHIRE_DATE: TDateTimeField;
84			EmployeesJOB_CODE: TIBStringField;
85			EmployeesJOB_COUNTRY: TIBStringField;
86			EmployeesJOB_GRADE: TSmallintField;
87			EmployeesLAST_NAME: TIBStringField;
88			EmployeesPHONE_EXT: TIBStringField;
89			EmployeesSALARY: TIBBCDField;
90			IBDateEdit1: TDBDateEdit;
91			IBDynamicGrid1: TIBDynamicGrid;
92			Countries: TIBQuery;
93			JobCodes: TIBQuery;
94			JobGradeDBComboBox: TDBComboBox;
95			Label10: TLabel;
96			Label11: TLabel;
97			Label12: TLabel;
98			Label13: TLabel;
99			Label3: TLabel;
100			Label4: TLabel;
101			Label5: TLabel;
102			Label6: TLabel;
103			Label7: TLabel;
104			Label8: TLabel;
105			Label9: TLabel;
106			Panel1: TPanel;
107			Panel2: TPanel;
108			EmployeeEditorPanel: TPanel;
109			SpeedButton1: TSpeedButton;
110			JobGradeChangeTimer: TTimer;
111			JobCodeChangeTimer: TTimer;
112			TotalsQueryTOTALSALARIES: TIBBCDField;
113			TotalsSource: TDataSource;
114			TotalsQuery: TIBQuery;
115			Label1: TLabel;
116			Label2: TLabel;
117			SaveChanges: TAction;
118			DeleteEmployee: TAction;
119			EditEmployee: TAction;
120			AddEmployee: TAction;
121			ActionList1: TActionList;
122			Button1: TButton;
123			Button2: TButton;
124			Button3: TButton;
125			EmployeeSource: TDataSource;
126			IBDatabase1: TIBDatabase;
127			IBTransaction1: TIBTransaction;
128			procedure EmployeesValidatePost(Sender: TObject; var CancelPost: boolean);
129			procedure JobCodeChangeTimerTimer(Sender: TObject);
130			procedure JobGradeChangeTimerTimer(Sender: TObject);
131			procedure JobGradeDBComboBoxCloseUp(Sender: TObject);
132			procedure SelectDeptExecute(Sender: TObject);
133			procedure AddEmployeeExecute(Sender: TObject);
134			procedure BeforeDateChange(Sender: TObject);
135			procedure CancelChangesExecute(Sender: TObject);
136			procedure CountriesBeforeOpen(DataSet: TDataSet);
137			procedure DeleteEmployeeExecute(Sender: TObject);
138			procedure EditEmployeeExecute(Sender: TObject);
139			procedure EditEmployeeUpdate(Sender: TObject);
140			procedure EmployeesAfterInsert(DataSet: TDataSet);
141			procedure EmployeesAfterOpen(DataSet: TDataSet);
142			procedure EmployeesAfterScroll(DataSet: TDataSet);
143			procedure EmployeesBeforeClose(DataSet: TDataSet);
144			procedure EmployeesBeforeOpen(DataSet: TDataSet);
145			procedure EmployeesJOB_CODEChange(Sender: TField);
146			procedure EmployeesJOB_GRADEChange(Sender: TField);
147			procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
148			procedure FormShow(Sender: TObject);
149			procedure EmployeesAfterDelete(DataSet: TDataSet);
150			procedure EmployeesAfterTransactionEnd(Sender: TObject);
151			procedure EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
152			var DataAction: TDataAction);
153			procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
154			DisplayText: Boolean);
155			procedure JobCodesBeforeOpen(DataSet: TDataSet);
156			procedure SaveChangesExecute(Sender: TObject);
157			procedure SaveChangesUpdate(Sender: TObject);
158			private
159			{ private declarations }
160			FDirty: boolean;
161			FClosing: boolean;
162			procedure Reopen(Data: PtrInt);
163			public
164			{ public declarations }
165			end;
166
167			var
168			Form1: TForm1;
169
170			implementation
171
172			{$R *.lfm}
173
174	tony	291	uses IB, Unit2, IBMessages;
175	tony	33
176			const
177			sNoName = '<no name>';
178
179			{ TForm1 }
180
181			procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
182			DisplayText: Boolean);
183			begin
184			if DisplayText then
185			begin
186			if Sender.IsNUll then
187			aText := ''
188			else
189			aText := FormatFloat('$#,##0.00',Sender.AsFloat)
190			end
191			else
192			aText := Sender.AsString
193			end;
194
195			procedure TForm1.JobCodesBeforeOpen(DataSet: TDataSet);
196			begin
197			JobCodes.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
198			JobCodes.ParamByName('JOB_COUNTRY').AsString := EmployeesJOB_COUNTRY.AsString
199			end;
200
201			procedure TForm1.SaveChangesExecute(Sender: TObject);
202			begin
203			Employees.Transaction.Commit
204			end;
205
206			procedure TForm1.SaveChangesUpdate(Sender: TObject);
207			begin
208			(Sender as TAction).Enabled := FDirty
209			end;
210
211			procedure TForm1.Reopen(Data: PtrInt);
212			begin
213			with IBTransaction1 do
214			if not InTransaction then StartTransaction;
215			Countries.Active := true;
216	tony	209	Employees.EnableStatistics := true;
217	tony	33	Employees.Active := true;
218			JobCodes.Active := true;
219			Depts.Active := true;
220			end;
221
222			procedure TForm1.AddEmployeeExecute(Sender: TObject);
223			begin
224			Employees.Append
225			end;
226
227			procedure TForm1.SelectDeptExecute(Sender: TObject);
228			var Dept_No: string;
229			begin
230			if SelectDeptDlg.ShowModal(EmployeesDEPT_KEY_PATH.AsString,Dept_No) = mrOK then
231			begin
232			Employees.Edit;
233			EmployeesDEPT_NO.AsString := Dept_No;
234			try
235			Employees.Post;
236			except
237			Employees.Cancel;
238			raise;
239			end;
240			IBDynamicGrid1.ShowEditorPanel;
241			end;
242			end;
243
244			procedure TForm1.EmployeesValidatePost(Sender: TObject; var CancelPost: boolean
245			);
246			begin
247			{Cancel if no name entered}
248			CancelPost := (EmployeesLAST_NAME.AsString = sNoName) and (EmployeesFIRST_NAME.AsString = sNoName);
249			end;
250
251			procedure TForm1.JobCodeChangeTimerTimer(Sender: TObject);
252			begin
253			Countries.Active := false;
254			Countries.Active := true;
255			JobCodeChangeTimer.Interval := 0;
256			end;
257
258			procedure TForm1.JobGradeChangeTimerTimer(Sender: TObject);
259			begin
260			Countries.Active := false;
261			JobCodes.Active := false;
262			Countries.Active := true;
263			JobCodes.Active := true;
264			JobGradeChangeTimer.Interval := 0;
265			end;
266
267			procedure TForm1.JobGradeDBComboBoxCloseUp(Sender: TObject);
268			begin
269			JobGradeDBComboBox.EditingDone; //See http://bugs.freepascal.org/view.php?id=27186
270			end;
271
272			procedure TForm1.BeforeDateChange(Sender: TObject);
273			begin
274			Employees.Active := false;
275			Employees.Active := true
276			end;
277
278			procedure TForm1.CancelChangesExecute(Sender: TObject);
279			begin
280			Employees.Transaction.Rollback
281			end;
282
283			procedure TForm1.CountriesBeforeOpen(DataSet: TDataSet);
284			begin
285			Countries.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
286			Countries.ParamByName('JOB_CODE').AsString := EmployeesJOB_CODE.AsString
287			end;
288
289			procedure TForm1.DeleteEmployeeExecute(Sender: TObject);
290			begin
291			if MessageDlg(
292			Format('Remove %s from Employee List?',[Employees.FieldByName('Full_Name').AsString]),
293			mtConfirmation,[mbYes,mbNo],0) = mrYes then
294			Employees.Delete
295			end;
296
297			procedure TForm1.EditEmployeeExecute(Sender: TObject);
298			begin
299			IBDynamicGrid1.ShowEditorPanel;
300			end;
301
302			procedure TForm1.EditEmployeeUpdate(Sender: TObject);
303			begin
304			(Sender as TAction).Enabled := Employees.Active and (Employees.RecordCount > 0)
305			end;
306
307			procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet);
308			begin
309			EmployeesJOB_COUNTRY.AsString := 'USA';
310			EmployeesJOB_CODE.AsString := 'SRep';
311			EmployeesJOB_GRADE.AsInteger := 4;
312			EmployeesSALARY.AsCurrency := 20000;
313			EmployeesFIRST_NAME.AsString := sNoName;
314			EmployeesLAST_NAME.AsString := sNoName;
315			EmployeesHIRE_DATE.AsDateTime := now;
316			EmployeesDEPT_NO.AsString := '000';
317			FDirty := true;
318			end;
319
320			procedure TForm1.EmployeesAfterOpen(DataSet: TDataSet);
321			begin
322			TotalsQuery.Active := true;
323			IBDynamicGrid1.SetFocus;
324			end;
325
326			procedure TForm1.EmployeesAfterScroll(DataSet: TDataSet);
327			begin
328			JobGradeChangeTimer.Interval := 200;
329			end;
330
331			procedure TForm1.EmployeesBeforeClose(DataSet: TDataSet);
332			begin
333			TotalsQuery.Active := false
334			end;
335
336			procedure TForm1.EmployeesBeforeOpen(DataSet: TDataSet);
337			begin
338			if BeforeDate.Date > 0 then
339			(DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE < :BeforeDate');
340			if AfterDate.Date > 0 then
341			(DataSet as TIBParserDataSet).Parser.Add2WhereClause('HIRE_DATE > :AfterDate');
342
343	tony	209
344	tony	33	case SalaryRange.ItemIndex of
345			1:
346			(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary < 40000');
347			2:
348			(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 40000 and Salary < 100000');
349			3:
350			(DataSet as TIBParserDataSet).Parser.Add2WhereClause('Salary >= 100000');
351			end;
352
353
354
355			{Parameter value must be set after all SQL changes have been made}
356			if BeforeDate.Date > 0 then
357			(DataSet as TIBParserDataSet).ParamByName('BeforeDate').AsDateTime := BeforeDate.Date;
358			if AfterDate.Date > 0 then
359			(DataSet as TIBParserDataSet).ParamByName('AfterDate').AsDateTime := AfterDate.Date;
360
361			end;
362
363			procedure TForm1.EmployeesJOB_CODEChange(Sender: TField);
364			begin
365			JobCodeChangeTimer.Interval := 200;
366			end;
367
368			procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
369			begin
370			JobGradeChangeTimer.Interval := 200;
371			end;
372
373			procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
374			begin
375			FClosing := true;
376	tony	363	try
377			if IBTransaction1.InTransaction then
378			IBTransaction1.Commit;
379
380			except on E: Exception do
381			begin
382			MessageDlg(E.Message,mtError,[mbOK],0);
383			IBDatabase1.ForceClose;
384			end;
385			end;
386	tony	33	end;
387
388			procedure TForm1.FormShow(Sender: TObject);
389			begin
390	tony	209	{Set IB Exceptions to only show text message - omit SQLCode and Engine Code}
391	tony	263	IBDatabase1.FirebirdAPI.GetStatus.SetIBDataBaseErrorMessages([ShowIBMessage]);
392	tony	209	Application.ExceptionDialog := aedOkMessageBox;
393	tony	33	repeat
394			try
395			IBDatabase1.Connected := true;
396			except
397			on E:EIBClientError do
398			begin
399			Close;
400			Exit
401			end;
402			On E:Exception do
403			MessageDlg(E.Message,mtError,[mbOK],0);
404			end;
405			until IBDatabase1.Connected;
406			Reopen(0);
407			end;
408
409			procedure TForm1.EmployeesAfterDelete(DataSet: TDataSet);
410			begin
411			FDirty := true
412			end;
413
414			procedure TForm1.EmployeesAfterTransactionEnd(Sender: TObject);
415			begin
416			FDirty := false;
417			if not FClosing then
418			Application.QueueAsyncCall(@Reopen,0)
419			end;
420
421			procedure TForm1.EmployeesPostError(DataSet: TDataSet; E: EDatabaseError;
422			var DataAction: TDataAction);
423			begin
424			if E is EIBError then
425			begin
426	tony	209	MessageDlg(EIBError(E).message,mtError,[mbOK],0);
427	tony	33	DataSet.Cancel;
428			DataAction := daAbort
429			end;
430			end;
431
432			end.
433