whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1548)

Database (90)
Files (137)
Forms (107)
Graphic (116)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

20 Visitors Online


 
...always show balloon tips upon other objects?
Autor: bl@ckcomb
[ Print tip ]  

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;


 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners