Userform as childwindow in statusbar not redrawn when Excel window is resized
Objective with this is to put the form in the Statusbar and solve the
problem described previously when Excel is minimized. Thanks are due to Karl
Peterson for the suggestion of the CBTProc as a way to trap Excel's Min/Max
events (many others too if needed, like resize, app activate/deactivate,
etc)
This is experimental to say the least, so test thoroughly. Code in a normal
module and in a form, with a button in top left corner. Also put two Forms
buttons on a sheet and assign macro to ShowForm & CloseFrm respectively. The
form must be shown modeless and unless you put a visible button in the form
(ie that will appear in the statusbar) with Unload Me you'll have no other
way to close the form.
Probably best also to call CloseFrm from the BeforeClose event
' Normal module
Option Explicit
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, ByVal lpfn As Long, ByVal hMod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" ( _
ByVal hHook As Long, ByVal nCode As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib _
"user32" (ByVal hHook As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Const WH_CBT = 5
' CBT Hook Codes
'Private Const HCBT_MOVESIZE = 0
Private Const HCBT_MINMAX = 1
'Private Const HCBT_QS = 2
'Private Const HCBT_CREATEWND = 3
'Private Const HCBT_DESTROYWND = 4
'Private Const HCBT_ACTIVATE = 5
'Private Const HCBT_CLICKSKIPPED = 6
'Private Const HCBT_KEYSKIPPED = 7
'Private Const HCBT_SYSCOMMAND = 8
'Private Const HCBT_SETFOCUS = 9
' Window State Values
Private Const SW_MAXIMIZE = 3
Private Const SW_MINIMIZE = 6
Private Const SW_RESTORE = 9
Private m_hHook As Long
Public ghWndForm As Long
Public ghWndBar As Long
Public gHwndApp As Long
Private mbIsMinimized As Boolean
Private mFrm As UserForm1
Sub ShowForm()
Application.DisplayStatusBar = True
gHwndApp = Application.hWnd ' need FindWindow XLMAIN in Excel 2000
Set mFrm = New UserForm1
mFrm.Show vbModeless
HookCBT
End Sub
Sub CloseFrm()
UnhookCBT
On Error Resume Next
If Not mFrm Is Nothing Then
Unload mFrm
End If
Set mFrm = Nothing
End Sub
Public Sub HookCBT()
Call UnhookCBT
m_hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, 0&,
GetCurrentThreadId())
End Sub
Public Sub UnhookCBT()
If m_hHook Then
Call UnhookWindowsHookEx(m_hHook)
m_hHook = 0
End If
End Sub
Private Function CBTProc(ByVal nCode As Long, ByVal wParam As Long, ByVal
lParam As Long) As Long
Dim bIsMin As Boolean, b As Boolean
Dim nRet As Long
On Error Resume Next
b = Len(mFrm.Caption)
On Error GoTo 0
If b And (wParam = gHwndApp) Then
If nCode = HCBT_MINMAX Then
If WordLo(lParam) = SW_MINIMIZE Then
bIsMin = True
Else
bIsMin = False
End If
If bIsMin < mbIsMinimized Then
mbIsMinimized = bIsMin
mFrm.AttachToBar (Not mbIsMinimized)
If bIsMin Then
mFrm.Hide
Else
mFrm.Show vbModeless
' mFrm.PosForm
End If
End If
End If
End If
CBTProc = CallNextHookEx(m_hHook, nCode, wParam, lParam)
End Function
Private Function WordLo(ByVal LongIn As Long) As Integer
' Low word retrieved by masking off high word.
' If low word is too large, twiddle sign bit.
If (LongIn And &HFFFF&) &H7FFF Then
WordLo = (LongIn And &HFFFF&) - &H10000
Else
WordLo = LongIn And &HFFFF&
End If
End Function
'' end normal module
' Userform
' put a fairly thin button at top left of the form
Option Explicit
Private Declare Function SetParent Lib "user32" ( _
ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long
Private Declare Function GetParent Lib "user32.dll" ( _
ByVal hWnd 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 FindWindowEx Lib "user32" _
Alias "FindWindowExA" ( _
ByVal hwndParent As Long, _
ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) 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 GetWindowLong Lib "user32" Alias _
"GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As
Long
Private Const GWL_HWNDPARENT As Long = -8
Private Const GWL_STYLE As Long = -16
Private Const GWL_EXSTYLE As Long = -20
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_EX_WINDOWEDGE As Long = &H100
Private mhWndForm As Long
Private mhWndBar As Long
Private mVer As Long
Dim mbOnBar As Boolean
Private Sub RemoveTitleBar()
Dim lStyle As Long
' remove title
lStyle = GetWindowLong(ghWndForm, GWL_STYLE)
lStyle = lStyle And Not WS_CAPTION
SetWindowLong ghWndForm, GWL_STYLE, lStyle
' remove frame
lStyle = GetWindowLong(ghWndForm, GWL_EXSTYLE)
lStyle = lStyle And WS_EX_WINDOWEDGE
SetWindowLong ghWndForm, GWL_EXSTYLE, lStyle
DrawMenuBar ghWndForm
End Sub
Public Sub AttachToBar(bToBar As Boolean)
Dim hWndP As Long, res As Long
If bToBar Then hWndP = mhWndBar Else hWndP = Application.hWnd
res = SetParent(ghWndForm, hWndP)
res = SetWindowLong(ghWndForm, GWL_HWNDPARENT, hWndP)
End Sub
Public Sub PosForm()
Me.Move (-Application.Left * 2 + 60)
Me.Height = 16
If mVer = 12 Then
Me.Top = 0
Else
Me.Top = -3
End If
End Sub
Private Sub CommandButton1_Click()
' Unload Me
MsgBox "Hello from Status Bar"
End Sub
Private Sub UserForm_Activate()
PosForm
End Sub
Private Sub UserForm_Initialize()
Dim sBarClass As String
Me.Caption = Now
ghWndForm = FindWindow("ThunderDFrame", Me.Caption)
Me.Caption = ghWndForm
mVer = Val(Application.Version)
If mVer = 12 Then
sBarClass = "EXCEL2"
Else
sBarClass = "EXCEL4"
End If
' Assumes 2002+
mhWndBar = FindWindowEx(Application.hWnd, 0&, sBarClass, vbNullString)
RemoveTitleBar
AttachToBar True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
UnhookCBT
End Sub
'''''''' end Userform
You may notice I changed some aspects of your API code.
Regards,
Peter T
"minimaster" wrote in message
...
I can confirm the problem with the minimized excel window. A rigth
click on the taskbar entry and then "restore" brings it back without
VBE/taskmanager involvement. Still not pretty at all. Another reason
to look at how to hook into the main excel window events.
|