如何在 Listbox 上显示 In-place Tooltips
来源:互联网 发布:淘宝网出售十字绣 编辑:程序博客网 时间:2024/05/21 07:12
大家知道 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.
- 如何在 Listbox 上显示 In-place Tooltips
- 如何在系统托盘(panel)中显示应用程序图标和气球帮助信息(balloon tooltips)
- Flex中如何在用户按住TextArea滚动条(横竖方向)拖动时显示ToolTips
- in-place
- Flex3工具显示(ToolTips)
- 如何使自制的listbox正确显示
- Custom Tooltips in WinForm TreeViews
- 如何在网页上显示当前日期
- 如何在WebForm上显示图像缩略图
- 如何在devexpress gridcontrol上显示行号
- 如何在IE上显示tif图片
- 如何在组件上显示图象
- 如何在devexpress gridcontrol上显示行号
- 有关如何在网页上显示PDF
- 如何在对话框上显示一张图片
- 如何在网页上显示一个钟表
- 如何在界面上显示本地图片
- 如何让多个DIV在一行上显示
- SymGetModuleInfo64函数的一个问题
- Unix系列shell程序编写
- 实例演示在MSSQL中启用全文检索
- 怎样编写CSS
- oracle函数大全
- 如何在 Listbox 上显示 In-place Tooltips
- 在Ubuntu 7.10上实现C/C++开发环境
- [转]linux安装配置JAVA
- CSS快速入门
- 在同一台机器上运行多个 MySQL 服务
- 《Delphi高手突破》第0章(预览版)——关于本书
- Linux操作系统下C语言编程的注意事项
- 配置Linux操作系统的环境变量
- 用ie关机或重起