時間のかかる処理中でもアプリを操作できるように
BackgroundWorkerコンポーネントを使って処理時間をごまかす
BackgroundWorkerの使い方メモ
環境
OS：Windows 10
使ったアプリ：Visual Studio Community 2015
画像を読み込んでいる時には操作も受け付けない状態なのを改善したくて
時間のかかる処理の進行状況を表示する: .NET Tips: C#, VB.NETここを見てなんとかできそうなところまでできた
http://dobon.net/vb/dotnet/programing/displayprogress.html
Button1を押すと指定したフォルダの画像ファイルを読み込んで画像一覧表示開始
緑のバーが処理の進み具合のプログレスバー
Button2を押すと処理のキャンセル
画像を読み込んでいる最中でもアプリの操作ができるようにと
読み込みが終わった画像からどんどん表示されるように
一番時間がかかる画像を読み込んで縮小画像作成する部分を
BackgroundWorkerコンポーネントを使って処理している
指定したフォルダはエクスプローラだとこう見えている
ファイル数は323個、フォルダ数は3個
ファイルは全て画像ファイルパスは "D:\ブログ用\作物"
デザイン画面
デザイン画面で追加するコントロールは
Button1、Button2、ProgressBar1、ListView1、BackgroundWorker1、ImageList1
大きさや配置以外のプロパティはそのままで変更なし
必要な変更はコードに書いた
コード
'時間のかかる処理の進行状況を表示する: .NET Tips: C#, VB.NET
Imports System.ComponentModel
Imports System.IO
Public Class Form1
Private iconSize As New Size(64, 64)
'最初の準備
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
With ImageList1
.ColorDepth = ColorDepth.Depth32Bit
.ImageSize = iconSize
End With
With ListView1
.Anchor = 1 Or 2 Or 4 Or 8
.LargeImageList = ImageList1
End With
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If BackgroundWorker1.IsBusy Then 'バックグラウンド処理中なら何もしない
Return
End If
'画像ファイルだけ入っているフォルダを指定
Dim dir() As String = Directory.GetFiles("D:\ブログ用\作物") '326ファイル
'Dim dir() As String = Directory.GetFiles("D:\ブログ用\チェック用2") '3000ファイル
Dim i As Integer
Dim lv As ListView = ListView1
Dim il As ImageList = ImageList1
Dim kari As Bitmap = SystemIcons.Application.ToBitmap '仮のアイコン画像
Cursor = Cursors.WaitCursor '待ちカーソル
ProgressBar1.Minimum = 0
ProgressBar1.Maximum = UBound(dir)
Dim lvi As New List(Of ListViewItem)
For i = 0 To UBound(dir)
lvi.Add(New ListViewItem(Path.GetFileName(dir(i)), i))
il.Images.Add(kari)
Next
lv.Items.AddRange(lvi.ToArray)
Cursor = Cursors.Default 'カーソルを元に戻す
'バックグラウンド処理
With BackgroundWorker1
.WorkerReportsProgress = True '進行状況の報告できるように
.WorkerSupportsCancellation = True 'キャンセルできるように
.RunWorkerAsync(dir) 'バックグラウンド処理開始、画像ファイルのパスを渡す
End With
End Sub
'バックグラウンド処理
Private Sub BackgroundWorker1_DoWork(sender As Object, e As DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim dir() As String = e.Argument '渡されたファイルのパスを受け取る
Dim i As Integer
Dim img As Image
Dim bgw As BackgroundWorker = DirectCast(sender, BackgroundWorker)
Dim g As Graphics
Dim w As Integer = iconSize.Width
Dim h As Integer = iconSize.Height
For i = 0 To UBound(dir)
'キャンセルされたか判定して処理
If bgw.CancellationPending Then
e.Cancel = True
Return
End If
Dim bmp As New Bitmap(w, h)
g = Graphics.FromImage(bmp)
'ファイルストリームで読み込んだ画像の縮小画像を作成してReportProgressを使ってProgressChangedに渡す
Using fs As New FileStream(dir(i), FileMode.Open, FileAccess.Read)
img = Image.FromStream(fs) '画像読み込み
g.DrawImage(img, 0, 0, w, h) '縮小画像作成
bgw.ReportProgress(i, bmp) '縮小画像を渡す
g.Dispose()
End Using
Next
End Sub
'バックグラウンド処理で作成された縮小画像を受け取ってImageListの仮の画像に上書き(入れ替え)する
Private Sub BackgroundWorker1_ProgressChanged(sender As Object, e As ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
Dim i As Integer = e.ProgressPercentage
Dim lv As ListView = ListView1
ImageList1.Images.Item(i) = DirectCast(e.UserState, Bitmap) '画像入れ替え
If i = 10 Then lv.Refresh() '10個めの画像を受け取ったらListViewの再描画
ProgressBar1.Value = i
End Sub
'バックグラウンド処理が終わった時の処理、必要はない
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
If e.Error IsNot Nothing Then
MsgBox("エラー発生：" & e.Error.Message)
ElseIf e.Cancelled Then
MsgBox("処理を中止しました")
Else
MsgBox("完了")
End If
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
'バックグラウンド処理のキャンセルを要求
BackgroundWorker1.CancelAsync()
End Sub
End Class
009: '最初の準備
010: Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
011: With ImageList1
012: .ColorDepth = ColorDepth.Depth32Bit
013: .ImageSize = iconSize
014: End With
015: With ListView1
016: .Anchor = 1 Or 2 Or 4 Or 8
017: .LargeImageList = ImageList1
018: End With
019: End Sub
起動時にListView1のLargeImageListにImageList1を指定する（17行目
036: Dim lvi As New List(Of ListViewItem)
037: For i = 0 To UBound(dir)
038: lvi.Add(New ListViewItem(Path.GetFileName(dir(i)), i))
039: il.Images.Add(kari)
040: Next
041: lv.Items.AddRange(lvi.ToArray)
042: Cursor = Cursors.Default 'カーソルを元に戻す
043:
044: 'バックグラウンド処理
045: With BackgroundWorker1
046: .WorkerReportsProgress = True '進行状況の報告できるように
047: .WorkerSupportsCancellation = True 'キャンセルできるように
048: .RunWorkerAsync(dir) 'バックグラウンド処理開始、画像ファイルのパスを渡す
049: End With
Button1が押されたら
dir()に指定フォルダの中のすべてのファイル名を入れる（26行目
ファイル名がListView1の項目の表示名になる
lviに作成した項目(ListViewItem)を入れて
ImageListには仮の画像を追加していく（37-40
ListView1にすべての項目を追加（41
すべての項目を作成、アイコン画像は仮の画像になっている
ここまでできたらバックグラウンド処理開始の合図（48
BackgroundWorkerのDoWorkイベントに移る
BackgroundWorkerのDoWorkイベントの中
072: Using fs As New FileStream(dir(i), FileMode.Open, FileAccess.Read)
073: img = Image.FromStream(fs) '画像読み込み
074: g.DrawImage(img, 0, 0, w, h) '縮小画像作成
075: bgw.ReportProgress(i, bmp) '縮小画像を渡す
076: g.Dispose()
077: End Using
一番時間がかかるところはこのDoWorkイベントで処理することで
処理中でもアプリの操作が可能になる
画像ファイルを読み込んで、縮小画像作成
できた縮小した画像をImageList1に登録するんだけど
この登録処理はBackgroundWorkerのDoWorkの中では実行できないので
BackgroundWorkerのProgressChangedイベントを発生させて
そこに渡して登録処理をする
これが75行目のReportProgressメソッド
これにできあがった縮小画像を持たせてあげる
BackgroundWorkerのProgressChangedイベントの中
086: ImageList1.Images.Item(i) = DirectCast(e.UserState, Bitmap) '画像入れ替え
e.UserStateで渡されたものを受け取ることができる
Bitmap画像なのでDirectCastでBitmapに変換して
ImageList1に登録、というか仮の画像に上書きしている
ここでなんで仮の画像を指定した後に縮小画像を指定し直すなんて面倒なことをしているのか、最初から縮小画像を指定すればいいじゃんってことなんだけど
最初は
039: il.Images.Add(kari)
仮の画像を登録するこの39行目を実行しないで86行目で登録する
086: ImageList1.Images.Add(DirectCast(e.UserState, Bitmap))
こうしていたんだけど、これだとここで処理が止まってしまう
理由はわからない
なので仮の画像を登録しておいて後から画像を入れ替えるのはどうだろうって
試したらうまくいったので今の方法になったってわけ
これでなんとか画像を読み込んでいる時間はごまかすことができた！
次に気になったのがListViewにListViewItemを作成して登録するところでも時間がかかっている！
でもこの部分はコントロールへの変更処理だからBackgroundWorkerでは処理できない
まずはどれくらい時間がかかっているか
323個のListViewItem作成登録とImageListへ画像登録にかかる時間
1.69秒
ImageListへは一個一個登録
0.32秒、5倍以上速くなった
0.65秒
さっきより少し遅い
でも両方共まとめて登録すれば速いかなあって思って
0.35秒
両方共まとめて登録してみたら速くなったけどListViewItemだけまとめて登録の時とほとんど差がないってことは
画像の指定は一個一個でも、まとめてからのどちらでもいいけど
ListViewItemの登録はまとめたほうが速い！
CPUのクロックは3GHzの100%固定で計測
AMD PhenomⅡ X3 720
ここまで書いていてちょっと違うことに気づいた
DoWorkイベントの中から縮小画像をProgressChangedイベントへ渡して
画像の入れ替えをしていたけど
075: bgw.ReportProgress(i, bmp) '縮小画像を渡す
086: ImageList1.Images.Item(i) = DirectCast(e.UserState, Bitmap) '画像入れ替え
この入れ替えはわざわざ渡さなくても、DoWorkの中で処理できる、できた
なので75行目を
075: ImageList1.Images.Item(i) = bmp '画像入れ替え
076: bgw.ReportProgress(i)
こう書き換えて、86行目は要らない
書き直した、太字のところが書き換えたところ
'時間のかかる処理の進行状況を表示する: .NET Tips: C#, VB.NET
Imports System.ComponentModel
Imports System.IO
Public Class Form1
Private iconSize As New Size(64, 64)
'最初の準備
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
With ImageList1
.ColorDepth = ColorDepth.Depth32Bit
.ImageSize = iconSize
End With
With ListView1
.Anchor = 1 Or 2 Or 4 Or 8
.LargeImageList = ImageList1
End With
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If BackgroundWorker1.IsBusy Then 'バックグラウンド処理中なら何もしない
Return
End If
'画像ファイルだけ入っているフォルダを指定
Dim dir() As String = Directory.GetFiles("D:\ブログ用\作物") '326ファイル
'Dim dir() As String = Directory.GetFiles("D:\ブログ用\チェック用2") '3000ファイル
Dim i As Integer
Dim lv As ListView = ListView1
Dim il As ImageList = ImageList1
Dim kari As Bitmap = SystemIcons.Application.ToBitmap '仮のアイコン画像
Cursor = Cursors.WaitCursor '待ちカーソル
ProgressBar1.Minimum = 0
ProgressBar1.Maximum = UBound(dir)
Dim lvi As New List(Of ListViewItem)
For i = 0 To UBound(dir)
lvi.Add(New ListViewItem(Path.GetFileName(dir(i)), i))
il.Images.Add(kari)
Next
lv.Items.AddRange(lvi.ToArray)
Cursor = Cursors.Default 'カーソルを元に戻す
'バックグラウンド処理
With BackgroundWorker1
.WorkerReportsProgress = True '進行状況の報告できるように
.WorkerSupportsCancellation = True 'キャンセルできるように
.RunWorkerAsync(dir) 'バックグラウンド処理開始、画像ファイルのパスを渡す
End With
End Sub
'バックグラウンド処理
Private Sub BackgroundWorker1_DoWork(sender As Object, e As DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim dir() As String = e.Argument '渡されたファイルのパスを受け取る
Dim i As Integer
Dim img As Image
Dim bgw As BackgroundWorker = DirectCast(sender, BackgroundWorker)
Dim g As Graphics
Dim w As Integer = iconSize.Width
Dim h As Integer = iconSize.Height
Dim ic As ImageList.ImageCollection = ImageList1.Images
For i = 0 To UBound(dir)
'キャンセルされたか判定して処理
If bgw.CancellationPending Then
e.Cancel = True
Return
End If
Dim bmp As New Bitmap(w, h)
g = Graphics.FromImage(bmp)
'ファイルストリームで読み込んだ画像の縮小画像を作成してImageListの画像に指定する
Using fs As New FileStream(dir(i), FileMode.Open, FileAccess.Read)
img = Image.FromStream(fs) '画像読み込み
g.DrawImage(img, 0, 0, w, h) '縮小画像作成
ic.Item(i) = bmp '画像入れ替え
bgw.ReportProgress(i) '進行状況(何番目の処理中か)を渡す
g.Dispose()
End Using
Next
End Sub
'バックグラウンド処理で作成された縮小画像を受け取ってImageListの仮の画像に上書き(入れ替え)する
Private Sub BackgroundWorker1_ProgressChanged(sender As Object, e As ProgressChangedEventArgs
) Handles BackgroundWorker1.ProgressChanged
Dim i As Integer = e.ProgressPercentage
If i = 10 Then ListView1.Refresh() '10個めの画像を受け取ったらListViewの再描画
ProgressBar1.Value = i
End Sub
'バックグラウンド処理が終わった時の処理、必要はない
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs
) Handles BackgroundWorker1.RunWorkerCompleted
If e.Error IsNot Nothing Then
MsgBox("エラー発生：" & e.Error.Message)
ElseIf e.Cancelled Then
MsgBox("処理を中止しました")
Else
MsgBox("完了")
End If
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
'バックグラウンド処理のキャンセルを要求
BackgroundWorker1.CancelAsync()
End Sub
End Class
黄色ラインが変更や追加、灰色が削除のあった箇所
後はこの前のアプリにこの機能を付け加えられるかだなあ
ダウンロード
OneDrive