MinMax

'aufbauend auf Microsoft Knowledgebase Article ID Q185733 Const maxanz = 20 'Maximale Anzahl gleichzeitig geöffneter Formen Dim minmaxz% Dim hwnd&(maxanz) Dim x1%(maxanz), y1%(maxanz), x2%(maxanz), y2%(maxanz) Dim lpPrevWndProc&(maxanz) 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 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) Private Function WindowProc(ByVal hw&, ByVal uMsg&, ByVal wParam&, ByVal lParam&) As Long i% = getminmaxindex%(hw&) If i% = 0 Then MsgBox "Assert": Exit Function 'sollte nie eintreten If uMsg& = WM_GETMINMAXINFO Then Dim MinMax As MINMAXINFO CopyMemoryToMinMaxInfo MinMax, lParam&, Len(MinMax) MinMax.ptMinTrackSize.x = x1%(i%) MinMax.ptMinTrackSize.y = y1%(i%) MinMax.ptMaxTrackSize.x = x2%(i%) MinMax.ptMaxTrackSize.y = y2%(i%) CopyMemoryFromMinMaxInfo lParam&, MinMax, Len(MinMax) WindowProc = DefWindowProc(hw&, uMsg&, wParam&, lParam&) Else WindowProc = CallWindowProc(lpPrevWndProc&(i%), hw&, uMsg&, wParam&, lParam&) End If End Function Private Function getminmaxindex%(h&) getminmaxindex% = 0 For n% = i% To minmaxz% If hwnd&(n%) = h& Then getminmaxindex% = n%: Exit For Next End Function Public Sub MinMaxUnload(h&) i% = getminmaxindex%(h&): If i% = 0 Then Exit Sub SetWindowLong h&, GWL_WNDPROC, lpPrevWndProc&(i%) minmaxz% = minmaxz% - 1 For n% = i% To minmaxz% x1%(n%) = x1%(n% + 1): y1%(n%) = y1%(n% + 1) x2%(n%) = x2%(n% + 1): y2%(n%) = y2%(n% + 1) hwnd&(n%) = hwnd&(n% + 1) lpPrevWndProc&(n%) = lpPrevWndProc&(n% + 1) Next End Sub Public Sub MinMaxInit(h&, xx1%, yy1%, xx2%, yy2%) If minmaxz% = maxanz Then Exit Sub minmaxz% = minmaxz% + 1 x1%(minmaxz%) = xx1%: y1%(minmaxz%) = yy1%: x2%(minmaxz%) = xx2%: y2%(minmaxz%) = yy2% hwnd&(minmaxz%) = h& lpPrevWndProc&(minmaxz%) = SetWindowLong(h&, GWL_WNDPROC, AddressOf WindowProc) End Sub