Дерево на базе MsSQL

Previous  Top  Next

    
 

 

Code:

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Дерево на базе MsSQL 7/2000 и DELPHI6 (BDE,ADO)

 

Узел дерева описывается через idParent,idPrior,idNext,idFirstChild.

В следствии такого подхода в многопользовательской среде достигается

минимальное количество блокировок при изменении узлов дерева.

Все функции реализованы в хранимых процедурах. Компанент, порожденный

от TTreeView, является интерфейсом для работы с деревом в клиенте.

Тексты хранимых процедур на странице

http://spenov.narod.ru/DBTree/DBTreeView.html

 

Зависимости: Classes,ComCtrls,CommCtrl,DB,DBTables,Controls,Messages,ADODB

Автор:       Пенов Сергей, spenov@narod.ru, ICQ:122597033, Москва

Copyright:   http://spenov.narod.ru/DBTree/DBTreeView.html

Дата:        6 сентября 2002 г.

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

 

//Тексты хранимых процедур на странице

// http://spenov.narod.ru/DBTree/DBTreeView.html

unit Un_TADODBTreeView;

 

interface

 

uses

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

 

type

TADODBTreeNode = class(TTreeNode)

private

   FIdNode: Integer;

public

   property idNode: Integer read FIdNode;

end;

 

TADODBTreeView = class(TCustomTreeView)

private

   FRootID: string;

   FOnEdited: TTVEditedEvent;

   FLDblCklick: Boolean; //показывает, что выполняется DblClick

   FDoExpColOnDblClick: Boolean;

   //Если True, то при DblClick не будет раскрываться/закрываться Node.

   FReopenOnExpand: Boolean;

   FConnection: TADOConnection;

   FRecordset: _Recordset;

   FIdTree: Integer;

   procedure SetRootID(Value: string);

   procedure SetConnection(Value: TADOConnection);

   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);

   procedure Notification(AComponent: TComponent; Operation: TOperation);

     override;

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 RootID: string read FRootID write SetRootID;

   property idDBTree: Integer read FIdTree write SetIdTree;

   property Connection: TADOConnection read FConnection write SetConnection;

   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 PopupMenu;

   property StateImages;

   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;

   //property Visible;

   { Items must be published after OnGetImageIndex and OnGetSelectedIndex }

   //property Items;

end;

 

procedure Register;

 

implementation

 

uses

SysUtils, Variants, Forms, DBLogDlg;

 

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('Penov', [TADODBTreeView]);

end;

 

{ TADODBTreeView }

 

procedure TADODBTreeView.AddChildren(AParent: TTreeNode);

var

NewNode: TADODBTreeNode;

TheCursor: TCursor;

Buf: TTVExpandedEvent;

begin

TheCursor := Screen.Cursor;

Screen.Cursor := crHourGlass;

try

   Buf := OnAddition;

   OnAddition := nil;

   try

     with FRecordset do

     begin

       if RecordCount > 0 then

         while not Eof do

         begin

           NewNode := Items.AddChild(AParent, Fields['Text'].Value) as

             TADODBTreeNode;

           with NewNode do

           begin

             HasChildren := not VarIsNull(Fields['idFirstChild'].Value);

             FIdNode := Fields['idNode'].Value;

           end;

           if Assigned(Buf) then

             Buf(Self, NewNode);

           MoveNext;

         end;

     end;

   finally

     OnAddition := Buf;

   end;

finally

   Screen.Cursor := TheCursor;

end;

end;

 

function TADODBTreeView.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 TADODBTreeNode) and

     Node.HasChildren then

   begin

     Items.BeginUpdate;

     try

       Node.DeleteChildren;

       Items.AddChild(Node, 'HasItems');

     finally

       Items.EndUpdate;

     end;

   end;

end;

end;

 

function TADODBTreeView.CanExpand(Node: TTreeNode): Boolean;

var

crBuf: TCursor;

begin

if FLDblCklick and not FDoExpColOnDblClick then

   Result := False

else

begin

   //Загрузка вложенных узлов

   if FReopenOnExpand and (Node is TADODBTreeNode) and Node.HasChildren then

   begin

     Items.BeginUpdate;

     try

       Node.DeleteChildren;

       if (FIdTree <> 0) and Assigned(FConnection) then

       begin

         crBuf := Screen.Cursor;

         Screen.Cursor := crSQLWait;

         try

           FRecordset := FConnection.Execute(Format(SQLLoadLevel, [FIdTree,

             IntToStr((Node as TADODBTreeNode).idNode)]));

         finally

           Screen.Cursor := crBuf;

         end;

         try

           AddChildren(Node);

         finally

           FRecordset := nil;

         end;

       end;

     finally

       Items.EndUpdate;

     end;

   end;

   Result := inherited CanExpand(Node);

end;

end;

 

constructor TADODBTreeView.Create(AOwner: TComponent);

begin

FRootID := 'NULL';

FReopenOnExpand := True;

FDoExpColOnDblClick := True;

inherited;

inherited OnEdited := DoEdited;

end;

 

function TADODBTreeView.CreateNode: TTreeNode;

begin

if Assigned(OnCreateNodeClass) then

   Result := inherited CreateNode

else

   Result := TADODBTreeNode.Create(Items);

end;

 

function TADODBTreeView.dbAddChild(AParent: TTreeNode; AText: string; idNode:

Integer = 0): TTreeNode;

var

NewNode: TTreeNode;

Buf: TTVExpandedEvent;

crBuf: TCursor;

 

function GetIdParent(Node: TTreeNode): string;

begin

   if Assigned(Node.Parent) then

     Result := IntToStr((Node.Parent as TADODBTreeNode).idNode)

   else

     Result := FRootID;

end;

function GetIdPrior(Node: TTreeNode): string;

var

   Prior: TTreeNode;

begin

   Prior := Node.getPrevSibling;

   if Assigned(Prior) then

     Result := IntToStr((Prior as TADODBTreeNode).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 TADODBTreeNode).idNode)

   else

     Result := 'NULL';

end;

function GetIdNode(idNode: Integer): string;

begin

   if idNode <> 0 then

     Result := IntToStr(idNode)

   else

     Result := 'NULL';

end;

 

begin

Result := nil;

Buf := OnAddition;

OnAddition := nil;

try

   Items.BeginUpdate;

   try

     if Assigned(AParent) and not AParent.Expanded then

       AParent.Expand(False);

     NewNode := Items.AddChild(AParent, AText);

     if (FIdTree <> 0) and Assigned(FConnection) then

     begin

       crBuf := Screen.Cursor;

       Screen.Cursor := crSQLWait;

       try

         FRecordset := FConnection.Execute(Format(SQLAddChild, [FIdTree,

           GetIdParent(NewNode), GetIdPrior(NewNode), GetIdNext(NewNode),

             AText,

             GetIdNode(idNode)]));

       finally

         Screen.Cursor := crBuf;

       end;

       try

         try

           if FRecordset.RecordCount > 0 then

           begin

             (NewNode as TADODBTreeNode).FIdNode :=

               FRecordset.Fields['NewId'].Value;

             //Выделяем добавленный узел

             FReopenOnExpand := False;

             try

               Selected := NewNode;

             finally

               FReopenOnExpand := True;

             end;

           end

           else

             raise

               Exception.Create('TADODBTreeView.dbAddChild:Не получен идентификатор нового узла.');

         except

           NewNode.Delete;

           raise;

         end;

       finally

         FRecordset := nil;

       end;

     end;

   finally

     Items.EndUpdate;

   end;

   Result := NewNode;

   if Assigned(Buf) then

     Buf(Self, NewNode);

finally

   OnAddition := Buf;

end;

end;

 

procedure TADODBTreeView.dbDeleteNode(Node: TTreeNode; ReQueryFromDB: Boolean =

False);

var

AParent: TTreeNode;

begin

if Node.HasChildren then

   raise

     Exception.Create('TADODBTreeView.dbDeleteNode:Этот узел удалить нельзя,т.к. есть вложеннные узлы.');

FConnection.Execute(Format(SQLDeleteNode, [FIdTree, (Node as

     TADODBTreeNode).idNode]));

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 TADODBTreeView.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('TADODBTreeView.dbMoveNode:Узел не может быть перемещен.')

else

begin

   FConnection.Execute(Format(SQLMoveNode, [FIdTree, (DNode as

       TADODBTreeNode).idNode, (SNode as TADODBTreeNode).idNode,

     BoolToInt[AsChild]]));

   Items.BeginUpdate;

   try

     if ReQueryFromDB then

     begin

       TheNodeId := (SNode as TADODBTreeNode).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 TADODBTreeNode).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;

 

procedure TADODBTreeView.Loaded;

begin

inherited;

if not (csDesigning in ComponentState) then

   dbLoadFirstLevel;

end;

 

procedure TADODBTreeView.dbLoadFirstLevel;

var

crBuf: TCursor;

begin

Items.Clear;

if not (csDesigning in Self.ComponentState) and not (csLoading in

   Self.ComponentState) and (FIdTree <> 0) and Assigned(FConnection) then

begin

   crBuf := Screen.Cursor;

   Screen.Cursor := crSQLWait;

   try

     FRecordset := FConnection.Execute(Format(SQLLoadLevel, [FIdTree,

       FRootID]));

   finally

     Screen.Cursor := crBuf;

   end;

   try

     AddChildren(nil);

   finally

     FRecordset := nil;

   end;

end;

end;

 

procedure TADODBTreeView.SetConnection(Value: TADOConnection);

begin

if Assigned(FConnection) and (FConnection.Owner <> Self.Owner) then

   FConnection.RemoveFreeNotification(Self);

FConnection := Value;

if Assigned(Value) then

begin

   if Value.Owner <> Self.Owner then

     Value.FreeNotification(Self);

   dbLoadFirstLevel;

end

else

   Items.Clear;

end;

 

procedure TADODBTreeView.SetIdTree(const Value: Integer);

begin

FIdTree := Value;

dbLoadFirstLevel;

end;

 

procedure TADODBTreeView.WMLButtonDblClk(var Message: TWMLButtonDblClk);

begin

FLDblCklick := True;

inherited;

FLDblCklick := False;

end;

 

function TADODBTreeView.GetSelectedID: Integer;

begin

if Assigned(Selected) and (Selected is TADODBTreeNode) then

   Result := (Selected as TADODBTreeNode).idNode

else

   Result := 0;

end;

 

procedure TADODBTreeView.SetSelectedID(const Value: Integer);

var

TheNode: TTreeNode;

ThePath: array of Integer;

I: Integer;

crBuf: TCursor;

begin

if (Items.Count > 0) and (Items[0] is TADODBTreeNode) then

begin

   Items.BeginUpdate;

   try

     try

       TheNode := Items[0];

       crBuf := Screen.Cursor;

       Screen.Cursor := crSQLWait;

       try

         FRecordset := FConnection.Execute(Format(SQLGetFullPath, [FIdTree,

           Value]));

       finally

         Screen.Cursor := crBuf;

       end;

       try

         if FRecordset.RecordCount <= 0 then

           raise

             Exception.Create('TADODBTreeView.SetSelectedID:Не получен путь к узлу ' + IntToStr(Value));

         SetLength(ThePath, FRecordset.RecordCount);

         I := 0;

         while not FRecordset.Eof do

         begin

           ThePath[I] := FRecordset.Fields['idNode'].Value;

           Inc(I);

           FRecordset.MoveNext;

         end;

       finally

         FRecordset := nil;

       end;

       for I := 0 to High(ThePath) do

       begin

         while Assigned(TheNode) and ((TheNode as TADODBTreeNode).idNode <>

           ThePath[I]) do

           TheNode := TheNode.getNextSibling;

         if not Assigned(TheNode) then

           raise Exception.Create('TADODBTreeView.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('TADODBTreeView.SetSelectedID:Не найден узел.');

       Selected := TheNode;

     finally

       ThePath := nil;

     end;

   finally

     Items.EndUpdate;

   end;

end;

end;

 

{ TADODBTreeNode }

 

procedure TADODBTreeView.DoEdited(Sender: TObject; Node: TTreeNode; var S:

string);

var

crBuf: TCursor;

begin

if Assigned(FOnEdited) then

   FOnEdited(Sender, Node, S);

if (Node is TADODBTreeNode) and (Node.Text <> S) then

try //Сохраняем изменения в базе

   crBuf := Screen.Cursor;

   Screen.Cursor := crSQLWait;

   try

     FRecordset := FConnection.Execute(Format(SQLRenameNode, [FIdTree, (Node as

         TADODBTreeNode).idNode, S]));

   finally

     Screen.Cursor := crBuf;

   end;

   try

     if FRecordset.RecordCount = 0 then

       raise

         Exception.Create('TADODBTreeView.DoEdited:Не получен результат переименования.');

     S := FRecordset.Fields['NewText'].Value;

   finally

     FRecordset := nil;

   end;

except

   S := Node.Text;

   raise;

end;

end;

 

procedure TADODBTreeView.SetRootID(Value: string);

var

I: Integer;

begin

if (UpperCase(Value) = 'NULL') or (Value = '') then

   FRootID := 'NULL'

else

begin

   for I := 1 to Length(Value) do

     if not (Value[I] in ['0'..'9']) then

       raise Exception.Create('"' + Value + '" - is not integer or NULL');

   FRootID := Value;

end;

dbLoadFirstLevel;

end;

 

procedure TADODBTreeView.Notification(AComponent: TComponent; Operation:

TOperation);

begin

if (Operation = opRemove) and (AComponent = FConnection) then

   SetConnection(nil);

end;

 

{ TADODBTreeNode }

 

end.

 

©Drkb::02872