如何在 Listbox 上显示 In-place Tooltips

原创 2002年06月21日 14:30:00

大家知道 TreeView 上的节点如果显示不完全,鼠标移上去会出现一提示,这就是 In-place Tooltips。下面这段代码在 Listbox 上实现这一功能(下面代码只是在标准 Listbox 上测试,如果是自画的,则要修改):

{直接将下面代码拷贝到新建工程中Form1的Unit1.pas文件即可运行,不需添加任何控件}

//------------------------------------------------------------------------------
//  在 ListBox 上实现 In-place Tooltips
//  原创作者:Joe Huang                 Email:Happyjoe@21cn.com
//
//------------------------------------------------------------------------------

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CommCtrl;

type
  //改写 TListBox 拦截 CM_MOUSELEAVE 消息
  TNewListBox = class(TListBox)
  protected
    { Protected declarations }
    procedure WndProc(var Message: TMessage); override;
  end;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    GHWND: HWND;
    TipVisable: Boolean;
    OldIndex, CurrentIndex: Integer;
    ti: TOOLINFO;
    ListBox1: TListBox;

    procedure InitListBox;   //动态生成 ListBox1
    procedure CreateTipsWindow;  //生成 Tooltip Window
    procedure HideTipsWindow;    //隐藏 Tooltip Window

    //拦截 WM_NOTIFY 消息,动态改变 Tooltip Window 显示的内容
    procedure WMNotify(var Msg: TMessage); message WM_NOTIFY;

    procedure ListBox_MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ListBox_MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TNewListBox }

procedure TNewListBox.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    CM_MOUSELEAVE: Form1.HideTipsWindow;
  end;
  inherited WndProc(Message);
end;

{ TForm1 }

procedure TForm1.InitListBox;
begin
  ListBox1 := TNewListBox.Create(Self);
  ListBox1.Parent := Self;
  ListBox1.Left := 50;
  ListBox1.Top := 50;
  ListBox1.Width := 200;
  ListBox1.Height := 200;
  //添加几项,以供测试用
  ListBox1.Items.Append('happyjoe');
  ListBox1.Items.Append('Please send me email: happyjoe@21cn.com');
  ListBox1.Items.Append('Delphi 5 开发人员指南');
  ListBox1.Items.Append('Delphi 5.X ADO/MTS/COM+ 高级程序设计篇');

  ListBox1.OnMouseMove := ListBox_MouseMove;
  ListBox1.OnMouseDown := ListBox_MouseDown;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Font.Name := 'Tahoma';
  InitListBox;
  CreateTipsWindow;
end;

procedure TForm1.CreateTipsWindow;
var
  iccex: tagINITCOMMONCONTROLSEX;
begin
  // Load the ToolTip class from the DLL.
  iccex.dwSize := sizeof(tagINITCOMMONCONTROLSEX);
  iccex.dwICC  := ICC_BAR_CLASSES;
  InitCommonControlsEx(iccex);

  // Create the ToolTip control.
  GHWND := CreateWindow(TOOLTIPS_CLASS, '',
                        WS_POPUP,
                        Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
                        Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
                        0, 0, hInstance,
                        nil);

  // Prepare TOOLINFO structure for use as tracking ToolTip.
  ti.cbSize := sizeof(ti);
  ti.uFlags := TTF_IDISHWND + TTF_TRACK + TTF_ABSOLUTE + TTF_TRANSPARENT;
  ti.hwnd   := Self.Handle;
  ti.uId    := ListBox1.Handle;
  ti.hinst  := hInstance;
  ti.lpszText  := LPSTR_TEXTCALLBACK;
  ti.rect.left := 0;
  ti.rect.top := 0;
  ti.rect.bottom := 0;
  ti.rect.right := 0;

  SendMessage(GHWND, WM_SETFONT, ListBox1.Font.Handle, Integer(LongBool(false)));
  SendMessage(GHWND,TTM_ADDTOOL,0,Integer(@ti));
end;

procedure TForm1.WMNotify(var Msg: TMessage);
var
  phd :PHDNotify;
  NMTTDISPINFO: PNMTTDispInfo;
begin
  phd := PHDNotify(Msg.lParam);
  if phd.Hdr.hwndFrom = GHWND then
  begin
    if phd.Hdr.code = TTN_NEEDTEXT then
    begin
      NMTTDISPINFO := PNMTTDispInfo(phd);
      NMTTDISPINFO.lpszText := PChar(ListBox1.Items[CurrentIndex]);
    end;
  end;
end;

procedure TForm1.ListBox_MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if TipVisable then     //当鼠标按下,将显示的 Tooltip Window 隐藏
  begin
    SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(false)), 0);
    TipVisable := false;
  end;
end;

procedure TForm1.ListBox_MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  Index: Integer;
  APoint: TPoint;
  ARect: TRect;
  ScreenRect: TRect;
begin
  Index := ListBox1.ItemAtPos(Point(X, Y), true);
  if Index = -1 then  //如果鼠标下没有 Item,将 Tooltip Window 隐藏
  begin
    SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(false)), 0);
    OldIndex := -1;
    TipVisable := false;
    exit;
  end;
  CurrentIndex := Index; 
  if Index = OldIndex then exit;  //如果鼠标在同一 Item 上移动,退出处理
  if TipVisable then   //先将显示的 Tooltip Window 隐藏
  begin
    SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(false)), 0);
    OldIndex := -1;
    TipVisable := false;
  end else
  begin
    ARect := ListBox1.ItemRect(Index);
    //判断该 Item 是否完全显示
    if (ARect.Right - ARect.Left - 2) >= ListBox1.Canvas.TextWidth(ListBox1.Items[Index]) then
    begin
      OldIndex := -1;
      exit;
    end;
    APoint := ListBox1.ClientToScreen(ARect.TopLeft);
    windows.GetClientRect(GetDesktopWindow, ScreenRect);
    //判断 Tooltip Window 显示后是否会超出屏幕范围,这里只判断了右边界
    if ListBox1.Canvas.TextWidth(ListBox1.Items[Index]) + APoint.X > ScreenRect.Right then
      APoint.X := ScreenRect.Right - ListBox1.Canvas.TextWidth(ListBox1.Items[Index]) - 5;
    SendMessage(GHWND,
                TTM_TRACKPOSITION,
                0,
                MAKELPARAM(APoint.x - 1, APoint.y - 2));

    SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(true)), Integer(@ti));
    OldIndex := Index;
    TipVisable := true;
  end;
end;

procedure TForm1.HideTipsWindow;
begin
  if TipVisable then
  begin
    SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(false)), 0);
    OldIndex := -1;
    TipVisable := false;
  end;
end;

end.

C++ LISTBOX控件常见用法(转)

1. 属性列表:     SelectionMode    组件中条目的选择类型,即多选(Multiple)、单选(Single)     Rows             列表框中显示总共多少行...
  • u012425536
  • u012425536
  • 2014年03月10日 08:54
  • 2059

WPF - ListBox显示任意内容

WFP是非常强大的。ListBox是一个很常用的控件,看了一下它的items属性,定义如下: public ItemCollection Items { get; } 这是一个collection...
  • zj510
  • zj510
  • 2013年03月02日 11:58
  • 5927

C#学习之控件:listbox显示多条数据以及周边操作

1.ListBox控件在C#之中,如果采用普通的绑定的方式的话,每行只能显示一个条目,但是如果需要多个信息在同一行里面显示的时候,就会产生一些问题,那么我们该如何解决呢? 2.Split函数的注意事项...
  • IMBA123456789
  • IMBA123456789
  • 2015年08月07日 00:19
  • 3797

Android App --- Q9 1.60 in place registration server

  • 2014年01月13日 11:23
  • 273KB
  • 下载

SpinWheel control to be used in place of either the UpDown c

  • 2006年02月23日 09:05
  • 35KB
  • 下载

SQL Server的升级之路系列课程(4):升级SQL Server 7.0.2000数据库引擎到SQL Server 2005.In-Place.rar

  • 2008年04月17日 16:16
  • 6.65MB
  • 下载

Invert (mirror) a bitmap in-place在内存中位图的对称位图(镜像

  • 2006年02月23日 09:05
  • 8KB
  • 下载

In place conversion between every one of the European Moneta

  • 2006年02月23日 09:05
  • 140KB
  • 下载

Edit in place for jRails.

  • 2009年06月18日 00:24
  • 12KB
  • 下载

快速排序算法及时间复杂度分析(原地in-place分区版本)

快速排序算法一般来说是采用递归来实现,其zuiguan
  • a0agd1X50
  • a0agd1X50
  • 2014年05月28日 21:54
  • 832
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:如何在 Listbox 上显示 In-place Tooltips
举报原因:
原因补充:

(最多只允许输入30个字)