Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to create a balloon-shaped tooltip Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
30-Aug-02
Category
Others
Language
Delphi 2.x
Views
146
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Tomas Rutkauskas

How to create a balloon-shaped tooltip

Answer:

Solve 1:

You could show a ToolTip control, which would have the appearance of a cartoon 
"balloon", with rounded corners and a stem pointing to the item. Also, there could 
be a multiline text and a caption with an icon. But in order to see this, be sure 
that there are Version 5.80 of Comctl32.dll and version 5.0 of Shlwapi.dll 
installed on your machine. Below is the code which would force the tooltip to show 
itself.

1   { ... }
2   var
3     FTTHandle: THandle;
4   
5   const
6     TTM_SETTITLE = $0420;
7     TTS_BALLOON = $040;
8   
9   procedure TForm1.SpeedButton2Click(Sender: TObject);
10  var
11    ti: TOOLINFO;
12    XRect: TRect;
13  begin
14    FTTHandle := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil, WS_POPUP or
15      TTS_NOPREFIX or TTS_BALLOON, 0, 0, 0, 0, Handle, 0, Application.Handle, nil);
16    ti.cbSize := sizeof(TOOLINFO);
17    ti.uFlags := TTF_SUBCLASS or TTF_DI_SETITEM;
18    ti.hwnd := Handle;
19    ti.hinst := Application.Handle;
20    ti.uId := 0;
21    ti.lpszText := 'First line' + #$0D#$0A + 'Second line' + #$0D#$0A + {...} 
22  		+ 'Last Line';
23    {ti.lpszText := LPSTR_TEXTCALLBACK;}
24    XRect := ClientRect;
25    ti.rect.left := XRect.left;
26    ti.rect.top := XRect.top;
27    ti.rect.right := XRect.right;
28    ti.rect.bottom := XRect.bottom;
29    SendMessage(FTTHandle, TTM_ADDTOOL, 0, integer(@ti));
30    SendMessage(FTTHandle, TTM_SETTITLE, 1, integer(PChar('Title')));
31    SendMessage(FTTHandle, TTM_SETMAXTIPWIDTH, 0, 100);
32    SendMessage(FTTHandle, TTM_SETTIPBKCOLOR, clMoneyGreen, 0);
33    SendMessage(FTTHandle, TTM_SETTIPTEXTCOLOR, clNavy, 0);
34  end;
35  
36  Basically, you could even perform some custom painting on the tooltip's surface. In 
37  order to do this add a WM_NOTIFY message handler to the form and handle the 
38  NM_CUSTOMDRAW notification. Below is an example:
39  
40  { ... }
41  type
42    TForm1 = class(TForm)
43      SpeedButton2: TSpeedButton;
44      procedure SpeedButton2Click(Sender: TObject);
45    protected
46      procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
47    end;
48  
49    { ... }
50  
51  procedure TForm1.WMNotify(var Message: TWMNotify);
52  var
53    XCanvas: TCanvas;
54    XRect: TRect;
55  begin
56    inherited;
57    if integer(Message.NMHdr.hwndFrom) = integer(FTTHandle) then
58    begin
59      case Message.NMHdr.code of
60        TTN_POP:
61          begin
62            {do something here, when tooltip hides}
63          end;
64        TTN_SHOW:
65          begin
66            {do something here, when tooltip show itself}
67          end;
68        TTN_NEEDTEXT:
69          begin
70            PTOOLTIPTEXT(Message.NMHdr).lpszText := '
71            {here you could set new text to the tooltip, but only in 
72  					case you've specified a LPSTR_TEXTCALLBACK constant
73  					in the lpszText identifier, in the SpeedButton2Click method}
74          end;
75        NM_CUSTOMDRAW:
76          begin
77            with PNMCustomDraw(message.NMHdr)^ do
78            begin
79              if dwDrawStage = CDDS_PREPAINT then
80              begin
81                message.Result := CDRF_NOTIFYPOSTPAINT;
82              end
83              else if dwDrawStage = CDDS_POSTPAINT then
84              begin
85                XCanvas := TCanvas.Create;
86                try
87                  XCanvas.Handle := hdc;
88                  XRect := PNMCustomDraw(message.NMHdr)^.rc;
89                  XRect.Left := XRect.Right - 40;
90                  XRect.Bottom := XRect.Top + 30;
91                  XCanvas.Brush.Color := clBlue;
92                  XCanvas.FillRect(RECT(XRect.Left, XRect.Top, XRect.Right, 
93  									XRect.Top + 15));
94                  XCanvas.Brush.Color := clYellow;
95                  XCanvas.FillRect(RECT(XRect.Left, XRect.Top + 15, 
96  									XRect.Right, XRect.Top + 30));
97                  XCanvas.Brush.Color := clBlack;
98                  XCanvas.FrameRect(XRect);
99                finally
100                 XCanvas.Free;
101               end;
102             end;
103           end;
104         end;
105     end;
106   end;
107 end;
108 
109 
110 Solve 2:
111 
112 unit Unit1;
113 
114 interface
115 
116 uses
117   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
118   Dialogs, CommCtrl, StdCtrls;
119 
120 const
121   TTS_BALLOON = $40;
122   TTM_SETTITLE = (WM_USER + 32);
123 
124 type
125   TForm1 = class(TForm)
126     Memo1: TMemo;
127     procedure FormCreate(Sender: TObject);
128   private
129     {Private declarations}
130   public
131     {Public declarations}
132   end;
133 
134 var
135   Form1: TForm1;
136   hTooltip: Cardinal;
137   ti: TToolInfo;
138   buffer: array[0..255] of char;
139 
140 implementation
141 
142 {$R *.dfm}
143 
144 procedure CreateToolTips(hWnd: Cardinal);
145 begin
146   hToolTip := CreateWindowEx(0, 'Tooltips_Class32', nil, TTS_ALWAYSTIP or 
147 TTS_BALLOON,
148     Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
149     Integer(CW_USEDEFAULT), hWnd, 0, hInstance, nil);
150   if hToolTip <> 0 then
151   begin
152     SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or
153       SWP_NOSIZE or SWP_NOACTIVATE);
154     ti.cbSize := SizeOf(TToolInfo);
155     ti.uFlags := TTF_SUBCLASS;
156     ti.hInst := hInstance;
157   end;
158 end;
159 
160 procedure AddToolTip(hwnd: dword; lpti: PToolInfo; IconType: Integer; Text, Title:
161   PChar);
162 var
163   Item: THandle;
164   Rect: TRect;
165 begin
166   Item := hWnd;
167   if (Item <> 0) and (GetClientRect(Item, Rect)) then
168   begin
169     lpti.hwnd := Item;
170     lpti.Rect := Rect;
171     lpti.lpszText := Text;
172     SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(lpti));
173     FillChar(buffer, sizeof(buffer), #0);
174     lstrcpy(buffer, Title);
175     if (IconType > 3) or (IconType < 0) then
176       IconType := 0;
177     SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@buffer));
178   end;
179 end;
180 
181 procedure TForm1.FormCreate(Sender: TObject);
182 begin
183   CreateToolTips(Form1.Handle);
184   AddToolTip(Memo1.Handle, @ti, 1, Memo1.Lines.GetText, 'Memo Text');
185 end;
186 
187 end.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC