winsize.bas

本软件为免费软件

Attribute VB_Name = "WinSize"
Option Explicit
Public OldWindowProc As Long

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
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 Const WM_GETMINMAXINFO = &H24


Type POINTAPI
     X As Long
     Y As Long
End Type


Type MINMAXINFO
        ptReserved As POINTAPI
        ptMaxSize As POINTAPI
        ptMaxPosition As POINTAPI
        ptMinTrackSize As POINTAPI
        ptMaxTrackSize As POINTAPI
End Type
Public Function SubClass1_WndMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
    
    If Msg = WM_GETMINMAXINFO Then

        Dim MinMax As MINMAXINFO
        

        CopyMemory MinMax, ByVal lp, Len(MinMax)

        MinMax.ptMinTrackSize.X = 12000 \ Screen.TwipsPerPixelX
        MinMax.ptMinTrackSize.Y = (9000 - 195) \ Screen.TwipsPerPixelY
        MinMax.ptMaxTrackSize.X = Screen.Width \ Screen.TwipsPerPixelX \ 2
        MinMax.ptMaxTrackSize.Y = 9000 \ Screen.TwipsPerPixelY - 195

        CopyMemory ByVal lp, MinMax, Len(MinMax)

        SubClass1_WndMessage = 1
        Exit Function
                
    End If
        
    SubClass1_WndMessage = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)
        
End Function