回答編集履歴

1

追記

2021/12/31 02:13

投稿

YAmaGNZ
YAmaGNZ

スコア10222

test CHANGED
@@ -7,3 +7,281 @@
7
7
  とすれば高速化できないでしょうか。
8
8
 
9
9
  ちょっと古い記事ですが[サムネイル画像の生成と表示](https://clown.cube-soft.jp/entry/20101008/1286517159)が参考になるのではないかと思います。
10
+
11
+
12
+
13
+ とりあえず動くものを作ってみました。
14
+
15
+ 言いたいことは伝わるのではないかと思います。
16
+
17
+ ```VBNET
18
+
19
+ Imports System.Threading
20
+
21
+
22
+
23
+ Public Class Form1
24
+
25
+
26
+
27
+ Const thumbnailwidth As Integer = 100
28
+
29
+ Const thumbnailheight As Integer = 80
30
+
31
+
32
+
33
+ Private listitem As New List(Of ListViewItem)
34
+
35
+ Private thumbnailCache As New Dictionary(Of String, Image)
36
+
37
+ Private listlock As New Object
38
+
39
+ Private cts As CancellationTokenSource
40
+
41
+ Private cachetask As Task
42
+
43
+
44
+
45
+ Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
46
+
47
+ Dim imagelist1 As New ImageList
48
+
49
+ imagelist1.ImageSize = New Size(thumbnailwidth, thumbnailheight)
50
+
51
+ ListView1.LargeImageList = imagelist1
52
+
53
+ ListView1.OwnerDraw = True
54
+
55
+ End Sub
56
+
57
+
58
+
59
+
60
+
61
+ Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
62
+
63
+ Dim imageDir As String = "C:\Users\user\Pictures" ' 画像ディレクトリ
64
+
65
+ Dim jpgFiles As IEnumerable = System.IO.Directory.EnumerateFiles(imageDir, "*.jpg", IO.SearchOption.AllDirectories)
66
+
67
+
68
+
69
+ 'サムネイルキャッシュ作成中であればキャンセル
70
+
71
+ If cachetask?.Status = TaskStatus.Running Then
72
+
73
+ cts.Cancel()
74
+
75
+ cachetask.Wait()
76
+
77
+ End If
78
+
79
+
80
+
81
+ listitem.Clear()
82
+
83
+ thumbnailCache.Clear()
84
+
85
+
86
+
87
+ For Each file As String In jpgFiles
88
+
89
+ Dim item = New ListViewItem(file)
90
+
91
+ listitem.Add(item)
92
+
93
+ Next
94
+
95
+ ListView1.VirtualMode = True
96
+
97
+ ListView1.VirtualListSize = listitem.Count
98
+
99
+
100
+
101
+ 'キャッシュ作成開始
102
+
103
+ CreateCache()
104
+
105
+ End Sub
106
+
107
+
108
+
109
+ Private Sub ListView1_RetrieveVirtualItem(sender As Object, e As RetrieveVirtualItemEventArgs) Handles ListView1.RetrieveVirtualItem
110
+
111
+ If e.Item Is Nothing Then e.Item = listitem(e.ItemIndex)
112
+
113
+ End Sub
114
+
115
+
116
+
117
+
118
+
119
+ Function createThumbnail(filename As String) As Image
120
+
121
+ Dim canvas As New Bitmap(thumbnailwidth, thumbnailheight)
122
+
123
+
124
+
125
+ Using original = Bitmap.FromFile(filename)
126
+
127
+
128
+
129
+ Using g As Graphics = Graphics.FromImage(canvas)
130
+
131
+ Using WhiteBrush = New SolidBrush(Color.White)
132
+
133
+ g.FillRectangle(WhiteBrush, 0, 0, thumbnailwidth, thumbnailheight)
134
+
135
+ End Using
136
+
137
+
138
+
139
+ Dim fw As Double = CDbl(thumbnailwidth) / CDbl(original.Width)
140
+
141
+ Dim fh As Double = CDbl(thumbnailheight) / CDbl(original.Height)
142
+
143
+ Dim scale As Double = Math.Min(fw, fh)
144
+
145
+
146
+
147
+ Dim w2 As Integer = CInt(original.Width * scale)
148
+
149
+ Dim h2 As Integer = CInt(original.Height * scale)
150
+
151
+
152
+
153
+ g.DrawImage(original, (thumbnailwidth - w2) \ 2, (thumbnailheight - h2) \ 2, w2, h2)
154
+
155
+ End Using
156
+
157
+ End Using
158
+
159
+
160
+
161
+ Return canvas
162
+
163
+ End Function
164
+
165
+
166
+
167
+
168
+
169
+ Private Sub CreateCache()
170
+
171
+ cts = New CancellationTokenSource
172
+
173
+ cachetask = Task.Factory.StartNew(Sub()
174
+
175
+ Try
176
+
177
+
178
+
179
+ For Each item In listitem
180
+
181
+ If thumbnailCache.ContainsKey(item.Text) = False Then
182
+
183
+ Dim thumbnail As Image = createThumbnail(item.Text)
184
+
185
+ SyncLock listlock
186
+
187
+ If thumbnailCache.ContainsKey(item.Text) = False Then
188
+
189
+ thumbnailCache.Add(item.Text, thumbnail)
190
+
191
+ End If
192
+
193
+ End SyncLock
194
+
195
+ Threading.Thread.Sleep(0)
196
+
197
+ cts.Token.ThrowIfCancellationRequested()
198
+
199
+ End If
200
+
201
+ Next
202
+
203
+
204
+
205
+ Catch ex As OperationCanceledException
206
+
207
+ Console.WriteLine("キャッシュ作成キャンセル")
208
+
209
+ End Try
210
+
211
+
212
+
213
+ End Sub, cts.Token)
214
+
215
+
216
+
217
+ End Sub
218
+
219
+
220
+
221
+ Private Sub ListView1_DrawItem(sender As Object, e As DrawListViewItemEventArgs) Handles ListView1.DrawItem
222
+
223
+ Dim filiename As String = e.Item.Text
224
+
225
+ Dim thumbnail As Image
226
+
227
+
228
+
229
+ 'サムネイルキャッシュに含まれている場合はキャッシュを
230
+
231
+ 'そうでない場合はサムネイルを作成、キャッシュに追加したのち描画する
232
+
233
+ If thumbnailCache.ContainsKey(filiename) Then
234
+
235
+ thumbnail = thumbnailCache(filiename)
236
+
237
+ Else
238
+
239
+ thumbnail = createThumbnail(filiename)
240
+
241
+ SyncLock listlock
242
+
243
+ If thumbnailCache.ContainsKey(filiename) = False Then
244
+
245
+ thumbnailCache.Add(filiename, thumbnail)
246
+
247
+ End If
248
+
249
+ End SyncLock
250
+
251
+ End If
252
+
253
+
254
+
255
+ 'アイテムの描画
256
+
257
+ 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))
258
+
259
+
260
+
261
+ e.DrawDefault = False
262
+
263
+ e.DrawBackground()
264
+
265
+ e.Graphics.DrawImage(thumbnail, imagerect)
266
+
267
+
268
+
269
+ Dim stringFormat = New StringFormat()
270
+
271
+ stringFormat.Alignment = StringAlignment.Center
272
+
273
+ stringFormat.LineAlignment = StringAlignment.Center
274
+
275
+ 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)
276
+
277
+
278
+
279
+ e.DrawFocusRectangle()
280
+
281
+ End Sub
282
+
283
+
284
+
285
+ End Class
286
+
287
+ ```