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, 4 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

# User Rev Content
1 tony 45 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