ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/ibcontrols/IBTreeView.pas
Revision: 143
Committed: Fri Feb 23 12:11:21 2018 UTC (6 years, 6 months ago) by tony
Content type: text/x-pascal
File size: 23238 byte(s)
Log Message:
Fixes Merged

File Contents

# User Rev Content
1 tony 21 (*
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 tony 23 * The Original Code is (C) 2015 Tony Whyman, MWA Software
19 tony 21 * (http://www.mwasoftware.co.uk).
20     *
21     * All Rights Reserved.
22     *
23     * Contributor(s): ______________________________________.
24     *
25     *)
26     unit IBTreeView;
27    
28     {$mode objfpc}{$H+}
29    
30     interface
31    
32     uses
33     Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
34 tony 27 DB, IBSQLParser, IBCustomDataSet;
35 tony 21
36     type
37     {
38     TIBTreeView is intended to be a data aware descendent of TCustomTreeView and used to display
39     hierarchically structured data in a natural manner. Nodes can be deleted, moved
40     and added to the tree and each change is reflected in the underlying dataset. The
41     Node text can similarly be edited.
42     }
43    
44     TVariantArray = array of variant;
45    
46     TIBTreeView = class;
47    
48     { TIBTreeViewDatalink }
49    
50     TIBTreeViewDatalink = class(TDataLink)
51     private
52     FOwner: TIBTreeView;
53     protected
54     procedure ActiveChanged; override;
55     procedure DataSetChanged; override;
56     procedure RecordChanged(Field: TField); override;
57     procedure UpdateData; override;
58     public
59     constructor Create(AOwner: TIBTreeView);
60     end;
61    
62 tony 27 { TIBTreeViewControlLink }
63    
64     TIBTreeViewControlLink = class(TIBControlLink)
65     private
66     FOwner: TIBTreeView;
67     protected
68     procedure UpdateSQL(Sender: TObject); override;
69     procedure UpdateParams(Sender: TObject); override;
70     public
71     constructor Create(AOwner: TIBTreeView);
72     end;
73    
74 tony 21 { TIBTreeNode }
75    
76     TIBTreeNode = class(TTreeNode)
77     private
78     FKeyValue: variant;
79     public
80 tony 80 constructor Create(AnOwner: TTreeNodes); override;
81 tony 21 procedure DeleteAll;
82     property KeyValue: variant read FKeyValue;
83     end;
84    
85     TIBTreeView = class(TCustomTreeView)
86     private
87     { Private declarations }
88     FDataLink: TIBTreeViewDatalink;
89 tony 27 FIBTreeViewControlLink: TIBTreeViewControlLink;
90 tony 21 FHasChildField: string;
91 tony 143 FImageIndexField: string;
92 tony 21 FKeyField: string;
93 tony 143 FSelectedIndexField: string;
94 tony 21 FTextField: string;
95     FParentField: string;
96     FExpandNode: TTreeNode;
97     FNoAddNodeToDataset: boolean;
98     FRelationName: string;
99     FUpdateNode: TIBTreeNode;
100     FModifiedNode: TIBTreeNode;
101     FUpdating: boolean;
102     FLocatingNode: boolean;
103     FLastSelected: TVariantArray;
104     procedure ActiveChanged(Sender: TObject);
105     procedure AddNodes;
106     procedure DataSetChanged(Sender: TObject);
107     function GetDataSet: TDataSet;
108     function GetDataSource: TDataSource;
109     function GetRelationNameQualifier: string;
110     function GetSelectedKeyValue: variant;
111 tony 27 procedure IBControlLinkChanged;
112 tony 21 procedure NodeMoved(Node: TTreeNode);
113     procedure NodeUpdated(Node: TTreeNode);
114     procedure RecordChanged(Sender: TObject; Field: TField);
115     procedure SetHasChildField(AValue: string);
116 tony 143 procedure SetImageIndexField(AValue: string);
117 tony 21 procedure SetKeyField(AValue: string);
118 tony 143 procedure SetSelectedIndexField(AValue: string);
119 tony 21 procedure SetTextField(AValue: string);
120     procedure SetDataSource(AValue: TDataSource);
121     procedure SetParentField(AValue: string);
122     function ScrollToNode(Node: TIBTreeNode): boolean;
123     procedure UpdateData(Sender: TObject);
124     procedure UpdateParams(Sender: TObject; Parser: TSelectSQLParser);
125     procedure UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
126     protected
127     { Protected declarations }
128     procedure Added(Node: TTreeNode); override;
129     procedure Delete(Node: TTreeNode); override;
130     procedure Change(Node: TTreeNode); override;
131     function CreateNode: TTreeNode; override;
132     function CanEdit(Node: TTreeNode): Boolean; override;
133     procedure Expand(Node: TTreeNode); override;
134     procedure Loaded; override;
135     procedure NodeChanged(Node: TTreeNode; ChangeEvent: TTreeNodeChangeReason); override;
136     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
137     procedure Reinitialise;
138     public
139     { Public declarations }
140     constructor Create(TheComponent: TComponent); override;
141     destructor Destroy; override;
142 tony 80 function FindNode(KeyValuePath: TVariantArray; SelectNode: boolean): TIBTreeNode; overload;
143 tony 21 function FindNode(KeyValue: variant): TIBTreeNode; overload;
144     function GetNodePath(Node: TTreeNode): TVariantArray;
145     property DataSet: TDataSet read GetDataSet;
146     property SelectedKeyValue: variant read GetSelectedKeyValue;
147     published
148     { Published declarations }
149     property Align;
150     property Anchors;
151     property AutoExpand;
152     property BorderSpacing;
153     //property BiDiMode;
154     property BackgroundColor;
155     property BorderStyle;
156     property BorderWidth;
157     property Color;
158     property Constraints;
159     property TextField: string read FTextField write SetTextField;
160     property DataSource: TDataSource read GetDataSource write SetDataSource;
161     property DefaultItemHeight;
162     property DragKind;
163     property DragCursor;
164     property DragMode;
165     property Enabled;
166     property ExpandSignColor;
167     property ExpandSignType;
168     property Font;
169     property HideSelection;
170     property HotTrack;
171     property Images;
172     property Indent;
173     property HasChildField: string read FHasChildField write SetHasChildField;
174 tony 143 property ImageIndexField: string read FImageIndexField write SetImageIndexField;
175     property SelectedIndexField: string read FSelectedIndexField write SetSelectedIndexField;
176 tony 21 property KeyField: string read FKeyField write SetKeyField;
177     property MultiSelect;
178     property MultiSelectStyle;
179     //property ParentBiDiMode;
180     property ParentColor default False;
181     property ParentField: string read FParentField write SetParentField;
182     property ParentFont;
183     property ParentShowHint;
184     property PopupMenu;
185     property ReadOnly;
186     property RelationName: string read FRelationName write FRelationName;
187     property RightClickSelect;
188     property RowSelect;
189     property ScrollBars;
190     property SelectionColor;
191     property ShowButtons;
192     property ShowHint;
193     property ShowLines;
194     property ShowRoot;
195     property StateImages;
196     property TabOrder;
197     property TabStop default True;
198     property Tag;
199     property ToolTips;
200     property Visible;
201     property OnAddition;
202     property OnAdvancedCustomDraw;
203     property OnAdvancedCustomDrawItem;
204     property OnChange;
205     property OnChanging;
206     property OnClick;
207     property OnCollapsed;
208     property OnCollapsing;
209     property OnCompare;
210     property OnContextPopup;
211     property OnCreateNodeClass;
212     property OnCustomCreateItem;
213     property OnCustomDraw;
214     property OnCustomDrawItem;
215     property OnDblClick;
216     property OnDeletion;
217     property OnDragDrop;
218     property OnDragOver;
219     property OnEdited;
220     property OnEditing;
221     property OnEditingEnd;
222     //property OnEndDock;
223     property OnEndDrag;
224     property OnEnter;
225     property OnExit;
226     property OnExpanded;
227     property OnExpanding;
228     property OnGetImageIndex;
229     property OnGetSelectedIndex;
230     property OnKeyDown;
231     property OnKeyPress;
232     property OnKeyUp;
233     property OnMouseDown;
234     property OnMouseEnter;
235     property OnMouseLeave;
236     property OnMouseMove;
237     property OnMouseUp;
238     property OnNodeChanged;
239     property OnSelectionChanged;
240     property OnShowHint;
241     //property OnStartDock;
242     property OnStartDrag;
243     property OnUTF8KeyPress;
244     property Options;
245     property Items;
246     property TreeLineColor;
247     property TreeLinePenStyle;
248     end;
249    
250     function StrIntListToVar(s: string): TVariantArray;
251     function VarToStrIntList(a: TVariantArray): string;
252    
253     implementation
254    
255 tony 27 uses IBQuery,Variants;
256 tony 21
257     function StrIntListToVar(s: string): TVariantArray;
258     var i, idx: integer;
259     List: TStringList;
260     begin
261     List := TStringList.Create;
262     try
263     idx := 1;
264     List.Clear;
265     while idx <= Length(s) do
266     List.Add(ExtractFieldName(s,idx));
267    
268     Setlength(Result,List.Count);
269     for i := 0 to List.Count - 1 do
270     Result[i] := StrToInt(List[i])
271     finally
272     List.Free
273     end;
274     end;
275    
276     function VarToStrIntList(a: TVariantArray): string;
277     var i: integer;
278     begin
279     for i := 0 to Length(a) - 1 do
280     if VarIsOrdinal(a[i]) then
281     begin
282     if i = 0 then
283     Result := IntToStr(a[i])
284     else
285     Result := Result + ';' + IntToStr(a[i])
286     end
287     else
288     raise Exception.Create('Ordinal Type Expected when converting to integer string');
289     end;
290    
291 tony 27 { TIBTreeViewControlLink }
292    
293     constructor TIBTreeViewControlLink.Create(AOwner: TIBTreeView);
294     begin
295     inherited Create;
296     FOwner := AOwner;
297     end;
298    
299     procedure TIBTreeViewControlLink.UpdateParams(Sender: TObject);
300     begin
301     FOwner.UpdateParams(self,TIBParserDataSet(Sender).Parser)
302     end;
303    
304     procedure TIBTreeViewControlLink.UpdateSQL(Sender: TObject);
305     begin
306     FOwner.UpdateSQL(self,TIBParserDataSet(Sender).Parser)
307     end;
308    
309 tony 21 { TIBTreeNode }
310    
311 tony 80 constructor TIBTreeNode.Create(AnOwner: TTreeNodes);
312     begin
313     inherited Create(AnOwner);
314     FKeyValue := NULL;
315     end;
316    
317 tony 21 procedure TIBTreeNode.DeleteAll;
318     var Node, NextNode: TTreeNode;
319     begin
320     Expand(true);
321     Node := GetFirstChild;
322     while Node <> nil do
323     begin
324     NextNode := Node.GetNextSibling;
325     TIBTreeNode(Node).DeleteAll;
326     Node := NextNode;
327     end;
328     Delete
329     end;
330    
331     { TIBTreeView }
332    
333     procedure TIBTreeView.ActiveChanged(Sender: TObject);
334     var AtTopLevel: boolean;
335     begin
336     if (csDesigning in ComponentState) then Exit;
337 tony 27 IBControlLinkChanged;
338 tony 21 if assigned(DataSet) and not DataSet.Active then
339     begin
340     if not assigned(FExpandNode) and not assigned(FUpdateNode) then {must really be closing}
341     Reinitialise
342     end
343     else
344     begin
345     AtTopLevel := Items.TopLvlCount = 0;
346     AddNodes;
347     if not FLocatingNode and (Selected = nil) and (Items.TopLvlCount > 0) then
348     begin
349     if Length(FLastSelected) > 0 then
350     Selected := FindNode(FLastSelected,true)
351     else
352     Selected := Items.TopLvlItems[0];
353     end
354     end
355     end;
356    
357     procedure TIBTreeView.AddNodes;
358     var Node: TTreeNode;
359     ChildCount: integer;
360     begin
361     if assigned(FExpandNode) or (Items.Count = 0) then
362     begin
363     ChildCount := 0;
364     FNoAddNodeToDataset := true;
365     try
366     DataSet.First;
367     while not DataSet.EOF do
368     begin
369 tony 143 if (FExpandNode = nil) or (TIBTreeNode(FExpandNode).KeyValue <> DataSet.FieldByName(KeyField).AsVariant) then
370     begin
371     Node := Items.AddChild(FExpandNode,DataSet.FieldByName(TextField).AsString);
372     if ImageIndexField <> '' then
373     Node.ImageIndex := DataSet.FieldByName(ImageIndexField).AsInteger;
374     if SelectedIndexField <> '' then
375     Node.SelectedIndex := DataSet.FieldByName(SelectedIndexField).AsInteger;
376     TIBTreeNode(Node).FKeyValue := DataSet.FieldByName(KeyField).AsVariant;
377     Node.HasChildren := (HasChildField = '') or (DataSet.FieldByName(HasChildField).AsInteger <> 0);
378     Inc(ChildCount);
379     end;
380 tony 21 DataSet.Next
381     end;
382     finally
383     FNoAddNodeToDataset := false
384     end;
385     if assigned(FExpandNode) then
386     FExpandNode.HasChildren := ChildCount > 0;
387     FExpandNode := nil
388     end
389     end;
390    
391     procedure TIBTreeView.DataSetChanged(Sender: TObject);
392     begin
393 tony 143 // Do nothing;
394 tony 21 end;
395    
396     function TIBTreeView.GetDataSet: TDataSet;
397     begin
398     Result := FDataLink.DataSet
399     end;
400    
401     function TIBTreeView.GetDataSource: TDataSource;
402     begin
403     Result := FDataLink.DataSource
404     end;
405    
406     function TIBTreeView.GetRelationNameQualifier: string;
407     begin
408     if FRelationName <> '' then
409     Result := FRelationName + '.'
410     else
411     Result := ''
412     end;
413    
414     function TIBTreeView.GetSelectedKeyValue: variant;
415     begin
416     Result := NULL;
417     if assigned(Selected) and (Selected is TIBTreeNode) then
418     Result := TIBTreeNode(Selected).KeyValue
419     end;
420    
421     procedure TIBTreeView.NodeMoved(Node: TTreeNode);
422     begin
423     {Need to update Parent}
424     if ScrollToNode(TIBTreeNode(Node)) then
425     begin
426     FDataLink.Edit;
427     FModifiedNode := TIBTreeNode(Node)
428     end;
429     end;
430    
431     procedure TIBTreeView.NodeUpdated(Node: TTreeNode);
432     begin
433     {Need to Update List Field}
434     if ScrollToNode(TIBTreeNode(Node)) then
435     begin
436     FDataLink.Edit;
437     FModifiedNode := TIBTreeNode(Node);
438     FDataLink.UpdateRecord
439     end;
440     end;
441    
442     procedure TIBTreeView.RecordChanged(Sender: TObject; Field: TField);
443     var Node: TIBTreeNode;
444     Destination: TIBTreeNode;
445     begin
446 tony 27 if DataSet.State = dsInsert then Exit;
447    
448 tony 21 if assigned(Field) and (Field.FieldName = TextField) then
449     begin
450     Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
451     if assigned(Node) then
452     begin
453     FUpdating := true;
454     try
455     Node.Text := Field.Text
456     finally
457     FUpdating := false
458     end;
459     end;
460     end
461     else
462 tony 143 if assigned(Field) and (Field.FieldName = ImageIndexField) then
463     begin
464     Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
465     if assigned(Node) then
466     begin
467     FUpdating := true;
468     try
469     Node.ImageIndex := Field.AsInteger
470     finally
471     FUpdating := false
472     end;
473     end;
474     end
475     else
476 tony 21 if assigned(Field) and (Field.FieldName = ParentField) then
477     begin
478     Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
479     if assigned(Node) then
480     begin
481     if DataSet.FieldByName(ParentField).IsNull then
482     Destination := nil
483     else
484     Destination := FindNode(DataSet.FieldByName(ParentField).AsVariant);
485    
486 tony 39 if (Destination = nil) or (Destination = Node.Parent) then Exit;
487 tony 21
488     FUpdating := true;
489     try
490     Node.MoveTo(Destination,naAddChild);
491     finally
492     FUpdating := false
493     end;
494     end;
495     end
496     end;
497    
498     procedure TIBTreeView.SetHasChildField(AValue: string);
499     begin
500     if FHasChildField = AValue then Exit;
501     FHasChildField := AValue;
502     Reinitialise
503     end;
504    
505 tony 143 procedure TIBTreeView.SetImageIndexField(AValue: string);
506     begin
507     if FImageIndexField = AValue then Exit;
508     FImageIndexField := AValue;
509     Reinitialise
510     end;
511    
512 tony 21 procedure TIBTreeView.SetKeyField(AValue: string);
513     begin
514     if FKeyField = AValue then Exit;
515     FKeyField := AValue;
516     Reinitialise
517     end;
518    
519 tony 143 procedure TIBTreeView.SetSelectedIndexField(AValue: string);
520     begin
521     if FSelectedIndexField = AValue then Exit;
522     FSelectedIndexField := AValue;
523     Reinitialise;
524     end;
525    
526 tony 21 procedure TIBTreeView.SetTextField(AValue: string);
527     begin
528     if FTextField = AValue then Exit;
529     FTextField := AValue;
530     Reinitialise
531     end;
532    
533     procedure TIBTreeView.SetDataSource(AValue: TDataSource);
534     begin
535 tony 27 FDataLink.DataSource := AValue;
536     IBControlLinkChanged;
537 tony 21 end;
538    
539     procedure TIBTreeView.SetParentField(AValue: string);
540     begin
541     if FParentField = AValue then Exit;
542     FParentField := AValue;
543     Reinitialise
544     end;
545    
546     function TIBTreeView.ScrollToNode(Node: TIBTreeNode): boolean;
547     begin
548     Result := assigned(DataSet) and DataSet.Active and assigned(Node) and not varIsNull(Node.KeyValue);
549     if Result then
550     begin
551     if DataSet.Active and (DataSet.RecordCount > 0)
552 tony 80 and DataSet.Locate(KeyField,Node.KeyValue,[]) then Exit;
553 tony 21
554     FUpdateNode := Node;
555     try
556     DataSet.Active := false;
557     DataSet.Active := true;
558     finally
559     FUpdateNode := nil
560     end;
561     Result := DataSet.FieldByName(KeyField).AsVariant = Node.KeyValue
562     end;
563     end;
564    
565     procedure TIBTreeView.UpdateData(Sender: TObject);
566     begin
567     if assigned(FModifiedNode) then
568     begin
569     DataSet.FieldByName(TextField).AsString := FModifiedNode.Text;
570     if FModifiedNode.Parent = nil then
571     DataSet.FieldByName(ParentField).Clear
572     else
573     DataSet.FieldByName(ParentField).AsVariant := TIBTreeNode(FModifiedNode.Parent).KeyValue;
574     FModifiedNode := nil
575     end
576     end;
577    
578     procedure TIBTreeView.UpdateParams(Sender: TObject; Parser: TSelectSQLParser);
579     begin
580     if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
581     begin
582 tony 27 if DataSource.DataSet is TIBQuery then
583     TIBQuery(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
584 tony 21 FUpdateNode.KeyValue
585     else
586 tony 27 if DataSource.DataSet is TIBDataSet then
587     TIBDataSet(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
588 tony 21 FUpdateNode.KeyValue
589     end
590     else
591     if assigned(FExpandNode) then
592     begin
593 tony 27 if DataSource.DataSet is TIBQuery then
594     TIBQuery(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
595 tony 21 TIBTreeNode(FExpandNode).KeyValue
596     else
597 tony 27 if DataSource.DataSet is TIBDataSet then
598     TIBDataSet(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
599 tony 21 TIBTreeNode(FExpandNode).KeyValue
600     end;
601     end;
602    
603     procedure TIBTreeView.UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
604     begin
605     if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
606     Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FKeyField + '" = :IBX_KEY_VALUE')
607     else
608     if (Items.Count = 0) then
609     {Need to Load Root Nodes}
610     Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FParentField + '" is null')
611     else
612     if assigned(FExpandNode) then
613 tony 143 begin
614 tony 21 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FParentField + '" = :IBX_PARENT_VALUE');
615 tony 143 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FKeyField + '" = :IBX_PARENT_VALUE',true);
616     end;
617 tony 21 end;
618    
619     procedure TIBTreeView.Added(Node: TTreeNode);
620     begin
621     if assigned(DataSet) and DataSet.Active and not FNoAddNodeToDataset then
622     begin
623     DataSet.Append;
624     TIBTreeNode(Node).FKeyValue := DataSet.FieldByName(KeyField).AsVariant;
625     if (Node.Text = '') and not DataSet.FieldByName(TextField).IsNull then
626     Node.Text := DataSet.FieldByName(TextField).AsString;
627     FModifiedNode := TIBTreeNode(Node);
628     FDataLink.UpdateRecord
629     end;
630     inherited Added(Node);
631     end;
632    
633     procedure TIBTreeView.Delete(Node: TTreeNode);
634     begin
635     if not (tvsUpdating in States) {TreeNodes being cleared}
636     and not (tvsManualNotify in States) {Tree Collapse with node delete}
637     and ScrollToNode(TIBTreeNode(Node)) then
638     DataSet.Delete;
639     inherited Delete(Node);
640     end;
641    
642     procedure TIBTreeView.Change(Node: TTreeNode);
643     begin
644     inherited Change(Node);
645     ScrollToNode(TIBTreeNode(Node));
646     end;
647    
648     function TIBTreeView.CreateNode: TTreeNode;
649     var
650     NewNodeClass: TTreeNodeClass;
651     begin
652     Result := nil;
653     if Assigned(OnCustomCreateItem) then
654     OnCustomCreateItem(Self, Result);
655     if Result = nil then
656     begin
657     NewNodeClass:=TIBTreeNode;
658     if Assigned(OnCreateNodeClass) then
659     OnCreateNodeClass(Self,NewNodeClass);
660     Result := NewNodeClass.Create(Items);
661     end;
662     end;
663    
664     function TIBTreeView.CanEdit(Node: TTreeNode): Boolean;
665     begin
666     Result := inherited CanEdit(Node)
667     and assigned(DataSet) and not DataSet.FieldByName(TextField).ReadOnly
668     end;
669    
670     procedure TIBTreeView.Expand(Node: TTreeNode);
671     begin
672     inherited Expand(Node);
673     if Node.HasChildren and assigned(DataSet) and (Node.GetFirstChild = nil) then
674     begin
675     FExpandNode := Node;
676     DataSet.Active := false;
677     DataSet.Active := true;
678 tony 143 Selected := Node;
679 tony 21 end;
680     end;
681    
682 tony 27 procedure TIBTreeView.IBControlLinkChanged;
683     begin
684     if assigned(DataSource) and (DataSource.DataSet <> nil) and (DataSource.DataSet is TIBParserDataset) then
685     FIBTreeViewControllink.IBDataSet := TIBCustomDataSet(DataSource.DataSet)
686     else
687     FIBTreeViewControllink.IBDataSet := nil;
688     end;
689    
690 tony 21 procedure TIBTreeView.Loaded;
691     begin
692     inherited Loaded;
693 tony 29 IBControlLinkChanged;
694 tony 21 Reinitialise
695     end;
696    
697     procedure TIBTreeView.NodeChanged(Node: TTreeNode;
698     ChangeEvent: TTreeNodeChangeReason);
699     begin
700     inherited NodeChanged(Node, ChangeEvent);
701     if not FNoAddNodeToDataset and not FUpdating then
702     case ChangeEvent of
703     ncTextChanged:
704     NodeUpdated(Node);
705     ncParentChanged:
706     NodeMoved(Node);
707     end;
708     end;
709    
710     procedure TIBTreeView.Notification(AComponent: TComponent; Operation: TOperation
711     );
712     begin
713     inherited Notification(AComponent, Operation);
714     if (Operation = opRemove) and
715 tony 27 (FDataLink <> nil) and (AComponent = DataSource) then
716     DataSource := nil;
717 tony 21 end;
718    
719     procedure TIBTreeView.Reinitialise;
720     begin
721     if [csDesigning,csLoading] * ComponentState <> [] then Exit;
722     FLastSelected := GetNodePath(Selected);
723     Items.Clear;
724     end;
725    
726     constructor TIBTreeView.Create(TheComponent: TComponent);
727     begin
728     inherited Create(TheComponent);
729     FDataLink := TIBTreeViewDatalink.Create(self);
730 tony 27 FIBTreeViewControlLink := TIBTreeViewControlLink.Create(self);
731 tony 21 end;
732    
733     destructor TIBTreeView.Destroy;
734     begin
735     if assigned(FDataLink) then FDataLink.Free;
736 tony 27 if assigned(FIBTreeViewControlLink) then FIBTreeViewControlLink.Free;
737 tony 21 inherited Destroy;
738     end;
739    
740 tony 80 function TIBTreeView.FindNode(KeyValuePath: TVariantArray; SelectNode: boolean
741     ): TIBTreeNode;
742 tony 21 var Node: TTreeNode;
743     i,j: integer;
744     begin
745     Result := nil;
746 tony 80 if Length(KeyValuePath) = 0 then Exit;
747    
748 tony 21 FLocatingNode := true;
749     try
750     for j := 0 to Items.TopLvlCount - 1 do
751     begin
752     Node := Items.TopLvlItems[j];
753     i := 0;
754     Node.Expand(false);
755     while assigned(Node) do
756     begin
757 tony 80 if not VarIsNull(TIBTreeNode(Node).KeyValue) and
758     (TIBTreeNode(Node).KeyValue = KeyValuePath[i]) then
759 tony 21 begin
760     Inc(i);
761     if i = Length(KeyValuePath) then
762     begin
763     Result := TIBTreeNode(Node);
764     if SelectNode then
765     Selected := Node;
766     Exit
767     end
768     else
769     begin
770     Node.Expand(false);
771     Node := Node.GetFirstChild;
772     end
773     end
774     else
775     Node := Node.GetNextSibling
776     end
777     end
778     finally
779     FLocatingNode := false
780     end
781     end;
782    
783     function TIBTreeView.FindNode(KeyValue: variant): TIBTreeNode;
784     var i: integer;
785     begin
786     Result := nil;
787     if (Selected <> nil) and (TIBTreeNode(Selected).KeyValue = KeyValue) then
788     Result := TIBTreeNode(Selected)
789     else
790     {Find it the hard way}
791     begin
792     FullExpand;
793     for i := 0 to Items.Count -1 do
794     if TIBTreeNode(Items[i]).KeyValue = KeyValue then
795     begin
796     Result := TIBTreeNode(Items[i])
797     end;
798     end;
799     end;
800    
801     function TIBTreeView.GetNodePath(Node: TTreeNode): TVariantArray;
802     var aParent: TTreeNode;
803     i: integer;
804     begin
805     if not assigned(Node) or not (Node is TIBTreeNode) then
806     SetLength(Result,0)
807     else
808     begin
809     {Count length of Path}
810     i := 1;
811     aParent := Node.Parent;
812     while (aParent <> nil) do
813     begin
814     Inc(i);
815     aParent := aParent.Parent
816     end;
817    
818     {Save Path}
819     Setlength(Result,i);
820     while i > 0 do
821     begin
822     Dec(i);
823     Result[i] := TIBTreeNode(Node).KeyValue;
824     Node := Node.Parent
825     end;
826     end;
827     end;
828    
829     { TIBTreeViewDatalink }
830    
831     procedure TIBTreeViewDatalink.ActiveChanged;
832     begin
833     FOwner.ActiveChanged(self)
834     end;
835    
836     procedure TIBTreeViewDatalink.DataSetChanged;
837     begin
838     FOwner.DataSetChanged(self)
839     end;
840    
841     procedure TIBTreeViewDatalink.RecordChanged(Field: TField);
842     begin
843     FOwner.RecordChanged(self,Field);
844     end;
845    
846     procedure TIBTreeViewDatalink.UpdateData;
847     begin
848     FOwner.UpdateData(self)
849     end;
850    
851     constructor TIBTreeViewDatalink.Create(AOwner: TIBTreeView);
852     begin
853     inherited Create;
854     FOwner := AOwner
855     end;
856    
857     end.