// 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





