縮小画像をPictureBoxに並べて表示
 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
指定のフォルダー内の画像を読込PictureBoxに縮小画像を並べて表示　　(160)
　　 'PictureBox ３個　VScrollBar・CommandButton・FileListBox　各１個
'Picture2 は Picture1 の中に貼り付けて下さい。大きさ・配置は下記にて
'設定しておりますので適当な所に貼り付けておいて下さい。

Option Explicit　　 'SampleNo=160　WindowsXP VB6.0(SP5) 2002.07.03

Private Sub Command1_Click()
　　File1.Path = "c:\windows"　 '画像が入っているフォルダーを指定
　　'取得するファイルのを拡張子で制限
　　File1.Pattern = "*.bmp;*.jpg;*.gif"
　　Picture2.Cls　　　　'一旦表示を消去
　　Call PictureShow　　'表示のプロシージャへ
End Sub

Private Sub Form_Load()
'必要なコントロールとプロパティの設定
　　'別途プロパティで設定されれば下記は必要ありません。
　　Me.WindowState = vbMaximized
　　With Picture1
　　　　.BorderStyle = 0
　　　　.Move 200, 200, 14700, 9500
　　　　.AutoRedraw = True
　　　　.Appearance = 0
　　　　.BackColor = Me.BackColor
　　End With
　　With Picture2
　　　　.BorderStyle = 0
　　　　.Move 0, 0, 18000, 9500
　　　　.AutoRedraw = True
　　　　.Appearance = 0
　　　　.BackColor = &HFF0000
　　End With
　　With Picture3
　　　　.Move 0, 0
　　　　.AutoRedraw = True
　　　　.Appearance = 0
　　　　.Visible = False
　　　　.AutoSize = True
　　End With
　　Command1.Move 500, 9900, 1700, 400
　　VScroll1.Visible = False
　　File1.Visible = False
End Sub


Private Sub PictureShow()
　　Dim x As Long, y As Long, i　　　　　 As Long, Zoom　　As Single
　　Dim LineHei　　　As Long, Pic3Wid　　 As Long, Pic3Hei As Long
　　Dim Pic3WidZoom　As Long, Pic3HeiZoom As Long
　　Zoom = 0.2　　　　　　　　　　　'縮小率の設定
　　On Error Resume Next　　　　　　'ファイルの読み込みエラー等が発生するので
　　For i = 0 To File1.ListCount - 1　　'フォルダー内で見つかったファイル数
　　　　'見つかったファイルを順次読込
　　　　Set Picture3.Picture = LoadPicture(File1.Path & "\" & File1.List(i))
　　　　' Label1.Caption = File1.Path & "\" & filFile.List(i)
　　　　' Label2.Caption = "　" & i + 1 & " ／ " & filFile.ListCount & " 件"
　　　　' DoEvents
　　　　If Err Then
　　　　　　Err.Clear
　　　　　　MsgBox "ファイルの読み込みでエラーが発生しました" & _
　　　　　　　　　　　　　　　　　 File1.Path & "\" & File1.List(i)
　　　　　　Exit For
　　　　End If
　　　　'元のファイルのサイズを取得
　　　　Pic3Wid = Picture3.Width
　　　　Pic3Hei = Picture3.Height
　　　　'そのサイズを縮小率に合わせてサイズ変更
　　　　Pic3WidZoom = Pic3Wid * Zoom
　　　　Pic3HeiZoom = Pic3Hei * Zoom
　　　　'横方向の折り返し処理
　　　　If x > 14700 - Pic3WidZoom Then
　　　　　　x = 0
　　　　　　y = y + LineHei + 20
　　　　　　LineHei = 0
　　　　　　If y >= 7500 Then　 '現在の表示高さ以上の場合
　　　　　　　　Picture2.Top = 7500 - y　　　'スクロールしながら読み込み
　　　　　　　　DoEvents
　　　　　　End If
　　　　End If
　　　　If LineHei < Pic3HeiZoom Then
　　　　　　LineHei = Pic3HeiZoom
　　　　End If
　　　　'表示しきれないので制限する(環境により違いがあります）
　　　　'エラーが発生する訳ではないので取得できない（私が解らない）
　　　　If y > 100000 Then
　　　　　　MsgBox "データが多すぎます。縮小して表示して下さい。"
　　　　　　Exit For
　　　　End If
　　　　'Picture2のサイズをスクロールに合わせて変更
　　　　If Picture2.Height < LineHei + y + 1000 Then
　　　　　　Picture2.Height = LineHei + y + 1000
　　　　End If
　　　　Picture2.PaintPicture Picture3.Picture, x, y, Pic3WidZoom, _
　　　　　　　　　　　　　　　　　　Pic3HeiZoom, 0, 0, Pic3Wid, Pic3Hei
　　　　x = x + Pic3WidZoom + 30
　　　　DoEvents
　　Next i
　　Picture2.Top = 0
　　Call ScrollBarShow
End Sub

Private Sub ScrollBarShow()
'スクロールバーの表示設定
　　Dim Pic1H As Long, Pic1W As Long, Pic1L As Long, Pic1T As Long
　　Dim Pic2H As Long, Pic2W As Long
　　With Picture1
　　　　Pic1H = .Height
　　　　Pic1W = .Width
　　　　Pic1L = .Left
　　　　Pic1T = .Top
　　End With
　　With Picture2
　　　　Pic2H = .Height
　　　　Pic2W = .Width
　　End With
　　'各Pictureのサイズを取得してVScroll1の表示位置を設定
　　With VScroll1
　　　　.Top = Pic1T
　　　　.Left = Pic1L + Pic1W
　　　　.Height = Pic1H
　　　　.Max = 100
　　　　.Visible = (Pic1H < Pic2H)
　　End With
End Sub

Private Sub VScroll1_Change()
　　'スクロール量の設定
　　Picture2.Top = -((Picture2.Height - 10000) * (VScroll1.Value / 100))
End Sub
　
時々、PictureBox のスクロールの仕方や表示位置の指定方法、スクロールしながらの表示の
仕方等の質問がありますのでそれらを踏まえたサンプルを作って見ました。
サンプルを簡単にするために直接フォルダー名を指定する等不必要な部分は省略しておりますし、
コントロールの表示位置等も機種による考慮はしておりません。
StretchBlt APIを使って縮小画像を転送すると綺麗な縮小画像を表示する事ができるのですが
表示に４倍近くかかってしまいます。
この方法より早く、綺麗な画像を表示できる方法がありましたら、ご教授願います。但し、あまり
複雑にならない範囲の方法でお願いします。






2003/02/12