type
  TForm1 = class(TForm)
    // Для вывода подсказки используется Label
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    // Описание собственной процедуры AppHint
    procedure AppHint(Sender: TObject);
  end;

// Вывод подсказки на экран
procedure TForm1.AppHint(Sender: TObject);
begin
   Label1.Caption := Application.Hint;
end;

// Присвоение событию Hint имени нашей процедуры AppHint
procedure TForm1.FormCreate(Sender: TObject);
begin
   Application.OnHint := AppHint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   Form1.Button1.Hint := 'Многострочная' + #13 + 'подсказка';
   Form1.Button1.ShowHint := True;
end;

// Способ первый
uses
  CommCtrl;

const
  TTS_BALLOON = $40;
  TTM_SETTITLE = WM_USER + 32;

var
  hTooltip: Cardinal;
  ti: TToolInfo;

procedure CreateToolTips(hWnd: Cardinal);
begin
   hToolTip := CreateWindowEx(0, 'Tooltips_Class32', nil, TTS_ALWAYSTIP or TTS_BALLOON,
                              Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
                              Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
                              hWnd, 0, hInstance, nil);
   if hToolTip <> 0 then
   begin
      SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0,
                   SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
      ti.cbSize := SizeOf(TToolInfo);
      ti.uFlags := TTF_SUBCLASS;
      ti.hInst := hInstance;
   end;
end;

procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer;
  Text: PChar; Title: PAnsiChar);
var
  Item: THandle;
  Rect: TRect;
begin
   Item := hWnd;
   if (Item <> 0) and GetClientRect(Item, Rect) then
   begin
      lpti.hwnd := Item;
      lpti.Rect := Rect;
      lpti.lpszText := Text;
      SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(lpti));
      if (IconType > 3) or (IconType < 0) then
         IconType := 0;
      SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(Title));
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   CreateToolTips(Form1.Handle);
   // IconType can be:
   // 0 - No icon
   // 1 - Information
   // 2 - Warning
   // 3 - Error
   AddToolTip(Button1.Handle, @ti, 1, 'Tooltip text', 'Title');
end;

// Способ второй
uses
  CommCtrl;

procedure ShowBalloonTip(Control: TWinControl; Icon: integer; Title: PAnsiChar;
  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
  hWndTip: THandle;
  ti: TOOLINFO;
  hWnd: THandle;
begin
   hWnd := Control.Handle;
   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
      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_SUBCLASS;
      ti.hwnd := hWnd;
      ti.lpszText := Text;
      Windows.GetClientRect(hWnd, ti.rect);
      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));
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   // IconType can be:
   // 0 - No icon
   // 1 - Information
   // 2 - Warning
   // 3 - Error
   ShowBalloonTip(Button1, 1, 'Title', 'Tooltip text', clBlue, clNavy);
end;

// Способ третий
type
  tagEDITBALLOONTIP = packed record
    cbStruct: DWORD;
    pszTitle: LPCWSTR;
    pszText: LPCWSTR;
    ttiIcon: Integer;
  end;
  PEditBalloonTip = ^TEditBalloonTip;
  TEditBalloonTip = tagEDITBALLOONTIP;

const
  ECM_FIRST = $1500;
  EM_SHOWBALLOONTIP = ECM_FIRST + 3;
  EM_HIDEBALLOONTIP = ECM_FIRST + 4;
  TTI_NONE = 0;
  TTI_INFO = 1;
  TTI_WARNING = 2;
  TTI_ERROR = 3;

  TTI_TITLES: array[0..3] of string =
    ('', 'Информация', 'Предупреждение', 'Ошибка');

implementation

procedure TForm1.Button1Click(Sender: TObject);
var
  ebt: TEditBalloonTip;
  icon: Integer;
begin
   icon := TTI_ERROR;
   with ebt do
   begin
      cbStruct := SizeOf(ebt);
      pszTitle := PWideChar(TTI_TITLES[icon]);
      pszText := PWideChar('Сообщение');
      ttiIcon := icon;
   end;
   SendMessage(Edit1.Handle, EM_SHOWBALLOONTIP, 0, Longint(@ebt));
end;

type
  TForm1 = class(TForm)
  public
    { Public declarations }
    procedure DoShowHint(var HintStr: string; var CanShow: Boolean;
      var HintInfo: THintInfo);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
   Application.OnShowHint := DoShowHint;
end;

procedure TForm1.DoShowHint(var HintStr: string; var CanShow: Boolean;
  var HintInfo: THintInfo);
begin
    with HintInfo do
       if HintControl is TWinControl then
       begin
          HintPos.X := Left + TWinControl(HintControl).Left;
          HintPos.Y := Top + TWinControl(HintControl).Top;
       end;
       // Если нужно изменить для конкретного элемента интерфейса,
       // тогда делаем так:
       // if HintControl = Button1 then
       // begin
       //    HintPos.X := Left + Button1.Left;
       //    HintPos.Y := Top + Button1.Top;
       // end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   Application.OnShowHint := DoShowHint;
end;