一个很好的演示鼠标和TreeView控制的例子

By Peter Below

type

 TForm1 = class(TForm)

   TreeView1: TTreeView;

   SelectedWordLabel: TLabel;

   procedure TreeView1MouseMove(Sender: TObject; Shift: TShiftState; X,

     Y: Integer);

 private

   FCharWidth: array of TABCFloat;

   procedure FindWordUnderMouse(Node: TTreenode; X: Integer);

   function GetCharacterWidth(Ch: Char): Integer;

   function GetSelectedWord: string;

   procedure GetTextMeasures(aFont: TFont);

   procedure SetSelectedWord(const Value: string);

 protected

 public

   property SelectedWord: string read GetSelectedWord write SetSelectedWord;

 end;

var

 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FindWordUnderMouse(Node: TTreenode; X: Integer);

const

 CharsInWord = ['a'..'z','A'..'Z','0'..'9'];

var

 S: string;

 R: TRect;

 DX: Integer;

 I, N: Integer;

begin

 GetTextMeasures(TTreeview(Node.TreeView).Font);

 S:= Node.Text;

 R:= Node.DisplayRect(true);

 DX:= R.Left;

 N:= 0;

 for i:= 1 to Length(S) do begin

   Inc(DX, GetCharacterWidth(S[I]));

   if DX > X then begin

     N:= I;

     Break;

   end;

 end;

 if N > 0 then begin

   if S[N] In CharsInWord then begin

     I:= N;

     while (I > 0) and (S[I] In CharsInWord) do

       Dec(I);

     Inc(I);

     while (N <= Length(S)) and (S[N] in CharsInWord) do

       Inc(N);

     SelectedWord := Copy(S, I, N-I);

   end

   else

     SelectedWord := '';

 end;

end;

function TForm1.GetCharacterWidth(Ch: Char): Integer;

begin

 with FCharWidth[Ord(Ch)] do

   Result := Round(abcfA + abcfB + abcfC);

end;

function TForm1.GetSelectedWord: string;

begin

 Result := SelectedWordLabel.Caption;

end;

procedure TForm1.GetTextMeasures(aFont: TFont);

begin

 if Length(FCharWidth) = 0 then begin

   SetLength(FCharWidth, 256);

   Canvas.Font := aFont;

   if not GetCharABCWidthsFloat(Canvas.Handle, 32, 255, FCharWidth[32])

   then

     raise Exception.Create('GetTextMeasures: selected font is not a TrueType font!');

 end;

end;

procedure TForm1.SetSelectedWord(const Value: string);

begin

 if Value = '' then

   SelectedWordLabel.Caption := '<none>'

 else

   SelectedWordLabel.Caption := Value;

end;

procedure TForm1.TreeView1MouseMove(Sender: TObject; Shift: TShiftState;

 X, Y: Integer);

var

 node: TTreenode;

 Tree: TTreeview;

begin

 Tree := sender as TTreeview;

 node := Tree.GetNodeAt(X,Y);

 if Assigned(node) and (htOnLabel In Tree.GetHitTestInfoAt(X,Y) ) then

   FindWordUnderMouse(Node, X)

 else

   SelectedWord := '';

end;