access2010 access2007 アプリケーションウィンドウの中央寄せ -2-

以前のポストをちょっと加工

アプリケーションウインドウが最大化されているときなど判断して移動とリサイズ

Option Compare Database
Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type WINDOWPLACEMENT
    Length As Long
    flags As Long
    showCmd As Long
    ptMinPosition As POINTAPI
    ptMaxPosition As POINTAPI
    rcNormalPosition As RECT
End Type

Private Type MONITORINFO
    cbSize As Long
    rcMonitor As RECT
    rcWork As RECT
    dwFlags As Long
End Type

#If VBA7 Then
'http://msdn.microsoft.com/ja-jp/library/cc364767.aspx
Private Declare PtrSafe Function GetWindowPlacement Lib "user32" ( _
                                        ByVal hwnd As LongPtr, _
                                        lpwndpl As WINDOWPLACEMENT _
                                        ) As Long

'http://msdn.microsoft.com/ja-jp/library/cc411205.aspx
Private Declare PtrSafe Function SetWindowPlacement Lib "user32" ( _
                                        ByVal hwnd As LongPtr, _
                                        lpwndpl As WINDOWPLACEMENT _
                                        ) As Long

Private Declare PtrSafe Function GetMonitorInfo Lib "user32.dll" _
                                        Alias "GetMonitorInfoA" ( _
                                        ByVal hMonitor As LongPtr, _
                                        ByRef lpmi As MONITORINFO _
                                        ) As Long
 
Private Declare PtrSafe Function MonitorFromWindow Lib "user32.dll" ( _
                                        ByVal hwnd As LongPtr, _
                                        ByVal dwFlags As Long _
                                        ) As Long

#Else
Private Declare Function GetWindowPlacement Lib "user32" ( _
                                        ByVal hwnd As Long, _
                                        lpwndpl As WINDOWPLACEMENT _
                                        ) As Long

Private Declare Function SetWindowPlacement Lib "user32" ( _
                                        ByVal hwnd As Long, _
                                        lpwndpl As WINDOWPLACEMENT _
                                        ) As Long

Private Declare Function GetMonitorInfo Lib "user32.dll" _
                                        Alias "GetMonitorInfoA" ( _
                                        ByVal hMonitor As Long, _
                                        ByRef lpmi As MONITORINFO _
                                        ) As Long
 
Private Declare Function MonitorFromWindow Lib "user32.dll" ( _
                                        ByVal hwnd As Long, _
                                        ByVal dwFlags As Long _
                                        ) As Long
#End If

Sub AppWindowCentering()
    Dim wp As WINDOWPLACEMENT, mi As MONITORINFO, mRect As RECT, aRect As RECT
#If VBA7 Then
    Dim hMonitor As LongPtr, ApphWnd As LongPtr
#Else
    Dim hMonitor As Long, ApphWnd As Long
#End If

    ApphWnd = Application.hWndAccessApp
    
    wp.Length = LenB(wp) '44bytes
    GetWindowPlacement ApphWnd, wp
    If wp.showCmd <> 1 Then Exit Sub '標準の状態でない場合
    aRect = wp.rcNormalPosition
    
    hMonitor = MonitorFromWindow(ApphWnd, &H2)
    mi.cbSize = LenB(mi) '40bytes
    GetMonitorInfo hMonitor, mi
    mRect = mi.rcWork
    
    Dim aw As Long, ah As Long, mw As Long, mh As Long
    aw = aRect.Right - aRect.Left: ah = aRect.Bottom - aRect.Top
    mw = mRect.Right - mRect.Left: mh = mRect.Bottom - mRect.Top
    If aw > mw Then aw = mw
    If ah > mh Then ah = mh

    With wp.rcNormalPosition
        .Left = (mRect.Left + mRect.Right - aw) / 2
        .Top = (mRect.Top + mRect.Bottom - ah) / 2
        .Right = (mRect.Left + mRect.Right - aw) / 2 + aw
        .Bottom = (mRect.Top + mRect.Bottom - ah) / 2 + ah
    End With
    wp.showCmd = 8& 'アクティブ最前面の効果
    SetWindowPlacement ApphWnd, wp    
End Sub

#If VBA7 Then
Function WindowState(ByVal hwnd As LongPtr) As Long
    Dim wp As WINDOWPLACEMENT
    wp.Length = LenB(wp)
    If GetWindowPlacement(hwnd, wp) = 0 Then Exit Function
    WindowState = wp.showCmd
End Function
#Else
Function WindowState(ByVal hwnd As Long) As Long
    Dim wp As WINDOWPLACEMENT
    wp.Length = LenB(wp)
    If GetWindowPlacement(hwnd, wp) = 0 Then Exit Function
    WindowState = wp.showCmd
End Function
#End If

'戻り値 1:標準 2:最小化 3:最大化
Function AppWindowState() As Long
    AppWindowState = WindowState(Application.hWndAccessApp)
End Function

Function AppWindowNormalRect() As RECT
    Dim wp As WINDOWPLACEMENT
    wp.Length = LenB(wp)
    GetWindowPlacement Application.hWndAccessApp, wp
    AppWindowNormalRect = wp.rcNormalPosition
End Function

あいかわらず途中で意味消失しそうになる。
あー、これだとタスクバーが上と左の場合だめね

てなわけで未検証改訂検討中

Option Compare Database
Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type WINDOWPLACEMENT
    Length As Long
    flags As Long
    showCmd As Long
    ptMinPosition As POINTAPI
    ptMaxPosition As POINTAPI
    rcNormalPosition As RECT
End Type

Private Type MONITORINFO
    cbSize As Long
    rcMonitor As RECT
    rcWork As RECT
    dwFlags As Long
End Type

#If VBA7 Then
'http://msdn.microsoft.com/ja-jp/library/cc364767.aspx
Private Declare PtrSafe Function GetWindowPlacement Lib "user32" ( _
                                        ByVal hwnd As LongPtr, _
                                        lpwndpl As WINDOWPLACEMENT _
                                        ) As Long

'http://msdn.microsoft.com/ja-jp/library/cc411205.aspx
Private Declare PtrSafe Function SetWindowPlacement Lib "user32" ( _
                                        ByVal hwnd As LongPtr, _
                                        lpwndpl As WINDOWPLACEMENT _
                                        ) As Long

Private Declare PtrSafe Function GetMonitorInfo Lib "user32.dll" _
                                        Alias "GetMonitorInfoA" ( _
                                        ByVal hMonitor As LongPtr, _
                                        ByRef lpmi As MONITORINFO _
                                        ) As Long
 
Private Declare PtrSafe Function MonitorFromWindow Lib "user32.dll" ( _
                                        ByVal hwnd As LongPtr, _
                                        ByVal dwFlags As Long _
                                        ) As Long
                                        
Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _
                                        ByVal hwnd As LongPtr, _
                                        lpRect As RECT _
                                        ) As Long
#Else
Private Declare Function GetWindowPlacement Lib "user32" ( _
                                        ByVal hwnd As Long, _
                                        lpwndpl As WINDOWPLACEMENT _
                                        ) As Long

Private Declare Function SetWindowPlacement Lib "user32" ( _
                                        ByVal hwnd As Long, _
                                        lpwndpl As WINDOWPLACEMENT _
                                        ) As Long

Private Declare Function GetMonitorInfo Lib "user32.dll" _
                                        Alias "GetMonitorInfoA" ( _
                                        ByVal hMonitor As Long, _
                                        ByRef lpmi As MONITORINFO _
                                        ) As Long
 
Private Declare Function MonitorFromWindow Lib "user32.dll" ( _
                                        ByVal hwnd As Long, _
                                        ByVal dwFlags As Long _
                                        ) As Long

Private Declare Function GetWindowRect Lib "user32" ( _
                                        ByVal hwnd As Long, _
                                        lpRect As RECT _
                                        ) As Long
#End If

Sub AppWindowCentering()
    Dim wp As WINDOWPLACEMENT, mi As MONITORINFO, mRect As RECT, aRect As RECT
#If VBA7 Then
    Dim hMonitor As LongPtr, ApphWnd As LongPtr
#Else
    Dim hMonitor As Long, ApphWnd As Long
#End If

    ApphWnd = Application.hWndAccessApp
    
    wp.Length = LenB(wp) '44bytes
    GetWindowPlacement ApphWnd, wp
    If wp.showCmd <> 1 Then Exit Sub '最大化最小化されていたら
    
    GetWindowRect ApphWnd, aRect

    hMonitor = MonitorFromWindow(ApphWnd, &H2)
    mi.cbSize = LenB(mi) '40bytes
    GetMonitorInfo hMonitor, mi
    mRect = mi.rcWork
    
    Dim aw As Long, ah As Long, mw As Long, mh As Long
    aw = aRect.Right - aRect.Left: ah = aRect.Bottom - aRect.Top
    mw = mRect.Right - mRect.Left: mh = mRect.Bottom - mRect.Top
    If aw > mw Then aw = mw
    If ah > mh Then ah = mh

    Dim tbOffset1 As Long, tbOffset2 As Long
    If mi.rcMonitor.Left <> mi.rcWork.Left Then tbOffset1 = mRect.Left
    If mi.rcMonitor.Top <> mi.rcWork.Top Then tbOffset2 = mRect.Top
    
    With wp.rcNormalPosition
        .Left = (mRect.Left + mRect.Right - aw) / 2 - tbOffset1
        .Top = (mRect.Top + mRect.Bottom - ah) / 2 - tbOffset2
        .Right = (mRect.Left + mRect.Right - aw) / 2 + aw - tbOffset1
        .Bottom = (mRect.Top + mRect.Bottom - ah) / 2 + ah - tbOffset2
    End With
    wp.showCmd = 8&
    SetWindowPlacement ApphWnd, wp
End Sub

#If VBA7 Then
Function WindowState(ByVal hwnd As LongPtr) As Long
    Dim wp As WINDOWPLACEMENT
    wp.Length = LenB(wp)
    If GetWindowPlacement(hwnd, wp) = 0 Then Exit Function
    WindowState = wp.showCmd
End Function
#Else
Function WindowState(ByVal hwnd As Long) As Long
    Dim wp As WINDOWPLACEMENT
    wp.Length = LenB(wp)
    If GetWindowPlacement(hwnd, wp) = 0 Then Exit Function
    WindowState = wp.showCmd
End Function
#End If

'戻り値 1:標準 2:最小化 3:最大化
Function AppWindowState() As Long
    AppWindowState = WindowState(Application.hWndAccessApp)
End Function

Function AppWindowNormalRect() As RECT
    Dim wp As WINDOWPLACEMENT
    wp.Length = LenB(wp)
    GetWindowPlacement Application.hWndAccessApp, wp
    AppWindowNormalRect = wp.rcNormalPosition
End Function

んー、タスクバーが上か下のときで、MONITORINFO構造体のrcWorkの値が見た目以上になることがある。タスクバーの高さ30なんだけど48に。まぁいいや。