【備忘録】VB6でコントロールの自動レイアウト

概要

昔作ったライブラリで、VBAのユーザーフォームにも適用できないかと思ったのですが、使えなかったのでVB6時代の備忘録として書きます。

アプリの画面サイズを変えたい

かつて(Windows 95が登場した頃)は、パソコンの画面サイズといえば、VGA(640x480)やXGA(1024x768)といった数種類の画面サイズがほとんどだったので、業務用ソフトなどでは想定する画面サイズが固定でも許されていました。
(当時仕事で携わっていた業務アプリは、どれも固定サイズばかりでした)

画面サイズを可変にしようとすると、フォームに配置したコントロールを画面サイズに合わせてレイアウトも合わせて適切な位置や大きさに配置し直す必要があります。

VB6のフォームでこれを実現するためには、Resizeイベントで各コントロールの位置を計算するロジックを実装すれフォームサイズに応じてコントロールを適切にレイアウトすることができます。

しかし、この方法はあまりに煩雑であったため、ほとんどの業務用ソフトでは画面サイズを固定するか、どうしても可変にしたい場合は、市販のコンポーネントを使うなどの方法がとられていました。

VB.NET 2005で登場したAnchorプロパティ

時代は移り、.NET Frameworkが登場しました。
.NET Framework 1.0, 1.1の頃はまだまだ使いづらい点がありましたが、.NET Framework 2.0とそれに対応したVisual Studio 2005で機能が大幅に拡充され、標準機能だけでも十分に実用的なソフトを作れるようになりました。

そして、当時VB6を触っていた私にとって感動的だったのは、フォームコントロールに追加されたAnchorプロパティでした。

Anchorプロパティとは

Anchorプロパティは、文字通りAnchor(錨)で、デザイン時の位置を元に親(フォームやコンテナコントロール)のサイズが変わったとき、その位置関係を維持してくれる機能です。

当時、プロパティを設定するだけで画面サイズを変えるとグリグリと画面のコントロールが追従してくれる様子に感動を覚えました。

VB6でもAnchorを使いたい

当時、VB6アプリのメンテナンスをしていた私は、Anchorプロパティの恩恵にあずかることはできませんでした。

しかし、私は諦めませんでした。

そうだ！　無いなら自分で作ろう！

仕組み

仕組み自体は複雑ではなく、最初に親のコントロールと位置関係を登録しておき、親のコントロールでResizeイベントが発生したら、位置を移動するだけです。
(当時、似たようなライブラリを作っていた人もいたのではないでしょうか。)

コンセプトとしては、なるべく、.NET FrameworkのAnchorと同じ使い勝手になるようにしました。

出来がったもの

フォームで、Anchorを使いたいコントロールの数だけ、Anchorクラスのインスタンスを配列として持ち、対象のコントロールとフォーム、Anchorの方向を設定しておくと、フォームのResizeイベントが発生した際に、レイアウトを再計算します。

FormMain.frm

Option Explicit
Private Enum ResizeControlEnum
    cmdTopLeft
    cmdTopLeftRight
    cmdTopRight
    
    cmdTopBottomLeft
    cmdTopBottomLeftRight
    cmdTopBottomRight
    
    cmdBottomLeft
    cmdBottomLeftRight
    cmdBottomRight
    Count
End Enum
Private m_Controls(ResizeControlEnum.Count - 1) As clsAnchor

''' <summary>Form Initialize時処理</summary>
Private Sub Form_Initialize()
    Dim loopIndex   As Long
    For loopIndex = 0 To UBound(m_Controls)
        Set m_Controls(loopIndex) = New clsAnchor
    Next
    Call m_Controls(ResizeControlEnum.cmdTopLeft).Initialize(Me, Me.cmdTopLeft, AnchorStyles.Top Or AnchorStyles.Left)
    Call m_Controls(ResizeControlEnum.cmdTopLeftRight).Initialize(Me, Me.cmdTopLeftRight, AnchorStyles.Top Or AnchorStyles.Left Or AnchorStyles.Right)
    Call m_Controls(ResizeControlEnum.cmdTopRight).Initialize(Me, Me.cmdTopRight, AnchorStyles.Top Or AnchorStyles.Right)
    
    Call m_Controls(ResizeControlEnum.cmdTopBottomLeft).Initialize(Me, Me.cmdTopBottomLeft, AnchorStyles.Top Or AnchorStyles.Bottom Or AnchorStyles.Left)
    Call m_Controls(ResizeControlEnum.cmdTopBottomLeftRight).Initialize(Me, Me.cmdTopBottomLeftRight, AnchorStyles.Top Or AnchorStyles.Bottom Or AnchorStyles.Left Or AnchorStyles.Right)
    Call m_Controls(ResizeControlEnum.cmdTopBottomRight).Initialize(Me, Me.cmdTopBottomRight, AnchorStyles.Top Or AnchorStyles.Bottom Or AnchorStyles.Right)
    
    Call m_Controls(ResizeControlEnum.cmdBottomLeft).Initialize(Me, Me.cmdBottomLeft, AnchorStyles.Bottom Or AnchorStyles.Left)
    Call m_Controls(ResizeControlEnum.cmdBottomLeftRight).Initialize(Me, Me.cmdBottomLeftRight, AnchorStyles.Bottom Or AnchorStyles.Left Or AnchorStyles.Right)
    Call m_Controls(ResizeControlEnum.cmdBottomRight).Initialize(Me, Me.cmdBottomRight, AnchorStyles.Bottom Or AnchorStyles.Right)
End Sub

clsAnchor

Option Explicit

Private Type Rectangle
    X       As Long
    Y       As Long
    Width   As Long
    Height  As Long
    Right   As Long
    Bottom  As Long
End Type

Public Enum AnchorStyles
    None = &H0
    Top = &H1
    Left = &H2
    Bottom = &H4
    Right = &H8
End Enum

Private m_TargetRect        As Rectangle
Private WithEvents m_Form   As Form
Private m_Target            As Control
Private m_Anchor            As AnchorStyles

''' <summary>初期化処理</summary>
''' <param name="pForm">親のフォーム</param>
''' <param name="pTarget">対象のコントロール</param>
''' <param name="pAnchor">Anchor</param>
Public Sub Initialize(ByRef pForm As Form, ByRef pTarget As Control, ByVal pAnchor As AnchorStyles)
    Set m_Form = pForm
    Set m_Target = pTarget
    m_Anchor = pAnchor
    m_TargetRect = GetRect(m_Target, m_Form)
End Sub

''' <summary>フォームのリサイズイベント時処理</summary>
Private Sub m_Form_Resize()
    Dim NewRect As Rectangle
    NewRect = GetRect(m_Target, m_Form)
    
    '横
    If (m_Anchor And AnchorStyles.Right) Then
        If Not (HasFlag(m_Anchor, AnchorStyles.Left)) Then
            NewRect.X = NewRect.X + NewRect.Right - m_TargetRect.Right
        End If
        NewRect.Right = m_TargetRect.Right
    End If
    NewRect.Width = m_Form.Width - NewRect.Right - NewRect.X
    If NewRect.Width < 0 Then NewRect.Width = 0
    
    '縦
    If (m_Anchor And AnchorStyles.Bottom) Then
        If Not (HasFlag(m_Anchor, AnchorStyles.Top)) Then
            NewRect.Y = NewRect.Y + NewRect.Bottom - m_TargetRect.Bottom
        End If
        NewRect.Bottom = m_TargetRect.Bottom
    End If
    NewRect.Height = m_Form.Height - NewRect.Bottom - NewRect.Y
    If NewRect.Height < 0 Then NewRect.Height = 0
    
    Call m_Target.Move(NewRect.X, NewRect.Y, NewRect.Width, NewRect.Height)
End Sub

''' <summary>Rectangleを取得する</summary>
''' <param name="pTarget">コントロール</param>
''' <param name="pForm">親のフォーム</param>
''' <returns>Rectangle</returns>
Private Function GetRect(ByRef pTarget As Control, ByRef pForm As Form) As Rectangle
    With GetRect
        .X = pTarget.Left
        .Y = pTarget.Top
        .Width = pTarget.Width
        .Height = pTarget.Height
        .Right = pForm.Width - (pTarget.Left + pTarget.Width)
        .Bottom = pForm.Height - (pTarget.Top + pTarget.Height)
    End With
'Debug.Print pTarget.Name & vbTab & " X:" & GetRect.X & " Y:" & GetRect.Y & " Width:" & GetRect.Width & " Height:" & GetRect.Height & " Right:" & GetRect.Right & " Bottom:" & GetRect.Bottom
End Function

''' <summary>AnchorStylesの値でフラグが立っているかを判定する</summary>
''' <param name="pSource">比較元の値</param>
''' <param name="pFlag">チェックするフラグ</param>
''' <returns>フラグが立っている=True, 立っていない=False</returns>
Private Function HasFlag(ByVal pSource As AnchorStyles, ByVal pFlag As AnchorStyles) As Boolean
    HasFlag = (pSource And pFlag) = pFlag
End Function

まとめ

そんな時代もあったねと　いつか話せる日が来るわ～♪