ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/ibcontrols/IBTreeView.pas
(Generate patch)

Comparing ibx/trunk/ibcontrols/IBTreeView.pas (file contents):
Revision 21 by tony, Thu Feb 26 10:33:34 2015 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

# Line 15 | Line 15
15   *
16   *  The Initial Developer of the Original Code is Tony Whyman.
17   *
18 < *  The Original Code is (C) 2011 Tony Whyman, MWA Software
18 > *  The Original Code is (C) 2015 Tony Whyman, MWA Software
19   *  (http://www.mwasoftware.co.uk).
20   *
21   *  All Rights Reserved.
# Line 31 | Line 31 | interface
31  
32   uses
33    Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
34 <  DB, IBSQLParser;
34 >  DB, IBSQLParser, IBCustomDataSet;
35  
36   type
37    {
# Line 52 | Line 52 | type
52      FOwner: TIBTreeView;
53    protected
54      procedure ActiveChanged; override;
55    procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
55      procedure DataSetChanged; override;
56      procedure RecordChanged(Field: TField); override;
57      procedure UpdateData; override;
# Line 60 | Line 59 | type
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;
# Line 74 | Line 86 | type
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;
# Line 93 | Line 108 | type
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);
# Line 121 | Line 139 | type
139      { Public declarations }
140      constructor Create(TheComponent: TComponent); override;
141      destructor Destroy; override;
142 <    function FindNode(KeyValuePath: array of variant; SelectNode: boolean): TIBTreeNode; overload;
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;
# Line 153 | Line 171 | type
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;
# Line 232 | Line 252 | type
252  
253   implementation
254  
255 < uses IBQuery,IBCustomDataSet, Variants;
255 > uses IBQuery,Variants;
256  
257   function StrIntListToVar(s: string): TVariantArray;
258   var i, idx: integer;
# Line 268 | Line 288 | begin
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
# Line 290 | Line 334 | procedure TIBTreeView.ActiveChanged(Send
334   var AtTopLevel: boolean;
335   begin
336    if (csDesigning in ComponentState) then Exit;
337 +  IBControlLinkChanged;
338    if assigned(DataSet) and not DataSet.Active then
339    begin
340      if not assigned(FExpandNode) and not assigned(FUpdateNode) then {must really be closing}
# Line 321 | Line 366 | begin
366        DataSet.First;
367        while not DataSet.EOF do
368        begin
369 <        Node := Items.AddChild(FExpandNode,DataSet.FieldByName(TextField).AsString);
370 <        TIBTreeNode(Node).FKeyValue := DataSet.FieldByName(KeyField).AsVariant;
371 <        Node.HasChildren := (HasChildField = '') or (DataSet.FieldByName(HasChildField).AsInteger <> 0);
372 <        Inc(ChildCount);
369 >        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          DataSet.Next
381        end;
382      finally
# Line 338 | Line 390 | end;
390  
391   procedure TIBTreeView.DataSetChanged(Sender: TObject);
392   begin
393 < //  Reinitialise
393 > //  Do nothing;
394   end;
395  
396   function TIBTreeView.GetDataSet: TDataSet;
# Line 391 | Line 443 | procedure TIBTreeView.RecordChanged(Send
443   var Node: TIBTreeNode;
444      Destination: TIBTreeNode;
445   begin
446 +  if DataSet.State = dsInsert then Exit;
447 +
448    if assigned(Field) and (Field.FieldName = TextField) then
449    begin
450      Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
# Line 405 | Line 459 | begin
459      end;
460    end
461    else
462 +  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    if assigned(Field) and (Field.FieldName = ParentField) then
477    begin
478      Node := FindNode(DataSet.FieldByName(KeyField).AsVariant);
# Line 415 | Line 483 | begin
483        else
484          Destination := FindNode(DataSet.FieldByName(ParentField).AsVariant);
485  
486 <      if Destination = Node.Parent then Exit;
486 >      if (Destination = nil) or (Destination = Node.Parent) then Exit;
487  
488        FUpdating := true;
489        try
# Line 434 | Line 502 | begin
502    Reinitialise
503   end;
504  
505 + procedure TIBTreeView.SetImageIndexField(AValue: string);
506 + begin
507 +  if FImageIndexField = AValue then Exit;
508 +  FImageIndexField := AValue;
509 +  Reinitialise
510 + end;
511 +
512   procedure TIBTreeView.SetKeyField(AValue: string);
513   begin
514    if FKeyField = AValue then Exit;
# Line 441 | Line 516 | begin
516    Reinitialise
517   end;
518  
519 + procedure TIBTreeView.SetSelectedIndexField(AValue: string);
520 + begin
521 +  if FSelectedIndexField = AValue then Exit;
522 +  FSelectedIndexField := AValue;
523 +  Reinitialise;
524 + end;
525 +
526   procedure TIBTreeView.SetTextField(AValue: string);
527   begin
528    if FTextField = AValue then Exit;
# Line 450 | Line 532 | end;
532  
533   procedure TIBTreeView.SetDataSource(AValue: TDataSource);
534   begin
535 <  FDataLink.DataSource := AValue
535 >  FDataLink.DataSource := AValue;
536 >  IBControlLinkChanged;
537   end;
538  
539   procedure TIBTreeView.SetParentField(AValue: string);
# Line 466 | Line 549 | begin
549    if Result then
550    begin
551      if DataSet.Active and (DataSet.RecordCount > 0)
552 <         and (Node.KeyValue = DataSet.FieldByName(KeyField).AsVariant) then Exit;
552 >         and DataSet.Locate(KeyField,Node.KeyValue,[]) then Exit;
553  
554      FUpdateNode := Node;
555      try
# Line 496 | Line 579 | procedure TIBTreeView.UpdateParams(Sende
579   begin
580    if not assigned(FExpandNode) and assigned(FUpdateNode)  then {Scrolling dataset}
581     begin
582 <     if (Sender as TDataLink).DataSet is TIBQuery then
583 <       TIBQuery((Sender as TDataLink).DataSet).ParamByName('IBX_KEY_VALUE').Value :=
582 >     if DataSource.DataSet is TIBQuery then
583 >       TIBQuery(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
584           FUpdateNode.KeyValue
585       else
586 <     if (Sender as TDataLink).DataSet is TIBDataSet then
587 <       TIBDataSet((Sender as TDataLink).DataSet).ParamByName('IBX_KEY_VALUE').Value :=
586 >     if DataSource.DataSet is TIBDataSet then
587 >       TIBDataSet(DataSource.DataSet).ParamByName('IBX_KEY_VALUE').Value :=
588           FUpdateNode.KeyValue
589     end
590    else
591    if assigned(FExpandNode) then
592    begin
593 <    if (Sender as TDataLink).DataSet is TIBQuery then
594 <      TIBQuery((Sender as TDataLink).DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
593 >    if DataSource.DataSet is TIBQuery then
594 >      TIBQuery(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
595          TIBTreeNode(FExpandNode).KeyValue
596      else
597 <    if (Sender as TDataLink).DataSet is TIBDataSet then
598 <      TIBDataSet((Sender as TDataLink).DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
597 >    if DataSource.DataSet is TIBDataSet then
598 >      TIBDataSet(DataSource.DataSet).ParamByName('IBX_PARENT_VALUE').Value :=
599          TIBTreeNode(FExpandNode).KeyValue
600    end;
601   end;
# Line 527 | Line 610 | begin
610        Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FParentField + '" is null')
611      else
612      if assigned(FExpandNode) then
613 +    begin
614        Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FParentField + '" = :IBX_PARENT_VALUE');
615 +      Parser.Add2WhereClause(GetRelationNameQualifier + '"' + FKeyField + '" = :IBX_PARENT_VALUE',true);
616 +    end;
617   end;
618  
619   procedure TIBTreeView.Added(Node: TTreeNode);
# Line 589 | Line 675 | begin
675      FExpandNode := Node;
676      DataSet.Active := false;
677      DataSet.Active := true;
678 <    if assigned(Selected) then
593 <      ScrollToNode(TIBTreeNode(Selected))
678 >    Selected := Node;
679    end;
680   end;
681  
682 + 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   procedure TIBTreeView.Loaded;
691   begin
692    inherited Loaded;
693 +  IBControlLinkChanged;
694    Reinitialise
695   end;
696  
# Line 618 | Line 712 | procedure TIBTreeView.Notification(AComp
712   begin
713    inherited Notification(AComponent, Operation);
714    if (Operation = opRemove) and
715 <     (FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil;
715 >     (FDataLink <> nil) and (AComponent = DataSource) then
716 >     DataSource := nil;
717   end;
718  
719   procedure TIBTreeView.Reinitialise;
# Line 632 | Line 727 | constructor TIBTreeView.Create(TheCompon
727   begin
728    inherited Create(TheComponent);
729    FDataLink := TIBTreeViewDatalink.Create(self);
730 +  FIBTreeViewControlLink := TIBTreeViewControlLink.Create(self);
731   end;
732  
733   destructor TIBTreeView.Destroy;
734   begin
735    if assigned(FDataLink) then FDataLink.Free;
736 +  if assigned(FIBTreeViewControlLink) then FIBTreeViewControlLink.Free;
737    inherited Destroy;
738   end;
739  
740 < function TIBTreeView.FindNode(KeyValuePath: array of variant;
741 <  SelectNode: boolean): TIBTreeNode;
740 > function TIBTreeView.FindNode(KeyValuePath: TVariantArray; SelectNode: boolean
741 >  ): TIBTreeNode;
742   var Node: TTreeNode;
743      i,j: integer;
744   begin
745    Result := nil;
746 +  if Length(KeyValuePath) = 0 then Exit;
747 +
748    FLocatingNode := true;
749    try
750     for j := 0 to Items.TopLvlCount - 1 do
# Line 655 | Line 754 | begin
754      Node.Expand(false);
755      while assigned(Node)  do
756      begin
757 <      if TIBTreeNode(Node).KeyValue = KeyValuePath[i] then
757 >      if not VarIsNull(TIBTreeNode(Node).KeyValue) and
758 >                        (TIBTreeNode(Node).KeyValue = KeyValuePath[i]) then
759        begin
760          Inc(i);
761          if i = Length(KeyValuePath) then
# Line 733 | Line 833 | begin
833    FOwner.ActiveChanged(self)
834   end;
835  
736 procedure TIBTreeViewDatalink.DataEvent(Event: TDataEvent; Info: Ptrint);
737 begin
738  if (Event = deCheckBrowseMode) and (Info = 1) and not DataSet.Active then
739  begin
740    if (DataSet is TIBDataSet) then
741      FOwner.UpdateSQL(self,TIBDataSet(DataSet).Parser)
742    else
743    if (DataSet is TIBQuery) then
744      FOwner.UpdateSQL(self,TIBQuery(DataSet).Parser)
745  end
746  else
747  if (Event = deCheckBrowseMode) and (Info = 2) and not DataSet.Active then
748  begin
749    if (DataSet is TIBDataSet) then
750      FOwner.UpdateParams(self,TIBDataSet(DataSet).Parser)
751    else
752    if (DataSet is TIBQuery) then
753      FOwner.UpdateParams(self,TIBQuery(DataSet).Parser)
754  end
755  else
756    inherited DataEvent(Event, Info);
757 end;
758
836   procedure TIBTreeViewDatalink.DataSetChanged;
837   begin
838    FOwner.DataSetChanged(self)

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines