８．MSChart のグラフをPictureBoxに転送表示及び各部の座標位置を取得

１．MSChart コントロールで作成したグラフを PictureBox に転送表示 ２．MSChart コントロールで作成したグラフの各部の座標位置を取得 ３．　 ４．　 ５．　 ６．

下記プログラムコードに関する補足・注意事項　 動作確認：Windows Vista・Windows 7 (32bit) / VB6.0(SP6) Option　：[Option Explicit] 参照設定：追加なし 使用 API：なし その他　：条件は、１．MSChart での基本的な設定(表示データの設定・グラフの種類の設定)の表示環境で。 　　　　：下記、コードは、sChartViewSet プロシージャ内に追加記入願います。

１．MSChart コントロールで作成したグラフを PictureBox に転送表示

図１．使用コントロールと配置図 　 MSChart コントロールと PictureBox コントロールを配置して下記コードを実行して下さい。 データの読み込みと表示設定は、これまでのサンプルと同様です。 マウス等のドラッグで Form のサイズを変更した場合、再度 Form のサイズに合わせてグラフを転送します。 Option Explicit Private Enum DVASPECT 　　DVASPECT_CONTENT = 1 　　DVASPECT_THUMBNAIL = 2 　　DVASPECT_ICON = 4 　　DVASPECT_DOCPRINT = 8 End Enum Private Type RECT 　　Left　 As Long 　　Top　　As Long 　　Right　As Long 　　Bottom As Long End Type Private Declare Function OleDraw Lib "ole32.dll" (ByVal pUnk As Object, _ 　　ByVal dwAspect As DVASPECT, ByVal hDCDraw As Long, lprcBounds As RECT) As Long Private Sub Form_Load() 　　'フォームのサイズを設定(好みで変更してください) 　　Form1.Move 0, 0, 10400, 7000 　　Form1.ScaleMode = vbPixels　　　'スケールモードをピクセル単位に設定 　　'MSChart コントロールの表示サイズを設定 　　MSChart1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight 　　'ピクチャーボックスのプロパティの初期設定 　　With Picture1 　　　　.ScaleMode = vbPixels　　　 'スケールモードをピクセル単位に設定 　　　　.BorderStyle = 0 　　　　.AutoRedraw = True 　　　　.Visible = True 　　　　.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight 　　End With 　　Call sDataOpen　　　　　　　　　'データの読み込み(これまでのサンプルと同じ) 　　Call sChartViewSet　　　　　　　'グラフの表示設定(どのグラフの表示でも可) End Sub Private Sub SetPicture(ctl As Object, MyPic As PictureBox) 'OleDraw API を使ってグラフを転送 　　Dim udtRect As RECT 　　With udtRect 　　　　.Left = 0 　　　　.Top = 0 　　　　.Right = ctl.Width - 1 　　　　.Bottom = ctl.Height - 1 　　End With 　　With MyPic 　　　　.Cls 　　　　.Move 0, 0, ctl.Width, ctl.Height 　　　　Call OleDraw(ctl.Object, DVASPECT_CONTENT, .hdc, udtRect) 　　End With End Sub Private Sub Form_Resize() 　　'フォームのサイズ変更に合わせて MSChart コントロールの表示サイズも変更する 　　MSChart1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight 　　Picture1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight 　　'フォームのサイズが変更されたら転送しなおす。 　　Call SetPicture(MSChart1, Picture1) End Sub

２．MSChart コントロールで作成したグラフの各部の座標位置を取得

PictureBox にグラフを転送しても補足描画しようと思っても座標位置が解らないと表示や加工をする事ができません。従って必要な座標位置を前もって取得する事にします。 但し、座標位置を取得する適当なプロパティが見当たりません、苦肉の策としてプロットエリアの背景色を通常使用しないような色に設定してその色が塗られている座標位置を調べる事にしました。 １．MSChart コントロールで作成したグラフを PictureBox に転送表示 のコードに下記を追加して下さい。 宣言セクションに追加 'ピクセルカラー値を取得する(P489) Private Declare Function GetPixel Lib "gdi32" _ 　 (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long Private PR　　 As RECT　　　'プロットエリアの座標位置 Private LPos() As Single　　'ラベルの表示座標 追加のプロシージャ Private Sub GetPlotAreas(ByVal MyChart As MSChart, ByVal MyPic As PictureBox) On Error Resume Next 　　Dim X1 As Long, X2 As Long, Y1 As Long, Y2 As Long 　　Dim myColor As Long 　　'プロットエリアに独自の色が設定されていたらそれを使って下さい。 '　　With MyChart '　　　　.Plot.Wall.Brush.Style = VtBrushStyleSolid '　　　　.Plot.Wall.Brush.FillColor.Set 254, 255, 255 '　　End With 　　myColor = RGB(MyChart.Plot.Wall.Brush.FillColor.Red, MyChart.Plot.Wall.Brush.FillColor.Green, _ 　　　　　　　　　　　　　　　　　　　　　　　　　　　　 MyChart.Plot.Wall.Brush.FillColor.Blue) 'プロットエリアに塗られている色を調べて、外枠の位置を取得 　　With MyChart.Plot.LocationRect 　　　　X1 = Me.ScaleX(.Min.X, vbTwips, vbPixels) 　　　　X2 = Me.ScaleX(.Max.X, vbTwips, vbPixels) 　　　　Y1 = MyChart.Height - Me.ScaleY(.Min.Y, vbTwips, vbPixels) 　　　　Y2 = MyChart.Height - Me.ScaleY(.Max.Y, vbTwips, vbPixels) 　　End With 　　'凡例の位置 　　'MyChart.Legend.Location.RECT.Max.X 　　'タイトル 　　'MyChart.Title.Location.RECT.Max.X '　　Picture1.DrawWidth = 3 '　　Picture1.Line ((MyChart.Legend.Location.RECT.Min.X \ 15) - 5, _ '　　　　(MyChart.Height - (MyChart.Legend.Location.RECT.Min.Y \ 15)) + 3)- _ '　　　　((MyChart.Legend.Location.RECT.Max.X \ 15) + 5, MyChart.Height - _ '　　　　((MyChart.Legend.Location.RECT.Max.Y \ 15) + 5)), vbRed, B '　　Picture1.DrawWidth = 1 '　 Debug.Print X1, X2, Y1, Y2 　　Dim i As Long 　　With MyPic 　　　　'X軸の始点のX座標を求める(一番左側の目盛りの縦線) 　　　　For i = X1 To 100 　　　　　　If GetPixel(.hdc, i, Y2 + 50) = myColor Then 　　　　　　　　PR.Left = i - 1　　 'ラインの太さ分を考慮 　　　　　　　　 Exit For 　　　　　　End If 　　　　Next i 　　　　'X軸の終点のX座標を求める(一番右側の目盛りの縦線) 　　　　For i = X2 To X2 - 100 Step -1 　　　　　　If GetPixel(.hdc, i, Y2 + 50) = myColor Then 　　　　　　　　PR.Right = i + 1　　'ラインの太さ分を考慮 　　　　　　　　Exit For 　　　　　　End If 　　　　Next i 　　　　'目盛りの始点のY座標を求める(グラフの 0点の横ラインの位置) 　　　　For i = Y1 To Y1 - 100 Step -1 　　　　　　If GetPixel(.hdc, PR.Left + 1, i) = myColor Then 　　　　　　　　PR.Bottom = i + 1　 'ラインの太さ分を考慮 　　　　　　　　Exit For 　　　　　　End If 　　　　Next i 　　　 '目盛りの最大点のY座標を求める(グラフの 100点の横ラインの位置) 　　　　For i = Y2 To Y2 + 100 　　　　　　If GetPixel(.hdc, PR.Left + 1, i) = myColor Then 　　　　　　　　PR.Top = i - 1　　　'ラインの太さ分を考慮 　　　　　　　　Exit For 　　　　　　End If 　　　　Next i '　　　　'これで縦棒の位置と間隔が求められます。 '　　　　Dim co As Long '　　　　Dim b(20) As Long '　　　　Dim n As Long '　　　　ReDim LPos(MyChart.RowCount) As Single '　　　　'生徒名1人当たりの幅を取得 '　　　　.DrawStyle = 6 '　　　　Dim XPos As Single '　　　　XPos = (PR.Right - PR.Left) / MyChart.RowCount '　　　　ReDim LPos(MyChart.RowCount) As Single '　　　　For i = 0 To MyChart.RowCount '　　　　　 LPos(i) = PR.Left + (i * XPos)　'各ラベルの左側の座標位置を取得 '　　　　Next i '　　　　co = myColor '　　　　For i = LPos(0) + 2 To LPos(1) '　　　　　　If co <> GetPixel(.hdc, i, 370) Then '　　　　　　　　b(n) = i - LPos(0) - 1 '　　　　　　　'　Debug.Print b(n) '　　　　　　　　n = n + 1 '　　　　　　End If '　　　　　　co = .Point(i, 370) '　　　　Next 　　End With End Sub 一部追加しましたので下記と差し替えて下さい。 Private Sub Form_Resize() 　　'フォームのサイズ変更に合わせて MSChart コントロールの表示サイズも変更する 　　MSChart1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight 　　Picture1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight 　　'フォームのサイズが変更されたら転送しなおす。 　　Call SetPicture(MSChart1, Picture1) 　　'プロットエリアのサイズを取得 　　Call GetPlotAreas(MSChart1, Picture1) 　　'取得したサイズの確認の為に四隅に○を描画 　　Picture1.Circle (PR.Left, PR.Top), 5, RGB(255, 0, 0) 　　Picture1.Circle (PR.Left, PR.Bottom), 5, RGB(255, 0, 0) 　　Picture1.Circle (PR.Right, PR.Top), 5, RGB(255, 0, 0) 　　Picture1.Circle (PR.Right, PR.Bottom), 5, RGB(255, 0, 0) 　　'座標位置が解れば、好きなように描画するだけ 　　Picture1.CurrentX = PR.Left - 45 　　Picture1.CurrentY = PR.Top - 22 　　Picture1.Print "金額単位:千円" '　 Debug.Print PR.Left, PR.Right, PR.Top, PR.Bottom End Sub グラフの作成とは直接関係は無いのですが参考に Private Sub sChartViewSet() 　　'グラフの種類を設定 　　With MSChart1 　　　　.chartType = VtChChartType2dBar　　　　　　　　　　 ' 2 D 棒グラフに設定 　　　　.Backdrop.Fill.Brush.Style = VtBrushStyleSolid 　　　　.Backdrop.Fill.Brush.FillColor.Set 255, 255, 255 　　　　'プロットエリアの背景色を設定 　　　　.Plot.Wall.Brush.Style = VtBrushStyleSolid　　　　　'塗りつぶし 　　　　.Plot.Wall.Brush.FillColor.Set 254, 255, 255　　　　'他で使用していない色で設定 　　　　.ShowLegend = True '　　　　.Plot.Axis(VtChAxisIdX).AxisTitle.Text = "　　" '　　　　.Plot.Axis(VtChAxisIdY).AxisTitle.Text = "　　" '　　　　.TitleText = "　　　" 　　End With End Sub 　　図２．上記実行結果 　 必要な座標位置は、上記のようにすれば取得できます。 MSChart のグラフの表示座標位置の基点は、左下になり、PictureBox の表示座標位置の基点は、左上になります、従って X 方向の座標位置は、そのままでもいいのですが、Y 方向は、逆になりますので、Y1 = MyChart.Height - Me.ScaleY(.Min.Y, vbTwips, vbPixels) のようにして求める必要があります。 座標位置さえ掴めれば、後は、PictureBox に好きなように描画するだけですから大抵の加工はできます。下記はその一例です。 http://hanatyan.sakura.ne.jp/samplepic/chartno27-1.gif 横棒グラフ http://hanatyan.sakura.ne.jp/samplepic/chartno32-1.gif 吊下げ棒グラフ http://hanatyan.sakura.ne.jp/samplepic/chartno32-2.gif 折れ線でデータが欠損している部分を点線でつなぐような事も簡単にできますし、アイデア次第では色々使えるかと思いますので標準の機能でできない部分を補う等してみて下さい。

３．

４．

５．

６．

検索キーワード及びサンプルコードの別名(機能名)

MSChart コントロール　チャートコントロール　グラフ