ユーザーフォームのサイズ変更 ⑤ 操作用フォームを一つ追加
先日は、複数枚の画像をユーザーフォームに表示してみた。
infoment.hatenablog.com
今日は、先日の続き。
まず先日の複数のユーザーフォームをNewして増やす手法は、私の独創ではない。書き忘れていたのだが、こちらを参照している。
thom.hateblo.jp
それで、先日の続きを作ろうとして昨晩、手が止まってしまった。これは何か扱い辛いぞ。10個のユーザーフォームがあったら、一つずつ閉じて回るのか?面倒くさいことこの上ない。
ということで、全部壊して作り直してみた。
まず、ユーザーフォーム側の大部分のコードを、標準モジュールに移動させた。
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 ' 約数を求める関数。 ' 約数を求めたい関数を1から順に割り、 ' 余りが0の値を約数として辞書に格納する。 ' ※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
次いで、ユーザーフォームを二つ準備する。
1)写真表示用ユーザーフォーム
こちらは、何もコードを持たない、コントロールを配置しただけのフォーム。
2)1)操作用のユーザーフォーム
取り敢えず、サイズ変更用スピンボタンと、一括終了用ボタンを準備した。
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%(1/√2倍)とした。 ' ※馴染みのあるAサイズ(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
それでは、試してみよう。
一昨日より、幾分かマシになったか。
これでようやく、先に進めます。
参考まで。