Access ウィンドウの制御

Last-modified: 2021-12-13 (月) 23:48:38

Win32 API の定義

'Win32 定数
Private Const GWL_STYLE = -16
Private Const HWND_TOP = &H0
Private Const MF_BYCOMMAND = &H0&
Private Const SC_CLOSE = &HF060
Private Const SC_MAXIMIZE = &HF030
Private Const SC_RESTORE = &HF120
Private Const SC_SIZE = &HF000
Private Const SPI_GETWORKAREA As Long = 48
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const WS_MAXIMIZEBOX = &H10000  '最大化ボタン
Private Const WS_MINIMIZEBOX = &H20000  '最小化ボタン
'Win32 メッセージ定数
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
'【ウィンドウ】
'〔ウィンドウの基本的な制御関連〕
'ウィンドウ全体の座標を取得する
Private Declare Function GetWindowRect Lib "user32" ( _
    ByVal hwnd As Long, lpRect As RECT) As Long
'ウィンドウのサイズ、位置、Zオーダーを変更する
Private Declare PtrSafe Function SetWindowPos Lib "user32" _
                                (ByVal hwnd As LongPtr, _
                                 ByVal hWndInsertAfter As LongPtr, _
                                 ByVal X As Long, ByVal Y As Long, _
                                 ByVal cx As Long, ByVal cy As Long, _
                                 ByVal wFlags As Long) As Long
'〔ウィンドウクラス関連〕
'ウィンドウの属性(スタイルなど)の一部を取得する
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
        (ByVal hwnd As Long, ByVal nIndex 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 Function DeleteMenu Lib "user32" _
   (ByVal hMenu As Long, _
   ByVal nPosition As Long, _
   ByVal wFlags As Long) As Long
'メニューバーを再描画する
Private Declare Function DrawMenuBar Lib "user32" _
   (ByVal hwnd As Long) As Long
'ウィンドウメニューのハンドルを取得する
Private Declare PtrSafe Function GetSystemMenu Lib "user32" _
                                (ByVal hwnd As LongPtr, _
                                 ByVal bRevert As Long) As LongPtr
'メニュー項目を削除する
Private Declare PtrSafe Function RemoveMenu Lib "user32" _
                                (ByVal hMenu As LongPtr, _
                                 ByVal nPosition As Long, _
                                 ByVal wFlags As Long) As Long
'〔システム情報関連〕
'システムに関するパラメータを取得する
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" ( _
    ByVal uiAction As Long, _
    ByVal uiParam As Long, _
    pvParam As Any, _
    ByVal fWinIni As Long) As Long
Public Enum AcWinMinMaxButtons
    None = 0        'なし
    MinEnabled = 1  '最小化ボタンのみ
    MaxEnabled = 2  '最大化ボタンのみ
    BothEnabled = 3 '最小化/最大化ボタン
End Enum
Public Enum BorderStyle
    None = 0  'なし
    Thin = 1  '細線
    Sizable = 2 'サイズ調整可
    Dialog = 3 'ダイアログ
End Enum

Access のウィンドウに自動中央寄せを設定する

 'Access ウィンドウの自動中央寄せを設定する。
 Public Property Let AutoCenter(blnAutoCenter As Boolean)
     If blnAutoCenter = False Then
         Exit Property

     End If

     Dim hWnd As Long

     hWnd = Application.hWndAccessApp

     Dim wRect As RECT

     '作業領域(タスクバーを除いた部分)のサイズを取得する
     Call SystemParametersInfo(SPI_GETWORKAREA, 0&, wRect, 0&)

     Dim sRect As RECT

     'スクリーン座標を取得する
     Call GetWindowRect(hWnd, sRect)

     'ウィンドウを移動する
     Call SetWindowPos( _
             hWnd, HWND_TOP, _
             (wRect.Right - wRect.Left - sRect.Right + sRect.Left) / 2, _
             (wRect.Bottom - wRect.Top - sRect.Bottom + sRect.Top) / 2, _
             0, 0, SWP_NOSIZE)

 End Property

Access のウィンドウに境界線スタイルを設定する

'Access ウィンドウの境界線スタイルを設定する。
Public Sub SetWindowBorderStyle(enmBorderStyle As BorderStyle)
    Dim hwnd As LongPtr
    hwnd = Application.hWndAccessApp
    Select Case enmBorderStyle
    Case BorderStyle.None
        'サイズ変更コマンドを削除する
        Call RemoveMenu(hwnd, SC_SIZE, MF_BYCOMMAND)
    Case BorderStyle.Thin
        'サイズ変更コマンドを削除する
        Call RemoveMenu(hwnd, SC_SIZE, MF_BYCOMMAND)
    Case BorderStyle.Sizable
    Case BorderStyle.Dialog
        'サイズ変更コマンドを削除する
        Call RemoveMenu(hwnd, SC_SIZE, MF_BYCOMMAND)
    End Select
End Sub

Access のウィンドウに閉じるボタンを設定する

'Access ウィンドウの閉じるボタンを設定する。
Public Property Let CloseButton(blnCloseButton As Boolean)
    Dim hMenu As Long

    If blnCloseButton Then
        'To Do

    Else
        'システムメニューのハンドルを取得
        hMenu = GetSystemMenu(Application.hWndAccessApp, 0)

        '閉じるボタンを無効にする
        Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)

        'メニューを再描画
        Call DrawMenuBar(Application.hWndAccessApp)

    End If

End Property

Access のウィンドウに最小化/最大化ボタンを設定する

 'Access ウィンドウの最小化/最大化ボタンを設定する。
 Public Property Let MinMaxButtons(enmMinMaxButtons As AcWinMinMaxButtons)
     Dim lngSetValue As Long

     '現在の設定値を取得
     lngSetValue = GetWindowLong(Application.hWndAccessApp, GWL_STYLE)

     Select Case enmMinMaxButtons
     Case AcWinMinMaxButtons.None
         '最小化ボタンと最大化ボタンを外す
         lngSetValue = lngSetValue And Not WS_MINIMIZEBOX
         lngSetValue = lngSetValue And Not WS_MAXIMIZEBOX

     Case AcWinMinMaxButtons.MinEnabled
         '最大化ボタンを外す
         lngSetValue = lngSetValue And Not WS_MAXIMIZEBOX

     Case AcWinMinMaxButtons.MaxEnabled
         '最小化ボタンを外す
         lngSetValue = lngSetValue And Not WS_MINIMIZEBOX

     Case AcWinMinMaxButtons.BothEnabled
         '最小化ボタンと最大化ボタンを付ける
         lngSetValue = lngSetValue Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX

     End Select

     '新しい設定値を設定
     Call SetWindowLong(Application.hWndAccessApp, GWL_STYLE, lngSetValue)

 End Property
 }}