ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/ibcontrols/IBTreeView.pas
Revision: 39
Committed: Tue May 17 08:14:52 2016 UTC (7 years, 10 months ago) by tony
Content type: text/x-pascal
File size: 21508 byte(s)
Log Message:
Committing updates for Release R1-4-1

File Contents

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