Option Explicit
Option Compare Text
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'******************************************************************************************************
' Declare for the Uni form title
' Added date: 29.11.2010 to test unicode form caption
#If VBA7 Then
Private Declare PtrSafe Function DefWindowProcW Lib "USER32" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "USER32" Alias "FindWindowExW" ( _
ByVal hWnd1 As LongPtr, _
ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As LongPtr, _
ByVal lpsz2 As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowW" (ByVal lpClassName As LongPtr, ByVal lpWindowName As LongPtr) As LongPtr
#Else
Private Declare Function DefWindowProcW Lib "USER32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindowEx Lib "USER32" Alias "FindWindowExW" ( _
ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As Long, _
ByVal lpsz2 As Long) As Long
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowW" (ByVal lpClassName As Long,ByVal lpWindowName As Long) As Long
#End If
'For the Title form
Private Const WM_SETTEXT As Long = &HC
'******************************************************************************************************
Private Const C_USERFORM_CLASSNAME = "ThunderDFrame"
#If VBA7 Then
Private Function HWndOfUserForm(UF As MSForms.UserForm) As LongPtr
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' HWndOfUserForm
' This returns the window handle (HWnd) of the userform referenced
' by UF. it first looks for a top-level window, then a child
' of the Application window, then a child of the ActiveWindow.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim AppHWnd As LongPtr
Dim DeskHWnd As LongPtr
Dim WinHWnd As LongPtr
Dim UFHWnd As LongPtr
Dim Cap As String
Dim WindowCap As String
Cap = UF.Caption
' First, look in top level windows
UFHWnd = FindWindow(StrPtr(C_USERFORM_CLASSNAME), StrPtr(Cap))
If UFHWnd <> 0 Then
HWndOfUserForm = UFHWnd
Exit Function
End If
' Not a top level window. Search for child of application.
AppHWnd = Application.hWnd
UFHWnd = FindWindowEx(AppHWnd, 0, StrPtr(C_USERFORM_CLASSNAME), StrPtr(Cap))
If UFHWnd <> 0 Then
HWndOfUserForm = UFHWnd
Exit Function
End If
' Not a child of the application.
' Search for child of ActiveWindow (Excel's ActiveWindow, not
' Window's ActiveWindow).
If Application.ActiveWindow Is Nothing Then
HWndOfUserForm = 0
Exit Function
End If
WinHWnd = WindowHWnd(Application.ActiveWindow)
UFHWnd = FindWindowEx(WinHWnd, 0&, C_USERFORM_CLASSNAME, Cap)
HWndOfUserForm = UFHWnd
End Function
#Else
Private Function HWndOfUserForm(UF As MSForms.UserForm) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' HWndOfUserForm
' This returns the window handle (HWnd) of the userform referenced
' by UF. it first looks for a top-level window, then a child
' of the Application window, then a child of the ActiveWindow.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim AppHWnd As Long
Dim DeskHWnd As Long
Dim WinHWnd As Long
Dim UFHWnd As Long
Dim Cap As String
Dim WindowCap As String
Cap = UF.Caption
' First, look in top level windows
UFHWnd = FindWindow(StrPtr(C_USERFORM_CLASSNAME), StrPtr(Cap))
If UFHWnd <> 0 Then
HWndOfUserForm = UFHWnd
Exit Function
End If
' Not a top level window. Search for child of application.
AppHWnd = Application.hWnd
UFHWnd = FindWindowEx(AppHWnd, 0, StrPtr(C_USERFORM_CLASSNAME), StrPtr(Cap))
If UFHWnd <> 0 Then
HWndOfUserForm = UFHWnd
Exit Function
End If
' Not a child of the application.
' Search for child of ActiveWindow (Excel's ActiveWindow, not
' Window's ActiveWindow).
If Application.ActiveWindow Is Nothing Then
HWndOfUserForm = 0
Exit Function
End If
WinHWnd = WindowHWnd(Application.ActiveWindow)
UFHWnd = FindWindowEx(WinHWnd, 0&, C_USERFORM_CLASSNAME, Cap)
HWndOfUserForm = UFHWnd
End Function
#End If
#If VBA7 Then
Function WindowHWnd(W As Excel.Window) As LongPtr
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' WindowHWnd
' This returns the HWnd of the Window referenced by W.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim DeskHWnd As LongPtr
Dim WHWnd As LongPtr
Dim Cap As String
DeskHWnd = FindWindowEx(Application.hWnd, 0&, StrPtr(C_EXCEL_DESK_CLASSNAME), 0)
If DeskHWnd > 0 Then
Cap = WindowCaption(W)
WHWnd = FindWindowEx(DeskHWnd, 0&, StrPtr(C_EXCEL_WiNDOW_CLASSNAME), StrPtr(Cap))
End If
WindowHWnd = WHWnd
End Function
#Else
Function WindowHWnd(W As Excel.Window) As Long
Dim AppHWnd As Long
Dim DeskHWnd As Long
Dim WHWnd As Long
Dim Cap As String
AppHWnd = Application.hWnd
DeskHWnd = FindWindowEx(AppHWnd, 0&, StrPtr(C_EXCEL_DESK_CLASSNAME), 0)
If DeskHWnd > 0 Then
Cap = WindowCaption(W)
WHWnd = FindWindowEx(DeskHWnd, 0&, StrPtr(C_EXCEL_WiNDOW_CLASSNAME), StrPtr(Cap))
End If
WindowHWnd = WHWnd
End Function
#End If
Public Sub SetUniText(UF As MSForms.UserForm, ByVal sUniText As String)
' Mo ta: Unicode TitleBar, Frame, Button, CheckBox, Option
' Yeu cau: Frame, Button, CheckBox, Option khong ho tro XP style
' Nguoi viet: thuongall
' Email: thuongall@yahoo.com
' Website: www.caulacbovb.com
#If VBA7 Then
Dim UFHWnd As LongPtr
#Else
Dim UFHWnd As Long
#End If
Dim Wininfo As Long
Dim r As Long
UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then Exit Sub
DefWindowProcW UFHWnd, WM_SETTEXT, &H0&, StrPtr(sUniText)
End Sub
