VB Forum / COM / July 2005

"Jason Kontkanen" <trash@ipdas.com>'s wild thoughts were
released on Thu, 14 Jul 2005 16:51:35 -0400 bearing the
following fruit:

Seriously, have you even looked at the code for this
usercontrol?

What's wrong with checking the caption in the CAPTION
propery let?

J

Jan Hyde (VB MVP)

I don't know if this will help... I wanted to force a form to be modal from
an activex exe... this is was only possible by "hooking" windows message
loop... You may be able to do this to get at events before they happen in
VB... I'm No guru at this as I found a perfect sample on-line for what I
needed... This may get you going in the right direction... (search on-line
for this information as I forgot exactly were I found it...)

[form1.frm]

Private Sub Form_Initialize()

If ForceShowInTaskBar Then HookAttach

End Sub

Private Sub Form_Load()

If ForceShowInTaskBar Then HookDetach

End Sub

[startup.bas]

Option Explicit

Dim m_ForceShowInTaskbar As Boolean

'*** hooks ****

Const WH_CALLWNDPROC = 4

' Misc Windows Messages
Const WM_CREATE = &H1
Const WM_DESTROY = &H2
Const WM_PARENTNOTIFY = &H210

'Misc Windows Windows
Const C_MDIFORMCLASS_IDE = "ThunderMDIForm"
Const C_MDIFORMCLASS_EXE = "ThunderRT6MDIForm"
Const C_MDIFORMCLASS5_IDE = "ThunderMDIForm"
Const C_MDIFORMCLASS5_EXE = "ThunderRT5MDIForm"
Const C_FORMCLASS_IDE_DC = "ThunderFormDC"
Const C_FORMCLASS_EXE_DC = "ThunderRT6FormDC"
Const C_FORMCLASS_IDE = "ThunderForm"
Const C_FORMCLASS_EXE = "ThunderRT6Form"
Const C_FORMCLASS5_IDE = "ThunderForm"
Const C_FORMCLASS5_EXE = "ThunderRT5Form"

' Extended Window Styles
Const WS_EX_DLGMODALFRAME = &H1&
Const WS_EX_NOPARENTNOTIFY = &H4&
Const WS_EX_TOPMOST = &H8&
Const WS_EX_ACCEPTFILES = &H10&
Const WS_EX_TRANSPARENT = &H20&
Const WS_EX_APPWINDOW = &H40000
Const WS_EX_TOOLWINDOW = &H80&
Const GWL_EXSTYLE = (-20)
Const GWL_WNDPROC = (-4)

Private Type CWPSTRUCT
   lParam As Long
   wParam As Long
   message As Long
   hwnd As Long
End Type

Private Type CREATESTRUCT
   lpCreateParams As Long
   hInstance As Long
   hMenu As Long
   hWndParent As Long
   cy As Long
   cx As Long
   y As Long
   x As Long
   style As Long
   lpszName As Long    ' String
   lpszClass As Long   ' String
   ExStyle As Long
End Type

Dim m_hHook As Long
Dim m_lHookWndProc As Long

'*******************
Dim ScanViewUI As clsScanViewUI
Dim CommonUI As ICommonUI

'*** hooks ***

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 GetClassName Lib "user32" Alias "GetClassNameA"
(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount 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 CallNextHookEx Lib "user32" (ByVal hHook As Long,
ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA"
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA"
(ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal
wParam As Long, ByVal lParam As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As
Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(Destination As Any, Source As Any, ByVal Length As Long)

Sub Main()

Do

 If App.StartMode = vbSModeAutomation Then Exit Do

 Set ScanViewUI = New clsScanViewUI

 ScanViewUI.mode = svmScanView

 Set CommonUI = ScanViewUI

 CommonUI.Show vbModal

Loop Until True

End Sub

'*** hooks ***

' 05/04/2005 Wendell Buckner
'  Have the ability to display the modal window in the taskbar...

Property Get ForceShowInTaskBar() As Boolean
ForceShowInTaskBar = m_ForceShowInTaskbar
End Property

Property Let ForceShowInTaskBar(ByVal NewForceInTaskbar As Boolean)
m_ForceShowInTaskbar = NewForceInTaskbar
End Property

Public Sub HookAttach()
  m_hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf AppHook,
App.hInstance, App.ThreadID)
  Debug.Assert m_hHook <> 0
End Sub

Public Sub HookDetach()
  If m_hHook <> 0 Then
     UnhookWindowsHookEx m_hHook
     m_hHook = 0
  End If
End Sub

Private Function Form_WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal
wParam As Long, ByVal lParam As Long) As Long
Dim lSetStyleEX As Long
  ' SPM - specific wnd proc for a form.  Only called once for the WM_CREATE
message.
  Select Case Msg
  Case WM_CREATE
     Dim tCS As CREATESTRUCT
     CopyMemory tCS, ByVal lParam, Len(tCS)
     lSetStyleEX = GetWindowLong(hwnd, GWL_EXSTYLE)
     lSetStyleEX = lSetStyleEX Or WS_EX_APPWINDOW
     lSetStyleEX = lSetStyleEX And (Not WS_EX_TOOLWINDOW)
     tCS.ExStyle = lSetStyleEX
     CopyMemory ByVal lParam, tCS, Len(tCS)
     SetWindowLong hwnd, GWL_WNDPROC, m_lHookWndProc
     SetWindowLong hwnd, GWL_EXSTYLE, tCS.ExStyle
  End Select
  Form_WndProc = CallWindowProc(m_lHookWndProc, hwnd, Msg, wParam, lParam)
End Function

Private Function IsIn(ByVal vComp As Variant, ParamArray vTo() As Variant)
As Boolean
Dim i As Long, iL As Long, iU As Long
  On Error Resume Next
  iU = UBound(vTo)
  If Err.Number = 0 Then
     iL = LBound(vTo)
     For i = iL To iU
        If vComp = vTo(i) Then
           IsIn = True
           Exit Function
        End If
     Next i
  End If
End Function

Private Function AppHook(ByVal idHook As Long, ByVal wParam As Long, ByVal
lParam As Long) As Long
Dim CWP As CWPSTRUCT
Dim k As Long, aClass As String

  If idHook >= 0 Then
     CopyMemory CWP, ByVal lParam, Len(CWP)
     Select Case CWP.message
     Case WM_CREATE
         aClass = Space$(128)
         k = GetClassName(CWP.hwnd, ByVal aClass, 128)
         aClass = Left$(aClass, k)
         If IsIn(aClass, C_MDIFORMCLASS_IDE, C_MDIFORMCLASS_EXE,
C_MDIFORMCLASS5_IDE, _
             C_MDIFORMCLASS5_EXE, C_FORMCLASS_IDE_DC, C_FORMCLASS_EXE_DC,
C_FORMCLASS_IDE, _
             C_FORMCLASS_EXE, C_FORMCLASS5_IDE, C_FORMCLASS5_EXE) Then
            m_lHookWndProc = SetWindowLong(CWP.hwnd, GWL_WNDPROC, AddressOf
Form_WndProc)
         End If
     End Select
  End If
  AppHook = CallNextHookEx(m_hHook, idHook, wParam, ByVal lParam)
End Function