View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Peter T Peter T is offline
external usenet poster
 
Posts: 5,600
Default 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.