examples/ibtreeview/Unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls, DbCtrls, ActnList, Menus, db, IBTreeView, IBDatabase,
  IBCustomDataSet, IBLookupComboEditBox, IBQuery, IBDynamicGrid, ComCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    AddFirstChild: TAction;
    AddSibling: TAction;
    AddChild: TAction;
    DeleteNode: TAction;
    ActionList1: TActionList;
    ApplicationProperties1: TApplicationProperties;
    DataSource2: TDataSource;
    DataSource3: TDataSource;
    DBEdit1: TDBEdit;
    DBEdit2: TDBEdit;
    DBEdit3: TDBEdit;
    DBEdit4: TDBEdit;
    DepartmentsCHILDCOUNT: TIntegerField;
    IBDynamicGrid1: TIBDynamicGrid;
    IBLookupComboEditBox1: TIBLookupComboEditBox;
    ImageList1: TImageList;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    PopupMenu1: TPopupMenu;
    Staff: TIBQuery;
    Label7: TLabel;
    Managers: TIBQuery;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Panel3: TPanel;
    SaveBtn: TButton;
    CancelBtn: TButton;
    DataSource1: TDataSource;
    DepartmentsBUDGET: TIBBCDField;
    DepartmentsDEPARTMENT: TIBStringField;
    DepartmentsDEPT_NO: TIBStringField;
    DepartmentsHEAD_DEPT: TIBStringField;
    DepartmentsLOCATION: TIBStringField;
    DepartmentsMNGR_NO: TSmallintField;
    DepartmentsPHONE_NO: TIBStringField;
    IBDatabase1: TIBDatabase;
    Departments: TIBDataSet;
    IBTransaction1: TIBTransaction;
    IBTreeView1: TIBTreeView;
    Label1: TLabel;
    Panel1: TPanel;
    Panel2: TPanel;
    Splitter1: TSplitter;
    StaffDEPT_NO: TIBStringField;
    StaffEMP_NO: TSmallintField;
    StaffFIRST_NAME: TIBStringField;
    StaffFULL_NAME: TIBStringField;
    StaffHIRE_DATE: TDateTimeField;
    StaffJOB_CODE: TIBStringField;
    StaffJOB_COUNTRY: TIBStringField;
    StaffJOB_GRADE: TSmallintField;
    StaffLAST_NAME: TIBStringField;
    StaffPHONE_EXT: TIBStringField;
    StaffSALARY: TIBBCDField;
    procedure AddChildExecute(Sender: TObject);
    procedure AddFirstChildExecute(Sender: TObject);
    procedure AddSiblingExecute(Sender: TObject);
    procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
    procedure CancelBtnClick(Sender: TObject);
    procedure DeleteNodeExecute(Sender: TObject);
    procedure DeleteNodeUpdate(Sender: TObject);
    procedure DepartmentsAfterDelete(DataSet: TDataSet);
    procedure DepartmentsAfterInsert(DataSet: TDataSet);
    procedure DepartmentsAfterTransactionEnd(Sender: TObject);
    procedure DepartmentsBUDGETChange(Sender: TField);
    procedure DepartmentsBUDGETGetText(Sender: TField; var aText: string;
      DisplayText: Boolean);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure IBTreeView1Addition(Sender: TObject; Node: TTreeNode);
    procedure IBTreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure IBTreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure SaveBtnClick(Sender: TObject);
  private
    { private declarations }
    FDirty: boolean;
    FClosing: boolean;
    procedure Reopen(Data: PtrInt);
    procedure SetNodeImage(Node: TTreeNode);
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

uses IB;

{ TForm1 }

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  FClosing := true;
  if IBTransaction1.Intransaction then
    IBTransaction1.Commit;
end;

procedure TForm1.ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
begin
  SaveBtn.Enabled := FDirty;
  CancelBtn.Enabled := FDirty
end;

procedure TForm1.AddChildExecute(Sender: TObject);
begin
  IBTreeView1.Selected.Expand(true);
  IBTreeView1.Selected := IBTreeView1.Items.AddChild(IBTreeView1.Selected,'');
  IBTreeView1.Selected.Expand(true);
  IBTreeView1.Selected.EditText;
end;

procedure TForm1.AddFirstChildExecute(Sender: TObject);
begin
  IBTreeView1.Selected.Expand(true);
  IBTreeView1.Selected := IBTreeView1.Items.AddChildFirst(IBTreeView1.Selected,'');
  IBTreeView1.Selected.Expand(true);
  IBTreeView1.Selected.EditText;
end;

procedure TForm1.AddSiblingExecute(Sender: TObject);
begin
  IBTreeView1.Selected := IBTreeView1.Items.Add(IBTreeView1.Selected,'');
  IBTreeView1.Selected.EditText;
end;

procedure TForm1.CancelBtnClick(Sender: TObject);
begin
  IBTransaction1.Rollback
end;

procedure TForm1.DeleteNodeExecute(Sender: TObject);
begin
  if MessageDlg(Format('Do you want to delete the %s department?',[IBTreeview1.Selected.Text]),
              mtConfirmation,[mbYes,mbNo],0) = mrYes then
    TIBTreeNode(IBTreeview1.Selected).DeleteAll
end;

procedure TForm1.DeleteNodeUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := IBTreeView1.Selected <> nil
end;

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

procedure TForm1.DepartmentsAfterInsert(DataSet: TDataSet);
begin
  FDirty := true;
  DataSet.FieldByName('Department').AsString := 'Dept ' + DataSet.FieldByName('DEPT_NO').AsString
end;

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

procedure TForm1.DepartmentsBUDGETChange(Sender: TField);
begin
  SetNodeImage(IBTreeView1.Selected)
end;

procedure TForm1.DepartmentsBUDGETGetText(Sender: TField; var aText: string;
  DisplayText: Boolean);
begin
  if DisplayText and not Sender.IsNull then
    aText := FormatFloat('$#,##0.00',Sender.AsFloat)
  else
    aText := Sender.AsString
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  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.IBTreeView1Addition(Sender: TObject; Node: TTreeNode);
begin
  SetNodeImage(Node)
end;

procedure TForm1.IBTreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var Node: TTreeNode;
    tv: TTreeView;
begin
  if Source = Sender then {Dragging within Tree View}
  begin
    tv := TTreeView(Sender);;
    Node := tv.GetNodeAt(X,Y); {Drop Point}
    if assigned(tv.Selected) and (tv.Selected <> Node) then
    begin
      if Node = nil then
        tv.Selected.MoveTo(nil,naAdd) {Move to Top Level}
      else
      begin
        if ssCtrl in GetKeyShiftState then
        begin
          Node.Expand(false);
          tv.Selected.MoveTo(Node,naAddChildFirst)
        end
        else
          tv.Selected.MoveTo(Node,naInsertBehind)
      end;
    end;
  end;
end;

procedure TForm1.IBTreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := Source = Sender
end;

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

procedure TForm1.Reopen(Data: PtrInt);
begin
  FDirty := false;
  IBTransaction1.StartTransaction;
  Managers.Active := true;
  Departments.Active := true;
  Staff.Active := true;
end;

procedure TForm1.SetNodeImage(Node: TTreeNode);
begin
  if Departments.FieldByName('Budget').AsFloat < 500000 then
     Node.ImageIndex := 0
  else
  if Departments.FieldByName('Budget').AsFloat = 500000 then
    Node.ImageIndex := 2
  else
    Node.ImageIndex := 1
end;

end.

Revision:	27
Committed:	Tue Apr 14 13:10:23 2015 UTC (9 years ago) by tony
Content type:	text/x-pascal
File size:	7565 byte(s)
Log Message:	Committing updates for Release R1-2-3
#	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	StdCtrls, DbCtrls, ActnList, Menus, db, IBTreeView, IBDatabase,
10	IBCustomDataSet, IBLookupComboEditBox, IBQuery, IBDynamicGrid, ComCtrls;
11
12	type
13
14	{ TForm1 }
15
16	TForm1 = class(TForm)
17	AddFirstChild: TAction;
18	AddSibling: TAction;
19	AddChild: TAction;
20	DeleteNode: TAction;
21	ActionList1: TActionList;
22	ApplicationProperties1: TApplicationProperties;
23	DataSource2: TDataSource;
24	DataSource3: TDataSource;
25	DBEdit1: TDBEdit;
26	DBEdit2: TDBEdit;
27	DBEdit3: TDBEdit;
28	DBEdit4: TDBEdit;
29	DepartmentsCHILDCOUNT: TIntegerField;
30	IBDynamicGrid1: TIBDynamicGrid;
31	IBLookupComboEditBox1: TIBLookupComboEditBox;
32	ImageList1: TImageList;
33	MenuItem1: TMenuItem;
34	MenuItem2: TMenuItem;
35	MenuItem3: TMenuItem;
36	MenuItem4: TMenuItem;
37	PopupMenu1: TPopupMenu;
38	Staff: TIBQuery;
39	Label7: TLabel;
40	Managers: TIBQuery;
41	Label2: TLabel;
42	Label3: TLabel;
43	Label4: TLabel;
44	Label5: TLabel;
45	Label6: TLabel;
46	Panel3: TPanel;
47	SaveBtn: TButton;
48	CancelBtn: TButton;
49	DataSource1: TDataSource;
50	DepartmentsBUDGET: TIBBCDField;
51	DepartmentsDEPARTMENT: TIBStringField;
52	DepartmentsDEPT_NO: TIBStringField;
53	DepartmentsHEAD_DEPT: TIBStringField;
54	DepartmentsLOCATION: TIBStringField;
55	DepartmentsMNGR_NO: TSmallintField;
56	DepartmentsPHONE_NO: TIBStringField;
57	IBDatabase1: TIBDatabase;
58	Departments: TIBDataSet;
59	IBTransaction1: TIBTransaction;
60	IBTreeView1: TIBTreeView;
61	Label1: TLabel;
62	Panel1: TPanel;
63	Panel2: TPanel;
64	Splitter1: TSplitter;
65	StaffDEPT_NO: TIBStringField;
66	StaffEMP_NO: TSmallintField;
67	StaffFIRST_NAME: TIBStringField;
68	StaffFULL_NAME: TIBStringField;
69	StaffHIRE_DATE: TDateTimeField;
70	StaffJOB_CODE: TIBStringField;
71	StaffJOB_COUNTRY: TIBStringField;
72	StaffJOB_GRADE: TSmallintField;
73	StaffLAST_NAME: TIBStringField;
74	StaffPHONE_EXT: TIBStringField;
75	StaffSALARY: TIBBCDField;
76	procedure AddChildExecute(Sender: TObject);
77	procedure AddFirstChildExecute(Sender: TObject);
78	procedure AddSiblingExecute(Sender: TObject);
79	procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
80	procedure CancelBtnClick(Sender: TObject);
81	procedure DeleteNodeExecute(Sender: TObject);
82	procedure DeleteNodeUpdate(Sender: TObject);
83	procedure DepartmentsAfterDelete(DataSet: TDataSet);
84	procedure DepartmentsAfterInsert(DataSet: TDataSet);
85	procedure DepartmentsAfterTransactionEnd(Sender: TObject);
86	procedure DepartmentsBUDGETChange(Sender: TField);
87	procedure DepartmentsBUDGETGetText(Sender: TField; var aText: string;
88	DisplayText: Boolean);
89	procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
90	procedure FormShow(Sender: TObject);
91	procedure IBTreeView1Addition(Sender: TObject; Node: TTreeNode);
92	procedure IBTreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
93	procedure IBTreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
94	State: TDragState; var Accept: Boolean);
95	procedure SaveBtnClick(Sender: TObject);
96	private
97	{ private declarations }
98	FDirty: boolean;
99	FClosing: boolean;
100	procedure Reopen(Data: PtrInt);
101	procedure SetNodeImage(Node: TTreeNode);
102	public
103	{ public declarations }
104	end;
105
106	var
107	Form1: TForm1;
108
109	implementation
110
111	{$R *.lfm}
112
113	uses IB;
114
115	{ TForm1 }
116
117	procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
118	begin
119	FClosing := true;
120	if IBTransaction1.Intransaction then
121	IBTransaction1.Commit;
122	end;
123
124	procedure TForm1.ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
125	begin
126	SaveBtn.Enabled := FDirty;
127	CancelBtn.Enabled := FDirty
128	end;
129
130	procedure TForm1.AddChildExecute(Sender: TObject);
131	begin
132	IBTreeView1.Selected.Expand(true);
133	IBTreeView1.Selected := IBTreeView1.Items.AddChild(IBTreeView1.Selected,'');
134	IBTreeView1.Selected.Expand(true);
135	IBTreeView1.Selected.EditText;
136	end;
137
138	procedure TForm1.AddFirstChildExecute(Sender: TObject);
139	begin
140	IBTreeView1.Selected.Expand(true);
141	IBTreeView1.Selected := IBTreeView1.Items.AddChildFirst(IBTreeView1.Selected,'');
142	IBTreeView1.Selected.Expand(true);
143	IBTreeView1.Selected.EditText;
144	end;
145
146	procedure TForm1.AddSiblingExecute(Sender: TObject);
147	begin
148	IBTreeView1.Selected := IBTreeView1.Items.Add(IBTreeView1.Selected,'');
149	IBTreeView1.Selected.EditText;
150	end;
151
152	procedure TForm1.CancelBtnClick(Sender: TObject);
153	begin
154	IBTransaction1.Rollback
155	end;
156
157	procedure TForm1.DeleteNodeExecute(Sender: TObject);
158	begin
159	if MessageDlg(Format('Do you want to delete the %s department?',[IBTreeview1.Selected.Text]),
160	mtConfirmation,[mbYes,mbNo],0) = mrYes then
161	TIBTreeNode(IBTreeview1.Selected).DeleteAll
162	end;
163
164	procedure TForm1.DeleteNodeUpdate(Sender: TObject);
165	begin
166	(Sender as TAction).Enabled := IBTreeView1.Selected <> nil
167	end;
168
169	procedure TForm1.DepartmentsAfterDelete(DataSet: TDataSet);
170	begin
171	FDirty := true
172	end;
173
174	procedure TForm1.DepartmentsAfterInsert(DataSet: TDataSet);
175	begin
176	FDirty := true;
177	DataSet.FieldByName('Department').AsString := 'Dept ' + DataSet.FieldByName('DEPT_NO').AsString
178	end;
179
180	procedure TForm1.DepartmentsAfterTransactionEnd(Sender: TObject);
181	begin
182	if not FClosing then
183	Application.QueueAsyncCall(@Reopen,0);
184	end;
185
186	procedure TForm1.DepartmentsBUDGETChange(Sender: TField);
187	begin
188	SetNodeImage(IBTreeView1.Selected)
189	end;
190
191	procedure TForm1.DepartmentsBUDGETGetText(Sender: TField; var aText: string;
192	DisplayText: Boolean);
193	begin
194	if DisplayText and not Sender.IsNull then
195	aText := FormatFloat('$#,##0.00',Sender.AsFloat)
196	else
197	aText := Sender.AsString
198	end;
199
200	procedure TForm1.FormShow(Sender: TObject);
201	begin
202	repeat
203	try
204	IBDatabase1.Connected := true;
205	except
206	on E:EIBClientError do
207	begin
208	Close;
209	Exit
210	end;
211	On E:Exception do
212	MessageDlg(E.Message,mtError,[mbOK],0);
213	end;
214	until IBDatabase1.Connected;
215	Reopen(0);
216	end;
217
218	procedure TForm1.IBTreeView1Addition(Sender: TObject; Node: TTreeNode);
219	begin
220	SetNodeImage(Node)
221	end;
222
223	procedure TForm1.IBTreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
224	var Node: TTreeNode;
225	tv: TTreeView;
226	begin
227	if Source = Sender then {Dragging within Tree View}
228	begin
229	tv := TTreeView(Sender);;
230	Node := tv.GetNodeAt(X,Y); {Drop Point}
231	if assigned(tv.Selected) and (tv.Selected <> Node) then
232	begin
233	if Node = nil then
234	tv.Selected.MoveTo(nil,naAdd) {Move to Top Level}
235	else
236	begin
237	if ssCtrl in GetKeyShiftState then
238	begin
239	Node.Expand(false);
240	tv.Selected.MoveTo(Node,naAddChildFirst)
241	end
242	else
243	tv.Selected.MoveTo(Node,naInsertBehind)
244	end;
245	end;
246	end;
247	end;
248
249	procedure TForm1.IBTreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
250	State: TDragState; var Accept: Boolean);
251	begin
252	Accept := Source = Sender
253	end;
254
255	procedure TForm1.SaveBtnClick(Sender: TObject);
256	begin
257	IBtransaction1.Commit
258	end;
259
260	procedure TForm1.Reopen(Data: PtrInt);
261	begin
262	FDirty := false;
263	IBTransaction1.StartTransaction;
264	Managers.Active := true;
265	Departments.Active := true;
266	Staff.Active := true;
267	end;
268
269	procedure TForm1.SetNodeImage(Node: TTreeNode);
270	begin
271	if Departments.FieldByName('Budget').AsFloat < 500000 then
272	Node.ImageIndex := 0
273	else
274	if Departments.FieldByName('Budget').AsFloat = 500000 then
275	Node.ImageIndex := 2
276	else
277	Node.ImageIndex := 1
278	end;
279
280	end.
281