同族ウィンドウを重ねて表示する

● 同族ウィンドウを重ねて表示する ●

エクセルなどのMDI環境であれば[ウィンドウ]親メニューがあり、「重ねて表示」「上下に並べて表示」「左右に並べて表示」という子メニューがある。これを単独ウィンドウ、要するにSDIなウィンドウで実現する。その昔、適当に作ってみたら動いてしまったまがい物だが、VBでは珍しいかもしれないので掲載しておく。まあやってみるもんだ。

＃SDIのメモ帳なんぞを作った場合、実装しておきたい機能だね。

やってることは極めて簡単。自分自身と同じウィンドウタイトルを持つウィンドウを拾い、そのウィンドウに対して「重ねて表示」する命令を送るだけ。CascadeWindows API関数の第３引数に RECT 構造体を指定することができるが、ここでは指定しない版で書いている。ではどんぞ!!

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

Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long

Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function IsZoomed Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function IsIconic Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

Private Const SW_RESTORE = 9

'引数を渡しやすい型に修正
'Private Declare Function CascadeWindows Lib "user32" (ByVal hwndParent As Long, ByVal wHow As Long, ByVal lpRect As RECT, ByVal cKids As Long, lpKids As Long) As Integer
Private Declare Function CascadeWindows Lib "user32" (ByVal hwndParent As Long, ByVal wHow As Long, ByVal lpRect As Long, ByVal cKids As Long, lpKids As Any) As Integer

'引数を渡しやすい型に修正
'Private Declare Function TileWindows Lib "user32" (ByVal hwndParent As Long, ByVal wHow As Long, lpRect As RECT, ByVal cKids As Long, lpKids As Long) As Integer
Private Declare Function TileWindows Lib "user32" (ByVal hwndParent As Long, ByVal wHow As Long, ByVal lpRect As Long, ByVal cKids As Long, lpKids As Any) As Integer

Private Const MDITILE_VERTICAL = &H0
Private Const MDITILE_HORIZONTAL = &H1
Private Const MDITILE_SKIPDISABLED = &H2

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'---------------------------------------------------------------------------
' 関数名： EnumFamilyWindows
' 機能  ： 起動したアプリケーションのハンドルを取得する
' 引数  ： (in) hFamily … 同族ウィンドウのハンドル
'          (in) TargetCaption … 呼び出しウィンドウのタイトル
' 返り値： なし
'---------------------------------------------------------------------------
Public Sub EnumFamilyWindows(ByRef hFamily() As Long, ByVal TargetCaption As String)

    Dim hTempWnd As Long
    Dim ArrayCnt As Long

    hTempWnd = FindWindow(vbNullString, vbNullString)
    Do
        If TargetCaption = GetWindowCaption(hTempWnd) Then
            ReDim Preserve hFamily(ArrayCnt) As Long
            hFamily(ArrayCnt) = hTempWnd
            ArrayCnt = ArrayCnt + 1
        End If

        '次のハンドルの取得
        hTempWnd = GetWindow(hTempWnd, GW_HWNDNEXT)
    Loop While hTempWnd <> 0

End Sub


'---------------------------------------------------------------------------
' 関数名： GetWindowCaption
' 機能  ： ウィンドウのタイトル文字列を取得する
' 引数  ： (in) hWnd … ウィンドウハンドル
' 返り値： ウィンドウのタイトル文字列
'---------------------------------------------------------------------------
Public Function GetWindowCaption(ByVal hWnd As Long) As String

    Dim WinTitle As String * 256
    Call GetWindowText(hWnd, WinTitle, Len(WinTitle))
    GetWindowCaption = Left$(WinTitle, InStr(WinTitle, Chr$(0)) - 1)

End Function


'---------------------------------------------------------------------------
' 関数名： SetCascadeWindows
' 機能  ： ウィンドウを重ねる
' 引数  ： (in) hFamily … 同族ウィンドウのハンドル
' 戻り値： 正常：０以外、 エラー：０
'---------------------------------------------------------------------------
Public Function SetCascadeWindows(ByRef hFamily() As Long) As Long
    If UBound(hFamily) = 0 Then Exit Function

    Dim i As Long

    '最大化・最小化されていたら元に戻す
    For i = 0 To UBound(hFamily)
        If IsZoomed(hFamily(i)) Or IsIconic(hFamily(i)) Then
            Call ShowWindow(hFamily(i), SW_RESTORE)
        End If
    Next i

    SetCascadeWindows = CascadeWindows(0&, MDITILE_SKIPDISABLED, 0&, _
                                       UBound(hFamily) + 1, hFamily(0))

End Function


'---------------------------------------------------------------------------
' 関数名： SetTileWindowsVertical
' 機能  ： ウィンドウを縦に重ねる
' 引数  ： (in) hFamily … 同族ウィンドウのハンドル
' 戻り値： 正常：０以外、 エラー：０
'---------------------------------------------------------------------------
Public Function SetTileWindowsVertical(ByRef hFamily() As Long) As Long
    If UBound(hFamily) = 0 Then Exit Function

    Dim i As Long

    '最大化・最小化されていたら元に戻す
    For i = 0 To UBound(hFamily)
        If IsZoomed(hFamily(i)) Or IsIconic(hFamily(i)) Then
            Call ShowWindow(hFamily(i), SW_RESTORE)
        End If
    Next i

    SetTileWindowsVertical = TileWindows(0&, MDITILE_VERTICAL, 0&, _
                                         UBound(hFamily) + 1, hFamily(0))

End Function


'---------------------------------------------------------------------------
' 関数名： SetTileWindowsHorizontal
' 機能  ： ウィンドウを横に重ねる
' 引数  ： (in) hFamily … 同族ウィンドウのハンドル
' 戻り値： 正常：０以外、 エラー：０
'---------------------------------------------------------------------------
Public Function SetTileWindowsHorizontal(ByRef hFamily() As Long) As Long
    If UBound(hFamily) = 0 Then Exit Function

    Dim i As Long

    '最大化・最小化されていたら元に戻す
    For i = 0 To UBound(hFamily)
        If IsZoomed(hFamily(i)) Or IsIconic(hFamily(i)) Then
            Call ShowWindow(hFamily(i), SW_RESTORE)
        End If
    Next i

    SetTileWindowsHorizontal = TileWindows(0&, MDITILE_HORIZONTAL, 0&, _
                                           UBound(hFamily) + 1, hFamily(0))

End Function

↓お約束の呼び出し側。

Private Sub Command1_Click()

    Dim hFamily() As Long
    Dim i As Long

    '同族ウィンドウのハンドルを取得
    Call EnumFamilyWindows(hFamily, Me.Caption)

    '重ねて表示する
    'Debug.Print SetCascadeWindows(hFamily)
    Debug.Print SetTileWindowsVertical(hFamily)    '縦
    'Debug.Print SetTileWindowsHorizontal(hFamily)  '横
End Sub

戻る