定时显示提示控件 TToolTip

转载过来的，文章出自：

http://www.delphifans.com/infoview/Article_3640.html

{
    修改者：ghs
    日期：20071218
    功能：在原版本的基础上增加。
          RegisterControl：注册需要提示的控件。
          BeginHelp：设置光标状态为帮助crHelp；
          鼠标弹起后，显示注册的提示信息，同时光标进行还原。
          
   原版本
   作者：thaoqi
   出处：http://www.2ccc.com/article.asp?articleid=4389
   功能：首先谢谢xsherry大大，来盒子很长一段时间了，老是下东西，没有为盒子做什么贡献。
        前段时间xsherry大大抛砖引玉的文章，给我启发很大，最近一个项目提出要求人
        机交互界面更加有好，尽量少用MessageBox，所以在他的基础上，我试图模仿XP
        登录时候的那个ToolTip提示功能，用API摸索出一个符合要求的ToolTip提示框出
        来，最后我把实现的函数封装成了一个VCL的控件，希望大家能多提意见！
}

代码

unit TooltipUtil;

interface

uses Messages, Windows, SysUtils, Classes, Contnrs, Controls, CommCtrl,
  StdCtrls, ExtCtrls, Consts, Forms, Dialogs, AppEvnts;

type
  TTipTool_ICON = (ttNoneIcon, ttInformationIcon, ttWarningIcon, ttStopIcon);
  TTipAlignment = (taLeft, taCenter, taRight);

PTipInfo = ^TTipInfo;
  
  TTipInfo = packed record
    WinControl: TWinControl;
    Handle: THandle;
    Caption: string;
    Msg: string;
    TipICON: TTipTool_ICON;
    TipAlg: TTipAlignment;
    Cursor: TCursor;
  end;
  
  TToolTip = class(TComponent)
  private
    fTitle: string;
    fText: string;
    fEnabled: Boolean;
    fWindowHandle: HWND;
    fTipHandle: HWND;
    fInterval: Cardinal;
    fToolInfo: TToolInfo;
    fAlignment: TTipAlignment;
    fTipIcon: TTipTool_ICON;
    fControl: TWinControl;
    //
    Flist: TList;
    ApplicationEvents: TApplicationEvents;
    FLastHandle: THandle;
    
    procedure SetText(AText: string); //设置气泡提示信息
    procedure SetTitle(ATitle: string); //设置气泡提示的标题

procedure UpdateTime; //更新计时器状态
    procedure WndProc(var Msg: TMessage); //接收windows消息
  protected
    //拦截消息=处理左键弹起
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    //结束帮助=设置光标为控件本来状态  
    procedure EndHelp;  
  public
    constructor Create(AOwner: TComponent); override; //构造函数，创建实例
    destructor Destroy; override; //析构函数，销毁实例
    //注册控件信息
    procedure RegisterControl(WinControl: TWinControl; aCaption, aMsg: string;
      TipICON: TTipTool_ICON = ttInformationIcon; TipAlignment: TTipAlignment = taLeft);
    //开始帮助=设置光标状态
    procedure BeginHelp;
    procedure Popup(Handle: HWND); overload; //在指定的句柄中弹出气泡（重载）
    procedure Popup(Handle: HWND; IconType: TTipTool_ICON; Title,
      Text: string); overload; //在指定的句柄中弹出气泡（重载）
      
  published
      //气泡窗体的窗体句柄
    property Handle: HWND read fTipHandle;
      //气泡窗体的提示信息
    property Text: string read fText write SetText;
      //气泡窗体的标题信息
    property Title: string read fTitle write SetTitle;
      //气泡窗体的信息图标
    property ICON: TTipTool_ICON read fTipIcon write fTipIcon;
      //气泡窗体弹出时对齐位置
    property Alignment: TTipAlignment read fAlignment write fAlignment default taLeft;
      //气泡窗体的显示时间
    property Interval: Cardinal read fInterval write fInterval default 1000;
  end;

procedure Register;

implementation

const
  TTS_BALLOON = $0040; //ToolTip提示窗口的外形，指定为气球型
  TTS_CLOSE = $0080; //关闭按钮
  TTF_PARSELINKS = $1000; //可使用超链接
  TTM_SETTITLE = WM_USER + 32; //社这提示标题信息的消息

constructor TToolTip.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

if not (AOwner is TWinControl) then
  begin
    raise exception.Create(‘TToolTip‘‘s owner must be a ‘‘TWinControl‘‘ type.‘);
    Destroy;
  end;

fWindowHandle := Classes.AllocateHWnd(WndProc);

fEnabled := False;
  fInterval := 1000;

//创建气泡提示窗口
  fTipHandle := CreateWindow(TOOLTIPS_CLASS, nil,
    WS_POPUP or TTS_NOPREFIX or
    TTS_BALLOON or TTS_ALWAYSTIP, // or TTS_CLOSE,
    0, 0, 0, 0, fWindowHandle,
    0, HInstance, nil);

if fTipHandle <> 0 then
  begin
    //设置ToolInfo的大小
    fToolInfo.cbSize := SizeOf(fToolInfo);
    //设置基本风格
    fToolInfo.uFlags := TTF_PARSELINKS or TTF_IDISHWND or TTF_TRACK;
    //设置所有者的句柄
    fToolInfo.uId := fWindowHandle;
  end;
  Flist := TList.Create;
  ApplicationEvents := TApplicationEvents.Create(nil);
  ApplicationEvents.OnMessage := ApplicationEvents1Message;
end;

destructor TToolTip.Destroy;
var
  I: Integer;
  tmpTipInfo: PTipInfo;
begin
  if fTipHandle <> 0 then
    CloseWindow(fTipHandle);
  for I := Flist.Count - 1 downto 0 do    // Iterate
  begin
    tmpTipInfo := PTipInfo(FList.Items[i]);
    Dispose(tmpTipInfo);
  end;    // for
  Flist.Free;
  ApplicationEvents.Free;
  inherited Destroy;
end;

procedure TToolTip.SetText(AText: string);
begin
  fText := AText;

if fTipHandle <> 0 then
  begin
    //设置标题信息
    fToolInfo.lpszText := PAnsiChar(fText);
    //向气泡窗体发送消息，将ToolInfo的信息设置到气泡窗体中
    SendMessage(fTipHandle, TTM_ADDTOOL, 0, Integer(@fToolInfo));
    SendMessage(fTipHandle, TTM_SETTOOLINFO, 0, Integer(@fToolInfo));
  end;
end;

procedure TToolTip.SetTitle(ATitle: string);
begin
  fTitle := ATitle;

if fTipHandle <> 0 then
    //设置气泡窗体的提示图标和标题信息
    SendMessage(fTipHandle, TTM_SETTITLE, Integer(fTipIcon), Integer(fTitle));
end;

procedure TToolTip.Popup(Handle: HWND);
var
  tmpRect: TRect;
  x, y: word;
begin
  x := 0;

fControl := FindControl(Handle);
  if fControl.Hint <> ‘‘ then
    fControl.ShowHint := False;

//得到需要显示窗体所在的屏幕区域
  GetWindowRect(Handle, tmpRect);

//计算显示区域位置的坐标
  with tmpRect do
  begin
    y := (Bottom - Top) div 2 + Top;

case fAlignment of
      taLeft: x := Left;
      taCenter: x := (Right - Left) div 2 + Left;
      taRight: x := Right;
    end;
  end;

//设置气泡窗体弹出的坐标
  SendMessage(fTipHandle, TTM_TRACKPOSITION, 0, MAKELONG(x, y));
  //激活气泡窗体，并显示出来
  SendMessage(fTipHandle, TTM_TRACKACTIVATE, Integer(True), Integer(@fToolInfo));

fEnabled := True;
  //更新计时器状态
  UpdateTime;
end;

procedure TToolTip.WndProc(var Msg: TMessage);
begin
  fEnabled := False;

with Msg do
  begin
    case Msg of
      WM_TIMER:
      try
        SendMessage(fTipHandle, TTM_TRACKACTIVATE,
          Integer(False), Integer(@fToolInfo));
        if fControl.Hint <> ‘‘ then
          fControl.ShowHint := True;
      except
        Application.HandleException(Self);
      end;
    else
      Result := DefWindowProc(fWindowHandle, Msg, wParam, lParam);
    end;  
  end;
  //更新计时器状态
  UpdateTime;
end;

procedure TToolTip.Popup(Handle: HWND; IconType: TTipTool_ICON;
  Title: string; Text: string);
begin
  fTipIcon := IconType;

SetTitle(Title);
  SetText(Text);

Popup(Handle);
end;

procedure TToolTip.UpdateTime;
begin
  KillTimer(fWindowHandle, 1);
  if (FInterval <> 0) and FEnabled then
    if SetTimer(fWindowHandle, 1, FInterval, nil) = 0 then
      raise EOutOfResources.Create(SNoTimers);
end;

procedure Register;
begin
  RegisterComponents(‘ToolTip‘, [TToolTip]);
end;

procedure TToolTip.RegisterControl(WinControl: TWinControl; aCaption, aMsg: string;
  TipICON: TTipTool_ICON = ttInformationIcon; TipAlignment: TTipAlignment = taLeft);
var
  TipInfo: PTipInfo;  
begin
  New(TipInfo);
  TipInfo.WinControl := WinControl;
  TipInfo.Handle := WinControl.Handle;
  TipInfo.Caption := aCaption;
  Tipinfo.Msg := aMsg;
  TipInfo.TipICON := TipICON;
  TIpInfo.TipAlg := TipAlignment;
  TipInfo.Cursor := WinControl.Cursor;
  
  Flist.Add(TipInfo);
end;

procedure TToolTip.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  I: Integer;
  tmpTipInfo: PTipInfo;
  tmpPoint: TPoint;
  tmpHandle: THandle;
begin
  if Msg.message = WM_LBUTTONUP then
  begin
    GetCurSorPos(tmpPoint);
    tmpHandle := WindowFromPoint(tmpPoint);
    if FLastHandle <> tmpHandle then //防止不停触发
    begin
      FLastHandle := tmpHandle;
      for I := 0 to FList.Count - 1 do    // Iterate
      begin
        tmpTipInfo := PTipInfo(FList.Items[i]);
        //只有调用了BeginHelp，才会弹出提示窗口
        if (tmpTipInfo.Handle = tmpHandle) and (tmpTipInfo.WinControl.Cursor = crHelp) then
        begin
          Popup(tmpHandle, tmpTipInfo.TipICON, tmpTipInfo.Caption, tmpTipInfo.Msg);
          break;
        end;
      end;    // for
      EndHelp;
      DefWindowProc(Msg.hwnd, Msg.message, Msg.wParam, Msg.lParam);  
    end;
  end;

end;

procedure TToolTip.BeginHelp;
var
  i: Integer;
  tmpTipInfo: PTipInfo;
begin
  for I := 0 to FList.Count - 1 do    // Iterate
  begin
    tmpTipInfo := PTipInfo(FList.Items[i]);
    tmpTipInfo.WinControl.Cursor := crHelp;
  end;    // for
end;

procedure TToolTip.EndHelp;
var
  i: Integer;
  tmpTipInfo: PTipInfo;
begin
  for I := 0 to FList.Count - 1 do    // Iterate
  begin
    tmpTipInfo := PTipInfo(FList.Items[i]);
    tmpTipInfo.WinControl.Cursor := tmpTipInfo.Cursor;
  end;    // for
end;

end.

调用一:

if edt3.Text=‘‘ then
  begin
    tltp1.Popup(TWinControl(edt3).Handle, ttStopIcon,‘提示‘,‘请输入产地‘);
    Exit;
  end;

调用二:

ToolTip1.RegisterControl(LabeledEdit1, ‘提示‘, ‘请输入用户名‘);
ToolTip1.BeginHelp;

http://www.cnblogs.com/kfarvid/archive/2010/08/02/1790603.html

时间： 2024-10-12 16:49:05

定时显示提示控件 TToolTip的相关文章

jquery的智能提示控件

福利到~分享一个基于jquery的智能提示控件intellSeach.js 一.需求 我们经常会遇到[站内搜索]的需求,为了提高用户体验,我们希望能做到像百度那样的即时智能提示.例如:某公司人事管理系统,想搜索李XX,只要输入“李”,系统自然会提示一些姓李的员工,这样方便用户使用.说白了,就是用户边输入,系统会提示相关的结果:或者,当用户点击搜索框时,就推荐一些内容,如360.百度都会提示今天的主要新闻或搜索量大的内容. jquery 已经有一个这样的插件了,叫 autocomplete, 但我

DevExpress控件库----FlyoutPanel提示控件

第一步:拖一个FlyoutPanel控件到WinForm窗体上.名称为 flyoutPanel1 设置在什么控件上显示提示信息: 设置在 panelControl1控件上显示提示信息 flyoutPanel1.OwnerControl = panelControl1; 在鼠标移入panelControl1上时 显示提示信息: private void panelControl1_MouseEnter(object sender, EventArgs e) { flyoutPanel1.ShowB

过一定时间显示可用控件

<!DOCTYPE html> <html xmlns="http://www.w3.org/1999/xhtml"> <head> <meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>     <title></title>     <script type="text/ja

iOS8统一的系统提示控件——UIAlertController

iOS8统一的系统提示控件——UIAlertController 一.引言 相信在iOS开发中,大家对UIAlertView和UIActionSheet一定不陌生,这两个控件在UI设计中发挥了很大的作用.然而如果你用过,你会发现这两个控件的设计思路有些繁琐,通过创建设置代理来进行界面的交互,将代码逻辑分割了,并且很容易形成冗余代码.在iOS8之后,系统吸引了UIAlertController这个类,整理了UIAlertView和UIActionSheet这两个控件,在iOS中,如果你扔使用UIA

iOS项目开发实战——自定义圆形进度提示控件

iOS中默认的进度条是水平方向的进度条,这往往不能满足我们的需求.但是我们可以自定义类似的圆形的进度提示控件,主要使用iOS中的绘图机制来实现.这里我们要实现一个通过按钮点击然后圆形进度提示不断增加的效果. (1)新建一个Cocoa Touch Class,注意要继承自UIView.这个是绘制图形的类,绘制一个圆形的背景和扇形的进度.具体实现如下: import UIKit class ProgressControl: UIView { override init(frame: CGRect)

jquery messagetip信息语提示控件

编写原因: 作为提示框,jquery有个messagebox的控件,也就是弹出的提示框.但这个控件如果不是用在需要确认的时候,单单警告提示.消息提示.失败提示时,用户还需要去点下确认,有时这操作还是挺烦的(尽管可以设置timeout,会自动消失). 控件需求: 现在需要一个简洁消息提示控件,不需确认. 1.提示框可以从顶部或底部滑入,在失效后滑出. 2.可以设置滑入时间,内容停留时间.滑出时间. PS:比较简单的控件 效果如下 编写过程: 1.在无文档的情况下, 我建议将用户能传的参数的定义写在

用按钮打开对话框选取图片按大小显示在控件中

[cpp] view plaincopy 打开按钮相应消息 [cpp] view plaincopy void CLoadBmpDlg::OnBtnOpenBmp() { // TODO: Add your control notification handler code here ////选取图片文件 [cpp] view plaincopy CFileDialog file_open_dlg(TRUE,NULL,NULL,OFN_HIDEREADONLY,"BMP Files(*.bmp)

BitmapImage处理网络图片，例如阿里云获取的图片。异步加载到需要显示的控件上。提升速度非常明显。

想直接把网络图片赋给控件,又要下载又要缓存,速度非常慢.不流畅. 需要进行处理,异步加载会显著提升速度.方法如下: public static BitmapImage ByteArrayToBitmapImage(byte[] byteArray) { BitmapImage bmp = null; try { bmp = new BitmapImage(); bmp.BeginInit(); bmp.StreamSource = new MemoryStream(byteArray); bmp

ASP.NET MVC显示UserControl控件(扩展篇)

昨晚Insus.NET有怀旧一下<念念不忘,ASP.NET MVC显示WebForm网页或UserControl控件>http://www.cnblogs.com/insus/p/3641610.html 那仅是小小尝试,还有很多不明的地方. 那一篇其中有Render用户控件ascx的.如今Insus.NET想重构它一下,让步其能在Action或是Razor语法中使用. 创建一个AscxUtility.cs,这们我们可以在应用程序中多个地方使用. 这样我们就可以重构一下昨晚那个public A