ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/ibcontrols/IBTreeView.pas
Revision: 272
Committed: Mon Feb 4 13:34:37 2019 UTC (5 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 23104 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     begin
335     if (csDesigning in ComponentState) then Exit;
336 tony 27 IBControlLinkChanged;
337 tony 21 if assigned(DataSet) and not DataSet.Active then
338     begin
339     if not assigned(FExpandNode) and not assigned(FUpdateNode) then {must really be closing}
340     Reinitialise
341     end
342     else
343     begin
344     AddNodes;
345     if not FLocatingNode and (Selected = nil) and (Items.TopLvlCount > 0) then
346     begin
347     if Length(FLastSelected) > 0 then
348     Selected := FindNode(FLastSelected,true)
349     else
350     Selected := Items.TopLvlItems[0];
351     end
352     end
353     end;
354    
355     procedure TIBTreeView.AddNodes;
356     var Node: TTreeNode;
357     ChildCount: integer;
358     begin
359     if assigned(FExpandNode) or (Items.Count = 0) then
360     begin
361     ChildCount := 0;
362     FNoAddNodeToDataset := true;
363     try
364     DataSet.First;
365     while not DataSet.EOF do
366     begin
367 tony 143 if (FExpandNode = nil) or (TIBTreeNode(FExpandNode).KeyValue <> DataSet.FieldByName(KeyField).AsVariant) then
368     begin
369     Node := Items.AddChild(FExpandNode,DataSet.FieldByName(TextField).AsString);
370     Node.HasChildren := (HasChildField = '') or (DataSet.FieldByName(HasChildField).AsInteger <> 0);
371     Inc(ChildCount);
372     end;
373 tony 21 DataSet.Next
374     end;
375     finally
376     FNoAddNodeToDataset := false
377     end;
378     if assigned(FExpandNode) then
379     FExpandNode.HasChildren := ChildCount > 0;
380     FExpandNode := nil
381     end
382     end;
383    
384     procedure TIBTreeView.DataSetChanged(Sender: TObject);
385     begin
386 tony 143 // Do nothing;
387 tony 21 end;
388    
389     function TIBTreeView.GetDataSet: TDataSet;
390     begin
391     Result := FDataLink.DataSet
392     end;
393    
394     function TIBTreeView.GetDataSource: TDataSource;
395     begin
396     Result := FDataLink.DataSource
397     end;
398    
399     function TIBTreeView.GetRelationNameQualifier: string;
400     begin
401     if FRelationName <> '' then
402     Result := FRelationName + '.'
403     else
404     Result := ''
405     end;
406    
407     function TIBTreeView.GetSelectedKeyValue: variant;
408     begin
409     Result := NULL;
410     if assigned(Selected) and (Selected is TIBTreeNode) then
411     Result := TIBTreeNode(Selected).KeyValue
412     end;
413    
414     procedure TIBTreeView.NodeMoved(Node: TTreeNode);
415     begin
416     {Need to update Parent}
417     if ScrollToNode(TIBTreeNode(Node)) then
418     begin
419     FDataLink.Edit;
420     FModifiedNode := TIBTreeNode(Node)
421     end;
422     end;
423    
424     procedure TIBTreeView.NodeUpdated(Node: TTreeNode);
425     begin
426     {Need to Update List Field}
427     if ScrollToNode(TIBTreeNode(Node)) then
428     begin
429     FDataLink.Edit;
430     FModifiedNode := TIBTreeNode(Node);
431     FDataLink.UpdateRecord
432     end;
433     end;
434    
435     procedure TIBTreeView.RecordChanged(Sender: TObject; Field: TField);
436     var Node: TIBTreeNode;
437     Destination: TIBTreeNode;
438     begin
439 tony 27 if DataSet.State = dsInsert then Exit;
440    
441 tony 21 if assigned(Field) and (Field.FieldName = TextField) then
442     begin
443     Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
444     if assigned(Node) then
445     begin
446     FUpdating := true;
447     try
448     Node.Text := Field.Text
449     finally
450     FUpdating := false
451     end;
452     end;
453     end
454     else
455 tony 143 if assigned(Field) and (Field.FieldName = ImageIndexField) then
456     begin
457     Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
458     if assigned(Node) then
459     begin
460     FUpdating := true;
461     try
462     Node.ImageIndex := Field.AsInteger
463     finally
464     FUpdating := false
465     end;
466     end;
467     end
468     else
469 tony 21 if assigned(Field) and (Field.FieldName = ParentField) then
470     begin
471     Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
472     if assigned(Node) then
473     begin
474     if DataSet.FieldByName(ParentField).IsNull then
475     Destination := nil
476     else
477     Destination := FindNode(DataSet.FieldByName(ParentField).AsVariant);
478    
479 tony 39 if (Destination = nil) or (Destination = Node.Parent) then Exit;
480 tony 21
481     FUpdating := true;
482     try
483     Node.MoveTo(Destination,naAddChild);
484     finally
485     FUpdating := false
486     end;
487     end;
488     end
489     end;
490    
491     procedure TIBTreeView.SetHasChildField(AValue: string);
492     begin
493     if FHasChildField = AValue then Exit;
494     FHasChildField := AValue;
495     Reinitialise
496     end;
497    
498 tony 143 procedure TIBTreeView.SetImageIndexField(AValue: string);
499     begin
500     if FImageIndexField = AValue then Exit;
501     FImageIndexField := AValue;
502     Reinitialise
503     end;
504    
505 tony 21 procedure TIBTreeView.SetKeyField(AValue: string);
506     begin
507     if FKeyField = AValue then Exit;
508     FKeyField := AValue;
509     Reinitialise
510     end;
511    
512 tony 143 procedure TIBTreeView.SetSelectedIndexField(AValue: string);
513     begin
514     if FSelectedIndexField = AValue then Exit;
515     FSelectedIndexField := AValue;
516     Reinitialise;
517     end;
518    
519 tony 21 procedure TIBTreeView.SetTextField(AValue: string);
520     begin
521     if FTextField = AValue then Exit;
522     FTextField := AValue;
523     Reinitialise
524     end;
525    
526     procedure TIBTreeView.SetDataSource(AValue: TDataSource);
527     begin
528 tony 27 FDataLink.DataSource := AValue;
529     IBControlLinkChanged;
530 tony 21 end;
531    
532     procedure TIBTreeView.SetParentField(AValue: string);
533     begin
534     if FParentField = AValue then Exit;
535     FParentField := AValue;
536     Reinitialise
537     end;
538    
539     function TIBTreeView.ScrollToNode(Node: TIBTreeNode): boolean;
540     begin
541     Result := assigned(DataSet) and DataSet.Active and assigned(Node) and not varIsNull(Node.KeyValue);
542     if Result then
543     begin
544     if DataSet.Active and (DataSet.RecordCount > 0)
545 tony 80 and DataSet.Locate(KeyField,Node.KeyValue,[]) then Exit;
546 tony 21
547     FUpdateNode := Node;
548     try
549     DataSet.Active := false;
550     DataSet.Active := true;
551     finally
552     FUpdateNode := nil
553     end;
554     Result := DataSet.FieldByName(KeyField).AsVariant = Node.KeyValue
555     end;
556     end;
557    
558     procedure TIBTreeView.UpdateData(Sender: TObject);
559     begin
560     if assigned(FModifiedNode) then
561     begin
562     DataSet.FieldByName(TextField).AsString := FModifiedNode.Text;
563     if FModifiedNode.Parent = nil then
564     DataSet.FieldByName(ParentField).Clear
565     else
566     DataSet.FieldByName(ParentField).AsVariant := TIBTreeNode(FModifiedNode.Parent).KeyValue;
567     FModifiedNode := nil
568     end
569     end;
570    
571     procedure TIBTreeView.UpdateParams(Sender: TObject; Parser: TSelectSQLParser);
572     begin
573     if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
574     begin
575 tony 27 if DataSource.DataSet is TIBQuery then
576     TIBQuery(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
577 tony 21 FUpdateNode.KeyValue
578     else
579 tony 27 if DataSource.DataSet is TIBDataSet then
580     TIBDataSet(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
581 tony 21 FUpdateNode.KeyValue
582     end
583     else
584     if assigned(FExpandNode) then
585     begin
586 tony 27 if DataSource.DataSet is TIBQuery then
587     TIBQuery(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
588 tony 21 TIBTreeNode(FExpandNode).KeyValue
589     else
590 tony 27 if DataSource.DataSet is TIBDataSet then
591     TIBDataSet(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
592 tony 21 TIBTreeNode(FExpandNode).KeyValue
593     end;
594     end;
595    
596     procedure TIBTreeView.UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
597     begin
598     if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
599     Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FKeyField + '" = :IBX_KEY_VALUE')
600     else
601     if (Items.Count = 0) then
602     {Need to Load Root Nodes}
603     Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FParentField + '" is null')
604     else
605     if assigned(FExpandNode) then
606 tony 143 begin
607 tony 21 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FParentField + '" = :IBX_PARENT_VALUE');
608 tony 143 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FKeyField + '" = :IBX_PARENT_VALUE',true);
609     end;
610 tony 21 end;
611    
612     procedure TIBTreeView.Added(Node: TTreeNode);
613     begin
614 tony 272 if assigned(DataSet) and DataSet.Active then
615 tony 21 begin
616 tony 272 if not FNoAddNodeToDataset then
617     begin
618     DataSet.Append;
619     if (Node.Text = '') and not DataSet.FieldByName(TextField).IsNull then
620     Node.Text := DataSet.FieldByName(TextField).AsString;
621     FModifiedNode := TIBTreeNode(Node);
622     FDataLink.UpdateRecord;
623     end;
624 tony 21 TIBTreeNode(Node).FKeyValue := DataSet.FieldByName(KeyField).AsVariant;
625 tony 272 if ImageIndexField <> '' then
626     Node.ImageIndex := DataSet.FieldByName(ImageIndexField).AsInteger;
627     if SelectedIndexField <> '' then
628     Node.SelectedIndex := DataSet.FieldByName(SelectedIndexField).AsInteger;
629 tony 21 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.