SubClassing to limit min. size for Access main window (Part II)

M

Max Moor

Hi All,

I'm trying to limit the minimum size of the main Access application
window. I'm using Access 2002.

Microsoft KB article #185733 shows some subclassing code to accomplish
this, and it's even in VB! I copied the code. If I pass the main Access
window's handle (Application.hWndAccessApp) to it from a form's load event
sub, it works! Sort of.

It runs perfectly, for about 10 seconds. I can resize the Access
window, and it stops shrinking where I set it to stop. After a short time,
Access just freezes up. No life. If I do a control break, then end,
Access closes.

I'm certainly no expert at API subclassing, but I don't see anything
suspicious in the code. Are there any subclassing fans out there that
would be willing to give this a try and help figure out what might be
wrong?

The knowledge base article is at:

http://support.microsoft.com/kb/185733



In a standard module...

Option Compare Database
Option Explicit


Private Const GWL_WNDPROC = -4
Private Const WM_GETMINMAXINFO = &H24

Private Type POINTAPI
x As Long
y As Long
End Type

Private Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type

Global lpPrevWndProc As Long
Global gHW As Long

Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam
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 SetWindowLong Lib "user32" Alias "SetWindowLongA"
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Sub CopyMemoryToMinMaxInfo Lib "KERNEL32" Alias
"RtlMoveMemory" (hpvDest As MINMAXINFO, ByVal hpvSource As Long, ByVal
cbCopy As Long)
Private Declare Sub CopyMemoryFromMinMaxInfo Lib "KERNEL32" Alias
"RtlMoveMemory" (ByVal hpvDest As Long, hpvSource As MINMAXINFO, ByVal
cbCopy As Long)

Public Sub Hook()
'Start subclassing.
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub Unhook()
Dim temp As Long

'Cease subclassing.
temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
End Sub


Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As
Long, ByVal lParam As Long) As Long

Dim MinMax As MINMAXINFO


'Check for request for min/max window sizes.
If (uMsg = WM_GETMINMAXINFO) Then

'Retrieve default MinMax settings
CopyMemoryToMinMaxInfo MinMax, lParam, Len(MinMax)

'Specify new minimum size for window.
MinMax.ptMinTrackSize.x = 600
MinMax.ptMinTrackSize.y = 600

'Specify new maximum size for window.
MinMax.ptMaxTrackSize.x = 1280
MinMax.ptMaxTrackSize.y = 960

'Copy local structure back.
CopyMemoryFromMinMaxInfo lParam, MinMax, Len(MinMax)

WindowProc = DefWindowProc(hw, uMsg, wParam, lParam)
Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam,
lParam)
End If

End Function



In a form module...

Private Sub Form_Load()

gHW = Application.hWndAccessApp

Hook

End Sub

Private Sub Form_Unload(Cancel As Integer)
Unhook
End Sub


I'm so close. Any advice would be greatly appreciated.

Regards,
Max
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top