ユーザーフォームのサイズ変更 ⑤ 操作用フォームを一つ追加

先日は、複数枚の画像をユーザーフォームに表示してみた。
infoment.hatenablog.com

今日は、先日の続き。

まず先日の複数のユーザーフォームをNewして増やす手法は、私の独創ではない。書き忘れていたのだが、こちらを参照している。
thom.hateblo.jp

それで、先日の続きを作ろうとして昨晩、手が止まってしまった。これは何か扱い辛いぞ。１０個のユーザーフォームがあったら、一つずつ閉じて回るのか？面倒くさいことこの上ない。

ということで、全部壊して作り直してみた。
まず、ユーザーフォーム側の大部分のコードを、標準モジュールに移動させた。

Option Explicit
' 画像ファイル取得用。
Public FSO As Scripting.FileSystemObject
' ファイルパス格納用コレクション。
Public myFiles As Collection

' 画像ファイル保存場所。
Public Const SorceFolder As String = "C:\Temp"
Public cUF As ImageControlForm
Public UFs() As ImageViewForm

Sub ShowUFs()
    Set FSO = New Scripting.FileSystemObject
    Set myFiles = New Collection
    
    ' ファイルパス格納処理。
    Dim File As Scripting.File
        For Each File In FSO.GetFolder(SorceFolder).Files
            myFiles.Add File.Path
        Next
    
    ' コレクションのアイテムの数だけユーザーフォーム作成。
    ReDim UFs(1 To myFiles.Count)
    Dim i As Long
        For i = 1 To myFiles.Count
            Set UFs(i) = New ImageViewForm
                UFs(i).Show vbModeless
                ' イメージコントロールに画像ファイル設定。
                UFs(i).Image1.Picture = LoadPicture(myFiles(i))
        Next

    ' コントロール用ユーザーフォーム起動。
    Set cUF = New ImageControlForm
        cUF.Show vbModeless
        
        cUF.SpinButton1 = 3

End Sub

Public Property Get unit_width() As Long
' ユーザーフォームの単位幅。
' スピンボタンを押すたびに、この値の倍数で
' ユーザーフォームの幅を変化させる。
    unit_width = ActiveWindow.Width / 12
End Property

' 約数を求める関数。
' 約数を求めたい関数を１から順に割り、
' 余りが０の値を約数として辞書に格納する。
' ※MicroSoft Scripting Runtime 参照済み。
Public Function Devisor(source_number As Long) As Scripting.Dictionary
    Dim Dict As Scripting.Dictionary
    Set Dict = New Scripting.Dictionary
    Dim i As Long
        For i = 1 To source_number
            If source_number Mod i = 0 Then
                Dict(Dict.Count + 1) = i
            End If
        Next
        Set Devisor = Dict
End Function

次いで、ユーザーフォームを二つ準備する。
１）写真表示用ユーザーフォーム
こちらは、何もコードを持たない、コントロールを配置しただけのフォーム。

２）１）操作用のユーザーフォーム

取り敢えず、サイズ変更用スピンボタンと、一括終了用ボタンを準備した。

Option Explicit

Private Sub CommandButton1_Click()
    Dim i As Long
        For i = 1 To UBound(UFs)
            Unload UFs(i)
        Next
End Sub

Private Sub UserForm_Initialize()
    ' スピンボタンの最大値と最小値を設定。
    SpinButton1.Min = 1
    SpinButton1.Max = 6
End Sub

Private Sub SpinButton1_Change()
    Static Dict As Scripting.Dictionary
        If Dict Is Nothing Then
            Set Dict = Devisor(12)
        End If

    ' ユーザーフォームのサイズ変更。
    ' 高さは、高さの約71％（１／√２倍）とした。
    ' ※馴染みのあるＡサイズ（A3やA4など）の比率。
    Dim i As Long
        For i = 1 To UBound(UFs)
            With UFs(i)
            ' ユーザーフォームのサイズ変更。
                .Width = unit_width * Dict(SpinButton1.Value)
                .Height = .Width / 2 ^ 0.5
                
            ' イメージのサイズ追従。
                .Image1.Width = .Width - 30
                .Image1.Height = .Height - 45
                .Image1.Top = 10
                .Image1.Left = 10
                
            ' ユーザーフォームの整列。
                .Top = 150
                .Left = (i - 1) * .Width
            End With
        Next
End Sub

それでは、試してみよう。

一昨日より、幾分かマシになったか。
これでようやく、先に進めます。

参考まで。