发掘ListBox的潜力(三):显示即时提示(Tips)
2005-10-31 19:23
288 查看
ListBox显示即时提示(Tips)
Listbox内容太长时超出Listbox宽度的部分将无法显示,一种解决方法是让Listbox产生横向滚动条,滚动显示内容(见前面的《发掘ListBox的潜力(一):自动调整横向滚动条宽度 》),另一种方法是让Listbox以Tips的方法显示完整内容。本文要实现的是后一种方式。
Tips其实是一个特殊的窗体,类名为:tooltips_class32(在Commctrl(D6)有定义),可使用CreateWindow函数创建;Windows定义了一组以TTM_开头的消息用来与之通信,比如设置显示内容使用TTM_SETTITLE、删除显示内容使用TTM_DELTOOL。下面是例子:
Tips有两种显示时机:鼠标指向某ListItem时和鼠标点击某ListItem时,这里提供了一个选项供用户,默认为鼠标点击ListItem时显示,因此在type作如下声明:
并在控件published处声明ShowToolTipWhen属性:
接下来处理WM_LBUTTONDOWN消息判断是否应该显示内容,及处理要显示的内容:
对WM_MOUSEMOVE的处理方式类似:
Tips的消隐则在CM_MOUSELE***E消息里处理:
下面给出TkktListBox的完整代码:
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)); |
TToolTipShowEvent = (tsMouseOver, tsClick); |
property ShowToolTipWhen: TToolTipShowEvent read FShowToolTipWhen write SetShowToolTipWhen default tsClick; |
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; |
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; |
procedure TkktListBox.CMMouseLeave(var Message: TMessage); begin inherited; HideToolTip; end; |
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. |
相关文章推荐
- 发掘ListBox的潜力(三):显示即时提示(Tips)
- 发掘ListBox的潜力(二):鼠标拖放插入点提示
- 发掘ListBox的潜力(二):鼠标拖放插入点提示
- 发掘ListBox的潜力(二):鼠标拖放插入点提示
- ToolTip显示即时提示消息
- 提示框 9款css3 tooltips鼠标悬停显示消息提示框样式(精)
- 如何在 Listbox 上显示 In-place Tooltips
- HTML 最简单的tips 怎么支持指定DIV显示提示信息
- 如何在 Listbox 上显示 In-place Tooltips
- 发掘ListBox的潜力(一):自动调整横向滚动条宽度
- 发掘ListBox的潜力 系列文章Link
- 发掘ListBox的潜力(一):自动调整横向滚动条宽度
- 设置cookie (tips提示框第一次进入显示 一天内再进入隐藏)
- 纯CSS3进行hover时显示带箭头的tips提示动画效果
- 技巧(1)- 数据窗口的错误提示不显示(item '' does not pass validation test!)
- 输入框显示提示文字
- WPF中的ListBox按块显示元素
- js数据验证:jquery的validate,及进行重置操作时不显示异常提示
- Jquery 鼠标跟随提示层(可显示文本,Div ,Table, Html 等等)
- 在js文件中显示jquery的智能提示VS2010