Imports System.Threading
Public Class Form1
Const thumbnailwidth As Integer = 50
Const thumbnailheight As Integer = 40
Private listitem As New List(Of ListViewItem)
Private thumbnailCache As New Dictionary(Of String, Image)
Private listlock As New Object
Private cts As CancellationTokenSource
Private cachetask As Task
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim imagelist1 As New ImageList
imagelist1.ImageSize = New Size(thumbnailwidth, thumbnailheight)
ListView1.LargeImageList = imagelist1
ListView1.OwnerDraw = True
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim imageDir As String = "C:\Users\user\Pictures"
Dim jpgFiles As IEnumerable = System.IO.Directory.EnumerateFiles(imageDir, "*.jpg", IO.SearchOption.AllDirectories)
If cachetask?.Status = TaskStatus.Running Then
cts.Cancel()
cachetask.Wait()
End If
listitem.Clear()
thumbnailCache.Clear()
For Each file As String In jpgFiles
Dim item = New ListViewItem(file)
listitem.Add(item)
Next
ListView1.VirtualMode = True
ListView1.VirtualListSize = listitem.Count
CreateCache()
End Sub
Private Sub ListView1_RetrieveVirtualItem(sender As Object, e As RetrieveVirtualItemEventArgs) Handles ListView1.RetrieveVirtualItem
If e.Item Is Nothing Then e.Item = listitem(e.ItemIndex)
End Sub
Function createThumbnail(filename As String) As Image
Dim canvas As New Bitmap(thumbnailwidth, thumbnailheight)
Using original = Bitmap.FromFile(filename)
Using g As Graphics = Graphics.FromImage(canvas)
Using WhiteBrush = New SolidBrush(Color.White)
g.FillRectangle(WhiteBrush, 0, 0, thumbnailwidth, thumbnailheight)
End Using
Dim fw As Double = CDbl(thumbnailwidth) / CDbl(original.Width)
Dim fh As Double = CDbl(thumbnailheight) / CDbl(original.Height)
Dim scale As Double = Math.Min(fw, fh)
Dim w2 As Integer = CInt(original.Width * scale)
Dim h2 As Integer = CInt(original.Height * scale)
g.DrawImage(original, (thumbnailwidth - w2) \ 2, (thumbnailheight - h2) \ 2, w2, h2)
End Using
End Using
Return canvas
End Function
Private Sub CreateCache()
cts = New CancellationTokenSource
cachetask = Task.Factory.StartNew(Sub()
Try
For Each item In listitem
If thumbnailCache.ContainsKey(item.Text) = False Then
Dim thumbnail As Image = createThumbnail(item.Text)
SyncLock listlock
If thumbnailCache.ContainsKey(item.Text) = False Then
thumbnailCache.Add(item.Text, thumbnail)
End If
End SyncLock
Threading.Thread.Sleep(0)
cts.Token.ThrowIfCancellationRequested()
End If
Next
Catch ex As OperationCanceledException
Console.WriteLine("キャッシュ作成キャンセル")
End Try
End Sub, cts.Token)
End Sub
Private Sub ListView1_DrawItem(sender As Object, e As DrawListViewItemEventArgs) Handles ListView1.DrawItem
Dim filiename As String = e.Item.Text
Dim thumbnail As Image
If thumbnailCache.ContainsKey(filiename) Then
thumbnail = thumbnailCache(filiename)
Else
thumbnail = createThumbnail(filiename)
SyncLock listlock
If thumbnailCache.ContainsKey(filiename) = False Then
thumbnailCache.Add(filiename, thumbnail)
End If
End SyncLock
End If
Dim imagerect As New Rectangle(New Point(e.Bounds.X + ((e.Bounds.Width - thumbnail.Width) / 2), e.Bounds.Y), New Size(thumbnail.Width, thumbnail.Height))
e.DrawDefault = False
e.DrawBackground()
e.Graphics.DrawImage(thumbnail, imagerect)
Dim stringFormat = New StringFormat()
stringFormat.Alignment = StringAlignment.Center
stringFormat.LineAlignment = StringAlignment.Center
e.Graphics.DrawString(e.Item.Text, ListView1.Font, Brushes.Black, New RectangleF(e.Bounds.X, e.Bounds.Y + imagerect.Height + 5, e.Bounds.Width, e.Bounds.Height - imagerect.Height - 5), stringFormat)
e.DrawFocusRectangle()
End Sub
End Class