VB6にもコントロールのAnchorを！

最近VB6のプロジェクトを担当しているのですが、
普段使っているC#と比べて、その不親切さに辟易しています。

中でもフォームのリサイズに伴う、各コントロールの配置の計算についてはめんどくさいことこの上ないです。
ということで、Form_Resizeイベントを拾って、コントロールの配置を計算してくれるクラスを作ってみました。

Scripting.Dictionaryを使用していますので、
Microsoft Scripting Runtimeを参照設定してください。

FormAnchor.cls

Option Explicit

'【解説】
'指定したフォームに対し、Addしたコントロールをアンカーします
'Marginクラスをセットで使用するので、別のプロジェクトと共有するときはMarginの追加も忘れずに
'
'【使い方】
'①SetContainerでフォームを突っ込む
'②Addで｢アンカーしたいコントロール｣と、｢アンカーの方法｣を指定
'③Formのリサイズイベント時に、コントロールの位置とサイズを勝手に制御してくれます
'
'【補足】
'　･アンカーしているコントロールを管理外にしたい場合はRemoveを使う

Public Enum AnchorEnum
    Top_ = 1
    Left_ = 2
    Bottom_ = 4
    Right_ = 8
End Enum

Private AnchorDic As Dictionary 'Key=コントロール名 Value=AnchorEnum
Private MarginDic As Dictionary 'Key=コントロール名 Value=Marginクラス
Private ControlDic As Dictionary 'Key=コントロール名 Value=コントロール

Private WithEvents mForm As Form

'アンカーするコントロールを追加します
'control :アンカーするコントロール
'anchor  :アンカーフラグ。｢Top_ Or Left_｣のように論理和を取れば複数アンカー出来ます
Public Sub Add(ByRef control As Object, anchor As AnchorEnum)
    Dim keyString As String
    keyString = GetKeyString(control)
    
    If (AnchorDic.Exists(keyString) = True) Then Call AnchorDic.Remove(keyString)
    Call AnchorDic.Add(keyString, anchor)
    
    Dim m As Margin
    Set m = CalcMargin(mForm, control, anchor)
    If (MarginDic.Exists(keyString) = True) Then Call MarginDic.Remove(keyString)
    Call MarginDic.Add(keyString, m)
    
    If (ControlDic.Exists(keyString) = True) Then Call ControlDic.Remove(keyString)
    Call ControlDic.Add(keyString, control)
End Sub

'アンカーの対象を削除します
Public Sub Remove(ByRef control As Object)
    Dim keyString As String
    keyString = GetKeyString(control)
    If (AnchorDic.Exists(keyString) = True) Then Call AnchorDic.Remove(keyString)
    If (MarginDic.Exists(keyString) = True) Then Call MarginDic.Remove(keyString)
    If (ControlDic.Exists(keyString) = True) Then Call ControlDic.Remove(keyString)
End Sub

'連想配列のキーを取得します
Private Function GetKeyString(ByRef control As Object) As String
    If (IsControlArray(control) = True) Then
        GetKeyString = control.Name & control.index    'コントロール配列の場合、Nameが同じになるので、indexを付加
    Else
        GetKeyString = control.Name
    End If
End Function

'コントロール配列かどうかを調べます。
Private Function IsControlArray(ByVal control As VB.control) As Boolean
    IsControlArray = Not TypeOf control.Parent.Controls(control.Name) Is VB.control
End Function

'アンカーの基準となるコンテナ(フォーム)をセットします。
Public Sub SetContainer(ByVal container As Form)
    Set mForm = container
End Sub

'列挙aに列挙bの要素を含んでいるか
Private Function HasFlag(a As AnchorEnum, b As AnchorEnum) As Boolean
    HasFlag = ((a And b) = b)
End Function

'マージン計算
Private Function CalcMargin(ByRef container As Form, ByRef target As Object, anchor As AnchorEnum) As Margin
    Dim m As New Margin
    
    m.Top = target.Top
    m.Left = target.Left
    m.Bottom = container.ScaleHeight - (target.Top + target.height)
    m.Right = container.ScaleWidth - (target.Left + target.width)
    
    Set CalcMargin = m
End Function

Private Sub Class_Initialize()
    Set AnchorDic = New Dictionary
    Set MarginDic = New Dictionary
    Set ControlDic = New Dictionary
End Sub

Private Sub Class_Terminate()
    Set mForm = Nothing
    Set AnchorDic = Nothing
    Set MarginDic = Nothing
    Set ControlDic = Nothing
End Sub

Private Sub mForm_Resize()
    Dim ae As AnchorEnum
    Dim m As Margin
    Dim key As Variant
    Dim target As Object
    
    If MarginDic.Count > 0 Then
        For Each key In MarginDic.Keys
            ae = AnchorDic(key)
            Set m = MarginDic(key)
            Set target = ControlDic(key)
            
            If (HasFlag(ae, Top_ Or Bottom_) = True) Then
                '高さ変更
                Dim height As Single
                height = mForm.ScaleHeight - (m.Top + m.Bottom)
                If (height < 0) Then height = 0
                target.height = height
            ElseIf (HasFlag(ae, Top_) = True) Then
                target.Top = m.Top
            ElseIf (HasFlag(ae, Bottom_) = True) Then
                target.Top = mForm.ScaleHeight - (m.Bottom + target.height)
            End If
            
            If (HasFlag(ae, Left_ Or Right_) = True) Then
                '幅変更
                Dim width As Single
                width = mForm.ScaleWidth - (m.Left + m.Right)
                If (width < 0) Then width = 0
                target.width = width
            ElseIf (HasFlag(ae, Left_) = True) Then
                target.Left = m.Left
            ElseIf (HasFlag(ae, Right_) = True) Then
                target.Left = mForm.ScaleWidth - (m.Right + target.width)
            End If
        Next
    End If
End Sub

さらにフォームとのマージンの値を保持するクラスを追加します。
(構造体替わりの単純なプレーンオブジェクトです)

Margin.cls

'FormAnchorクラスで使用するマージンデータ格納クラス

Option Explicit

Private mTop, mLeft, mBottom, mRight As Single

Public Property Get Top() As Single
    Top = mTop
End Property
Public Property Let Top(value As Single)
    mTop = value
End Property

Public Property Get Left() As Single
    Left = mLeft
End Property
Public Property Let Left(value As Single)
    mLeft = value
End Property

Public Property Get Bottom() As Single
    Bottom = mBottom
End Property
Public Property Let Bottom(value As Single)
    mBottom = value
End Property

Public Property Get Right() As Single
    Right = mRight
End Property
Public Property Let Right(value As Single)
    mRight = value
End Property

使うときはこんな感じで。
Addプロシージャの第2引数の列挙に論理和を指定すると、その分アンカーを追加できます。

Form1.frm

Option Explicit

Private mFormAnchor As FormAnchor

Private Sub Form_Load()
    Set mFormAnchor = New FormAnchor
    
    mFormAnchor.SetContainer Me 'まず自分をセットする
    
    Call mFormAnchor.Add(Command1, Top_ Or Right_)  '上と右のマージンを固定
    Call mFormAnchor.Add(Label1, Bottom_ Or Right_)  '下と右のマージンを固定
    Call mFormAnchor.Add(Option1(0), Bottom_ Or Right_)  'コントロール配列でもOK
    Call mFormAnchor.Add(Text1, Top_ Or Left_ Or Bottom_ Or Right_)  'フォームの大きさに合わせてサイズも変化
End Sub

これでフォームのリサイズに合わせて、AnchorにAddしたコントロールの配置やサイズが変動します。

.Net系言語のように、コンテナ内のコントロールなどにも対応させたかったのですが、
プロパティ名の違いなどから、今回は対応を見送りました。

あんまりテストや検証をしてないので、SetContainerの前にAddしたらエラーが起きるとか、いろいろバグが有るかもしれませんが、その辺はご容赦下さい。