Главная » Delphi » Основная » Как показать подсказку ввиде баллона оттуда, там где часики..

Как показать подсказку ввиде баллона оттуда, там где часики..

19:58
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Commctrl, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  hWndTip: THandle;
implementation
 
{$R *.dfm}
 
procedure ShowBalloonTip(Control: TWinControl; Icon: integer; Title: pchar; Text: PWideChar;
  BackCL, TextCL: TColor);
const
  TOOLTIPS_CLASS = 'tooltips_class32';
  TTS_ALWAYSTIP = $01;
  TTS_NOPREFIX = $02;
  TTS_BALLOON = $40;
  TTF_SUBCLASS = $0010;
  TTF_TRANSPARENT = $0100;
  TTF_CENTERTIP = $0002;
  TTM_ADDTOOL = $0400 + 50;
  TTM_SETTITLE = (WM_USER + 32);
  ICC_WIN95_CLASSES = $000000FF;
type
  TOOLINFO = packed record
    cbSize: Integer;
    uFlags: Integer;
    hwnd: THandle;
    uId: Integer;
    rect: TRect;
    hinst: THandle;
    lpszText: PWideChar;
    lParam: Integer;
  end;
var
  TrayWnd, TrayNWnd: THandle;
  ti: TOOLINFO;
  hWnd: THandle;
  Msg: TMSg;
begin
  hWnd := Control.Handle;
  TrayWnd := FindWindow('Shell_TrayWnd', nil);
  TrayNWnd := FindWindowEx(TrayWnd, 0, 'TrayNotifyWnd', nil);
  hWndTip := CreateWindow(TOOLTIPS_CLASS, nil,
    WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
    0, 0, 0, 0, hWnd, 0, HInstance, nil);
  if hWndTip <> 0 then
  begin
    hWnd := form1.Handle;
    hWndTip := CreateWindow(TOOLTIPS_CLASS, nil,
      TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
      0, 0, 0, 0, 0, 0, 0, nil);
    if hWndTip <> 0 then
    begin
      SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0,
        SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
      ti.cbSize := SizeOf(ti);
      ti.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_TRACK;
      ti.hwnd := hWnd;
      ti.lpszText := Text;
      ti.rect := rect(0, 0, 0, 0);
      SendMessage(hWndTip, TTM_SETTIPBKCOLOR, BackCL, 0);
      SendMessage(hWndTip, TTM_SETTIPTEXTCOLOR, TextCL, 0);
      SendMessage(hWndTip, TTM_ADDTOOL, 1, Integer(@ti));
      SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, Integer(Title));
      SendMessage(hWndTip, TTM_TRACKPOSITION, 0, MAKELONG(screen.WorkAreaWidth - 20, screen.WorkAreaHeight));
      SendMessage(hWndTip, TTM_TRACKACTIVATE, 1, Integer(@ti));
      msg.hwnd := hWnd;
      msg.message := WM_LBUTTONDOWN;
    end;
 
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowBalloonTip(Button1, 1, ' .',
    '..', $00D9FFFF, clBlack);
end;
 
 
end.