[NumLock]

Сообщение от DJ PhoeniX

Да ну, неужели в WinAPI нет стандартных функций для подсказок? В жизни не поверю...

да есть конечно: tooltips_class32

Код:

unit Unit1;

interface

uses
  CommCtrl,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  FToolTip: HWND;

const
  TTI_NONE = 0;
  TTI_INFO = 1;
  TTI_WARNING = 2;
  TTI_ERROR = 3;

  TTS_ALWAYSTIP = $01;
  TTS_NOPREFIX = $02;
  TTS_NOANIMATE = $10;
  TTS_NOFADE = $20;
  TTS_BALLOON = $40;
  TTS_CLOSE = $80;

  TTM_SETTITLE = WM_USER+32;

implementation

{$R *.dfm}

procedure AddTool(Control: TWinControl; Text: String; Center: Boolean);
var
  ti: TOOLINFO;
begin
  ZeroMemory(@ti, SizeOf(TOOLINFO));
  ti.cbSize:=SizeOf(TOOLINFO);
  if Center then ti.uFlags:=TTF_SUBCLASS or TTF_CENTERTIP
  else ti.uFlags:=TTF_SUBCLASS;
  ti.hwnd:=Control.Handle;
  ti.lpszText:=PChar(Text);
  GetClientRect(Control.Handle, ti.Rect);
  SendMessage(FToolTip, TTM_ADDTOOL, 0, LPARAM(@ti));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FToolTip:=CreateWindowEx(WS_EX_TOPMOST,
    TOOLTIPS_CLASS,
    nil,
    TTS_BALLOON or
    WS_POPUP or TTS_NOPREFIX or TTS_ALWAYSTIP,
    0, 0, 0, 0,
    0, 0, HInstance, nil);
  AddTool(Button1, 'Button1', True);
  AddTool(Edit1, 'Edit1', True);
  AddTool(Memo1, 'Memo1', False);
  AddTool(ListBox1, 'ListBox1', False);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DestroyWindow(FToolTip);
end;

end.

http://data.cod.ru/128082
стиль баллон можно убрать TTS_BALLOON, чтобы выглядела как обычно.