Дерево на базе MsSQL
Falk0ner, вс, 06/07/2008 - 15:34.
Дерево на базе MsSQL
{ **** UBPFD *********** by delphibase.endimus.com ****
>> 7/2000 и DELPHI6 (BDE,ADO)
Узел дерева описывается через idParent,idPrior,id,idFirstChild.
В следствии такого подхода в многопользовательской среде достигается
минимальное количество блокировок при изменении узлов дерева.
Все функции реализованы в хранимых процедурах. Компанент, порожденный
от TTreeView, является интерфейсом для работы с деревом в клиенте.
Тексты хранимых процедур на странице
http://spenov.narod.ru/DBTree/DBTreeView.html
Зависимости: Classes,ComCtrls,CommCtrl,DB,DBTables,Controls,Messages,ADODB
Автор: Пенов Сергей, <a href="mailto:spenov@narod.ru">spenov@narod.ru</a>, ICQ:122597033, Москва
Copyright: http://spenov.narod.ru/DBTree/DBTreeView.html
Дата: 6 сентября 2002 г.
***************************************************** }
//Тексты хранимых процедур на странице
// <a href="http://spenov.narod.ru/DBTree/DBTreeView.html
unit" title="http://spenov.narod.ru/DBTree/DBTreeView.html
unit">http://spenov.narod.ru/DBTree/DBTreeView.html
unit</a> 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,@id=%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);
Move;
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 GetId(Node: TTreeNode): string;
var
: TTreeNode;
begin
:= Node.getSibling;
if Assigned() then
Result := IntToStr(( 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), GetId(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.getSibling;
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.Move;
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.getSibling;
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.
>> 7/2000 и DELPHI6 (BDE,ADO)
Узел дерева описывается через idParent,idPrior,id,idFirstChild.
В следствии такого подхода в многопользовательской среде достигается
минимальное количество блокировок при изменении узлов дерева.
Все функции реализованы в хранимых процедурах. Компанент, порожденный
от TTreeView, является интерфейсом для работы с деревом в клиенте.
Тексты хранимых процедур на странице
http://spenov.narod.ru/DBTree/DBTreeView.html
Зависимости: Classes,ComCtrls,CommCtrl,DB,DBTables,Controls,Messages,ADODB
Автор: Пенов Сергей, <a href="mailto:spenov@narod.ru">spenov@narod.ru</a>, ICQ:122597033, Москва
Copyright: http://spenov.narod.ru/DBTree/DBTreeView.html
Дата: 6 сентября 2002 г.
***************************************************** }
//Тексты хранимых процедур на странице
// <a href="http://spenov.narod.ru/DBTree/DBTreeView.html
unit" title="http://spenov.narod.ru/DBTree/DBTreeView.html
unit">http://spenov.narod.ru/DBTree/DBTreeView.html
unit</a> 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,@id=%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);
Move;
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 GetId(Node: TTreeNode): string;
var
: TTreeNode;
begin
:= Node.getSibling;
if Assigned() then
Result := IntToStr(( 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), GetId(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.getSibling;
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.Move;
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.getSibling;
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.
Отправить комментарий