ListBox显示即时提示(Tips)

  Listbox内容太长时超出Listbox宽度的部分将无法显示,一种解决方法是让Listbox产生横向滚动条,滚动显示内容(见前面的《发掘ListBox的潜力(一):自动调整横向滚动条宽度 》),另一种方法是让Listbox以Tips的方法显示完整内容。本文要实现的是后一种方式。

  Tips其实是一个特殊的窗体,类名为:tooltips_class32(在Commctrl(D6)有定义),可使用CreateWindow函数创建;Windows定义了一组以TTM_开头的消息用来与之通信,比如设置显示内容使用TTM_SETTITLE、删除显示内容使用TTM_DELTOOL。下面是例子:

hWndTip := CreateWindow(TOOLTIPS_CLASS, 'kktListBoxToolTips',
    WS_POPUP or TTS_NOPREFIX or TTS_ALWAYSTIP, 0, 0, 0, 0, hWndTip, 0, HInstance, nil);
SendMessage(hWndTip, TTM_ADDTOOL, 0, Integer(@ti));
SendMessage(hWndTip, TTM_DELTOOL, 0, Integer(@ti));

Tips有两种显示时机:鼠标指向某ListItem时和鼠标点击某ListItem时,这里提供了一个选项供用户,默认为鼠标点击ListItem时显示,因此在type作如下声明:

TToolTipShowEvent = (tsMouseOver, tsClick);

并在控件published处声明ShowToolTipWhen属性:

property ShowToolTipWhen: TToolTipShowEvent read FShowToolTipWhen writeSetShowToolTipWhen default tsClick;

接下来处理WM_LBUTTONDOWN消息判断是否应该显示内容,及处理要显示的内容:

procedure TkktListBox.WMMouseLBDown(var Message: TMessage);
var
  
X, Y, i: integer;
begin
  inherited;
  if (FShowToolTipWhen = tsMouseOver) then Exit;
  X := LOWORD(Message.lParam);
  Y := HIWORD(Message.lParam);
  i := ItemAtPos(Point(X, Y), true); //ItemIndex
  if (i = -1) and (TipsIndex <> -1) then HideToolTip;
  if i<>-1 then ShowToolTip(X, Y, i);
end;

对WM_MOUSEMOVE的处理方式类似:

procedure TkktListBox.WMMouseMove(var Message: TMessage);
var
  X, Y, i: integer;
begin
  if (FShowToolTipWhen = tsClick) then Exit;
  X := LOWORD(Message.lParam);
  Y := HIWORD(Message.lParam);
  i := ItemAtPos(Point(X, Y), true);
  if (i = -1) and (TipsIndex <> -1) then HideToolTip;
  if i<>-1 then ShowToolTip(X, Y, i);
  inherited;
end;

Tips的消隐则在CM_MOUSELEAVE消息里处理:

procedure TkktListBox.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  HideToolTip;
end;

下面给出TkktListBox的完整代码:

unit kktListBox;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Commctrl; const
TTM_SETTITLE = (WM_USER + 32); type
TGetHintTextEvent = procedure(Index: integer; var HintText: string; Sender: TObject) of object;
TToolTipShowEvent = (tsMouseOver, tsClick); TkktListBox = class(TListBox)
private

hWndTip: THandle;
ti: TOOLINFO;
TipsIndex: integer;
FOnGetHintText: TGetHintTextEvent;
FHintTitle: String;
FShowToolTipWhen: TToolTipShowEvent;

    procedure SetHintText(Index: integer);
procedure SetHintTitle(const Value: String);
procedure SetShowToolTipWhen(const Value: TToolTipShowEvent); protected
property ScrollWidth stored False;
public

constructor Create(AOwner: TComponent); override;
procedure CreateWnd; override;
destructor Destroy; override; published
property HintTitle: String read FHintTitle write SetHintTitle;
property ShowToolTipWhen: TToolTipShowEvent read FShowToolTipWhen write SetShowToolTipWhen default tsClick;
property OnGetHintText: TGetHintTextEvent Read FOnGetHintText write FOnGetHintText; end; procedure Register; implementation { TkktListBox }

procedure TkktListBox.CMMouseLeave(var Message: TMessage);
begin
inherited;
HideToolTip;
end; constructor TkktListBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
TipsIndex := -1;
FShowToolTipWhen := tsClick;
end;

    //uId := Handle;

hinst := hInstance;
lpszText := nil;
//LPSTR_TEXTCALLBACK;
//CALLBACK将导致回调次数太多
Rect.Left := 0;
Rect.Top := 0;
Rect.Bottom := 0;
Rect.Right := 0;
end;
sendMessage(hWndTip, WM_SETFONT, Self.Font.Handle, Integer(LongBool(False)));
SendMessage(hWndTip, TTM_ADDTOOL, 0, Integer(@ti));
SendMessage(hWndTip, TTM_SETTITLE, 0, Integer(Pchar(FHintTitle)));
end; destructor TkktListBox.Destroy;
begin
if hWndTip<>0 then SendMessage(hWndTip, WM_CLOSE, 0, 0);
inherited;
end; procedure TkktListBox.HideToolTip;
begin
TipsIndex := -1;
SendMessage(hWndTip, TTM_TRACKACTIVATE, 0, 0);
end; procedure TkktListBox.ShowToolTip(X, Y, Index: integer);
var
APoint: TPoint;
ARect: TRect;
begin
if (FShowToolTipWhen = tsClick) and (Index = TipsIndex) then Exit; if FShowToolTipWhen = tsMouseOver then begin
APoint := Point(X+20, Y+20);
end else begin //FShowToolTipWhen = tsClick
ARect := ItemRect(Index);
APoint := ARect.TopLeft;
end;
APoint := Self.ClientToScreen(APoint); SendMessage(hWndTip, TTM_TRACKPOSITION, 0, MAKELPARAM(APoint.X, APoint.Y));
if Index = TipsIndex then Exit;
SetHintText(Index);
SendMessage(hWndTip, TTM_TRACKACTIVATE, 1, integer(@ti));
TipsIndex := Index;
end; procedure TkktListBox.WMMouseLBDown(var Message: TMessage);
var
X, Y, i: integer;
begin
inherited;
if (csDesigning in ComponentState) or (FShowToolTipWhen = tsMouseOver) then Exit;
X := LOWORD(Message.lParam);
Y := HIWORD(Message.lParam);
i := ItemAtPos(Point(X, Y), true); //ItemIndex
if (i = -1) and (TipsIndex <> -1) then HideToolTip;
if i<>-1 then ShowToolTip(X, Y, i);
end; procedure TkktListBox.WMMouseMove(var Message: TMessage);
var
X, Y, i: integer;
begin
if (csDesigning in ComponentState) or (FShowToolTipWhen = tsClick) then Exit;
X := LOWORD(Message.lParam);
Y := HIWORD(Message.lParam);
i := ItemAtPos(Point(X, Y), true);
if (i = -1) and (TipsIndex <> -1) then HideToolTip;
if i<>-1 then ShowToolTip(X, Y, i);
inherited;
end; procedure TkktListBox.SetHintTitle(const Value: String);
begin
if FHintTitle = Value then Exit;
FHintTitle := Value;
SendMessage(hWndTip, TTM_SETTITLE, 0, Integer(Pchar(FHintTitle)));
end; procedure TkktListBox.SetHintText(Index: integer);
var
HintText: string;
begin
if Index<0 then Exit;
SendMessage(hWndTip, TTM_DELTOOL, 0, Integer(@ti));
HideToolTip;
HintText := Items[Index];
if Assigned(FOnGetHintText) then FOnGetHintText(Index, HintText, Self);
ti.lpszText := @HintText[1];
SendMessage(hWndTip, TTM_ADDTOOL, 0, Integer(@ti));
end; procedure TkktListBox.SetShowToolTipWhen(const Value: TToolTipShowEvent);
begin
if FShowToolTipWhen <> Value then begin
FShowToolTipWhen := Value;
HideToolTip;
end;
end; procedure Register;
begin
RegisterComponents('Kacarton', [TkktListBox]);
end; end.

http://blog.csdn.net/nhconch/article/details/520164

发掘ListBox的潜力(三):显示即时提示(Tips)的更多相关文章

  1. 发掘ListBox的潜力(一):自动调整横向滚动条宽度

    <自绘ListBox的两种效果>一文帖出之后,从反馈信息来看,大家对这种小技巧还是很认同.接下来我将继续围绕ListBox写一系列的文章,进一步发掘ListBox的潜力,其中包括:自动调整 ...

  2. 发掘ListBox的潜力(二):鼠标拖放插入点提示

    鼠标拖放插入点提示 鼠标拖放是Windows常见的操作,比如拷贝文件就可用拖放方式进行.在我们编写的应用程序中,有时为了方便用户操作需要支持鼠标拖放.对于大部分的VCL控件只要鼠标将DragMode设 ...

  3. [Domino]从嵌入另一个数据库嵌入的Embedded View无法正常显示,提示unable to lauch

    发现问题 1. 项目中需要在一个数据库中插入另一个数据库的Embedded View,使用起来十分费劲,在选择数据库的下拉菜单中经常会找不到目标数据库: 2. 在做日文版的时候,从workbench导 ...

  4. 实现password框中显示文字提示的方式

    其实实际上实现中并不能让password中显示文字提示,但是我们在工作中有这样的需求,当没输入东西的时候,框内有提示输入密码,但是当输入东西的时候又显示的是*号,那么是如何实现的呢?其实原理很简单,就 ...

  5. Android三种消息提示

    Android消息提示有三种方式: 1  使用Toast显示消息提示框 Toast类用于在屏幕中显示一个提示信息框,该消息提示框没有任何控制按钮,并且不会获得焦点,经过一定时间后自动消失.通常用于显示 ...

  6. Android Studio移动鼠标显示悬浮提示的设置方法

    欢迎和大家交流技术相关问题: 邮箱: jiangxinnju@163.com 博客园地址: http://www.cnblogs.com/jiangxinnju GitHub地址: https://g ...

  7. PowerShell 显示气球提示框 1

    #加载 Winform 程序集,使用Out-Null抑制输出 [system.Reflection.Assembly]::LoadWithPartialName('System.Windows.For ...

  8. 使用ElasticSearch服务从MySQL同步数据实现搜索即时提示与全文搜索功能

    最近用了几天时间为公司项目集成了全文搜索引擎,项目初步目标是用于搜索框的即时提示.数据需要从MySQL中同步过来,因为数据不小,因此需要考虑初次同步后进行持续的增量同步.这里用到的开源服务就是Elas ...

  9. 解决在Pycharm中无法显示代码提示的问题

    #coding: utf-8from cx_Oracle.CURSOR import *import cx_Oracle conn= cx_Oracle.connect('XX', 'XX', '12 ...

随机推荐

  1. ionic slidebox 嵌套问题

    ionic slidebox 嵌套 会有一个 冒泡 事件 , 即使是 阻止了 父级冒泡也不管用 , 最终 用  滑动 事件on-drag="drag()"   去阻止 了父级的 滑 ...

  2. Use Spring transaction to simplify Hibernate session management

    Spring对Hibernate有很好的支持    DataSource ->SessionFactory-> HibernateTranscationManagerHibernate中通 ...

  3. Sql Server服务远程过程调用失败解决

    Sql Server服务远程过程调用失败解决   问题:       今天SQL数据库登录不上了,然后想启动Sql实例,却发现如下问题(配置环境:win7旗舰版x64,SqlServer2008R2, ...

  4. ssh-copy-id帮你建立信任

    一.ssh-keygen -t rsa [nameA@machineA]$ ssh-keygen -t rsa Generating public/private rsa key pair. Ente ...

  5. JavaScript之图片滚动

    向上滚动: <!doctype html> <title>javascript无缝滚动</title> <meta charset="utf-8&q ...

  6. 【转】Qt之模型/视图

    [本文转自]http://blog.sina.com.cn/s/blog_a6fb6cc90101hh20.html   作者: 一去丶二三里 关于Qt中MVC的介绍与使用,助手中有一节模型/视图编程 ...

  7. 07.31 zepto

    tag事件 viewport标签 flexbox弹性布局 响应式布局 rem 交互优化 touchstart touchend 高清图片 1px  单文本溢出  多文本溢出

  8. 【C语言探险】 第四课的第二部分:串

    内容简单介绍 1.课程大纲 2.第二部分第四课: 字符串 3.第二部分第五课预告: 预处理 课程大纲 我们的课程分为四大部分,每个部分结束后都会有练习题,并会发布答案.还会带大家用C语言编写三个游戏. ...

  9. 【javascript】Promise/A+ 规范简单实现 异步流程控制思想

    ——基于es6:Promise/A+ 规范简单实现 异步流程控制思想  前言: nodejs强大的异步处理能力使得它在服务器端大放异彩,基于它的应用不断的增加,但是异步随之带来的嵌套.难以理解的代码让 ...

  10. Docker常规防止容器自动退出

    [root@server-crm /]# docker attach songheng [root@fc0a891e1861 /]# cat /bin/auto_service.sh #!/bin/s ...