Mega Code Archive
Always show balloon tips upon other objects
<![CDATA[
Title: always show balloon tips upon other objects?
uses CommCtrl;
(* var
{...}
ti: TToolInfo;
hTooltip: Cardinal; *)
// Automatisches Ausblenden:
// Timer_Balloon: TTimer erstellen mit OnTimer:
(* procedure TForm1.Timer_BalloonTimer(Sender: TObject);
begin
If Timer_Balloon.Enabled Then
begin
DisplayToolTip(ti.hwnd, hToolTip, ti, False, Point(0, 0));
Timer_Balloon.Enabled := False;
end;
end; *)
// Diese Prozedur bei Form1.OnCreate aufrufen:
// Beispiel:
// CreateToolTips(Form1.Handle, False, ti, hToolTip);
// Der Parameter CtrlAddicted entscheidet, ob die Balloon-Hilfe nur
// über einem bestimmten Control erscheinen soll (True) oder ob du
// selbst entscheiden willst, wann und wo sie erscheint (False).
procedure CreateToolTips(hWnd: Cardinal; CtrlAddicted: Boolean;
var ToolInfo: TToolInfo; var ToolTip: Cardinal);
const
TTS_BALLOON = $40;
begin
ToolTip := 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 ToolTip 0 then
begin
SetWindowPos(ToolTip,
HWND_TOPMOST,
0,
0,
0,
0,
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
ToolInfo.cbSize := SizeOf(TToolInfo);
if CtrlAddicted then
ToolInfo.uFlags := TTF_SUBCLASS
else
ToolInfo.uFlags := TTF_TRACK;
ToolInfo.hInst := hInstance;
end;
end;
// Vor dem Anzeigen kann - falls der Titel neu gesetzt oder geändert
// werden soll - diese Prozedur aufgerufen werden:
// Beispiel:
// SetToolTipTitle(hToolTip, 1 {= Informationssymbol}, 'Information');
// Werte für IconType:
// 0 = kein Symbol
// 1 = Information
// 2 = Warnung
// 3 = Fehler
procedure SetToolTipTitle(ToolTip: Cardinal; IconType: Integer; Title: string);
var
buffer: array[0..255] of Char;
const
TTM_SETTITLE = (WM_USER + 32);
begin
FillChar(buffer, SizeOf(buffer), #0);
lstrcpy(buffer, PChar(Title));
SendMessage(ToolTip, TTM_SETTITLE, IconType, Integer(@buffer));
end;
// falls du eine von einem Control abhängige Balloon-Hilfe erzeugen willst
// (ansonsten nicht benötigt):
procedure AddToolTip(hwnd: DWORD; ToolTip: Cardinal; lpti: PToolInfo;
Text: string);
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 := PChar(Text);
SendMessage(ToolTip, TTM_ADDTOOL, 0, Integer(lpti));
end;
end;
// Anzeige auslösen:
// Beispiel:
// DisplayToolTip(Form1.Handle, hToolTip, ti, True {= Einblenden;
// False = Ausblenden}, Memo1.ClientToScreen(Point(50, 50)),
// 'Text...', 5000 {Zeit in ms, nach der die Balloon-Hilfe wieder
// ausgeblendet wird; 0 = nicht automatisch ausblenden});
procedure DisplayToolTip(hwnd: DWORD; ToolTip: Cardinal; var lti: TToolInfo;
Show: Boolean; Position: TPoint; Text: string = ''; Time: Cardinal = 5000);
begin
lti.hwnd := hwnd;
if Text '' then
begin
lti.lpszText := PChar(Text);
SendMessage(ToolTip, TTM_UPDATETIPTEXT, 0, Integer(@lti));
end;
if Show then
SendMessage(ToolTip, TTM_TRACKPOSITION, 0, MakeLParam(Position.X, Position.Y));
SendMessage(ToolTip, TTM_TRACKACTIVATE, Ord(Show), Integer(@lti));
curhToolTip := ToolTip;
curti := lti;
Form1.Timer_Balloon.Interval := Time;
Form1.Timer_Balloon.Enabled := False;
Form1.Timer_Balloon.Enabled := True;
end;
]]>