'-----------------------------------------
'****************************************************
'Author: Nguyen Duy Tuan - duytuan@bluesofts.net
'Tel: 0904.210.337
'website: www.bluesofts.net
' www.atoolspro.com
'****************************************************
Option Explicit
Private Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_THICKFRAME = &H40000
Private Const WS_SIZEBOX = WS_THICKFRAME
Private Const WM_SETICON = &H80
Private Const WM_SETTEXT As Long = &HC
'Private Const WS_MAXIMIZE = &H1000000
'Private Const WS_MINIMIZE = &H20000000
'
'Private Const SW_ERASE = &H4
'Private Const SW_HIDE = 0
'Private Const SW_INVALIDATE = &H2
'Private Const SW_MAX = 10
'Private Const SW_MAXIMIZE = 3
'Private Const SW_MINIMIZE = 6
'Private Const SW_NORMAL = 1
'Private Const SW_OTHERUNZOOM = 4
'Private Const SW_OTHERZOOM = 2
'Private Const SW_PARENTCLOSING = 1
'Private Const SW_PARENTOPENING = 3
'Private Const SW_RESTORE = 9
'Private Const SW_SCROLLCHILDREN = &H1
'Private Const SW_SHOW = 5
'Private Const SW_SHOWDEFAULT = 10
'Private Const SW_SHOWMAXIMIZED = 3
'Private Const SW_SHOWMINIMIZED = 2
'Private Const SW_SHOWMINNOACTIVE = 7
'Private Const SW_SHOWNA = 8
'Private Const SW_SHOWNOACTIVATE = 4
'Private Const SW_SHOWNORMAL = 1
#If VBA7 Then
Private Declare PtrSafe Function DefWindowProcW Lib "user32" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal nCmdShow As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As LongPtr, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam 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 ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
Dim PrevStyle&
Dim OldWidth As Double, OldHeight As Double
Dim AllowResize As Boolean
Private Sub UserForm_Initialize()
#If VBA7 Then
Dim lngIcon As LongPtr
Dim lnghWnd As LongPtr
#Else
Dim lngIcon As Long
Dim lnghWnd As Long
#End If
Dim sUniText As String
'----------------------------------------------
AllowResize = True
OldWidth = Width
OldHeight = Height
If Val(Application.Version) < 9 Then
lnghWnd = FindWindow("ThunderXFrame", Caption) 'XL97
Else
lnghWnd = FindWindow("ThunderDFrame", Caption) 'XL2000
End If
PrevStyle = GetWindowLong(lnghWnd, GWL_STYLE)
SetWindowLong lnghWnd, GWL_STYLE, PrevStyle Or WS_SIZEBOX Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
'----------------------------------------------
#If VBA7 Then
lngIcon = ExtractIcon(Application.HinstancePtr, Application.Path & "\Excel.exe", 0) ' HinstancePtr
#Else
lngIcon = ExtractIcon(Application.Hinstance, Application.Path & "\Excel.exe", 0) ' HinstancePtr
#End If
' SendMessage lnghWnd, WM_SETICON, True, lngIcon
SendMessage lnghWnd, WM_SETICON, False, lngIcon
sUniText = "Caption hi" & ChrW(7875) & "n th" & ChrW(7883) & " Ti" & ChrW(7871) & "ng Vi" & ChrW(7879) & "t"
DefWindowProcW lnghWnd, WM_SETTEXT, 0, StrPtr(sUniText)
' SetUniText Me, "Caption hi" & ChrW(7875) & "n th" & ChrW(7883) & " Ti" & ChrW(7871) & "ng Vi" & ChrW(7879) & "t"
End Sub