VB.NETで円グラフ

原文／情報元（C#.NET） ⇒ 類似情報

VB.NET で円グラフを動的に作るサンプルソース

2005/10/17版
AccessDB.mdb

---

◆ソースコード（ＶＢ．ＮＥＴ）
　汎用される場合はデータベース（＊.mdb）に合せて朱文字のみを変更すればＯＫのハズです。（最低４箇所）

=== ここより ===
<%@ Page language="VB" Debug="true" %>
<%@ Import Namespace="System.Data" %>
<%@ Import Namespace="System.Data.OleDb" %>
<%@ Import Namespace="System.Drawing" %>
<%@ Import Namespace="System.Drawing.Imaging" %>
<%@ Import Namespace="System.Math" %>

<script language="VB" runat="server">

Sub Page_Load(sender As [Object], e As EventArgs)
' データベースに接続して，特定のテーブルの特定のカラムのための情報を獲得する必要がある
Dim tableName As String = "Products" ' テーブル名
Dim dataColumnName As String = "UnitPrice" ' フィールド(data)名
Dim labelColumnName As String = "ProductName" ' フィールド(name)名
Dim title As String = "表題：円グラフ" ' 円グラフのタイトル（表題）
Dim width As Integer = 300 ' 円グラフ全体のサイズ（大きさ）

' 1. 接続を作成する
Dim connString As [String] = " Provider = Microsoft.Jet.OLEDB.4.0; Data Source = " + Server.MapPath("Access.mdb")
Dim myConnection As New OleDbConnection(connString)
Try ' DBオープンエラー処理
myConnection.Open()
Catch
Response.Write("mdbファイルが見つかりませんでした。
：")
Response.End()
End Try

' 2. クエリーのためのコマンドオブジェクトを作成する
'Dim sql As [String] = "SELECT [" + dataColumnName + "], " + labelColumnName + " FROM [" + tableName + "]"
Dim sql As [String] = "SELECT * FROM " + tableName
Dim myCommand As New OleDbCommand(sql, myConnection)

' 3. DataSetを作成／充填する
Dim ds As New DataSet()
Dim myAdapter As New OleDbDataAdapter(myCommand)
Try ' データベース排他接続時のエラー処理
myAdapter.Fill(ds)
Catch
'Dim today As Datetime = today ' ←何のこっちゃ！
Response.Write("データベースは（他者により）既に排他的に開かれています。
データベース利用者へ（排他処理「例えばデザインビューモード」を）開放する様に伝えてください。

<% = today %>")
Response.End()
End Try

' 接続を閉じる
myConnection.Close()


' 全データ件数（totalCount）を取得
Dim totalCount As Integer = ds.Tables(0).Rows.Count ' IntegerはInt32でも全く同じ（なぜならIntegerとInt32は同一値を扱うから）

' 数値データの合計（total）を計算する
Dim total As Decimal = 0F ' 初期値は 0 とす.（取り扱うデータ値をDecimal型とす／誤差が出ない様にするため）
Dim tmp As Decimal
Dim iLoop As Int32 ' iLoopには0～負の値を持つ整数である（元ソースはInteger型なるもInt32へ変えた／但しIntegerとInt32は同一値を扱える）.
For iLoop = 0 To totalCount - 1 ' iLoop++ と、++ iLoop は同じ！？
tmp = Convert.ToDecimal(ds.Tables(0).Rows(iLoop)(dataColumnName))
total += tmp
Next iLoop

' 凡例とタイトルのためのフォントを作る必要がある。文字サイズは（凡例：10、タイトル：15（ボルドスタイル））とす。
Dim fontLegend As New Font("Verdana", 10)
Dim fontTitle As New Font("Verdana", 15, FontStyle.Bold)

' 凡例とタイトルを作る必要があるが，どれだけの大きさだろうか？　凡例とタイトルの高さによって，円グラフ全体のサイズも調整しなければならない
Const bufferSpace As Integer = 15 ' 上余白
Dim legendHeight As Integer = fontLegend.Height *(totalCount + 1) + bufferSpace ' 凡例領域の高さ：凡例領域の高さ（凡例１行の高さ * (件数 + 1)） + 上余白の高さ
Dim titleHeight As Integer = fontTitle.Height + bufferSpace ' titleの高さ ：上余白の高さ + titolフォントの高さ
Dim height As Integer = width + legendHeight + titleHeight + bufferSpace ' 全体の高さ ：width（円グラフ領域）+ 凡例領域の高さ + タイトルの高さ + 上余白の高さ
Dim pieHeight As Integer = width ' 円グラフの高さ：1対1の比率を維持する（円とする為に）

' ▼解説▼
' Rectangle 構造体
' 四角形の位置とサイズを表す 4 つの整数を格納します。
' http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/cpref/html/frlrfsystemdrawingrectangleclasstopic.asp
' ▼事例／ RectangleF(x, y, width, height)
' y
' x ＋─(Width) ┐
' │■■■■■(Heitht)
' └─────┘

' 円グラフを描くための矩形（四角形）を作る
Dim pieRect As New System.Drawing.Rectangle(0, titleHeight, width, pieHeight)

' ランダムな256色のArrayList（配列リスト）を作る
Dim colors As New ArrayList()
Dim rnd As New Random()
For iLoop = 0 To totalCount - 1
' ▼解説▼
' SolidBrushは、単色のブラシを定義します。ブラシは四角形、楕円、扇形、多角形、パスなどのグラフィックス形状を塗りつぶす場合に使用します。このクラスは継承できません。
' http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/cpref/html/frlrfsystemdrawingsolidbrushclasstopic.asp
' ▼参考
' colors（ArrayList() で初期化された配列リスト）の末尾にオブジェクトを追加します。
' Brushは、グラフィカル形状の内部を塗りつぶすときに使用するオブジェクトを定義します。
' SolidBrush：このクラスは Brush クラスから継承します。
' ▼解説▼
' Color.FromArgb メソッド (Int32, Int32, Int32)
' 指定の 8 ビット カラー値 (赤、緑、青) から Color 構造体を作成します。アルファ値は暗黙的に 255 (完全不透明) になります。このメソッドでは各カラー コンポーネントの 32 ビット値を渡すことができますが、各カラー コンポーネントの値は 8 ビットに限定されます。
' http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/cpref/html/frlrfsystemdrawingcolorclassfromargbtopic3.asp
' ▼解説▼
' Rnd 関数
' 単精度浮動小数点数型 (Single) の乱数を返します。
' http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/vblr7/html/vafctrnd.asp
' Rnd 関数は 0 以上、1 未満の範囲の値を返します。　Rnd[(number)] とし、引数（number）には、任意の有効な数式を指定します。
' http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/script56/html/vsfctrnd.asp

colors.Add(New SolidBrush(Color.FromArgb(rnd.Next(255), rnd.Next(255), rnd.Next(255))))
Next iLoop

'GraphicsクラスにはFillPieというメソッドが含まれていて，これが円グラフの項目を描画する。このメソッドには次の定義が含まれる。
'FillPie(Brush, Rectangle, [Single], [Single])

' Bitmapのインスタンスを作成
Dim objBitmap As New Bitmap(width, height)
Dim objGraphics As Graphics = Graphics.FromImage(objBitmap)

' 凡例の文字色
Dim blackBrush As New SolidBrush(Color.Black)

' 白い背景を置く（White or Snow）
objGraphics.FillRectangle(New SolidBrush(Color.Snow), 0, 0, width, height)

' ▼解説▼
' Graphics.FillPie メソッド (Brush, Rectangle, Single, Single)
' Graphics.FillPie メソッド (Brush, Rectangle, startAngle, sweepAngle)
' Graphics.FillPie メソッド (塗りつぶしの特性, 扇形の元となる楕円を定義する外接する四角形, x 軸から扇形の最初の辺まで、時計回りに測定した角度, startAngle パラメータから扇形の 2 番目の辺まで、時計回りに測定した角度)
' RectangleF 構造体と 2 本の半径によって指定された楕円で定義される扇形の内部を塗りつぶします。
' http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/cpref/html/frlrfsystemdrawinggraphicsclassfillpietopic1.asp
' ▼参考
' Graphics.FillPie メソッド (Brush, Single, Single, Single, Single, Single, Single)
' Graphics.FillPie メソッド (Brush, Int32, Int32, Int32, Int32, Int32, Int32)
' Graphics.FillPie メソッド (Brush, x, y, width, height, startAngle, sweepAngle)
' 座標ペア、幅、および高さで指定された楕円と 2 本の半径によって定義される扇形の内部を塗りつぶします。
' http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/cpref/html/frlrfsystemdrawinggraphicsclassfillpietopic2.asp
' ▼事例
' ①開いた曲線・閉じた曲線・円弧・塗りつぶされた扇形 等 http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/cpguide/html/_gdiplus_open_and_closed_curves_about.asp
' ②GDI+ による線および形状の描画 http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/vbcon/html/vbtskdrawinglinesshapeswithgdi.asp

Dim fAngle As Single = - 90F ' 円グラフ（扇形）の描画開始位置

' 扇形を繋いで円グラフとす！？
For iLoop = 0 To totalCount - 1
Dim idata As Single = Convert.ToSingle(ds.Tables(0).Rows(iLoop)(dataColumnName)) ' データ値
Dim fSweep As Integer = idata / total * 360 ' データ値に対する角度

objGraphics.FillPie(CType(colors(iLoop), SolidBrush), pieRect, fAngle, fSweep) ' 扇形（色で塗りつぶす

fAngle += fSweep ' fAngle = fAngle + fSweep ' 次データの扇型の開始位置の角度 ' fAngleをインクリメントする
Next iLoop

fAngle = - 90F ' 円グラフ（扇形）の描画開始位置を再セット
For iLoop = 0 To totalCount - 1
Dim idata As Single = Convert.ToSingle(ds.Tables(0).Rows(iLoop)(dataColumnName)) ' データ値
Dim fSweep As Integer = idata / total * 360 ' データ値に対する角度
Dim fSweep2 As Integer = (idata / total * 360) / 2 ' fSweepの半分の角度
Dim fSweep3 As Integer = fAngle + fSweep - fSweep2 ' データの扇型の中央部の角度
Dim canmaidata As String = idata.ToString("n0") ' ３桁カンマ区切りへ変換
Dim stringFont As New Font("Arial", 10) ' フォント オブジェクトを作成し、Arial (16 ポイント) に設定
Dim stringSize As New SizeF() ' サイズ オブジェクトを作成し、そのオブジェクトとフォント オブジェクトを使用して、文字列のサイズを計測
'stringSize = objGraphics.MeasureString(canmaidata, stringFont)
stringSize = objGraphics.MeasureString(CType(ds.Tables(0).Rows(iLoop)(labelColumnName), [String]), stringFont)

' ▼解説▼
' Graphics.DrawString メソッド (String, Font, Brush, PointF)
' 指定した位置に、指定した Brush オブジェクトと Font オブジェクトで、指定した文字列を描画します。
' http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/cpref/html/frlrfsystemdrawinggraphicsclassdrawstringtopic1.asp
' ▼解説▼
' PointF 構造体／／PointF(x座標, y座標)
' 2 次元平面に点を定義する浮動小数点座標ペア (x 座標と y 座標) を表します。
' http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/cpref/html/frlrfsystemdrawingpointfclasstopic.asp

' 座標（x,y）の値を算出しなければならない ' ■参考 http://www.openspc2.org/reibun/javascript/convert/001/
Dim x As Integer = (width / 2) + ((width / 2) - (width / 2) / 3) * System.Math.cos(fSweep3 * System.Math.PI / 180)
Dim y As Integer = (pieHeight / 2) + titleHeight + ((pieHeight / 2) - (pieHeight / 2) / 3) * System.Math.sin(fSweep3 * System.Math.PI / 180)

' 文字列の計測サイズを使用して赤い四角形を描画
' objGraphics.DrawRectangle(New Pen(Color.Gray, 1), x - stringSize.Width / 2, y - stringSize.Height / 2, stringSize.Width, stringSize.Height)

Dim data As Decimal = Convert.ToDecimal(ds.Tables(0).Rows(iLoop)(dataColumnName))
Dim data1 As Decimal = Convert.ToDecimal(data) / total
Dim percentage As String = data1.ToString("P") ' ％へ変換
'Response.Write(percentage_fSweep & "
")
'Response.End()
If data1 >= "0.05" Then
' 扇形（円グラフ）内に文字列を描画
objGraphics.DrawString(CType(ds.Tables(0).Rows(iLoop)(labelColumnName), [String]), stringFont, Brushes.Black, New PointF(x - stringSize.Width / 2, y - stringSize.Height / 2))
' objGraphics.DrawString(canmaidata, stringFont, Brushes.Black, New PointF(x - stringSize.Width / 2, y - stringSize.Height / 2 + 17))
objGraphics.DrawString(percentage, stringFont, Brushes.Black, New PointF(x - stringSize.Width / 2, y - stringSize.Height / 2 + 17))
End If
fAngle += fSweep ' fAngle = fAngle + fSweep ' 次データの扇型の開始位置の角度 ' fAngleをインクリメントする
Next iLoop

' （中央寄せ）の前置処理
Dim stringFormat As New StringFormat() ' この３つは同じ！？
'Dim stringFormat As StringFormat = New StringFormat() ' この３つは同じ！？
'Dim stringFormat As New StringFormat ' この３つは同じ！？
stringFormat.Alignment = StringAlignment.Center ' 中央寄せ
'stringFormat.LineAlignment = StringAlignment.Center

' ▼解説▼
' RectangleF コンストラクタ (Single, Single, Single, Single)
' RectangleF(x, y, width, height)
' 指定した位置とサイズで、 RectangleF クラスの新しいインスタンスを初期化します。
' y
' x ＋─(Width) ┐
' │■■■■■(Heitht)
' └─────┘四角の内部は真っ黒と認識せよ！
' http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/cpref/html/frlrfsystemdrawingrectanglefclassctortopic2.asp

Dim valueRect As New RectangleF(0, 0, width, titleHeight)

'▼解説▼
' Graphics.DrawString メソッド (String, Font, Brush, PointF, StringFormat)
' Graphics.DrawString(文字列, 太文字・サイズ・間隔等の書式, 色とテクスチャ, 左上隅, 行間や配置などの書式属性)
' 指定した StringFormat オブジェクトの書式属性を使用して、指定した Brush オブジェクトおよび Font オブジェクトで、指定した位置に指定した文字列を描画します。
' http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/cpref/html/frlrfsystemdrawinggraphicsclassdrawstringtopic3.asp

' タイトル（文字列を）中央に描く
objGraphics.DrawString(title, fontTitle, blackBrush, valueRect, stringFormat)

' ▼解説▼
' Graphics.DrawRectangle メソッド (Pen, Int32, Int32, Int32, Int32)
' Graphics.DrawRectangle メソッド (Pen, Single, Single, Single, Single)
' Graphics.DrawRectangle メソッド (Pen, x, y, width, height)
' 座標ペア、幅、および高さで指定された四角形を描画します。
' y
' x ＋─(Width) ┐
' │Pen (Heitht)
' └─────┘
' http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/cpref/html/frlrfsystemdrawinggraphicsclassdrawrectangletopic2.asp

' 凡例を作成
objGraphics.DrawRectangle(New Pen(Color.Black, 2), 0, height - legendHeight, width, legendHeight)

' 凡例の行数を件数分描く
For iLoop = 0 To totalCount - 1
' データをパーセント（％）や、３桁区切りへ変換
Dim data As Decimal = Convert.ToDecimal(ds.Tables(0).Rows(iLoop)(dataColumnName))
Dim data1 As Decimal = Convert.ToDecimal(data) / total
Dim percentage As String = data1.ToString("P") ' ％へ変換
Dim canmaData As String = data.ToString("n0") ' ３桁カンマ区切りへ変換

' 右寄せ（右寄せ）の前置処理
Dim x1 As Single = 0F ' 描画位置？
Dim x2 As Single = 0F ' 描画位置？
Dim height1 As Single = height - legendHeight + fontLegend.Height * iLoop + 1 ' 描画位置？
Dim height2 As Single = height - legendHeight + fontLegend.Height * iLoop + 1 ' 描画位置？
Dim drawRect As New RectangleF(x1, height1, width - 60, height2) ' 描画位置（RectangleF(左上x座標, 左上y座標, 四角形の幅(width), 四角形の高さ(height))：交差する四角形）
Dim style3 As New StringFormat()
style3.Alignment = StringAlignment.Far ' 右寄せ
Dim drawRect4 As New RectangleF(x1, height1, width - 2, height2)
Dim style4 As New StringFormat()
style4.Alignment = StringAlignment.Far ' 右寄せ

' ▼解説▼
' Graphics.FillRectangle メソッド (Brush, Int32, Int32, Int32, Int32)
' Graphics.FillRectangle メソッド (Brush, Single, Single, Single, Single)
' Graphics.FillRectangle メソッド (Brush, x, y, width, height)
' 座標ペア、幅、および高さで指定された四角形の内部を塗りつぶします。Brush は塗りつぶしの特性を決定する
' Brush は四角形、楕円、扇形、多角形、パスなどのグラフィカル形状の内部を塗りつぶすときに使用するオブジェクトを定義します
' y
' x ＋─(Width) ┐
' │■■■■■(Heitht)
' └─────┘
' http://www.microsoft.com/japan/msdn/library/default.asp?url=/japan/msdn/library/ja/cpref/html/frlrfsystemdrawinggraphicsclassfillrectangletopic3.asp

' 凡例：（四角形の内部）を指定した色で塗る
objGraphics.FillRectangle(CType(colors(iLoop), SolidBrush), 5, height - legendHeight + fontLegend.Height * iLoop + 5, 10, 10)

' 凡例：指定した文字列（テキスト・データ・％）を描画
objGraphics.DrawString(CType(ds.Tables(0).Rows(iLoop)(labelColumnName), [String]), fontLegend, blackBrush, 20, height - legendHeight + fontLegend.Height * iLoop + 1)
'objGraphics.DrawString(canmaData, fontLegend, blackBrush, 145, height - legendHeight + fontLegend.Height * iLoop + 1)
objGraphics.DrawString(canmaData, New Font("Verdana", 10), Brushes.Red, drawRect, style3)
'objGraphics.DrawString("(" + percentage + ")", fontLegend, Brushes.Gray, 222, height - legendHeight + fontLegend.Height * iLoop + 1)
objGraphics.DrawString(percentage, fontLegend, Brushes.Gray, drawRect4, style4)
Next iLoop

' お試し表示
' objGraphics.DrawString("お試し", fontLegend, Brushes.Gainsboro, width -50, height - legendHeight + fontLegend.Height * iLoop + 1)

' 合計の文字色
Dim blackBrush2 As New SolidBrush(Color.Blue)
'Dim blackBrush3 As New SolidBrush(Color.Red)

Dim tCount As String = totalCount.ToString("n0") ' ３桁カンマ区切りへ変換
Dim canmaTotal As String = total.ToString("n0") ' ３桁カンマ区切りへ変換
Dim canmaTotalLength As String = canmaTotal.Length ' 文字列長（カンマ記号(,)を含む）は何文字あるのか？

' 右寄せの前置処理
Dim height5 As Single = height - fontLegend.Height - 5
Dim drawRect5 As New RectangleF(0, height5, width - 60 + 1, 0)
Dim drawRect6 As New RectangleF(width - 120 - canmaTotalLength * 6, height5, 120, 0) ' 文字列（合計）表示開始位置：ちょっといい加減の自動伸縮とす
Dim style5 As New StringFormat()
style5.Alignment = StringAlignment.Far ' 右寄せ
Dim style51 As New StringFormat()
style51.Alignment = StringAlignment.Near ' 左寄せ

' 凡例（末尾の行）：指定した文字列（件数・文字列（合計）・データ合計値を描画
objGraphics.DrawString(tCount + "件", fontLegend, blackBrush2, 20, height - fontLegend.Height - 5)
objGraphics.DrawString("合計:", fontLegend, Brushes.Red, drawRect6, style51)
objGraphics.DrawString(canmaTotal, fontLegend, Brushes.Red, drawRect5, style5 )

' Jpegを出力するので，それに合わせてContentTypeを適切に設定
Response.ContentType = "image/jpeg"

' 画像をJpegファイルとして保存　（画面に表示するだけなら、不要）
'objBitmap.Save(Server.MapPath("Figure11.jpg"), ImageFormat.Jpeg)

' 画像をOutputStreamにSaveする
objBitmap.Save(Response.OutputStream, ImageFormat.Jpeg)

' （とりあえず最後に挿入）
' ビットマップとグラフィックスとSolidBrushを開放
objBitmap.Dispose()
objGraphics.Dispose()
aliceblue_brush.Dispose()
End Sub

</script>
=== ここまで ===

---

①.用途によっては、利用可能なデータ長、小数点以下の数値も扱える様にする等の改良が必要です。
②.無駄な部分もあると思います。バグ情報などは、GDN Japan 掲示板の本件の投稿記事にてご指摘いただければ幸いです。

---

ソースコードは完成するまで、随時更新改良しますので、時々ご訪問ください。



以上.（The End.）更新:2018-5-10