Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue54/Persist/tiTreeViewPlus.pas

Pascal/Delphi Source File | 2000-01-08 | 10.3 KB | 365 lines

{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  Purpose: A TTreeView with a family of contained forms for editing the nodes

  Revision History:
  Dec 1999, PWH, Created

  Useage:
  a) Drop on a form
  b) Set the DataProperty to a TPersistent, which may contain other TPersistents
     RTTI will be used to display any published 'Caption' properties in the list
     as nodes.
  c) Call RegisterChildForm( pDataClassRef ; pFormClassRef )
     passing a DataType ( must be TPersisistent descendant) and
     a FormType ( must be a TForm )
  d) Write some code in the OnSave, OnCancel, OnClose, etc events.

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }

{
  ToDo 4 -cTTreeView:
  a) Hide popup menu choices if no code is assigned to the event.
  b) Deactivate <Save> and <Cancel> if data is not dirty.
  c) Speed buttons linked to popup menu.
  d) Ability to drag & drop tree nodes automatically.
  e) Custom Glyphs on tree nodes (probably using a TCollection)
}

unit tiTreeViewPlus;

interface
uses
  Classes
  ,Controls
  ,Extctrls
  ,ComCtrls
  ,tiTreeView
  ,ImgList
  ,Forms
  ,Dialogs    // ShowMessage, for debugging
  ;

type

  { ToDo 1 -cGUI: Validate current child form before saving }

  TtiTVDataClassRef = class of TPersistent ;
  TtiTVFormClassRef = class of TForm ;

  TtiTreeViewPlus = class( TCustomPanel )
  private
    FTV               : TtiTreeView ;
    FSplitter         : TSplitter ;
    FOnGetDataPage    : TTVGetDataPageEvent ;
    FslChildForms     : TStringList ;
    FCurrentChildForm : TForm ;

    { ToDo 1 -ctiTreeView: VisibleMenuItems and EnabledMenuItems set properties }

    function  GetItems: TTreeNodes ;
    function  GetData: TPersistent;
    procedure SetData(const Value: TPersistent);
    function  GetImages: TCustomImageList;
    procedure SetImages(const Value: TCustomImageList);
    function  GetOnNew: TtiTVNewEvent;
    procedure SetOnNew(const Value: TtiTVNewEvent);
    function  GetOnSave: TNotifyEvent;
    procedure SetOnSave(const Value: TNotifyEvent);
    function  GetOnDelete: TtiTVDeleteEvent;
    procedure SetOnDelete(const Value: TtiTVDeleteEvent);
    function  GetOnClose: TNotifyEvent;
    procedure SetOnClose(const Value: TNotifyEvent);
    function  GetOnCancel: TNotifyEvent;
    procedure SetOnCancel(const Value: TNotifyEvent);
    function  GetSplitterPos: integer;
    procedure SetSplitterPos(const Value: integer);

    // The currently selected node has changed, so this proc will be executed
    procedure DoOnGetDataPage( pData : TObject ; pNode : TTreeNode ) ;
    procedure DoOnChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean);
    function  GetSelected: TTreeNode;
    procedure SetSelected( pData : TTreeNode ) ;

  protected
  published
    property Align ;
    property Anchors ;
    property SplitterPos   : integer      read GetSplitterPos write SetSplitterPos ;
    property Images        : TCustomImageList read GetImages write SetImages ;
    property OnGetDataPage : TTVGetDataPageEvent read FOnGetDataPage write FOnGetDataPage  ;
    property OnNew         : TtiTVNewEvent read GetOnNew    write SetOnNew    ;
    property OnSave        : TNotifyEvent read GetOnSave   write SetOnSave   ;
    property OnDelete      : TtiTVDeleteEvent read GetOnDelete write SetOnDelete ;
    property OnClose       : TNotifyEvent read GetOnClose  write SetOnClose  ;
    property OnCancel      : TNotifyEvent read GetOnCancel write SetOnCancel ;

    // We can't publish OnChangeas is is used internally
    // property OnChange ;

  public
    Constructor Create( owner : TComponent ) ; override ;
    Destructor  destroy ; override ;
    Procedure   UpdateNodeText( const psValue : string ) ;
    Property    Items : TTreeNodes  read GetItems ;
    Property    Data  : TPersistent read GetData write SetData ;
    Property    Selected : TTreeNode read GetSelected write SetSelected ;
    Procedure   FullExpand ;
    Procedure   RegisterChildForm( pDataClassRef : TtiTVDataClassRef ; pFormClassRef : TtiTVFormClassRef ) ;    // Property    TopItem ;
    Procedure   DoNew ;
    procedure   DoDelete ;

    // Use RTTI to test the Valid property on the child form. The GetValid function
    // must also save any data from the from to its Data property.
    function    IsCurrentChildFormValid: boolean;
  end ;

implementation
uses
   TypInfo
  ,SysUtils
   ;

{ TtiTreeViewPlus }

constructor TtiTreeViewPlus.create(owner: TComponent);
begin
  inherited Create( owner ) ;
  ControlStyle := ControlStyle - [csSetCaption] ;
  BevelInner  := bvNone ;
  BevelOuter  := bvNone ;
  BorderStyle := bsNone ;
  Align       := alClient ;

  FSplitter        := TSplitter.Create( self ) ;
  FSplitter.Parent := self ;
  FSplitter.Left   := 150 ;

  FTV        := TtiTreeView.Create( self ) ;
  FTV.Parent := self ;
  FTV.Align  := alLeft ;
  FTV.OnGetDataPage := DoOnGetDataPage ;
  FTV.OnChanging    := DoOnChanging ;

{  FPanelParent             := TPanel.Create( self ) ;
  FPanelParent.Parent      := self ;
  FPanelParent.BorderStyle := bsNone ;
  FPanelParent.BevelInner  := bvNone ;
  FPanelParent.Align       := alClient ;
}
  FslChildForms    := TStringList.Create ;

end;

destructor TtiTreeViewPlus.destroy;
var
  i : integer ;
begin
  FTV.Free ;
  FSplitter.Free ;
  for i := 0 to FslChildForms.Count - 1 do
    TObject( FslChildForms.Objects[i] ).Free ;
  FslChildForms.Free ;
  inherited;
end;

procedure TtiTreeViewPlus.DoOnChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean);
begin
  AllowChange := IsCurrentChildFormValid ;
end;

function TtiTreeViewPlus.IsCurrentChildFormValid : boolean ;
begin
  result := true ;
  if FCurrentChildForm <> nil then
    if IsPublishedProp( FCurrentChildForm, 'Valid' ) then
      result := GetPropValue( FCurrentChildForm, 'Valid', false )
end ;

procedure TtiTreeViewPlus.DoOnGetDataPage(pData: TObject; pNode: TTreeNode);
var
  i : integer ;
begin

  // If CurrentChildForm was assigned, then do some cleaning up.
  if FCurrentChildForm <> nil then begin
    SetObjectProp( FCurrentChildForm, 'Data',     nil ) ;
    SetObjectProp( FCurrentChildForm, 'TreeNode', nil ) ;
    FCurrentChildForm.Visible := false ;
    FCurrentChildForm := nil ;
  end ;

  // If the OnGetDataPage event was assinged, then execute it
  if Assigned( FOnGetDataPage ) then
    FOnGetDataPage( pData, pNode ) ;

  // Find a childForm for editing the Data class attached to the selected node.
  i := FslChildForms.IndexOf( upperCase( pData.ClassName )) ;

  // There was a form for this node, so setup the form
  if i <> -1 then begin
    FCurrentChildForm := TForm( FslChildForms.Objects[ i ]) ;
    SetObjectProp( FCurrentChildForm, 'Data', pData ) ;
    SetObjectProp( FCurrentChildForm, 'TreeNode', pNode ) ;
    FCurrentChildForm.Visible := true ;
  end ;

end;

function TtiTreeViewPlus.GetData: TPersistent;
begin
  result := FTV.Data ;
end;

function TtiTreeViewPlus.GetImages: TCustomImageList;
begin
  result := FTV.Images ;
end;

function TtiTreeViewPlus.GetItems : TTreeNodes ;
begin
  result := FTV.Items ;
end;

function TtiTreeViewPlus.GetOnCancel: TNotifyEvent;
begin
  result := FTV.OnCancel ;
end;

function TtiTreeViewPlus.GetOnClose: TNotifyEvent;
begin
  result := FTV.OnClose ;
end;

function TtiTreeViewPlus.GetOnDelete: TtiTVDeleteEvent;
begin
  result := FTV.OnDelete ;
end;

function TtiTreeViewPlus.GetOnNew: TtiTVNewEvent;
begin
  result := FTV.OnNew ;
end;

function TtiTreeViewPlus.GetOnSave: TNotifyEvent;
begin
  result := FTV.OnSave ;
end;

function TtiTreeViewPlus.GetSplitterPos: integer;
begin
//  result := FSplitter.Left ;
  result := FTV.Width ;
end;

procedure TtiTreeViewPlus.RegisterChildForm(pDataClassRef: TtiTVDataClassRef;  pFormClassRef: TtiTVFormClassRef);
var
  lForm : TForm ;
  lsMessage : string ;
begin
  lForm             := pFormClassRef.Create( nil ) ;
  lsMessage := '' ;

  if not IsPublishedProp( lForm, 'Data' ) then begin
    if lsMessage <> '' then lsMessage := lsMessage + #13 ;
    lsMessage := lsMessage +
      '''Data'' property not published' ;
  end ;

  if not IsPublishedProp( lForm, 'TreeNode' ) then begin
    if lsMessage <> '' then lsMessage := lsMessage + #13 ;
    lsMessage := lsMessage +
      '''TreeNode'' property not published' ;
  end ;

  if lsMessage <> '' then begin
     lsMessage := lsMessage + #13 + #13 +
       'Called in TtiTreeViewPlus.DoOnGetDataPage' ;
    raise exception.create( lsMessage ) ;
  end ;

  if lsMessage = '' then begin
    lForm.Parent      := self ;
    lForm.BorderStyle := bsNone ;
    lForm.Align       := alClient ;
    lForm.Visible     := false ;
    FslChildForms.AddObject( upperCase( pDataClassRef.ClassName ),
                             lForm ) ;
  end else begin
    lForm.Free ;
  end ;

end;

procedure TtiTreeViewPlus.SetData(const Value: TPersistent);
begin
  FTV.Data := Value ;
end;

procedure TtiTreeViewPlus.SetImages(const Value: TCustomImageList);
begin
  FTV.Images := Value ;
end;

procedure TtiTreeViewPlus.SetOnCancel(const Value: TNotifyEvent);
begin
  FTV.OnCancel := Value ;
end;

procedure TtiTreeViewPlus.SetOnClose(const Value: TNotifyEvent);
begin
  FTV.OnClose := Value ;
end;

procedure TtiTreeViewPlus.SetOnDelete(const Value: TtiTVDeleteEvent);
begin
  FTV.OnDelete := Value ;
end;

procedure TtiTreeViewPlus.SetOnNew(const Value: TtiTVNewEvent);
begin
  FTV.OnNew := Value ;
end;

procedure TtiTreeViewPlus.SetOnSave(const Value: TNotifyEvent);
begin
  FTV.OnSave := Value ;
end;

procedure TtiTreeViewPlus.SetSplitterPos(const Value: integer);
begin
//  FSplitter.Left := Value ;
  FTV.Width := Value ;
end;

procedure TtiTreeViewPlus.UpdateNodeText(const psValue: string);
begin
  FTV.UpdateNodeText( psValue ) ;
end;

function TtiTreeViewPlus.GetSelected: TTreeNode;
begin
  result := FTV.Selected ;
end;

procedure TtiTreeViewPlus.SetSelected(pData: TTreeNode);
begin
  FTV.Selected := pData ;
end;

procedure TtiTreeViewPlus.FullExpand;
begin
  FTV.FullExpand ;
end;

procedure TtiTreeViewPlus.DoNew ;
begin
  FTV.DoNew ;
end;

procedure TtiTreeViewPlus.DoDelete ;
begin
  FTV.DoDelete ;
end;

end.