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
}}