// Wenn man unter
XP bei "TWinControls" statt Hints lieber Balloon- // siehe auch
Komponente TBalloon anwenden 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