treeform.~pas

关于利用DELPHI来进行企业级方案解决的著作的附书源码

unit TreeForm;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Menus;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    MainMenu1: TMainMenu;
    Options1: TMenuItem;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Root1: TMenuItem;
    Buttons1: TMenuItem;
    Lines1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Root1Click(Sender: TObject);
    procedure Buttons1Click(Sender: TObject);
    procedure Lines1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  TreeView1.LoadFromFile (
    ExtractFilePath (Application.ExeName) + 'TreeText.txt');
end;

procedure TForm1.Root1Click(Sender: TObject);
begin
  TreeView1.ShowRoot := not TreeView1.ShowRoot;
  Root1.Checked := TreeView1.ShowRoot;
end;

procedure TForm1.Buttons1Click(Sender: TObject);
begin
  TreeView1.ShowButtons := not TreeView1.ShowButtons;
  Buttons1.Checked := TreeView1.ShowButtons;
end;

procedure TForm1.Lines1Click(Sender: TObject);
begin
  TreeView1.ShowLines := not TreeView1.ShowLines;
  Lines1.Checked := TreeView1.ShowLines;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  TargetNode, SourceNode: TTreeNode;
begin
  // 获取目的节点
  TargetNode := TreeView1.GetNodeAt (X, Y);
  if (Source = Sender) and (TargetNode <> nil) then
  begin
    Accept := True;
    // 获取源节点
    SourceNode := TreeView1.Selected;
    // 检查目的节点的层次
    while (TargetNode.Parent <> nil) and
        (TargetNode <> SourceNode) do
      TargetNode := TargetNode.Parent;
    //如果没有移动则不允许拖动
    if TargetNode = SourceNode then
      Accept := False;
  end
  else
    Accept := False;
end;

procedure TForm1.TreeView1DragDrop(Sender, Source: TObject;
  X, Y: Integer);
var
  TargetNode, SourceNode: TTreeNode;
begin
  TargetNode := TreeView1.GetNodeAt (X, Y);
  if TargetNode <> nil then
  begin
    SourceNode := TreeView1.Selected;
  {将源节点移动到目的节点 }
    SourceNode.MoveTo (TargetNode, naAddChildFirst);
    TargetNode.Expand (False);
    TreeView1.Selected := TargetNode;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  TreeView1.SaveToFile (
    ExtractFilePath (Application.ExeName) + 'TreeText.txt');
end;

procedure TForm1.TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  TreeView1.BeginDrag (False); 
end;

end.