● Access2000Tips Win32 API サブフォームの大きさをAccessウィンドウの大きさの変化に伴いフィットさせたり、ウィンドウのサイズ自体を変更したり、最前面を固定化したり、の方法
★ サンプルのダウンロード
Access2000Tips Win32 API サブフォームの大きさをAccessウィンドウの大きさの変化に伴いフィットさせたり、ウィンドウのサイズ自体を変更したり、最前面を固定化したり、のサンプルダウンロード
（ESETでウィルスチェックしてあります）
(01)「サブフォームフィット例.mdb」
（外側の「ガワ（＝アプリケーションウィンドウ）」の大きさの自動変更のサンプルも同じフォームの中に作りました。）
(02)「Access2000ランタイムダウンロード」
※ランタイムはバージョン2000のものです。Access2000を持っていない方でも、サンプルのmdb（ここでは「サブフォームフィット例.mdb」）の動作の確認をしていただけます。
ただ、Win10で動くかはまだチェックしていません。仮想マシンのXPなどで動かすほうが確実かと思います。
なお、仮想マシンの中ではAccessランタイムでの動作では、「Accessウィンドウ（ガワ）の大きさを変える」ボタンでエラーになってしまいました。そのほかは動くようです。仮想マシンでないマシン上で正常動作するかもチェックはしていません。
ランタイムではないAccess2000ならエラーにはならないと思います。
↑
↓
以下のコードを、Accessの標準モジュールを1個つくってコピペして使ってください。
イベントプロシージャや標準モジュールのプロシージャから呼び出せば、以下のようなことができます。
(a)サブフォームの大きさをAccessウィンドウの大きさの変化に伴って
連動フィットさせる場合の、最小化時のエラーやCPU使用率100%の回避
(b)自mdbのウィンドウのサイズ自体を変更
(c)他mdbのウィンドウのサイズを変更
(d)メモ帳などの他のソフトのウィンドウのサイズをAccessから変更
(e)自mdbの画面（Access画面丸ごと）の「最前面」設定の固定化
(f)デスクトップに開いている各ソフトのウィンドウを左右に並べる（4分割以上）
(g)同じく上下に並べる
※ 最後の2つの(f)と(g)は、事前に、VBEの参照設定にて「Microsoft Shell Controls And Automation」に照設定をしておきます。APIとは関係ありません。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 |
' ' Option Compare Database Option Explicit '●Win32API ウィンドウの最大化、最小化、等、状態の取得用の定義 Public Const SW_HIDE = 0 Public Const SW_SHOWMAXIMIZED = 3 Public Const SW_SHOWMINIMIZED = 2 Public Const SW_SHOWNORMAL = 1 'Type RECT ' Left As Long ' Top As Long ' Right As Long ' Bottom As Long 'End Type 'Type POINTAPI ' X As Long ' Y As Long 'End Type 'Type WINDOWPLACEMENT ' Length As Long ' Flags As Long ' ShowCmd As Long ' PtMinPosition As POINTAPI ' PtMaxPosition As POINTAPI ' RcNormalPosition As RECT 'End Type Public Const WPF_RESTORETOMAXIMIZED = &H2 Public Const WPF_SETMINPOSITION = &H1 'Declare Function GetWindowPlacement Lib "user32" (ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long '●Win32API ウィンドの大きさ変更用の定義 Public Declare Function GetForegroundWindow _ Lib "user32" () As Long Public Type POINTAPI X As Long Y As Long End Type Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Public Type WINDOWPLACEMENT Length As Long Flags As Long ShowCmd As Long PtMinPosition As POINTAPI PtMaxPosition As POINTAPI RcNormalPosition As RECT End Type Public Declare Function GetWindowPlacement Lib "user32" (ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long Public Declare Function SetWindowPlacement Lib "user32" (ByVal hWnd As Long, lpwndpl As WINDOWPLACEMENT) As Long '●Win32API ウィンドウの最前面表示用の定義 Declare Function FindWindow% Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, _ ByVal lpCaption As Any) Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, _ ByVal hWndInsertAfter As Long, _ ByVal X As Long, _ ByVal Y As Long, _ ByVal cx As Long, _ ByVal cy As Long, _ ByVal wFlags As Long) As Long Global Const HWND_TOPMOST = -1 ' 最全面に表示する Global Const HWND_NOTOPMOST = -2 ' 最前面に表示するのをやめる Global Const SWP_NOSIZE = &H1 ' サイズを変更しない Global Const SWP_NOMOVE = &H2 ' 位置を変更しない '########## Win32APIの呼び出しはここまで ################################################ '########## 以下、Win32APIを呼び出すための関数（Win32APIを利用するための関数） ################################################ '###################################################################################### '他のmdbのウィンドウを最前面にする関数 'win_hwnd には、「objAccess.hWndAccessApp」などで取得したウィンドウハンドルの値（Long型）を渡す 'hwndは Handle Of Window の略 '###################################################################################### Function window_most_top_on(win_hwnd As Long) Call SetWindowPos(win_hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE) End Function '###################################################################################### '他のmdbのウィンドウの最前面を解除する関数 'win_hwnd には、「objAccess.hWndAccessApp」などで取得したウィンドウハンドルの値（Long型）を渡す ''hwndは Handle Of Window の略 '###################################################################################### Function window_most_top_off(win_hwnd As Long) Call SetWindowPos(win_hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE) End Function '###################################################################################### '●上記関数の呼び出しの使用例のコード Sub testtest() Dim objAccess As Access.Application Set objAccess = CurrentProject.Application Call window_most_top_off(objAccess.hWndAccessApp) End Sub '###################################################################################### '●(02)自mdbを最前面にする使用例のコード Sub test101() Dim objAccess As Access.Application Set objAccess = CurrentProject.Application Call SetWindowPos(objAccess.hWndAccessApp, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE) Set objAccess = Nothing End Sub '●(03)自mdbの最前面を解除する使用例のコード Sub test102() Dim objAccess As Access.Application Set objAccess = CurrentProject.Application Call SetWindowPos(objAccess.hWndAccessApp, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE) Set objAccess = Nothing End Sub '################################################################### '開いた何らかのアプリケーションをリサイズする関数 'タイトル名からリサイズする。 'タイトル名は全部じゃなくても一部でもOKみたいです。 '################################################################### Function app_window_risize_for_title_name(active_title_name As String, _ left_position As Integer, _ Top_position As Integer, _ Width_length As Integer, _ Height_length As Integer) Dim myHwnd As Long Dim myWindowPlacement As WINDOWPLACEMENT '対象をアクティブにする。アクティブにしないと動かない。 AppActivate active_title_name, False 'ウィンドウハンドルの取得 myHwnd = GetForegroundWindow() 'ウィンドウ情報の取得 GetWindowPlacement myHwnd, myWindowPlacement 'ウィンドウ情報を変更して設定 With myWindowPlacement.RcNormalPosition .Left = left_position .Top = Top_position .Right = Width_length + left_position .Bottom = Height_length + Top_position End With SetWindowPlacement myHwnd, myWindowPlacement End Function '################################################################### '開いた何らかのアプリケーションをリサイズする関数。 'タスクID(プロセスID）からリサイズする。 ' '################################################################### Function app_window_risize_for_p_id(p_id As Integer, _ left_position As Integer, _ Top_position As Integer, _ Width_length As Integer, _ Height_length As Integer) Dim myHwnd As Long Dim myWindowPlacement As WINDOWPLACEMENT '対象をアクティブにする。アクティブにしないと動かない。 AppActivate p_id, False 'ウィンドウハンドルの取得 myHwnd = GetForegroundWindow() 'ウィンドウ情報の取得 GetWindowPlacement myHwnd, myWindowPlacement 'ウィンドウ情報を変更して設定 With myWindowPlacement.RcNormalPosition .Left = left_position .Top = Top_position .Right = Width_length + left_position .Bottom = Height_length + Top_position End With SetWindowPlacement myHwnd, myWindowPlacement End Function '################################################################### '開いているmdb内のフォームをリサイズする関数 '上記関数を変形しただけ。 'フォーム名をモトにリサイズする。 ' '################################################################### Function form_api_risize(active_form_name As String, _ left_position As Integer, _ Top_position As Integer, _ Width_length As Integer, _ Height_length As Integer) Dim myHwnd As Long Dim myWindowPlacement As WINDOWPLACEMENT 'フォームのウィンドウハンドルの取得 myHwnd = Forms(active_form_name).hWnd 'ウィンドウ情報の取得 GetWindowPlacement myHwnd, myWindowPlacement 'ウィンドウ情報を変更して設定 With myWindowPlacement.RcNormalPosition .Left = left_position .Top = Top_position .Right = Width_length + left_position .Bottom = Height_length + Top_position End With SetWindowPlacement myHwnd, myWindowPlacement End Function '################################################################################ 'フォームの状態を調べる関数（最大化、最小化、通常、非表示） 'hWnd01 はウィンドウハンドルを指定する。Me.Hwnd など。 ' '################################################################################ Function frm_size_State01(hWnd01 As Long) As String Dim lRet As Long Dim lpWnd As WINDOWPLACEMENT Dim str01 As String With lpWnd .Length = LenB(lpWnd) lRet = GetWindowPlacement(hWnd01, lpWnd) 'str01 = "フォームの表示状態：" If lRet <> 0 Then If .ShowCmd = SW_SHOWMINIMIZED Then ' str01 = str01 & "最小化サイズ" & vbCrLf frm_size_State01 = "最小" ElseIf .ShowCmd = SW_SHOWMAXIMIZED Then ' str01 = str01 & "最大化サイズ" & vbCrLf frm_size_State01 = "最大" ElseIf .ShowCmd = SW_SHOWNORMAL Then ' str01 = str01 & "通常サイズ" & vbCrLf frm_size_State01 = "通常" ElseIf .ShowCmd = SW_HIDE Then ' str01 = str01 & "非表示" & vbCrLf frm_size_State01 = "非表示" Else ' str01 = str01 & "不明" & vbCrLf frm_size_State01 = "不明" End If Else ' str01 = str01 & "取得エラー" & vbCrLf frm_size_State01 = "取得エラー" End If End With End Function '################################################################### '上のコードの土台 '################################################################### Function frm_size_State01_test(hWnd01 As Long) Dim lRet As Long Dim lpWnd As WINDOWPLACEMENT Dim str01 As String With lpWnd .Length = LenB(lpWnd) lRet = GetWindowPlacement(hWnd01, lpWnd) str01 = "フォームの表示状態：" If lRet <> 0 Then If .ShowCmd = SW_SHOWMINIMIZED Then str01 = str01 & "最小化サイズ" & vbCrLf ElseIf .ShowCmd = SW_SHOWMAXIMIZED Then str01 = str01 & "最大化サイズ" & vbCrLf ElseIf .ShowCmd = SW_SHOWNORMAL Then str01 = str01 & "通常サイズ" & vbCrLf ElseIf .ShowCmd = SW_HIDE Then str01 = str01 & "非表示" & vbCrLf Else str01 = str01 & "不明" & vbCrLf End If str01 = str01 & _ "通常サイズ時の座標(L,T)-(W,H)：" _ & "(" & .RcNormalPosition.Left & "," & .RcNormalPosition.Top & ")" _ & "-(" & .RcNormalPosition.Right & "," & .RcNormalPosition.Bottom & ")" & vbCrLf str01 = str01 & _ "最大化サイズ時の座標(L,T)：" _ & "(" & .PtMaxPosition.X & "," & .PtMaxPosition.Y & ")" & vbCrLf str01 = str01 & _ "最小化サイズ時の座標(L,T)：" _ & "(" & .PtMinPosition.X & "," & .PtMinPosition.Y & ")" & vbCrLf Else str01 = str01 & "取得エラー" & vbCrLf End If End With Debug.Print str01 End Function '############################################################################# '現在開いているウィンドウたちを左右に並べて表示する関数 '事前に、VBEの参照設定にて '「Microsoft Shell Controls And Automation」に '照設定をしておきます。 '############################################################################# Function Folder_Open() '事前に、VBEの参照設定にて '「Microsoft Shell Controls And Automation」に '照設定をしておきます。 Dim objsample As Shell Set objsample = New Shell objsample.TileVertically 'Windows画面が分割表示されます。 Set objsample = Nothing '開放します。 End Function '############################################################################# '現在開いているウィンドウたちを上下に並べて表示する関数 '事前に、VBEの参照設定にて '「Microsoft Shell Controls And Automation」に '照設定をしておきます。 '############################################################################# Function Folder_Open02() Dim objsample01 As Shell Set objsample01 = New Shell objsample01.TileHorizontally 'Windows画面が分割表示されます。 Set objsample01 = Nothing '開放します。 End Function ' ' |
★ サブフォームの大きさを、「ガワ（親）」のAccessのアプリケーションウィンドウの大きさの変化に合わせて、フィットさせるコードは以下の通りです。
フォームの「リサイズ」のイベントに書きます。
以下のコードをサブフォームを持つフォームに書きます。
「Private Sub Form_Resize()」と「End Sub」は抜いて、中身だけをコピペすればOKかと思います。
フィットさせること自体にはWin32APIは必要ないのですが、最小化するときなどにエラー回避などで必要になります。（「frm_size_State01()関数による状態チェックで。）
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 |
' ' Private Sub Form_Resize() '最小化すると何故かCPUの使用率が100%になってしまうのでそれを回避 '（Win32API使用） If frm_size_State01(Me.hWnd) = "最小" Then Exit Sub ElseIf frm_size_State01(Me.hWnd) = "不明" Then Exit Sub ElseIf frm_size_State01(Me.hWnd) = "取得エラー" Then Exit Sub Else End If '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ 'これ以降のプログラムは、実際に、サブフォームの大きさを 'フィットさせる処理ですが、本当はWin32APIなしでもOKです。 'ウィンドウを最小化する事がないないなら、 'Win32API（これより上のプログラム）は要りません。 '（ここでは最小化することを前提としているので、 ' 上記のWin32APIのコードも追記してあります。） 'また、あまりウィンドウを小さくするとサブフォームの大きさがゼロよりも '小さくなってしまうのか、よくわかりませんが、エラーになります。 'そのときのエラー処理は書いてませんので、ご自分で書いてみてください。 'エラーになったらExit Subでプログラムを終了させればOKかと思います。 '●フォームの詳細セクションの大きさの調整 '（フォームヘッダやフォームフッタの大きさは変わりません。 Me.Width = Me.InsideWidth '詳細セクションには幅のプロパティが無いのでMe.（フォーム）で幅を調整 'このコードはなくてもエラーにならないかもです。 Me.詳細.Height = Me.InsideHeight - Me.フォームヘッダー.Height - Me.フォームフッター.Height - 800 '最後のマイナスの数値の1000(twip)は、 '「埋め込みとしてのガワ01」のHeightの数字と同じくらいか、 '少し小さくするといいみたい。 'あまり数字が大きくても小さくてもエラーになるっぽいです。 '「= Me.InsideHeight - 」じゃなくて、「= Me.詳細.Height - 」でもいいかも。 On Error Resume Next '最小化時にここでエラーになるので回避 '●サブフォームの大きさの調整 Me.埋め込みとしてのガワ01.Width = Me.InsideWidth - 500 '最後のマイナスの数値が500よりも低すぎると、 'サブフォームの右端の縦方向のスクロールバーが隠れてしまい、 '切れた感じになるので注意。 '数字はピクセルではなくて、twipです。 Me.埋め込みとしてのガワ01.Height = Me.InsideHeight - Me.フォームヘッダー.Height - Me.フォームフッター.Height - 1000 '最後のマイナスの数値を1000以下にすると、サブフォームの下側の '横方向のスクロールバーが下に隠れてしまう場合もあるので注意。 '数字はピクセルではなくて、twipです。 '「= Me.InsideHeight - 」じゃなくて、「= Me.埋め込みとしてのガワ01.Height - 」でもいいかも。 End Sub ' ' |
- 投稿タグ
- Ac2000-Win32API
