最大・最小サイズを設定する

● 最大・最小サイズを設定する ●

作ったツールでウィンドウ・プロシージャを使用している場合、そのついでにウィンドウのサイズを限定してしまう処理を入れてみてもいいんじゃない。特に最小ウィンドウサイズの限定はそれなりに有用であると個人的には思っている。

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

'デフォルトのウィンドウ･プロシージャを呼ぶ
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 Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'メモリコピー
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)

Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_GETMINMAXINFO = &H24  'ウィンドウサイズ情報

Public OldWindowhWnd As Long

'-----------------------------------------------------------------------
' 関数名 ： SubClass
' 機能   ： サブクラス化を開始する
' 引数   ： (in) hWnd  … コールバック対象となるウインドウのハンドル
' 戻り値 ： なし
'-----------------------------------------------------------------------
Public Function SubClass(ByVal hWnd As Long) As Long
    OldWindowhWnd = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
    SubClass = OldWindowhWnd
End Function


'-----------------------------------------------------------------------
' 関数名 ： UnSubClass
' 機能   ： サブクラス化を終了する
' 引数   ： (in) hWnd  … コールバック対象となるウインドウのハンドル
' 戻り値 ： なし
'-----------------------------------------------------------------------
Public Sub UnSubClass(ByVal hWnd As Long)
    Dim FuncRet As Long

    If OldWindowhWnd <> 0 Then
        '元のプロシージャアドレスに設定する
        FuncRet = SetWindowLong(hWnd, GWL_WNDPROC, OldWindowhWnd)
        OldWindowhWnd = 0
    End If
End Sub


'-----------------------------------------------------------------------
' 関数名：WindowProc
' 機  能：いわずとしれたウインドウプロシージャ
'-----------------------------------------------------------------------
Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
                      ByVal wParam As Long, ByVal lParam As Long) As Long

    Dim udtMinMax As MINMAXINFO

    Select Case uMsg
        Case WM_GETMINMAXINFO
            'アドレスより構造体取得
            Call CopyMemory(udtMinMax, ByVal lParam, Len(udtMinMax))

            With udtMinMax
                .ptMinTrackSize.X = 200 '横の最小サイズ
                .ptMinTrackSize.Y = 200 '縦の最小サイズ
                .ptMaxTrackSize.X = 600 '横の最大サイズ
                .ptMaxTrackSize.Y = 400 '縦の最大サイズ
                .ptMaxPosition.X = 10   '最大化されたときのＸ座標
                .ptMaxPosition.Y = 10   '最大化されたときのＹ座標
                .ptMaxSize.X = 130      '最大化されたときの幅
                .ptMaxSize.Y = 190      '最大化されたときの高さ
            End With

            '値を設定した構造体をlParamに設定
            Call CopyMemory(ByVal lParam, udtMinMax, Len(udtMinMax))

            WindowProc = 0&
            Exit Function
    End Select

    WindowProc = CallWindowProc(OldWindowhWnd, hWnd, uMsg, wParam, lParam)

End Function

あとは例によって以下の実装。

Private Sub Form_Load()

    'サブクラス化開始
    Call SubClass(Me.hWnd)

End Sub

Private Sub Form_Unload(Cancel As Integer)

    'サブクラス化終了
    Call UnSubClass(Me.hWnd)

End Sub

戻る