'In a Bas Module
' [url]http://matthart.com[/url]
Public Type CWPSTRUCT
lParam As Long
wParam As Long
message As Long
hwnd As Long
End Type
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public 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
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public 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
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Const WH_CALLWNDPROC = 4
Public Const WM_INITDIALOG = &H110
Public Const GWL_WNDPROC = (-4)
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public lWndProc As Long
Public hHook As Long, lHookWndProc As Long
Public Function AppHook(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim CWP As CWPSTRUCT
CopyMemory CWP, ByVal lParam, Len(CWP)
Select Case CWP.message
Case WM_INITDIALOG
lWndProc = SetWindowLong(CWP.hwnd, GWL_WNDPROC, AddressOf Dlg_WndProc)
AppHook = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
UnhookWindowsHookEx hHook
hHook = 0
Exit Function
End Select
AppHook = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
End Function
Public Function Dlg_WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case Msg
Case WM_INITDIALOG
Dim R As RECT, x As Long, y As Long
GetWindowRect hwnd, R
x = (Form1.Left \ Screen.TwipsPerPixelX + (Form1.Width \ Screen.TwipsPerPixelX - (R.Right - R.Left)) \ 2)
y = (Form1.Top \ Screen.TwipsPerPixelY + (Form1.Height \ Screen.TwipsPerPixelY - (R.Bottom - R.Top)) \ 2)
SetWindowPos hwnd, 0, x, y, 0, 0, SWP_NOSIZE Or SWP_NOACTIVATE
SetWindowLong hwnd, GWL_WNDPROC, lWndProc
End Select
Dlg_WndProc = CallWindowProc(lWndProc, hwnd, Msg, wParam, lParam)
End Function
'on the form with the common dialog control
Private Sub Command1_Click()
' [url]http://matthart.com[/url]
'
' This sample shows the how to use subclassing to process the
' dialog messages and move the dialog.
'
' It's actually a bit easier if you use the API common dialog
' functions rather than the control. You can specify a callback
' procedure when you create the dialog rather than having to mess
' with hooking the application so that you can watch for the
' dialog to receive the WM_INITDIALOG message.
'
' However, you can see that I immediately unhook and unsubclass
' the application as soon as I finish processing the needed
' message. That leaves nothing "messy" hanging around. I do double
' check that the hook is released in case there was some kind
' of error attempting to create the dialog.
'
' There's also another way to do it - use the DWL_DLGPROC to
' set a pointer to a dialog box procedure. However, I found that
' using this method doesn't seem to work very well with VB's
' common dialog control.
'
' Note that this sample [sort of] uses the method I created for
' my "setting windows styles" article in Visual Basic Programmer's
' Journal - an application hook to watch for messages as an object
' is being created.
hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf AppHook, App.hInstance, App.ThreadID)
CommonDialog1.ShowPrinter
If hHook Then UnhookWindowsHookEx hHook
End Sub