unit Un_DBTreeView;

interface

uses
   Classes,ComCtrls,CommCtrl,DB,DBTables,Controls,Messages;

type
   TpsDBTreeNode = class (TTreeNode)
   private
      FIdNode   :Integer;
   public
      property idNode:Integer read FIdNode;
   end;

   TpsDBTreeView = class(TCustomTreeView)
   private
      FOnEdited: TTVEditedEvent;
      FLDblCklick:Boolean; //показывает, что выполняется DblClick
      FDoExpColOnDblClick:Boolean; //Если True, то при DblClick не будет раскрываться/закрываться Node.
      FReopenOnExpand:Boolean;
      FQuery:TQuery;
      FIdTree:Integer;
      function GetDatabaseName: string;
      procedure SetDatabaseName(const Value: string);
      procedure SetIdTree(const Value: Integer);
      procedure AddChildren(AParent:TTreeNode);
      procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
      function GetSelectedID: Integer;
      procedure SetSelectedID(const Value: Integer);
   protected
      procedure Loaded; override;
      function CreateNode: TTreeNode; override;
      function CanExpand(Node: TTreeNode): Boolean; override;
      function CanCollapse(Node: TTreeNode): Boolean; override;
      procedure DoEdited(Sender: TObject; Node: TTreeNode; var S: string);
   public
      constructor Create(AOwner:TComponent); override;
      procedure dbLoadFirstLevel;
      function dbAddChild(AParent:TTreeNode;AText:string;idNode:Integer=0):TTreeNode;
      procedure dbDeleteNode(Node:TTreeNode;ReQueryFromDB:Boolean=False);
      procedure dbMoveNode(DNode,SNode:TTreeNode;AsChild:Boolean=False;ReQueryFromDB:Boolean=False);
      property Items;
      property SelectedID:Integer read GetSelectedID write SetSelectedID;
   published
      property idTree:Integer read FIdTree write SetIdTree;
      property DatabaseName:string read GetDatabaseName write SetDatabaseName;
      property DoExpColOnDblClick:Boolean read FDoExpColOnDblClick write FDoExpColOnDblClick default True;
      property OnEdited:TTVEditedEvent read FOnEdited write FOnEdited;
   published //Из TCustomTreeView
      property Align;
      property Anchors;
      property BevelEdges;
      property BevelInner;
      property BevelOuter;
      property BevelKind default bkNone;
      property BevelWidth;
      property BiDiMode;
      property BorderStyle;
      property BorderWidth;
      property ChangeDelay;
      property Color;
      property Ctl3D;
      property Constraints;
      property DragKind;
      property DragCursor;
      property DragMode;
      property Enabled;
      property Font;
      property HideSelection;
      property HotTrack;
      property Images;
      property ReadOnly;
      property RightClickSelect;
      property RowSelect;
      property ShowButtons;
      property ShowHint;
      property ShowLines;
      property ShowRoot;
      property OnAddition;
      property OnAdvancedCustomDraw;
      property OnAdvancedCustomDrawItem;
      property OnChange;
      property OnChanging;
      property OnClick;
      property OnCollapsed;
      property OnCollapsing;
      property OnCompare;
      property OnContextPopup;
      property OnCreateNodeClass;
      property OnCustomDraw;
      property OnCustomDrawItem;
      property OnDblClick;
      property OnDeletion;
      property OnDragDrop;
      property OnDragOver;
      property OnEditing;
      property OnEndDock;
      property OnEndDrag;
      property OnEnter;
      property OnExit;
      property OnExpanding;
      property OnExpanded;
      property OnGetImageIndex;
      property OnGetSelectedIndex;
      property OnKeyDown;
      property OnKeyPress;
      property OnKeyUp;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
      property OnStartDock;
      property OnStartDrag;
      { Items must be published after OnGetImageIndex and OnGetSelectedIndex }
      //property Items;
   end;

procedure Register;

implementation

uses
   SysUtils,Variants,Forms;

const
    SQLLoadLevel  :string='EXEC upDBTreeGetChildren @idDBTree=%d,@idParent=%s';
    SQLAddChild   :string='EXEC upDBTreeAddNode @idDBTree=%d,@idParent=%s,@idPrior=%s,@idNext=%s,@Text=''%s'',@idNode=%s';
    SQLDeleteNode :string='EXEC upDBTreeDeleteNode @idDBTree=%d,@idNode=%d';
    SQLMoveNode   :string='EXEC upDBTreeMoveNode @idDBTree=%d,@idDNode=%d,@idSNode=%d,@AsChild=%d';
    SQLRenameNode :string='EXEC upDBTreeRenameNode @idDBTree=%d,@idNode=%d,@NewText=''%s''';
    SQLGetFullPath:string='EXEC upDBTreeGetFullPath @idDBTree=%d,@idNode=%d';

procedure Register;
begin
   RegisterComponents('My Components',[TpsDBTreeView]);
end;

{ TpsDBTreeView }

procedure TpsDBTreeView.AddChildren(AParent:TTreeNode);
var
   NewNode:TpsDBTreeNode;
   TheCursor:TCursor;
begin
   TheCursor:=Screen.Cursor;
   Screen.Cursor:=crHourGlass;
   try
      with FQuery do begin
         Open;
         try
            if not IsEmpty then
             while not Eof do begin
                NewNode:=Items.AddChild(AParent,FieldByName('Text').AsString) as TpsDBTreeNode;
                if not FieldByName('idFirstChild').IsNull then
                   Items.AddChild(NewNode,'HasChildren');
                with NewNode do begin
                   FIdNode:=FieldByName('idNode').AsInteger;
                end;
                Next;
             end;
         finally
            Close;
         end;
      end;
   finally
      Screen.Cursor:=TheCursor;
   end;
end;

function TpsDBTreeView.CanCollapse(Node: TTreeNode): Boolean;
begin
   if FLDblCklick and not FDoExpColOnDblClick then
      Result:=False
   else begin
      Result:=inherited CanCollapse(Node);
      //Удаление вложенных узлов
      if Result and FReopenOnExpand and (Node is TpsDBTreeNode) and Node.HasChildren then begin
         Items.BeginUpdate;
         try
            Node.DeleteChildren;
            Items.AddChild(Node,'HasItems');
         finally
            Items.EndUpdate;
         end;
      end;
   end;
end;

function TpsDBTreeView.CanExpand(Node: TTreeNode): Boolean;
begin
   if FLDblCklick and not FDoExpColOnDblClick then
      Result:=False
   else begin
      //Загрузка вложенных узлов
      if FReopenOnExpand and (Node is TpsDBTreeNode) and Node.HasChildren then begin
         Items.BeginUpdate;
         try
            Node.DeleteChildren;
            if (FIdTree<>0) and (DatabaseName<>'') then begin
               FQuery.SQL.Text:=Format(SQLLoadLevel,[FIdTree,IntToStr((Node as TpsDBTreeNode).idNode)]);
               AddChildren(Node);
            end;
         finally
            Items.EndUpdate;
         end;
      end;
      Result:=inherited CanExpand(Node);
   end;
end;

constructor TpsDBTreeView.Create(AOwner: TComponent);
begin
  FReopenOnExpand:=True;
  FDoExpColOnDblClick:=True;
  inherited;
  inherited OnEdited:=DoEdited;
  FQuery:=TQuery.Create(Self);
end;

function TpsDBTreeView.CreateNode: TTreeNode;
begin
  if Assigned(OnCreateNodeClass) then
    Result:=inherited CreateNode
  else Result:=TpsDBTreeNode.Create(Items);
end;

function TpsDBTreeView.dbAddChild(AParent: TTreeNode;AText:string;idNode:Integer=0): TTreeNode;
var
   NewNode:TTreeNode;

   function GetIdParent(Node:TTreeNode):string;
   begin
      if Assigned(Node.Parent) then
         Result:=IntToStr((Node.Parent as TpsDBTreeNode).idNode)
      else Result:='NULL';
   end;
   function GetIdPrior(Node:TTreeNode):string;
   var
      Prior:TTreeNode;
   begin
      Prior:=Node.getPrevSibling;
      if Assigned(Prior) then
         Result:=IntToStr((Prior as TpsDBTreeNode).idNode)
      else Result:='NULL';
   end;
   function GetIdNext(Node:TTreeNode):string;
   var
      Next:TTreeNode;
   begin
      Next:=Node.getNextSibling;
      if Assigned(Next) then
         Result:=IntToStr((Next as TpsDBTreeNode).idNode)
      else Result:='NULL';
   end;
   function GetIdNode(idNode:Integer):string;
   begin
      if idNode<>0 then
         Result:=IntToStr(idNode)
      else Result:='NULL';
   end;

begin
   Items.BeginUpdate;
   try
      if Assigned(AParent) and not AParent.Expanded then
         AParent.Expand(False);
      NewNode:=Items.AddChild(AParent,AText);
      with FQuery do
       if (FIdTree<>0)and(DatabaseName<>'') then begin
         FQuery.SQL.Text:=Format(SQLAddChild,[FIdTree,GetIdParent(NewNode),GetIdPrior(NewNode),GetIdNext(NewNode),AText,GetIdNode(idNode)]);
         try
            Open;
            try
              if not IsEmpty then begin
                 (NewNode as TpsDBTreeNode).FIdNode:=FieldByName('NewId').AsInteger;
                 //Выделяем добавленный узел
                 FReopenOnExpand:=False;
                 try
                    Selected:=NewNode;
                 finally
                    FReopenOnExpand:=True;
                 end;
              end else Raise Exception.Create('TpsDBTreeView.dbAddChild:Не получен идентификатор нового узла.');
            finally
              Close;
            end;
         except
            NewNode.Delete;
            Raise;
         end;
       end;
   finally
      Items.EndUpdate;
   end;
   Result:=NewNode;
end;

procedure TpsDBTreeView.dbDeleteNode(Node: TTreeNode;ReQueryFromDB:Boolean=False);
var
   AParent:TTreeNode;
begin
   if Node.HasChildren then
      Raise Exception.Create('TpsDBTreeView.dbDeleteNode:Этот узел удалить нельзя,т.к. есть вложеннные узлы.');
   with FQuery do begin
      SQL.Text:=Format(SQLDeleteNode,[FIdTree,(Node as TpsDBTreeNode).idNode]);
      ExecSQL;
   end;
   if ReQueryFromDB then
    begin
       Items.BeginUpdate;
       try
          AParent:=Node.Parent;
          if Assigned(AParent) then
           begin
              AParent.Collapse(False);
              AParent.Expand(False);
           end
          else dbLoadFirstLevel;
       finally
          Items.EndUpdate;
       end;
    end
   else Node.Delete;
end;

procedure TpsDBTreeView.dbMoveNode(DNode, SNode: TTreeNode;AsChild: Boolean=False;ReQueryFromDB:Boolean=False);
const
   BoolToInt:array[Boolean] of Integer =(0,1);
var
   DParent,SParent,Node:TTreeNode;
   TheNodeId:Integer;
begin
   if not Assigned(DNode) or not Assigned(SNode) or (DNode=SNode) then
      Exit;
   if DNode.HasAsParent(SNode) then
      Raise Exception.Create('TpsDBTreeView.dbMoveNode:Узел не может быть перемещен.')
   else begin
      with FQuery do begin
         SQL.Text:=Format(SQLMoveNode,[FIdTree,(DNode as TpsDBTreeNode).idNode,(SNode as TpsDBTreeNode).idNode,BoolToInt[AsChild]]);
         ExecSQL;
      end;
      Items.BeginUpdate;
      try
         if ReQueryFromDB then
          begin
             TheNodeId:=(SNode as TpsDBTreeNode).idNode;
             DParent:=DNode.Parent;
             SParent:=SNode.Parent;
             if Assigned(DParent) and Assigned(SParent) then
              begin
                 DParent.Collapse(False);
                 DParent.Expand(False);
                 if (DParent<>SParent) and not SParent.HasAsParent(DParent) then begin
                    DParent.Collapse(False);
                    DParent.Expand(False);
                 end;
              end
             else dbLoadFirstLevel;
             if Assigned(DParent) then
                Node:=DParent.getFirstChild
             else Node:=Items.GetFirstNode;
             while Assigned(Node) and ((Node as TpsDBTreeNode).idNode<>TheNodeId) do
                Node:=Node.getNextSibling;
             if Assigned(Node) then
                Selected:=Node;
          end
         else
            try
              if AsChild then
               begin
                 if DNode.Expanded then
                  begin
                     FReopenOnExpand:=False;
                     SNode.MoveTo(DNode,naAddChild);
                  end
                 else begin
                    Items.AddChildFirst(DNode,'HasChildren');//Надо добавить узел,что бы DNode открылся.
                    if CanExpand(DNode) then begin
                       SNode.Delete;
                       FReopenOnExpand:=False;
                       DNode.GetLastChild.Selected:=True;
                    end;
                 end;
               end
              else begin
                 FReopenOnExpand:=False;
                 SNode.MoveTo(DNode,naInsert);
              end;
            finally
              FReopenOnExpand:=True;
            end;
      finally
         Items.EndUpdate;
      end;
   end;
end;

function TpsDBTreeView.GetDatabaseName: string;
begin
   Result:=FQuery.DatabaseName;
end;

procedure TpsDBTreeView.Loaded;
begin
  inherited;
  if not (csDesigning in ComponentState) then
    dbLoadFirstLevel;
end;

procedure TpsDBTreeView.dbLoadFirstLevel;
begin
   Items.Clear;
   if not (csDesigning in Self.ComponentState) and not (csLoading in Self.ComponentState) and (FIdTree<>0) and (DatabaseName<>'') then begin
      FQuery.SQL.Text:=Format(SQLLoadLevel,[FIdTree,'NULL']);
      AddChildren(nil);
   end;
end;

procedure TpsDBTreeView.SetDatabaseName(const Value: string);
begin
   FQuery.DatabaseName:=Value;
   dbLoadFirstLevel;
end;

procedure TpsDBTreeView.SetIdTree(const Value: Integer);
begin
   FIdTree := Value;
   dbLoadFirstLevel;
end;

procedure TpsDBTreeView.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
   FLDblCklick:=True;
   inherited;
   FLDblCklick:=False;
end;

function TpsDBTreeView.GetSelectedID: Integer;
begin
   if Assigned(Selected) and (Selected is TpsDBTreeNode) then
      Result:=(Selected as TpsDBTreeNode).idNode
   else Result:=0;
end;

procedure TpsDBTreeView.SetSelectedID(const Value: Integer);
var
   TheNode:TTreeNode;
   ThePath:array of Integer;
   I:Integer;
begin
   if (Items.Count>0)and(Items[0] is TpsDBTreeNode) then begin
      Items.BeginUpdate;
      try
        try
           TheNode:=Items[0];
           with FQuery do begin
              SQL.Text:=Format(SQLGetFullPath,[FIdTree,Value]);
              Open;
              try
                 if IsEmpty then
                    Raise Exception.Create('TpsDBTreeView.SetSelectedID:Не получен путь к узлу '+IntToStr(Value));
                 Last;First;
                 SetLength(ThePath,RecordCount);
                 I:=0;
                 while not Eof do begin
                    ThePath[I]:=FieldByName('idNode').AsInteger;
                    Inc(I);
                    Next;
                 end;
              finally
                 Close;
              end;
           end;
           for I:=0 to High(ThePath) do begin
              while Assigned(TheNode) and ((TheNode as TpsDBTreeNode).idNode<>ThePath[I]) do
                 TheNode:=TheNode.getNextSibling;
              if not Assigned(TheNode) then
                 Raise Exception.Create('TpsDBTreeView.SetSelectedID:Не найден узел '+IntToStr(ThePath[I]));
              if I<High(ThePath) then begin
                 TheNode.Expand(False);
                 TheNode:=TheNode.getFirstChild;
              end;
           end;
           if not Assigned(TheNode) then
              Raise Exception.Create('TpsDBTreeView.SetSelectedID:Не найден узел.');
           Selected:=TheNode;
        finally
           ThePath:=nil;
        end;
      finally
         Items.EndUpdate;
      end;
   end;
end;

{ TpsDBTreeNode }

procedure TpsDBTreeView.DoEdited(Sender: TObject; Node: TTreeNode;var S: string);
begin
   if Assigned(FOnEdited) then
      FOnEdited(Sender,Node,S);
   if (Node is TpsDBTreeNode) and (Node.Text<>S) then
    try //Сохраняем изменения в базе
       with FQuery do begin
          SQL.Text:=Format(SQLRenameNode,[FIdTree,(Node as TpsDBTreeNode).idNode,S]);
          try
             Open;
             if IsEmpty then
                Raise Exception.Create('TpsDBTreeView.DoEdited:Не получен результат переименования.');
             S:=FieldByName('NewText').AsString;
          finally
             Close;
          end;
       end;
    except
       S:=Node.Text;
       Raise;
    end;
end;

{ TpsDBTreeNode }

end.