● 指定ウインドウを画面の中央に表示する ●

一応2つ書いておく。両者は何故か同じ座標に表示されず、数ピクセルずれる。まあ、お好きな方を選んでちょ〜よ。あと、フォームのプロパティ:StartUpPosition に 3(画面の中央) を設定する方法があるが、これはタスクバーの高さが考慮されない。従って [その2] の "- TaskBatHeight * Screen.TwipsPerPixelY" の部分をコメント化すれば、プロパティ:StartUpPosition = 3 の設定と同様の位置にウィンドウが表示される。

 [その1]
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

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

Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

'上2つは解像度、下2つはデスクトップ領域
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17

'---------------------------------------------------------------
' 関数名: MoveWindowCenter
' 機  能: 指定ウインドウを画面の中央に表示する
' 引  数: (in) hWnd … 中央に表示するウインドウのハンドル
' 返り値: なし
'---------------------------------------------------------------
Public Sub MoveWindowCenter(ByVal hwnd As Long)
    Dim udtRect As RECT
    Dim DesktopWidth&, DesktopHeight As Long
    Dim WindowWidth&, WindowHeight As Long

    'デスクトップの幅、高さを取得する(単位:Pixel)
    DesktopWidth = GetSystemMetrics(SM_CXFULLSCREEN)
    DesktopHeight = GetSystemMetrics(SM_CYFULLSCREEN)

    '指定ウインドウ領域サイズを取得する
    Call GetWindowRect(hwnd, udtRect)

    '指定ウインドウの幅、高さを取得する(単位:Pixel)
    WindowWidth = udtRect.Right - udtRect.Left
    WindowHeight = udtRect.Bottom - udtRect.Top

    Call MoveWindow(hwnd, (DesktopWidth - WindowWidth) / 2, _
                          (DesktopHeight - WindowHeight) / 2, _
                           WindowWidth, WindowHeight, 1)
End Sub

 [その2]
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type APPBARDATA
    cbSize As Long
    hwnd As Long
    uCallbackMessage As Long
    uEdge As Long
    rc As RECT
    lParam As Long
End Type
Private Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As APPBARDATA) As Long

Private Const ABM_GETTASKBARPOS = &H5

'---------------------------------------------------------------
' 関数名: MoveWindowCenter
' 機  能: 指定ウインドウを画面の中央に表示する
' 引  数: (in) hWnd … 中央に表示するウインドウのハンドル
' 返り値: なし
'---------------------------------------------------------------
Public Sub MoveWindowCenter(ByVal SrcForm As Form)
    Dim udtAPB As APPBARDATA
    Dim TaskBatHeight As Long
    Dim DesktopWidth&, DesktopHeight As Long
    Dim WindowWidth&, WindowHeight As Long

    '解像度を取得する(単位:Twip)
    DesktopWidth = Screen.Width
    DesktopHeight = Screen.Height

    '指定ウインドウの幅、高さを取得する(単位:Twip)
    WindowWidth = SrcForm.Width
    WindowHeight = SrcForm.Height

    With udtAPB
        .cbSize = Len(udtAPB)
        .hwnd = SrcForm.hwnd
    End With

    Call SHAppBarMessage(ABM_GETTASKBARPOS, udtAPB)

    'タスクバーの高さを取得する
    TaskBatHeight = (udtAPB.rc.Bottom - udtAPB.rc.Top)

    With SrcForm
        .Left = (DesktopWidth - WindowWidth) / 2
        .Top = (DesktopHeight - WindowHeight) / 2 - TaskBatHeight * Screen.TwipsPerPixelY
    End With
End Sub

 [その3 - 自分自身を中央に表示する場合(最も簡単でVBらしいやり方)]
Private Sub Form_Load()

    With Me
      .Left = (Screen.Width - .Width) / 2
      .Top = (Screen.Height - .Height) / 2
    End With

End Sub

戻る