ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/examples/ibtable/Unit1.pas
Revision: 312
Committed: Tue Aug 25 15:40:58 2020 UTC (3 years, 7 months ago) by tony
Content type: text/x-pascal
File size: 3531 byte(s)
Log Message:
Fixes Merged

File Contents

# 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 45 unit Unit1;
28    
29     {$mode objfpc}{$H+}
30    
31     interface
32    
33     uses
34     Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
35 tony 272 DBGrids, StdCtrls, db, IBDatabase, IBTable, IBCustomDataSet, IBDynamicGrid,
36     IB;
37 tony 45
38     type
39    
40     { TForm1 }
41    
42     TForm1 = class(TForm)
43 tony 272 CheckBox1: TCheckBox;
44 tony 45 Datasource1: TDataSource;
45     DataSource2: TDataSource;
46 tony 312 EmployeesFULL_NAME: TIBStringField;
47 tony 45 IBDatabase1: TIBDatabase;
48     IBDynamicGrid1: TIBDynamicGrid;
49     Employees: TIBTable;
50     EmployeesDEPT_NO: TIBStringField;
51     EmployeesEMP_NO: TSmallintField;
52     EmployeesFIRST_NAME: TIBStringField;
53     EmployeesHIRE_DATE: TDateTimeField;
54     EmployeesJOB_CODE: TIBStringField;
55     EmployeesJOB_COUNTRY: TIBStringField;
56     EmployeesJOB_GRADE: TSmallintField;
57     EmployeesLAST_NAME: TIBStringField;
58     EmployeesPHONE_EXT: TIBStringField;
59     EmployeesSALARY: TIBBCDField;
60     Depts: TIBTable;
61     DeptsBUDGET: TIBBCDField;
62     DeptsDEPARTMENT: TIBStringField;
63     DeptsDEPT_NO: TIBStringField;
64     DeptsHEAD_DEPT: TIBStringField;
65     DeptsLOCATION: TIBStringField;
66     DeptsMNGR_NO: TSmallintField;
67     DeptsPHONE_NO: TIBStringField;
68 tony 272 IBDynamicGrid2: TIBDynamicGrid;
69 tony 45 IBTransaction1: TIBTransaction;
70     Panel1: TPanel;
71     Panel2: TPanel;
72 tony 272 Panel3: TPanel;
73     Panel4: TPanel;
74 tony 45 Splitter1: TSplitter;
75 tony 272 procedure CheckBox1Change(Sender: TObject);
76 tony 45 procedure EmployeesSALARYGetText(Sender: TField; var aText: string;
77     DisplayText: Boolean);
78     procedure FormShow(Sender: TObject);
79     procedure IBDatabase1AfterConnect(Sender: TObject);
80     procedure DeptsAfterOpen(DataSet: TDataSet);
81     private
82     { private declarations }
83     public
84     { public declarations }
85     end;
86    
87     var
88     Form1: TForm1;
89    
90     implementation
91    
92     {$R *.lfm}
93    
94     { TForm1 }
95    
96     procedure TForm1.FormShow(Sender: TObject);
97     begin
98     repeat
99     try
100     IBDatabase1.Connected := true;
101     except
102     on E:EIBClientError do
103     begin
104     Close;
105     Exit
106     end;
107     On E:Exception do
108     MessageDlg(E.Message,mtError,[mbOK],0);
109     end;
110     until IBDatabase1.Connected;
111     end;
112    
113     procedure TForm1.EmployeesSALARYGetText(Sender: TField; var aText: string;
114     DisplayText: Boolean);
115     begin
116     if DisplayText and not Sender.IsNull then
117     aText := FormatFloat('$#,##0.00',Sender.AsFloat)
118     else
119     aText := Sender.AsString;
120     end;
121    
122 tony 272 procedure TForm1.CheckBox1Change(Sender: TObject);
123     begin
124     if (Sender as TCheckbox).Checked then
125     Employees.Filter := 'Salary < 100000'
126     else
127     Employees.Filter := '';
128     end;
129    
130 tony 45 procedure TForm1.IBDatabase1AfterConnect(Sender: TObject);
131     begin
132     Depts.Active := true;
133     end;
134    
135     procedure TForm1.DeptsAfterOpen(DataSet: TDataSet);
136     begin
137     Employees.Active := true;
138     end;
139    
140     end.
141