I've stumbled upon this thread linked from a post in the main VB6 forum. I think it's an excellent candidate to take advantage of VB6's ability to pass UDT parameters as pointers thus eliminating the need for the double CopyMemory of the MINMAXINFO structure. The same idea can address Victor's concern about the double subclassing by passing "dwRefData" as a pointer to a UDT. Thus the "MinMaxSize_Proc" function could be written like this:
Here's the complete code to paste in a new project with a Form1.frm a Module1.bas:Code:Private Function MinMaxSize_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, lParam As MINMAXINFO, ByVal uIdSubclass As Long, dwRefData As MinMaxSize) As Long
Form1.frm
Module1.basCode:Option Explicit Private tMinMaxSize As MinMaxSize Private Sub Form_Load() With tMinMaxSize .MinWidth = 300: .MinHeight = 400: .MaxWidth = 500: .MaxHeight = 600 End With SubclassFormMinMaxSize Me, tMinMaxSize Me.Top = (Screen.Height - Me.Height) / 2 Me.Left = (Screen.Width - Me.Width) / 2 End Sub
Code:Option Explicit Public Type MinMaxSize MinWidth As Long MaxWidth As Long MinHeight As Long MaxHeight As Long End Type Private Const WM_DESTROY As Long = &H2&, WM_UAHDESTROYWINDOW As Long = &H90&, WM_GETMINMAXINFO As Long = &H24& Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long Private Declare Function NextSubclassProcOnChain Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public 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 Private Sub SubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional dwRefData As Long) Call SetWindowSubclass(hWnd, AddressOf_ProcToSubclass, hWnd, dwRefData) End Sub Private Sub UnSubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long) Call RemoveWindowSubclass(hWnd, AddressOf_ProcToSubclass, hWnd) End Sub Public Sub SubclassFormMinMaxSize(frm As VB.Form, tMinMaxSize As MinMaxSize) With tMinMaxSize If .MinWidth > .MaxWidth And .MaxWidth <> 0 Then .MaxWidth = .MinWidth If .MinHeight > .MaxHeight And .MaxHeight <> 0 Then .MaxHeight = .MinHeight End With SubclassSomeWindow frm.hWnd, AddressOf MinMaxSize_Proc, VarPtr(tMinMaxSize) End Sub Private Function MinMaxSize_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, lParam As MINMAXINFO, ByVal uIdSubclass As Long, dwRefData As MinMaxSize) As Long Select Case uMsg Case WM_DESTROY, WM_UAHDESTROYWINDOW ' Allows for IDE stop button UnSubclassSomeWindow hWnd, AddressOf Module1.MinMaxSize_Proc MinMaxSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, VarPtr(lParam)) Exit Function Case WM_GETMINMAXINFO With dwRefData If .MinWidth Then lParam.ptMinTrackSize.X = .MinWidth If .MinHeight Then lParam.ptMinTrackSize.Y = .MinHeight If .MaxWidth Then lParam.ptMaxTrackSize.X = .MaxWidth If .MaxHeight Then lParam.ptMaxTrackSize.Y = .MaxHeight End With Exit Function End Select MinMaxSize_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, VarPtr(lParam)) End Function




Reply With Quote