汽泡提醒

unit u_TipsWindow;

interface

uses

  CommCtrl,

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ComCtrls, ExtCtrls, StdCtrls;

type

  TTipsWindow = class(TObject)

  private

    FTipsWnd: HWND;

    FTipsInfo: TToolInfoA;

    FTipVisable: Boolean;

    FTimer: TTimer;

    procedure CreateTipsWindow(const hWndParent: THandle);

    procedure FTimerTimer(Sender: TObject);

  public

    procedure ShowTips(const APoint: TPoint; const strText: string);

    procedure HideTips;

  public

    constructor Create(AParent: TWinControl);

    destructor Destroy; override;

  end;

implementation

const

  CCM_SETWINDOWTHEME = (CCM_FIRST + $0B);

  TTF_PARSELINKS = $1000;

  TTM_GETBUBBLESIZE = (WM_USER + 30);

  TTM_ADJUSTRECT = (WM_USER + 31);

{$IFDEF UNICODE}

  TTM_SETTITLE = (WM_USER + 33);

{$ELSE}

  TTM_SETTITLE = (WM_USER + 32);

{$ENDIF}

  TTM_POPUP = (WM_USER + 34);

  TTM_GETTITLE = (WM_USER + 35);

  TTM_SETWINDOWTHEME = CCM_SETWINDOWTHEME;

  TTS_BALLOON = $40;

const

  TTS_NOANIMATE = $10;

  TTS_NOFADE = $20;

  TTS_CLOSE = $80;

  TTS_USEVISUALSTYLE = $100;

type

  TToolTipStyle = (ttsAlwaysTip, ttsBalloon, ttsNoAnimate, ttsNoFade,

    ttsNoPrefix, ttsClose, ttsUseVisualStyle);

  TToolTipStyles = set of TToolTipStyle;

const

  ToolTipStyleValue: array[TToolTipStyle] of Longword = (TTS_ALWAYSTIP,

    TTS_BALLOON, TTS_NOANIMATE, TTS_NOFADE, TTS_NOPREFIX, TTS_CLOSE,

    TTS_USEVISUALSTYLE);

function ToolTipStylesValue(const Styles: TToolTipStyles): LongWord;

var

  Style: TToolTipStyle;

begin

  Result := 0;

  for Style := Low(TToolTipStyle) to High(TToolTipStyle) do

    if Style in Styles then

      Result := Result or ToolTipStyleValue[Style];

end;

{ TTipsWindow }

constructor TTipsWindow.Create(AParent: TWinControl);

begin

  CreateTipsWindow(AParent.Handle);

  FTimer := TTimer.Create(nil);

  FTimer.Enabled := False;

  FTimer.Interval := 2000;

  FTimer.OnTimer := FTimerTimer;

end;

procedure TTipsWindow.CreateTipsWindow(const hWndParent: THandle);

var

  iccex: TInitCommonControlsEx;

begin

  // Load the ToolTip class from the DLL.

  iccex.dwSize := SizeOf(TInitCommonControlsEx);

  iccex.dwICC := ICC_BAR_CLASSES;

  InitCommonControlsEx(iccex);

  // Create the ToolTip control.

  FTipsWnd := CreateWindowEx(WS_EX_TOPMOST,

    TOOLTIPS_CLASS,

    '',

    WS_POPUP or (ToolTipStylesValue([ttsAlwaysTip, ttsBalloon, ttsNoPrefix])),

    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),

    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),

    0,

    0,

    hInstance,

    nil);

  SetWindowPos(FTipsWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or  SWP_NOSIZE or SWP_NOACTIVATE);

  // Prepare TOOLINFO structure for use as tracking ToolTip.

  FTipsInfo.cbSize := SizeOf(FTipsInfo);

  FTipsInfo.uFlags := TTF_IDISHWND + TTF_TRACK + TTF_ABSOLUTE + TTF_TRANSPARENT;

  FTipsInfo.hwnd := hWndParent;

  FTipsInfo.uId := 0; //注释掉ListBox1.Handle;

  FTipsInfo.hinst := hInstance;

  FTipsInfo.lpszText := 'AQ'; // LPSTR_TEXTCALLBACK;

  FTipsInfo.Rect.Left := 0;

  FTipsInfo.Rect.Top := 0;

  FTipsInfo.Rect.Bottom := 0;

  FTipsInfo.Rect.Right := 0;

  //注释掉SendMessage(FTipsWnd, WM_SETFONT, ListBox1.Font.Handle, LPARAM(LongBool(False)));

  SendMessage(FTipsWnd, TTM_ADDTOOL, 0, LPARAM(@FTipsInfo));

  //SendMessage(FTipsWnd, TTM_SETDELAYTIME, TTDT_INITIAL, 1000);

end;

destructor TTipsWindow.Destroy;

begin

  FTimer.Enabled := False;

  FTimer.Free;

  HideTips;

  DestroyWindow(FTipsWnd);

  inherited;

end;

procedure TTipsWindow.FTimerTimer(Sender: TObject);

begin

  FTimer.Enabled := False;

  HideTips;

end;

procedure TTipsWindow.HideTips;

begin

  if FTipVisable then

  begin

    FTipVisable := False;

    SendMessage(FTipsWnd, TTM_TRACKACTIVATE, WPARAM(LongBool(False)), 0);

  end;

end;

procedure TTipsWindow.ShowTips(const APoint: TPoint;

  const strText: string);

begin

  FTipsInfo.lpszText := PChar(strText);

  SendMessage(FTipsWnd, TTM_UPDATETIPTEXT, 0, LPARAM(@FTipsInfo));

  SendMessage(FTipsWnd, TTM_TRACKPOSITION, 0, MAKELPARAM(APoint.x - 1, APoint.y - 2));

  SendMessage(FTipsWnd, TTM_TRACKACTIVATE, WPARAM(LongBool(True)), LPARAM(@FTipsInfo));

  FTipVisable := True;

 // FTimer.Enabled := True;

end;

end.