ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/ibcontrols/IBTreeView.pas
Revision: 217
Committed: Fri Mar 16 10:27:26 2018 UTC (6 years, 9 months ago) by tony
Content type: text/x-pascal
Original Path: ibx/trunk/ibcontrols/IBTreeView.pas
File size: 23172 byte(s)
Log Message:
Fixes Merged

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 constructor Create(AnOwner: TTreeNodes); override;
81 procedure DeleteAll;
82 property KeyValue: variant read FKeyValue;
83 end;
84
85 TIBTreeView = class(TCustomTreeView)
86 private
87 { Private declarations }
88 FDataLink: TIBTreeViewDatalink;
89 FIBTreeViewControlLink: TIBTreeViewControlLink;
90 FHasChildField: string;
91 FImageIndexField: string;
92 FKeyField: string;
93 FSelectedIndexField: string;
94 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 procedure IBControlLinkChanged;
112 procedure NodeMoved(Node: TTreeNode);
113 procedure NodeUpdated(Node: TTreeNode);
114 procedure RecordChanged(Sender: TObject; Field: TField);
115 procedure SetHasChildField(AValue: string);
116 procedure SetImageIndexField(AValue: string);
117 procedure SetKeyField(AValue: string);
118 procedure SetSelectedIndexField(AValue: string);
119 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 function FindNode(KeyValuePath: TVariantArray; SelectNode: boolean): TIBTreeNode; overload;
143 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 property ImageIndexField: string read FImageIndexField write SetImageIndexField;
175 property SelectedIndexField: string read FSelectedIndexField write SetSelectedIndexField;
176 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 uses IBQuery,Variants;
256
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 { 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 { TIBTreeNode }
310
311 constructor TIBTreeNode.Create(AnOwner: TTreeNodes);
312 begin
313 inherited Create(AnOwner);
314 FKeyValue := NULL;
315 end;
316
317 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 IBControlLinkChanged;
337 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 if (FExpandNode = nil) or (TIBTreeNode(FExpandNode).KeyValue <> DataSet.FieldByName(KeyField).AsVariant) then
368 begin
369 Node := Items.AddChild(FExpandNode,DataSet.FieldByName(TextField).AsString);
370 if ImageIndexField <> '' then
371 Node.ImageIndex := DataSet.FieldByName(ImageIndexField).AsInteger;
372 if SelectedIndexField <> '' then
373 Node.SelectedIndex := DataSet.FieldByName(SelectedIndexField).AsInteger;
374 TIBTreeNode(Node).FKeyValue := DataSet.FieldByName(KeyField).AsVariant;
375 Node.HasChildren := (HasChildField = '') or (DataSet.FieldByName(HasChildField).AsInteger <> 0);
376 Inc(ChildCount);
377 end;
378 DataSet.Next
379 end;
380 finally
381 FNoAddNodeToDataset := false
382 end;
383 if assigned(FExpandNode) then
384 FExpandNode.HasChildren := ChildCount > 0;
385 FExpandNode := nil
386 end
387 end;
388
389 procedure TIBTreeView.DataSetChanged(Sender: TObject);
390 begin
391 // Do nothing;
392 end;
393
394 function TIBTreeView.GetDataSet: TDataSet;
395 begin
396 Result := FDataLink.DataSet
397 end;
398
399 function TIBTreeView.GetDataSource: TDataSource;
400 begin
401 Result := FDataLink.DataSource
402 end;
403
404 function TIBTreeView.GetRelationNameQualifier: string;
405 begin
406 if FRelationName <> '' then
407 Result := FRelationName + '.'
408 else
409 Result := ''
410 end;
411
412 function TIBTreeView.GetSelectedKeyValue: variant;
413 begin
414 Result := NULL;
415 if assigned(Selected) and (Selected is TIBTreeNode) then
416 Result := TIBTreeNode(Selected).KeyValue
417 end;
418
419 procedure TIBTreeView.NodeMoved(Node: TTreeNode);
420 begin
421 {Need to update Parent}
422 if ScrollToNode(TIBTreeNode(Node)) then
423 begin
424 FDataLink.Edit;
425 FModifiedNode := TIBTreeNode(Node)
426 end;
427 end;
428
429 procedure TIBTreeView.NodeUpdated(Node: TTreeNode);
430 begin
431 {Need to Update List Field}
432 if ScrollToNode(TIBTreeNode(Node)) then
433 begin
434 FDataLink.Edit;
435 FModifiedNode := TIBTreeNode(Node);
436 FDataLink.UpdateRecord
437 end;
438 end;
439
440 procedure TIBTreeView.RecordChanged(Sender: TObject; Field: TField);
441 var Node: TIBTreeNode;
442 Destination: TIBTreeNode;
443 begin
444 if DataSet.State = dsInsert then Exit;
445
446 if assigned(Field) and (Field.FieldName = TextField) then
447 begin
448 Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
449 if assigned(Node) then
450 begin
451 FUpdating := true;
452 try
453 Node.Text := Field.Text
454 finally
455 FUpdating := false
456 end;
457 end;
458 end
459 else
460 if assigned(Field) and (Field.FieldName = ImageIndexField) then
461 begin
462 Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
463 if assigned(Node) then
464 begin
465 FUpdating := true;
466 try
467 Node.ImageIndex := Field.AsInteger
468 finally
469 FUpdating := false
470 end;
471 end;
472 end
473 else
474 if assigned(Field) and (Field.FieldName = ParentField) then
475 begin
476 Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
477 if assigned(Node) then
478 begin
479 if DataSet.FieldByName(ParentField).IsNull then
480 Destination := nil
481 else
482 Destination := FindNode(DataSet.FieldByName(ParentField).AsVariant);
483
484 if (Destination = nil) or (Destination = Node.Parent) then Exit;
485
486 FUpdating := true;
487 try
488 Node.MoveTo(Destination,naAddChild);
489 finally
490 FUpdating := false
491 end;
492 end;
493 end
494 end;
495
496 procedure TIBTreeView.SetHasChildField(AValue: string);
497 begin
498 if FHasChildField = AValue then Exit;
499 FHasChildField := AValue;
500 Reinitialise
501 end;
502
503 procedure TIBTreeView.SetImageIndexField(AValue: string);
504 begin
505 if FImageIndexField = AValue then Exit;
506 FImageIndexField := AValue;
507 Reinitialise
508 end;
509
510 procedure TIBTreeView.SetKeyField(AValue: string);
511 begin
512 if FKeyField = AValue then Exit;
513 FKeyField := AValue;
514 Reinitialise
515 end;
516
517 procedure TIBTreeView.SetSelectedIndexField(AValue: string);
518 begin
519 if FSelectedIndexField = AValue then Exit;
520 FSelectedIndexField := AValue;
521 Reinitialise;
522 end;
523
524 procedure TIBTreeView.SetTextField(AValue: string);
525 begin
526 if FTextField = AValue then Exit;
527 FTextField := AValue;
528 Reinitialise
529 end;
530
531 procedure TIBTreeView.SetDataSource(AValue: TDataSource);
532 begin
533 FDataLink.DataSource := AValue;
534 IBControlLinkChanged;
535 end;
536
537 procedure TIBTreeView.SetParentField(AValue: string);
538 begin
539 if FParentField = AValue then Exit;
540 FParentField := AValue;
541 Reinitialise
542 end;
543
544 function TIBTreeView.ScrollToNode(Node: TIBTreeNode): boolean;
545 begin
546 Result := assigned(DataSet) and DataSet.Active and assigned(Node) and not varIsNull(Node.KeyValue);
547 if Result then
548 begin
549 if DataSet.Active and (DataSet.RecordCount > 0)
550 and DataSet.Locate(KeyField,Node.KeyValue,[]) then Exit;
551
552 FUpdateNode := Node;
553 try
554 DataSet.Active := false;
555 DataSet.Active := true;
556 finally
557 FUpdateNode := nil
558 end;
559 Result := DataSet.FieldByName(KeyField).AsVariant = Node.KeyValue
560 end;
561 end;
562
563 procedure TIBTreeView.UpdateData(Sender: TObject);
564 begin
565 if assigned(FModifiedNode) then
566 begin
567 DataSet.FieldByName(TextField).AsString := FModifiedNode.Text;
568 if FModifiedNode.Parent = nil then
569 DataSet.FieldByName(ParentField).Clear
570 else
571 DataSet.FieldByName(ParentField).AsVariant := TIBTreeNode(FModifiedNode.Parent).KeyValue;
572 FModifiedNode := nil
573 end
574 end;
575
576 procedure TIBTreeView.UpdateParams(Sender: TObject; Parser: TSelectSQLParser);
577 begin
578 if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
579 begin
580 if DataSource.DataSet is TIBQuery then
581 TIBQuery(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
582 FUpdateNode.KeyValue
583 else
584 if DataSource.DataSet is TIBDataSet then
585 TIBDataSet(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
586 FUpdateNode.KeyValue
587 end
588 else
589 if assigned(FExpandNode) then
590 begin
591 if DataSource.DataSet is TIBQuery then
592 TIBQuery(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
593 TIBTreeNode(FExpandNode).KeyValue
594 else
595 if DataSource.DataSet is TIBDataSet then
596 TIBDataSet(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
597 TIBTreeNode(FExpandNode).KeyValue
598 end;
599 end;
600
601 procedure TIBTreeView.UpdateSQL(Sender: TObject; Parser: TSelectSQLParser);
602 begin
603 if not assigned(FExpandNode) and assigned(FUpdateNode) then {Scrolling dataset}
604 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FKeyField + '" = :IBX_KEY_VALUE')
605 else
606 if (Items.Count = 0) then
607 {Need to Load Root Nodes}
608 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FParentField + '" is null')
609 else
610 if assigned(FExpandNode) then
611 begin
612 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FParentField + '" = :IBX_PARENT_VALUE');
613 Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FKeyField + '" = :IBX_PARENT_VALUE',true);
614 end;
615 end;
616
617 procedure TIBTreeView.Added(Node: TTreeNode);
618 begin
619 if assigned(DataSet) and DataSet.Active and not FNoAddNodeToDataset then
620 begin
621 DataSet.Append;
622 TIBTreeNode(Node).FKeyValue := DataSet.FieldByName(KeyField).AsVariant;
623 if (Node.Text = '') and not DataSet.FieldByName(TextField).IsNull then
624 Node.Text := DataSet.FieldByName(TextField).AsString;
625 FModifiedNode := TIBTreeNode(Node);
626 FDataLink.UpdateRecord
627 end;
628 inherited Added(Node);
629 end;
630
631 procedure TIBTreeView.Delete(Node: TTreeNode);
632 begin
633 if not (tvsUpdating in States) {TreeNodes being cleared}
634 and not (tvsManualNotify in States) {Tree Collapse with node delete}
635 and ScrollToNode(TIBTreeNode(Node)) then
636 DataSet.Delete;
637 inherited Delete(Node);
638 end;
639
640 procedure TIBTreeView.Change(Node: TTreeNode);
641 begin
642 inherited Change(Node);
643 ScrollToNode(TIBTreeNode(Node));
644 end;
645
646 function TIBTreeView.CreateNode: TTreeNode;
647 var
648 NewNodeClass: TTreeNodeClass;
649 begin
650 Result := nil;
651 if Assigned(OnCustomCreateItem) then
652 OnCustomCreateItem(Self, Result);
653 if Result = nil then
654 begin
655 NewNodeClass:=TIBTreeNode;
656 if Assigned(OnCreateNodeClass) then
657 OnCreateNodeClass(Self,NewNodeClass);
658 Result := NewNodeClass.Create(Items);
659 end;
660 end;
661
662 function TIBTreeView.CanEdit(Node: TTreeNode): Boolean;
663 begin
664 Result := inherited CanEdit(Node)
665 and assigned(DataSet) and not DataSet.FieldByName(TextField).ReadOnly
666 end;
667
668 procedure TIBTreeView.Expand(Node: TTreeNode);
669 begin
670 inherited Expand(Node);
671 if Node.HasChildren and assigned(DataSet) and (Node.GetFirstChild = nil) then
672 begin
673 FExpandNode := Node;
674 DataSet.Active := false;
675 DataSet.Active := true;
676 Selected := Node;
677 end;
678 end;
679
680 procedure TIBTreeView.IBControlLinkChanged;
681 begin
682 if assigned(DataSource) and (DataSource.DataSet <> nil) and (DataSource.DataSet is TIBParserDataset) then
683 FIBTreeViewControllink.IBDataSet := TIBCustomDataSet(DataSource.DataSet)
684 else
685 FIBTreeViewControllink.IBDataSet := nil;
686 end;
687
688 procedure TIBTreeView.Loaded;
689 begin
690 inherited Loaded;
691 IBControlLinkChanged;
692 Reinitialise
693 end;
694
695 procedure TIBTreeView.NodeChanged(Node: TTreeNode;
696 ChangeEvent: TTreeNodeChangeReason);
697 begin
698 inherited NodeChanged(Node, ChangeEvent);
699 if not FNoAddNodeToDataset and not FUpdating then
700 case ChangeEvent of
701 ncTextChanged:
702 NodeUpdated(Node);
703 ncParentChanged:
704 NodeMoved(Node);
705 end;
706 end;
707
708 procedure TIBTreeView.Notification(AComponent: TComponent; Operation: TOperation
709 );
710 begin
711 inherited Notification(AComponent, Operation);
712 if (Operation = opRemove) and
713 (FDataLink <> nil) and (AComponent = DataSource) then
714 DataSource := nil;
715 end;
716
717 procedure TIBTreeView.Reinitialise;
718 begin
719 if [csDesigning,csLoading] * ComponentState <> [] then Exit;
720 FLastSelected := GetNodePath(Selected);
721 Items.Clear;
722 end;
723
724 constructor TIBTreeView.Create(TheComponent: TComponent);
725 begin
726 inherited Create(TheComponent);
727 FDataLink := TIBTreeViewDatalink.Create(self);
728 FIBTreeViewControlLink := TIBTreeViewControlLink.Create(self);
729 end;
730
731 destructor TIBTreeView.Destroy;
732 begin
733 if assigned(FDataLink) then FDataLink.Free;
734 if assigned(FIBTreeViewControlLink) then FIBTreeViewControlLink.Free;
735 inherited Destroy;
736 end;
737
738 function TIBTreeView.FindNode(KeyValuePath: TVariantArray; SelectNode: boolean
739 ): TIBTreeNode;
740 var Node: TTreeNode;
741 i,j: integer;
742 begin
743 Result := nil;
744 if Length(KeyValuePath) = 0 then Exit;
745
746 FLocatingNode := true;
747 try
748 for j := 0 to Items.TopLvlCount - 1 do
749 begin
750 Node := Items.TopLvlItems[j];
751 i := 0;
752 Node.Expand(false);
753 while assigned(Node) do
754 begin
755 if not VarIsNull(TIBTreeNode(Node).KeyValue) and
756 (TIBTreeNode(Node).KeyValue = KeyValuePath[i]) then
757 begin
758 Inc(i);
759 if i = Length(KeyValuePath) then
760 begin
761 Result := TIBTreeNode(Node);
762 if SelectNode then
763 Selected := Node;
764 Exit
765 end
766 else
767 begin
768 Node.Expand(false);
769 Node := Node.GetFirstChild;
770 end
771 end
772 else
773 Node := Node.GetNextSibling
774 end
775 end
776 finally
777 FLocatingNode := false
778 end
779 end;
780
781 function TIBTreeView.FindNode(KeyValue: variant): TIBTreeNode;
782 var i: integer;
783 begin
784 Result := nil;
785 if (Selected <> nil) and (TIBTreeNode(Selected).KeyValue = KeyValue) then
786 Result := TIBTreeNode(Selected)
787 else
788 {Find it the hard way}
789 begin
790 FullExpand;
791 for i := 0 to Items.Count -1 do
792 if TIBTreeNode(Items[i]).KeyValue = KeyValue then
793 begin
794 Result := TIBTreeNode(Items[i])
795 end;
796 end;
797 end;
798
799 function TIBTreeView.GetNodePath(Node: TTreeNode): TVariantArray;
800 var aParent: TTreeNode;
801 i: integer;
802 begin
803 if not assigned(Node) or not (Node is TIBTreeNode) then
804 SetLength(Result,0)
805 else
806 begin
807 {Count length of Path}
808 i := 1;
809 aParent := Node.Parent;
810 while (aParent <> nil) do
811 begin
812 Inc(i);
813 aParent := aParent.Parent
814 end;
815
816 {Save Path}
817 Setlength(Result,i);
818 while i > 0 do
819 begin
820 Dec(i);
821 Result[i] := TIBTreeNode(Node).KeyValue;
822 Node := Node.Parent
823 end;
824 end;
825 end;
826
827 { TIBTreeViewDatalink }
828
829 procedure TIBTreeViewDatalink.ActiveChanged;
830 begin
831 FOwner.ActiveChanged(self)
832 end;
833
834 procedure TIBTreeViewDatalink.DataSetChanged;
835 begin
836 FOwner.DataSetChanged(self)
837 end;
838
839 procedure TIBTreeViewDatalink.RecordChanged(Field: TField);
840 begin
841 FOwner.RecordChanged(self,Field);
842 end;
843
844 procedure TIBTreeViewDatalink.UpdateData;
845 begin
846 FOwner.UpdateData(self)
847 end;
848
849 constructor TIBTreeViewDatalink.Create(AOwner: TIBTreeView);
850 begin
851 inherited Create;
852 FOwner := AOwner
853 end;
854
855 end.