プログレスバーは水平方向に、左から右へ。と思ってたのですが、
世の中には色々な事を考える人がいるもんですね。
垂直方向のプログレスバーの実装の仕方が ProgressBarRenderer クラス に書いてあります。
それと、今回は Style プロパティや ForeColor プロパティをいじる際に Visual Style が有効であるかどうかの判定を
行う必要があったため、ちょっとだけ調べてみました。
visual スタイルが使用されているコントロールのレンダリング
の visual スタイルのサポートのチェック にある通りにチェックしていけばよさげな感じです。
■参考文献
ProgressBar クラス
ProgressBarRenderer クラス
visual スタイルが使用されているコントロールのレンダリング
■実行画像
VisualStyle 有効

VisualStyle 無効

しばしお待ち下さい画面

Public Class ProgressBarTest
'' おまけ XP Style が有効かどうかの判定
<System.Runtime.InteropServices.DllImport("UxTheme.dll", CharSet:=System.Runtime.InteropServices.CharSet.Auto)> _
Shared Function IsAppThemed() As Boolean
End Function
Private Const PROGRESSBAR_NAME As String = "MyProgressBar"
Private Const STSSTRIP_NAME As String = "MyStatusStrip"
Private Const STSPROGRESSBAR_NAME As String = "MyStatusProgressBar"
Private Const STSLABEL_NAME As String = "MyStatusLabel"
Private ReadOnly PROGRESSBAR_SIZE As Size = New Size(150, 15)
Private Sub ProgressBarTest_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim blocksProgressBar As ProgressBar = New ProgressBar()
Me.Controls.Add(blocksProgressBar)
With blocksProgressBar
.Location = New Point(10, 40)
.Size = PROGRESSBAR_SIZE
.Style = ProgressBarStyle.Blocks
.Maximum = 100 ' 最大値
.Minimum = 1 ' 最小値
.Step = 1 ' 増減値
.Increment(20) ' 20 進める
.Increment(-10) ' -10 進める
.PerformStep() ' Step 分進める
' MouseHover 時に StatusStrip の Label に Style を表示する
AddHandler .MouseHover, AddressOf ProgressBars_MouseEnter
AddHandler .MouseLeave, AddressOf ProgressBars_MouseLeave
End With
If Not IsSupportedVisualStyle() Then
' VisualStyle が 有効でない場合 Continuous
Dim continuousProgressBar As ProgressBar = New ProgressBar()
Me.Controls.Add(continuousProgressBar)
With continuousProgressBar
.Location = New Point(10, 60)
.Size = PROGRESSBAR_SIZE
.Name = PROGRESSBAR_NAME
.Style = ProgressBarStyle.Continuous
' VisualStyle が有効でない場合のみ ForeColor の変更可能
.ForeColor = Color.Salmon
.Maximum = 100
' MouseHover 時に StatusStrip の Label に Style を表示する
AddHandler .MouseHover, AddressOf ProgressBars_MouseEnter
AddHandler .MouseLeave, AddressOf ProgressBars_MouseLeave
End With
Else
' VisualStyle が 有効な場合 Marquee
Dim marqueeProgressBar As ProgressBar = New ProgressBar()
Me.Controls.Add(marqueeProgressBar)
With marqueeProgressBar
.Location = New Point(10, 60)
.Size = PROGRESSBAR_SIZE
.Name = PROGRESSBAR_NAME
.Style = ProgressBarStyle.Marquee
.MarqueeAnimationSpeed = 1000 ' Marquee の時のアニメーションスピード
.Maximum = 100
' MouseHover 時に StatusStrip の Label に Style を表示する
AddHandler .MouseHover, AddressOf ProgressBars_MouseEnter
AddHandler .MouseLeave, AddressOf ProgressBars_MouseLeave
End With
End If
'' StatusStrip に ToolStripProgressBar を配置する
Dim stsStrip As StatusStrip = New StatusStrip()
With stsStrip
.Dock = DockStyle.Bottom
.Name = STSSTRIP_NAME
End With
Me.Controls.Add(stsStrip)
' Label in StatusStrip
Dim toolstriplabel As ToolStripLabel = New ToolStripLabel()
stsStrip.Items.Add(toolstriplabel)
With toolstriplabel
.Name = STSLABEL_NAME
.Alignment = ToolStripItemAlignment.Left
.AutoSize = False
.TextAlign = ContentAlignment.MiddleLeft
.Size = New Size(100, .Size.Height)
End With
' ProgressBar in StatusStrip
Dim toolstripProgress As ToolStripProgressBar = New ToolStripProgressBar()
stsStrip.Items.Add(toolstripProgress)
With toolstripProgress
.Name = STSPROGRESSBAR_NAME
.Alignment = ToolStripItemAlignment.Right ' 位置
.Style = ProgressBarStyle.Blocks
.Size = PROGRESSBAR_SIZE
End With
'' 開始ボタン
Dim startButton As Button = New Button()
Me.Controls.Add(startButton)
With startButton
.Text = "開始"
.Location = New Point(10, 10)
AddHandler .Click, AddressOf StartButton_Click
End With
'' 読込ボタン
Dim readButton As Button = New Button()
Me.Controls.Add(readButton)
With readButton
.Text = "読込"
.Location = New Point(100, 10)
AddHandler .Click, AddressOf ReadButton_Click
End With
End Sub
'' 開始ボタン
Public Sub StartButton_Click(ByVal sender As Object, ByVal e As System.EventArgs)
Dim prgBar As ProgressBar = DirectCast(Me.Controls(PROGRESSBAR_NAME), ProgressBar)
prgBar.Value = 0
For counter As Integer = prgBar.Minimum To prgBar.Maximum
System.Threading.Thread.Sleep(1000)
Application.DoEvents()
prgBar.Value = counter
Next
End Sub
Private Const DIALOG_PRGORESS_NAME As String = "myDialogProgressBar"
Private m_myDialog As Form
Private m_myData As DataTable
'' 読込ボタン
Public Sub ReadButton_Click(ByVal sender As Object, ByVal e As System.EventArgs)
'' ToolStripProgressBar の設定
Dim stsPrgBar As ToolStripProgressBar = _
DirectCast(DirectCast(Me.Controls(STSSTRIP_NAME), StatusStrip).Items(STSPROGRESSBAR_NAME), ToolStripProgressBar)
With stsPrgBar
.Minimum = 0
.Maximum = 100
.Value = 0
End With
'' ダイアログ の設定
Dim myDialogProgress As ProgressBar = New ProgressBar()
With myDialogProgress
.Location = New Point(10, 10)
.Size = PROGRESSBAR_SIZE
.Name = DIALOG_PRGORESS_NAME
.Minimum = 0
.Maximum = 100
.Value = 0
End With
Me.m_myDialog = New Form()
With Me.m_myDialog
.Size = New Size(200, 100)
.ControlBox = False
.Controls.Clear()
.Controls.Add(myDialogProgress)
.Show()
End With
'' BackGroundWorker の設定
Dim bk As System.ComponentModel.BackgroundWorker = _
New System.ComponentModel.BackgroundWorker()
bk.WorkerReportsProgress = True ' 進捗の通知を可能にする
AddHandler bk.DoWork, AddressOf DoWork
AddHandler bk.ProgressChanged, AddressOf ProgressChanged
AddHandler bk.RunWorkerCompleted, AddressOf RunWorkerCompleted
bk.RunWorkerAsync()
End Sub
'' 非同期の仕事
Private Sub DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs)
' SQL Server の Northwind の Invoices から先頭 100 件を取得
Const CONNECTION_STRING As String = _
"Data Source=(local);Initial Catalog=Northwind;Integrated Security=SSPI;"
Me.m_myData = New DataTable()
Using connection As SqlClient.SqlConnection = New SqlClient.SqlConnection(CONNECTION_STRING)
connection.Open()
Try
Using adapter As SqlClient.SqlDataAdapter = _
New SqlClient.SqlDataAdapter("SELECT TOP 100 * FROM Invoices", connection)
adapter.Fill(Me.m_myData)
End Using
Finally
If Not connection Is Nothing Then connection.Close()
End Try
End Using
Dim bk As System.ComponentModel.BackgroundWorker = _
DirectCast(sender, System.ComponentModel.BackgroundWorker)
For counter As Integer = 0 To Me.m_myData.Rows.Count - 1
System.Diagnostics.Debug.WriteLine(StrDup(50, "="c))
' 進捗報告
bk.ReportProgress(CInt(Math.Floor(counter + 1 / (Me.m_myData.Rows.Count))))
For filedCounter As Integer = 0 To Me.m_myData.Columns.Count - 1
Dim fieldName As String = Me.m_myData.Columns(filedCounter).ColumnName
System.Diagnostics.Debug.WriteLine(fieldName & ":" & Convert.ToString(Me.m_myData.Rows(counter)(filedCounter)))
Next
Next
End Sub
' 非同期の仕事で進捗があったとき
Private Sub ProgressChanged(ByVal sender As Object, ByVal e As System.ComponentModel.ProgressChangedEventArgs)
'' StatusStrip の ToolStripProgressBar を進める
Dim stsPrgBar As ToolStripProgressBar = _
DirectCast(DirectCast(Me.Controls(STSSTRIP_NAME), StatusStrip).Items(STSPROGRESSBAR_NAME), ToolStripProgressBar)
stsPrgBar.Value = e.ProgressPercentage
'' ダイアログの ProgressBar を進める
Dim prgBar As ProgressBar = DirectCast(Me.m_myDialog.Controls(DIALOG_PRGORESS_NAME), ProgressBar)
prgBar.Value = e.ProgressPercentage
Me.m_myDialog.Text = String.Format("しばしお待ち下さい... {0}%", e.ProgressPercentage)
End Sub
' 非同期の仕事が終わったとき
Private Sub RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs)
If Not Me.m_myDialog Is Nothing Then
Me.m_myDialog.Close()
Me.m_myDialog.Dispose()
End If
End Sub
'' MouseHover 時に StatusStrip の Label に Style を表示する
Private Sub ProgressBars_MouseEnter(ByVal sender As Object, ByVal e As EventArgs)
Dim lb As ToolStripLabel = _
DirectCast(DirectCast(Me.Controls(STSSTRIP_NAME), StatusStrip).Items(STSLABEL_NAME), ToolStripLabel)
lb.Text = DirectCast(sender, ProgressBar).Style.ToString()
End Sub
Private Sub ProgressBars_MouseLeave(ByVal sender As Object, ByVal e As EventArgs)
Dim lb As ToolStripLabel = _
DirectCast(DirectCast(Me.Controls(STSSTRIP_NAME), StatusStrip).Items(STSLABEL_NAME), ToolStripLabel)
lb.Text = String.Empty
End Sub
' Visual Style が有効かどうかのチェック
Private Function IsSupportedVisualStyle() As Boolean
' オペレーティング システムが visual スタイルをサポートしている
If Not System.Windows.Forms.VisualStyles.VisualStyleInformation.IsSupportedByOS() Then Return False
' ユーザーが、オペレーティング システムで visual スタイルを有効にしている
If Not System.Windows.Forms.VisualStyles.VisualStyleInformation.IsEnabledByUser() Then Return False
' アプリケーション ウィンドウのクライアント領域を描画するために、visual スタイルが使用されている
If Not Application.VisualStyleState = VisualStyles.VisualStyleState.ClientAndNonClientAreasEnabled AndAlso _
Not Application.VisualStyleState = VisualStyles.VisualStyleState.ClientAreaEnabled Then Return False
Return True
End Function
End Class