Balloon-Tooltips (CreateWindow fails)

[VBTricks.de.vu Webmaster]

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
_____________________________________________________

 

[m.posseth]

Well here is a working class gthat does exactly what you want

atached and here in copy paste code


Option Explicit On

Option Strict On

Imports System.Runtime.InteropServices

Public Class Balloon

<StructLayout(LayoutKind.Sequential)> _

Public Structure NOTIFYICONDATA

Public cbSize As Int32

Public hwnd As IntPtr

Public uID As Int32

Public uFlags As Int32

Public uCallbackMessage As IntPtr

Public hIcon As IntPtr

<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=128)> _

Public szTip As String

Public dwState As Int32

Public dwStateMask As Int32

<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=256)> _

Public szInfo As String

Public uTimeout As Int32

<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=64)> _

Public szInfoTitle As String

Public dwInfoFlags As Int32

End Structure

Public Const NIF_MESSAGE As Int32 = &H1

Public Const NIF_ICON As Int32 = &H2

Public Const NIF_STATE As Int32 = &H8

Public Const NIF_INFO As Int32 = &H10

Public Const NIF_TIP As Int32 = &H4

Public Const NIM_ADD As Int32 = &H0

Public Const NIM_MODIFY As Int32 = &H1

Public Const NIM_DELETE As Int32 = &H2

Public Const NIM_SETVERSION As Int32 = &H4

Public Const NOTIFYICON_VERSION As Int32 = &H5

Public Const NIIF_ERROR As Int32 = &H3

Public Const NIIF_INFO As Int32 = &H1

Public Const NIIF_NONE As Int32 = &H0

Public Const NIM_SETFOCUS As Int32 = &H3

Public Enum BalloonMessageType

None = &H0

Info = &H1

[Error] = &H3

End Enum

Shared Sub NotifyBalloon(ByRef ntfyIcon As NotifyIcon, ByVal Title As
String, ByVal Info As String, ByVal Type As BalloonMessageType, ByVal
Timeout As Integer)

Dim t As Type = GetType(NotifyIcon)

Dim window As IntPtr = (CType(t.GetField("window",
System.Reflection.BindingFlags.Instance Or
System.Reflection.BindingFlags.NonPublic).GetValue(ntfyIcon),
NativeWindow)).Handle

Dim id As Int32 = CType(t.GetField("id",
System.Reflection.BindingFlags.Instance Or
System.Reflection.BindingFlags.NonPublic).GetValue(ntfyIcon), Integer)

Dim uNIF As NOTIFYICONDATA

uNIF.cbSize = 0

uNIF.dwInfoFlags = 0

uNIF.dwState = 0

uNIF.dwStateMask = 0

uNIF.hIcon = IntPtr.Zero

uNIF.szTip = ""

uNIF.uCallbackMessage = New IntPtr(&H200)

uNIF.szInfoTitle = Title

uNIF.uTimeout = Timeout

uNIF.hwnd = window

uNIF.uID = id

uNIF.dwInfoFlags = CType(Type, Int32)

uNIF.uTimeout = NOTIFYICON_VERSION

uNIF.szInfo = Info

uNIF.uFlags = NIF_INFO

uNIF.cbSize = Marshal.SizeOf(uNIF)

Dim result As Int32 = Shell_NotifyIconA(NIM_MODIFY, uNIF)

End Sub

Private Declare Function Shell_NotifyIconA Lib "shell32" (ByVal dwMessage As
Int32, ByRef pnid As NOTIFYICONDATA) As Int32

End Class



regards



Michel Posseth [MCP]

 

[VBTricks.de.vu Webmaster]

Well,

thanks for the source, but I want the balloon tooltips for my controls
on a form, not for the notify icon.


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
_____________________________________________________

 

[Dragon]

Hi Stefan,

Private Const TOOLTIPS_CLASS As String = "tooltips_class"

Change it to
Private Const TOOLTIPS_CLASS As String = "tooltips_class32"

"tooltips_class" class doesn't exist, so you get error 1407.

A piece of advice: don't use ByRef with Frm and Ctl parameters. It's
redundant.

I hope this helps

Roman

 

[VBTricks.de.vu Webmaster]

Thanks Roman,

CreateWindows succeeds!

To your advice: Am I right in saying that the form/control is delivered
ByRef? I want to write the deliver type explicit to code (you know, your
told to at university...)


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
_____________________________________________________

 

[Dragon]

To your advice: Am I right in saying that the form/control is delivered

ByRef?

If you pass the parameter ByVal, its value gets copied.
If you pass the parameter ByRef, then the pointer to it is created and then
passed to subroutine.

But, reference-type variable (controls etc) is already stored as a pointer,
so:
If you pass it ByVal, this pointer get copied.
If you pass it ByRef, pointer to this pointer is created and passed.

Thus, you can see that passing a reference-type ByVal is similar to passing
value-type ByRef.
But, changes made to ByVal parameter are not passed back, so if you want to
assign it to something else, you need to pass it ByRef. Otherwise, you don't
need it.

I hope I answered your question.