Hi,

I'm using as class to create multiline tooltips. I have a screen with more
than 1000 little frames and they all have a multiline tooltip. Because of
the tooltips the program is very slow. I'm creating the tooltips at the
start of the program. Is there a way to make it faster? Maybe create the
tooltips when needed?

Tia
John


This is the class

Option Explicit

Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOSIZE = &H1

Private Const WM_USER = &H400
Private Const WM_PAINT = &HF
Private Const WM_PRINT = &H317

Private Const TTF_SUBCLASS = &H10

Private Const TTM_ADDTOOLA = (WM_USER + 4)
Private Const TTM_SETMAXTIPWIDTH = (WM_USER + 24)
Private Const TTM_SETTIPBKCOLOR = (WM_USER + 19)
Private Const TTM_SETTIPTEXTCOLOR = (WM_USER + 20)

Private Const TTS_ALWAYSTIP = &H1
Private Const TTS_BALLOON = &H40

Private Const TOOLTIPS_CLASSA = "tooltips_class32"
Private Const HWND_TOPMOST = -1

Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA"
_
  (ByVal dwExStyle As Long, _
   ByVal lpClassName As String, _
   ByVal lpWindowName As String, _
   ByVal dwStyle As Long, _
   ByVal X As Long, _
   ByVal Y As Long, _
   ByVal nWidth As Long, _
   ByVal nHeight As Long, _
   ByVal hWndParent As Long, _
   ByVal hMenu As Long, _
   ByVal hInstance As Long, _
   lpParam As Any) As Long

Private Declare Function DestroyWindow Lib "user32" _
  (ByVal hWnd As Long) As Long

Private Declare Function SetWindowPos Lib "user32" _
  (ByVal hWnd As Long, _
   ByVal hWndInsertAfter As Long, _
   ByVal X As Long, _
   ByVal Y As Long, _
   ByVal cx As Long, _
   ByVal cy As Long, _
   ByVal wFlags As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  (ByVal hWnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long

Private Declare Function GetClientRect Lib "user32" _
  (ByVal hWnd As Long, lpRect As RECT) As Long

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Type TOOLINFO
  cbSize As Long
  uFlags As Long
  hWnd As Long
  uid As Long
  RECT As RECT
  hinst As Long
  lpszText As String
  lParam As Long
End Type


Public Function Add(hTarget As Long, sMessage As String, Optional
lBackgroundColor As Variant, Optional lForegroundColor As Variant, Optional
lBalloon As Boolean) As Long
  Dim TipWindow As Long
  Dim ti As TOOLINFO
  Dim RECT As RECT

  TipWindow = CreateWindowEx(0&, TOOLTIPS_CLASSA, "", _
     TTS_ALWAYSTIP Or IIf(lBalloon, TTS_BALLOON, 0), _
     0, 0, 0, 0, hTarget, 0&, App.hInstance, 0&)

  Add = TipWindow

  SetWindowPos TipWindow, HWND_TOPMOST, 0, 0, 0, 0, _
     SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE

  GetClientRect hTarget, RECT

  With ti
    .cbSize = Len(ti)
    .uFlags = TTF_SUBCLASS
    .hWnd = hTarget
   '.hinst = App.hInstance
    .uid = 0
    .lpszText = sMessage
    .RECT = RECT
  End With

  SendMessage TipWindow, TTM_ADDTOOLA, 0, ti

  SendMessage TipWindow, TTM_SETMAXTIPWIDTH, 0, 0

  If IsMissing(lBackgroundColor) = False Then _
    SendMessage TipWindow, TTM_SETTIPBKCOLOR, lBackgroundColor, 0

  If IsMissing(lForegroundColor) = False Then _
    SendMessage TipWindow, TTM_SETTIPTEXTCOLOR, lForegroundColor, 0

End Function

Public Function Remove(TipWindow As Long) As Long
  If TipWindow <> 0 Then _
    DestroyWindow TipWindow
End Function

You're creating 1000 tooltips whether they show or not? 1000 frames? Sheesh
<g>

Yes... definitely... don't create any until you need them and then create
only one. Populate it's "text" on the fly.

Probably because (it appears anyway) you're creating a new tooltip
window for each tip and 1000+ would chew up a lot of system resources.
A single tooltip window can supply all your tips. Create one, and then
add individual tips with TTM_ADDTOOL.

Also worth mentioning (though I'm not sure this would make much
difference in performance) you can use the control in callback mode
(iow respond to TTN_NEEDTEXT) which places the burden of storing /
fetching the tip string data on the app.


-Tom
MVP - Visual Basic
(please post replies to the newsgroup)

How to best resize a form?
Using Control Array in User Control
[function LOF] Fails after WordPad saving
Proper way to resize a Form
VB6---.NET
Why Randomize() won't work?
Passing data from a dll to the main VB program
Problems with vbCtrlMask
VB.NET Shutdown from text file
can't use a function from dll built in delphi