// Wenn man unter XP bei "TWinControls" statt Hints lieber Balloon-
// Tooltips verwenden möchte, dann kann man das mit dem folgenden
// Code tun. Die Variable "Center" bestimmt dabei, ob der Tip direkt
// an der Spitze des Mauspfeils erscheint oder in der Mitte einer
// Seitenkante des Controls. Wenn
Title = '' (nichts) ist, wird
// kein Icon angezeigt. Und wenn
Txt = ''
ist, wird der Tooltip gar
// nicht angezeigt.

// siehe auch Komponente TBalloon anwenden

//
Variante 1
// Getestet mit D4 unter XP

uses Commctrl; 
 
procedure BalloonTip(Control: TWinControl; Center: boolean; Icon: byte; 
  Title: PChar; Txt: PWideChar; Backgrnd, TextUndRand: TColor); 
var 
  CenterBalloon: integer; 
  TInfo: tagTOOLINFOW; 
  HTip: THandle; 
begin 
  Icon := Icon mod 4; 
  CenterBalloon := ord(Center) * 2; 
  HTip := CreateWindow('tooltips_class32', nil, 
    WS_POPUP or $43, 0, 0, 0, 0, Control.Handle, 0, HInstance, nil); 
  if HTip <> 0 then begin 
    Control.ShowHint := false; 
    SetWindowPos(HTip, HWND_TOPMOST, 0, 0, 0, 0, 
      SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW); 
    TInfo.cbSize := SizeOf(tagTOOLINFOW); 
    TInfo.uFlags := CenterBalloon or $10; 
    TInfo.hWnd := Control.Handle; 
    TInfo.lpszText := Txt; 
    Windows.GetClientRect(Control.Handle, TInfo.Rect); 
    SendMessage(HTip, TTM_ADDTOOLW, 1, Longint(@TInfo)); 
    SendMessage(HTip, TTM_SETTIPBKCOLOR, Backgrnd, 0); 
    SendMessage(HTip, TTM_SETTIPTEXTCOLOR, TextUndRand, 0); 
    SendMessage(HTip, TB_SETBITMAPSIZE, Icon, Longint(Title)); 
  end; 
end; 
 
var 
  pnl: TPanel; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  BalloonTip(Button1, false, 2, 'Achtung', 
    'Das ist ein Tool-Tip', $99FFFF, clRed); 
  BalloonTip(Button2, false, 1, 'INFO', 
    'Das ist Button2', $FFE8E8, clBlack); 
 
// -- Trick für TImage (kein TWinControl!) --------- 
  pnl := TPanel.create(self); 
  pnl.BevelOuter := bvNone; 
  pnl.Caption := ''; 
  pnl.boundsrect := Image1.boundsrect; 
  pnl.parent := self; 
  image1.left := 0; 
  image1.top := 0; 
  image1.parent := pnl; 
  BalloonTip(pnl, false, 3, 'Trick', 
    'Tool-Tip für ein "TImage"', $CCFFCC, $4000); 
// ------------------------------------------------ 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  pnl.free; 
end; 
 
//   ICON: 
// 0 = kein 
// 1 = Information 
// 2 = Achtung 
// 3 = Fehler/Stopp
// ----------------------------------------------------------------------- 
// Variante 2
// Geringfügig geändert
// Getestet mit D2010 unter W7
uses Commctrl; 
procedure addBalloonTip(Control: TWinControl; Center: boolean; Icon: byte; 
  Title: PAnsiChar; Txt: PWideChar); 
var 
  CenterBalloon: integer; 
  TInfo: tagTOOLINFOW; 
  HTip: THandle; 
begin 
  Icon := Icon mod 4; 
  CenterBalloon := ord(Center) * 2; 
  HTip := CreateWindow(TOOLTIPS_CLASS, nil, 
    WS_POPUP OR TTS_NOPREFIX OR TTS_BALLOON OR TTS_ALWAYSTIP, 0, 0, 0, 0, 
    Control.Handle, 0, HInstance, nil); 
  if HTip <> 0 then 
  begin 
    Control.ShowHint := false; 
    SetWindowPos(HTip, HWND_TOPMOST, 0, 0, 0, 0, 
      SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW); 
    TInfo.cbSize := SizeOf(tagTOOLINFOW); 
    TInfo.uFlags := CenterBalloon or $10; 
    TInfo.hWnd := Control.Handle; 
    TInfo.lpszText := Txt; 
    Windows.GetClientRect(Control.Handle, TInfo.Rect); 
    SendMessage(HTip, TTM_ADDTOOLW, 1, Longint(@TInfo)); 
    SendMessage(HTip, TB_SETBITMAPSIZE, Icon, Longint(Title)); 
  end; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  addBalloonTip(Button1, true, 1, 'Information', 'Text'); 
  addBalloonTip(Button2, false, 0, 'Test', 'Ohne Icon'); 
  addBalloonTip(Button3, false, 2, 'Achtung', 'Ballon Tooltip'); 
  addBalloonTip(Button4, true, 3, 'FEHLER', 'Button2'); 
end;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke