ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/ibtable/Unit1.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (7 years, 3 months ago) by tony
Content type: text/x-pascal
File size: 2365 byte(s)
Log Message:
Committing updates for Release R2-0-0

File Contents

# Content
1 unit Unit1;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9 DBGrids, db, IBDatabase, IBTable, IBCustomDataSet, IBDynamicGrid, IB;
10
11 type
12
13 { TForm1 }
14
15 TForm1 = class(TForm)
16 Datasource1: TDataSource;
17 DataSource2: TDataSource;
18 IBDatabase1: TIBDatabase;
19 IBDynamicGrid1: TIBDynamicGrid;
20 IBDynamicGrid2: TIBDynamicGrid;
21 Employees: TIBTable;
22 EmployeesDEPT_NO: TIBStringField;
23 EmployeesEMP_NO: TSmallintField;
24 EmployeesFIRST_NAME: TIBStringField;
25 EmployeesFULL_NAME: TIBStringField;
26 EmployeesHIRE_DATE: TDateTimeField;
27 EmployeesJOB_CODE: TIBStringField;
28 EmployeesJOB_COUNTRY: TIBStringField;
29 EmployeesJOB_GRADE: TSmallintField;
30 EmployeesLAST_NAME: TIBStringField;
31 EmployeesPHONE_EXT: TIBStringField;
32 EmployeesSALARY: TIBBCDField;
33 Depts: TIBTable;
34 DeptsBUDGET: TIBBCDField;
35 DeptsDEPARTMENT: TIBStringField;
36 DeptsDEPT_NO: TIBStringField;
37 DeptsHEAD_DEPT: TIBStringField;
38 DeptsLOCATION: TIBStringField;
39 DeptsMNGR_NO: TSmallintField;
40 DeptsPHONE_NO: TIBStringField;
41 IBTransaction1: TIBTransaction;
42 Panel1: TPanel;
43 Panel2: TPanel;
44 Splitter1: TSplitter;
45 procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
46 DisplayText: Boolean);
47 procedure FormShow(Sender: TObject);
48 procedure IBDatabase1AfterConnect(Sender: TObject);
49 procedure DeptsAfterOpen(DataSet: TDataSet);
50 private
51 { private declarations }
52 public
53 { public declarations }
54 end;
55
56 var
57 Form1: TForm1;
58
59 implementation
60
61 {$R *.lfm}
62
63 { TForm1 }
64
65 procedure TForm1.FormShow(Sender: TObject);
66 begin
67 repeat
68 try
69 IBDatabase1.Connected := true;
70 except
71 on E:EIBClientError do
72 begin
73 Close;
74 Exit
75 end;
76 On E:Exception do
77 MessageDlg(E.Message,mtError,[mbOK],0);
78 end;
79 until IBDatabase1.Connected;
80 end;
81
82 procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
83 DisplayText: Boolean);
84 begin
85 if DisplayText and not Sender.IsNull then
86 aText := FormatFloat('$#,##0.00',Sender.AsFloat)
87 else
88 aText := Sender.AsString;
89 end;
90
91 procedure TForm1.IBDatabase1AfterConnect(Sender: TObject);
92 begin
93 Depts.Active := true;
94 end;
95
96 procedure TForm1.DeptsAfterOpen(DataSet: TDataSet);
97 begin
98 Employees.Active := true;
99 end;
100
101 end.
102