Tips (1541)

Tip Rating (8):

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;