Hello,
I'm currently trying to port a piece of code from VB6 to VB.net which
enables my application to display balloon tooltips. Unfortunately it
doesn't seem to work. This is the code
VB:
Public Class clsBalloonTips
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
Private Structure INITCOMMONCONTROLSEXSTRUCT
Public dwSize As Int32 'size of this structure
Public dwICC As Int32 'flags indicating which classes to be
initialized
End Structure
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
Private Structure RECT
Public Left As Int32
Public Top As Int32
Public Right As Int32
Public Bottom As Int32
End Structure
Private Structure TOOLINFO
Public cbSize As Int32
Public uFlags As Int32
Public hwnd As Int32
Public uID As Int32
Public WinRect As Rect
Public hInst As Int32
Public lpszText As String
Public lParam As Int32
End Structure
Private Declare Function CreateWindowEx Lib "user32.dll" Alias _
"CreateWindowExA" (ByVal dwExStyle As Int32, _
ByVal lpClassName As String, ByVal lpWindowName As String, _
ByVal dwStyle As Int32, ByVal x As Int32, ByVal y As Int32, _
ByVal nWidth As Int32, ByVal nHeight As Int32, _
ByVal hWndParent As Int32, ByVal hMenu As Int32, _
ByVal hInstance As Int32, ByVal lpParam As Int32) As Int32
Private Declare Function SetWindowPos Lib "user32.dll" _
(ByVal hwnd As Int32, ByVal hWndInsertAfter As Int32, _
ByVal x As Int32, ByVal y As Int32, ByVal cx As Int32, _
ByVal cy As Int32, ByVal wFlags As Int32) As Int32
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" _
(ByRef TLPINITCOMMONCONTROLSEX As INITCOMMONCONTROLSEXSTRUCT) _
As Int32
Private Declare Function DestroyWindow Lib "user32.dll" _
(ByVal hwnd As Int32) As Int32
Private Declare Function SendMessage Lib "user32.dll" Alias _
"SendMessageA" (ByVal hwnd As Int32, ByVal wMsg As Int32, _
ByVal wParam As Int32, ByVal lParam As TOOLINFO) As Int32
Private Declare Function GetModuleHandle Lib "kernel32.dll" _
Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Int32
Private Declare Function GetLastError Lib "kernel32.dll" () As Int32
Public Enum TooltipFlagConstants
ttfAlwaysTip = &H1
ttfNoPrefix = &H2
ttfNoAnimate = &H10
ttfNoFade = &H20
ttfBalloon = &H40
End Enum
Public Enum ToolFlagConstants
tfCenterTip = &H2
tfRtlReading = &H4
tfTrack = &H20
tfAbsolute = &H80
tfTransparent = &H100
End Enum
Private Const ICC_WIN95_CLASSES As Int32 = &HFF
Private Const ICC_BAR_CLASSES As Int32 = &H4
Private Const WS_EX_TOPMOST As Int32 = &H8I
Private Const TOOLTIPS_CLASS As String = "tooltips_class"
Private Const WS_POPUP As Int32 = &H80000000
Private Const CW_USEDEFAULT As Int32 = &H80000000
Private Const HWND_TOPMOST As Int32 = -1
Private Const SWP_NOMOVE As Int32 = &H2
Private Const SWP_NOSIZE As Int32 = &H1
Private Const SWP_NOACTIVATE As Int32 = &H10
Private Const TTF_IDISHWND = &H1
Private Const TTF_SUBCLASS = &H10
Private Const WM_USER = &H400
Private Const TTM_ADDTOOL = WM_USER + 50
Private hWndTT As Int32
Public Sub New()
End Sub
Public Sub Dispose()
Destroy()
End Sub
Public Sub Create(ByRef Frm As Form, ByVal Flags As
TooltipFlagConstants)
Try
Dim InitCtrls As INITCOMMONCONTROLSEXSTRUCT
InitCtrls.dwSize = Len(InitCtrls)
InitCtrls.dwICC = ICC_WIN95_CLASSES Or ICC_BAR_CLASSES
Destroy()
Dim intResult As Int32
intResult = InitCommonControlsEx(InitCtrls)
intResult = Frm.Handle.ToInt32
intResult = GetModuleHandle(Nothing)
' =========== FAILS HERE =============
hWndTT = CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, "", _
WS_POPUP Or Flags, CW_USEDEFAULT, CW_USEDEFAULT, _
CW_USEDEFAULT, CW_USEDEFAULT, Frm.Handle.ToInt32, 0, _
GetModuleHandle(Nothing), 0)
intResult = GetLastError()
SetWindowPos(hWndTT, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or _
SWP_NOSIZE Or SWP_NOACTIVATE)
Catch ex As Exception
End Try
End Sub
Public Sub AddTool(ByRef Ctl As Control, _
ByVal Flags As ToolFlagConstants, Optional ByVal Text As
String= "")
Try
Dim Info As TOOLINFO
If hWndTT = 0 Then Return
Info.cbSize = Len(Info)
Info.uFlags = Flags
If Not (Flags And ToolFlagConstants.tfTrack) Then
Info.uFlags = Info.uFlags Or TTF_SUBCLASS
End If
Info.uFlags = Info.uFlags Or TTF_IDISHWND
Info.hwnd = Ctl.Parent.Handle.ToInt32
Info.hInst = 0
Info.uID = Ctl.Handle.ToInt32 ' Ctl.hwnd
If Len(Text) > 0 Then
Info.lpszText = Text
End If
SendMessage(hWndTT, TTM_ADDTOOL, 0, Info)
Catch ex As Exception
End Try
End Sub
Public Sub Destroy()
If hWndTT <> 0 Then DestroyWindow(hWndTT)
End Sub
End Class
The class is called like this:
VB:
Dim cToolTips As New clsToolTips
cToolTips.Create(Me, _
clsBalloonTips.TooltipFlagConstants.ttfBalloon Or _
clsBalloonTips.TooltipFlagConstants.ttfAlwaysTip)
cToolTips.AddTool(button1, "Hello ya")
I debugged the code and the error occurs at the marked line.
CreateWindow returns 0, GetLastError returns 1407 (class not found). I
suppose passing the class string does not work? How to fix it?
Thanks in advance,
Stefan
--
___________________________________www.VBTricks.de .vu
the free resource for Visual Basic, Gambas and Pascal
components, tips & complete projects
www: http://www.VBTricks.de.vu
mail: vbtricks <at> gmx <dot> net
__________________________________________________ ___
