examples/lookupcombobox/Unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    ApplicationProperties1: TApplicationProperties;
    DBEdit5: TDBEdit;
    DeleteBtn: TButton;
    CountriesSource: TDataSource;
    EmployeesDEPT_KEY_PATH: TIBStringField;
    EmployeesDEPT_PATH: TIBStringField;
    IBLookupComboEditBox2: TIBLookupComboEditBox;
    IBLookupComboEditBox3: TIBLookupComboEditBox;
    JobCodeSource: TDataSource;
    DBComboBox1: TDBComboBox;
    DBEdit4: TDBEdit;
    IBDateEdit1: TDBDateEdit;
    Countries: TIBQuery;
    JobCodes: TIBQuery;
    Label10: TLabel;
    Label11: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    SaveBtn: TButton;
    CancelBtn: TButton;
    EmployeeSource: TDataSource;
    DBEdit1: TDBEdit;
    DBEdit2: TDBEdit;
    DBEdit3: TDBEdit;
    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;
    IBDatabase1: TIBDatabase;
    Employees: TIBDataSet;
    IBLookupComboEditBox1: TIBLookupComboEditBox;
    IBTransaction1: TIBTransaction;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
    procedure CancelBtnClick(Sender: TObject);
    procedure CountriesBeforeOpen(DataSet: TDataSet);
    procedure EmployeeSourceDataChange(Sender: TObject; Field: TField);
    procedure DBComboBox1CloseUp(Sender: TObject);
    procedure DeleteBtnClick(Sender: TObject);
    procedure EmployeesAfterDelete(DataSet: TDataSet);
    procedure EmployeesAfterInsert(DataSet: TDataSet);
    procedure EmployeesAfterPost(DataSet: TDataSet);
    procedure EmployeesAfterTransactionEnd(Sender: TObject);
    procedure EmployeesBeforeScroll(DataSet: TDataSet);
    procedure EmployeesFULL_NAMEChange(Sender: TField);
    procedure EmployeesJOB_CODEChange(Sender: TField);
    procedure EmployeesJOB_GRADEChange(Sender: TField);
    procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
      DisplayText: Boolean);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure IBLookupComboEditBox1CanAutoInsert(Sender: TObject;
      aText: string; var Accept: boolean);
    procedure JobCodesBeforeOpen(DataSet: TDataSet);
    procedure SaveBtnClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { private declarations }
    FDirty: boolean;
    FClosing: boolean;
    FLastJobGrade: integer;
    FLastJobCode: string;
    procedure OpenDataSets(Data: PtrInt);
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2, IB;

{$R *.lfm}

{ TForm1 }

procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
  DisplayText: Boolean);
begin
  if not Sender.IsNull and DisplayText then
    aText := FormatFloat('$#,##0.00',Sender.AsFloat)
  else
    aText := Sender.AsString
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
  FClosing := false;
  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;
  OpenDataSets(0)
end;

procedure TForm1.IBLookupComboEditBox1CanAutoInsert(Sender: TObject;
  aText: string; var Accept: boolean);
begin
  Accept := MessageDlg(Format('Insert a new Employee record for ''%s''?',
              [aText]),mtConfirmation,[mbYes,mbNo],0) = mrYes
end;

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

procedure TForm1.SaveBtnClick(Sender: TObject);
begin
  IBTransaction1.Commit
end;

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

procedure TForm1.OpenDataSets(Data: PtrInt);
begin
  FDirty := false;
  IBTransaction1.StartTransaction;
  JobCodes.Active := true;
  Countries.Active := true;
  Employees.Active := true;
end;

procedure TForm1.ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
begin
  SaveBtn.Enabled := FDirty;
  CancelBtn.Enabled := FDirty;
  DeleteBtn.Enabled := Employees.Active and (Employees.RecordCount > 0)
end;

procedure TForm1.CancelBtnClick(Sender: TObject);
begin
  if Employees.State in [dsInsert,dsEdit] then
    Employees.Cancel;
  IBTransaction1.Rollback
end;

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

procedure TForm1.EmployeeSourceDataChange(Sender: TObject; Field: TField);
begin
  if FLastJobGrade <>  EmployeesJOB_GRADE.AsInteger then
  begin
    JobCodes.Active := false;
    JobCodes.Active := true;
    Countries.Active := false;
    Countries.Active := true;
  end
  else
  if FLastJobCode <> EmployeesJOB_CODE.AsString then
  begin
    Countries.Active := false;
    Countries.Active := true;
  end;
end;

procedure TForm1.DBComboBox1CloseUp(Sender: TObject);
begin
  (Sender as TCustomDBComboBox).EditingDone
end;

procedure TForm1.DeleteBtnClick(Sender: TObject);
begin
  if MessageDlg(Format('Do you really want to delete ''%s''?',
                           [EmployeesFULL_NAME.AsString]),
                           mtConfirmation,[mbYes,mbNo],0) = mrYes then
    Employees.Delete
end;

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

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

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

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

procedure TForm1.EmployeesBeforeScroll(DataSet: TDataSet);
begin
  with DataSet do
    if State in [dsInsert,dsEdit] then
    try
      Post
    except on E: Exception do
      begin
        Cancel;
        MessageDlg(E.Message,mtError,[mbOK],0)
      end;
    end;
end;

procedure TForm1.EmployeesFULL_NAMEChange(Sender: TField);
var I: integer;
    aText: string;
begin
  aText := Sender.AsString;
  I := Pos(',',aText);
  Employees.Edit;
  if I > 0 then
  begin
    EmployeesLAST_NAME.AsString := system.copy(aText,1,I-1);
    EmployeesFIRST_NAME.AsString := Trim(system.copy(aText,I+1,Length(aText) - I));
  end
  else
  begin
    EmployeesLAST_NAME.AsString := aText;
    EmployeesFIRST_NAME.AsString := '!!unknown!!';
  end;
end;

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

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

end.

Revision:	21
Committed:	Thu Feb 26 10:33:34 2015 UTC (9 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	8442 byte(s)
Log Message:	Committing updates for Release R1-2-0
#	User	Rev	Content
1	tony	21	unit Unit1;
2
3			{$mode objfpc}{$H+}
4
5			interface
6
7			uses
8			Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
9			ExtCtrls, DbCtrls, EditBtn, Buttons, db, IBDatabase, IBCustomDataSet,
10			IBLookupComboEditBox, IBQuery, DBExtCtrls;
11
12			type
13
14			{ TForm1 }
15
16			TForm1 = class(TForm)
17			ApplicationProperties1: TApplicationProperties;
18			DBEdit5: TDBEdit;
19			DeleteBtn: TButton;
20			CountriesSource: TDataSource;
21			EmployeesDEPT_KEY_PATH: TIBStringField;
22			EmployeesDEPT_PATH: TIBStringField;
23			IBLookupComboEditBox2: TIBLookupComboEditBox;
24			IBLookupComboEditBox3: TIBLookupComboEditBox;
25			JobCodeSource: TDataSource;
26			DBComboBox1: TDBComboBox;
27			DBEdit4: TDBEdit;
28			IBDateEdit1: TDBDateEdit;
29			Countries: TIBQuery;
30			JobCodes: TIBQuery;
31			Label10: TLabel;
32			Label11: TLabel;
33			Label6: TLabel;
34			Label7: TLabel;
35			Label8: TLabel;
36			Label9: TLabel;
37			SaveBtn: TButton;
38			CancelBtn: TButton;
39			EmployeeSource: TDataSource;
40			DBEdit1: TDBEdit;
41			DBEdit2: TDBEdit;
42			DBEdit3: TDBEdit;
43			EmployeesDEPT_NO: TIBStringField;
44			EmployeesEMP_NO: TSmallintField;
45			EmployeesFIRST_NAME: TIBStringField;
46			EmployeesFULL_NAME: TIBStringField;
47			EmployeesHIRE_DATE: TDateTimeField;
48			EmployeesJOB_CODE: TIBStringField;
49			EmployeesJOB_COUNTRY: TIBStringField;
50			EmployeesJOB_GRADE: TSmallintField;
51			EmployeesLAST_NAME: TIBStringField;
52			EmployeesPHONE_EXT: TIBStringField;
53			EmployeesSALARY: TIBBCDField;
54			IBDatabase1: TIBDatabase;
55			Employees: TIBDataSet;
56			IBLookupComboEditBox1: TIBLookupComboEditBox;
57			IBTransaction1: TIBTransaction;
58			Label1: TLabel;
59			Label2: TLabel;
60			Label3: TLabel;
61			Label4: TLabel;
62			Label5: TLabel;
63			Panel1: TPanel;
64			SpeedButton1: TSpeedButton;
65			procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
66			procedure CancelBtnClick(Sender: TObject);
67			procedure CountriesBeforeOpen(DataSet: TDataSet);
68			procedure EmployeeSourceDataChange(Sender: TObject; Field: TField);
69			procedure DBComboBox1CloseUp(Sender: TObject);
70			procedure DeleteBtnClick(Sender: TObject);
71			procedure EmployeesAfterDelete(DataSet: TDataSet);
72			procedure EmployeesAfterInsert(DataSet: TDataSet);
73			procedure EmployeesAfterPost(DataSet: TDataSet);
74			procedure EmployeesAfterTransactionEnd(Sender: TObject);
75			procedure EmployeesBeforeScroll(DataSet: TDataSet);
76			procedure EmployeesFULL_NAMEChange(Sender: TField);
77			procedure EmployeesJOB_CODEChange(Sender: TField);
78			procedure EmployeesJOB_GRADEChange(Sender: TField);
79			procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
80			DisplayText: Boolean);
81			procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
82			procedure FormShow(Sender: TObject);
83			procedure IBLookupComboEditBox1CanAutoInsert(Sender: TObject;
84			aText: string; var Accept: boolean);
85			procedure JobCodesBeforeOpen(DataSet: TDataSet);
86			procedure SaveBtnClick(Sender: TObject);
87			procedure SpeedButton1Click(Sender: TObject);
88			private
89			{ private declarations }
90			FDirty: boolean;
91			FClosing: boolean;
92			FLastJobGrade: integer;
93			FLastJobCode: string;
94			procedure OpenDataSets(Data: PtrInt);
95			public
96			{ public declarations }
97			end;
98
99			var
100			Form1: TForm1;
101
102			implementation
103
104			uses Unit2, IB;
105
106			{$R *.lfm}
107
108			{ TForm1 }
109
110			procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
111			DisplayText: Boolean);
112			begin
113			if not Sender.IsNull and DisplayText then
114			aText := FormatFloat('$#,##0.00',Sender.AsFloat)
115			else
116			aText := Sender.AsString
117			end;
118
119			procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
120			begin
121			FClosing := true;
122			if IBTransaction1.InTransaction then
123			IBTransaction1.Commit
124			end;
125
126			procedure TForm1.FormShow(Sender: TObject);
127			begin
128			FClosing := false;
129			repeat
130			try
131			IBDatabase1.Connected := true;
132			except
133			on E:EIBClientError do
134			begin
135			Close;
136			Exit
137			end;
138			On E:Exception do
139			MessageDlg(E.Message,mtError,[mbOK],0);
140			end;
141			until IBDatabase1.Connected;
142			OpenDataSets(0)
143			end;
144
145			procedure TForm1.IBLookupComboEditBox1CanAutoInsert(Sender: TObject;
146			aText: string; var Accept: boolean);
147			begin
148			Accept := MessageDlg(Format('Insert a new Employee record for ''%s''?',
149			[aText]),mtConfirmation,[mbYes,mbNo],0) = mrYes
150			end;
151
152			procedure TForm1.JobCodesBeforeOpen(DataSet: TDataSet);
153			begin
154			JobCodes.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
155			FLastJobGrade := EmployeesJOB_GRADE.AsInteger;
156			end;
157
158			procedure TForm1.SaveBtnClick(Sender: TObject);
159			begin
160			IBTransaction1.Commit
161			end;
162
163			procedure TForm1.SpeedButton1Click(Sender: TObject);
164			var DeptNo: string;
165			begin
166			if SelectDeptDlg.ShowModal(EmployeesDEPT_KEY_PATH.AsString,DeptNo) = mrOK then
167			begin
168			Employees.Edit;
169			EmployeesDEPT_NO.AsString := DeptNo;
170			try
171			Employees.Post;
172			except
173			Employees.Cancel;
174			raise;
175			end;
176			end;
177			end;
178
179			procedure TForm1.OpenDataSets(Data: PtrInt);
180			begin
181			FDirty := false;
182			IBTransaction1.StartTransaction;
183			JobCodes.Active := true;
184			Countries.Active := true;
185			Employees.Active := true;
186			end;
187
188			procedure TForm1.ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
189			begin
190			SaveBtn.Enabled := FDirty;
191			CancelBtn.Enabled := FDirty;
192			DeleteBtn.Enabled := Employees.Active and (Employees.RecordCount > 0)
193			end;
194
195			procedure TForm1.CancelBtnClick(Sender: TObject);
196			begin
197			if Employees.State in [dsInsert,dsEdit] then
198			Employees.Cancel;
199			IBTransaction1.Rollback
200			end;
201
202			procedure TForm1.CountriesBeforeOpen(DataSet: TDataSet);
203			begin
204			Countries.ParamByName('JOB_GRADE').AsInteger := EmployeesJOB_GRADE.AsInteger;
205			Countries.ParamByName('JOB_CODE').AsString := EmployeesJOB_CODE.AsString;
206			FLastJobGrade := EmployeesJOB_GRADE.AsInteger;
207			FLastJobCode := EmployeesJOB_CODE.AsString;
208			end;
209
210			procedure TForm1.EmployeeSourceDataChange(Sender: TObject; Field: TField);
211			begin
212			if FLastJobGrade <> EmployeesJOB_GRADE.AsInteger then
213			begin
214			JobCodes.Active := false;
215			JobCodes.Active := true;
216			Countries.Active := false;
217			Countries.Active := true;
218			end
219			else
220			if FLastJobCode <> EmployeesJOB_CODE.AsString then
221			begin
222			Countries.Active := false;
223			Countries.Active := true;
224			end;
225			end;
226
227			procedure TForm1.DBComboBox1CloseUp(Sender: TObject);
228			begin
229			(Sender as TCustomDBComboBox).EditingDone
230			end;
231
232			procedure TForm1.DeleteBtnClick(Sender: TObject);
233			begin
234			if MessageDlg(Format('Do you really want to delete ''%s''?',
235			[EmployeesFULL_NAME.AsString]),
236			mtConfirmation,[mbYes,mbNo],0) = mrYes then
237			Employees.Delete
238			end;
239
240			procedure TForm1.EmployeesAfterDelete(DataSet: TDataSet);
241			begin
242			FDirty := true
243			end;
244
245			procedure TForm1.EmployeesAfterInsert(DataSet: TDataSet);
246			begin
247			FDirty := true;
248			EmployeesJOB_COUNTRY.AsString := 'USA';
249			EmployeesJOB_CODE.AsString := 'SRep';
250			EmployeesJOB_GRADE.AsInteger := 4;
251			EmployeesSALARY.AsCurrency := 20000;
252			EmployeesFIRST_NAME.AsString := 'John';
253			EmployeesLAST_NAME.AsString := 'Doe';
254			EmployeesHIRE_DATE.AsDateTime := now;
255			EmployeesDEPT_NO.AsString := '000';
256			end;
257
258			procedure TForm1.EmployeesAfterPost(DataSet: TDataSet);
259			begin
260			Employees.Refresh;
261			end;
262
263			procedure TForm1.EmployeesAfterTransactionEnd(Sender: TObject);
264			begin
265			if not FClosing then
266			Application.QueueAsyncCall(@OpenDataSets,0)
267			end;
268
269			procedure TForm1.EmployeesBeforeScroll(DataSet: TDataSet);
270			begin
271			with DataSet do
272			if State in [dsInsert,dsEdit] then
273			try
274			Post
275			except on E: Exception do
276			begin
277			Cancel;
278			MessageDlg(E.Message,mtError,[mbOK],0)
279			end;
280			end;
281			end;
282
283			procedure TForm1.EmployeesFULL_NAMEChange(Sender: TField);
284			var I: integer;
285			aText: string;
286			begin
287			aText := Sender.AsString;
288			I := Pos(',',aText);
289			Employees.Edit;
290			if I > 0 then
291			begin
292			EmployeesLAST_NAME.AsString := system.copy(aText,1,I-1);
293			EmployeesFIRST_NAME.AsString := Trim(system.copy(aText,I+1,Length(aText) - I));
294			end
295			else
296			begin
297			EmployeesLAST_NAME.AsString := aText;
298			EmployeesFIRST_NAME.AsString := '!!unknown!!';
299			end;
300			end;
301
302			procedure TForm1.EmployeesJOB_CODEChange(Sender: TField);
303			begin
304			Countries.Active := false;
305			Countries.Active := true;
306			end;
307
308			procedure TForm1.EmployeesJOB_GRADEChange(Sender: TField);
309			begin
310			JobCodes.Active := false;
311			JobCodes.Active := true;
312			Countries.Active := false;
313			Countries.Active := true;
314			end;
315
316			end.
317