- 日時： 2007/08/24 11:43
- 名前： 花ちゃん
- ***********************************************************************************
* カテゴリー：[チャート][][] *
* キーワード：ピクチャーボックス,項目の位置,位置,座標,描画,塗る,こんな事も出来ます*
***********************************************************************************
>>27 MSChartコントロールで作成したグラフをPictureBoxに転送表示する の応用例で今まで
色々掲示板で質問があったのですが、MSChartコントロール 上では出来なくてもPictureBox上
に転送する事により出来るのでここに紹介して置きます。
色々なケースに合せて作成するのは大変なので、今回は、一部決め打ちを行っておりますので
ご使用状況に合せて変更願います。
下記のような場合は、これで解決できるかと思います。
MSChartで補完してプロットする.. - ラトリア 2007/05/23-14:58 No.9211
MSChartの座標値を求めるには - わかば 2007/07/08/21-20:17 No.9938
-----------------------------------------------------------------------------------
投稿者：花ちゃん MSChartコントロールの色々なグラフの表示位置を取得する 2007/08/24
-----------------------------------------------------------------------------------
１．数値軸及び第二数値軸のX座標位置の取得
これにより各ラベルの間隔・位置等も取得できます。
２．数値軸の目盛りの基点(0 点）の横線のY座標を取得
３．数値軸の目盛りの終点(100 点）の横線のY座標を取得
(これにより座標位置でのデータの値が取得できグラフの表示位置が求められる）
４．マウス位置の色を取得する事により上記と組み合わせれば、マウス位置のデータの値が
取得できる
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
'-----------------------------------------------------------------------------
'ピクセルカラー値を取得する(P489)
Private Declare Function GetPixel Lib "gdi32" _
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private LPos() As Single 'ラベルの表示座標
Private Sub Form_Resize()
'フォームのサイズ変更に合わせて MSChart コントロールの表示サイズも変更する
If Me.Visible = False Then Exit Sub
MSChart1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
Picture1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
'フォームのサイズが変更されたら転送しなおす。
Call SetPicture(MSChart1, Picture1)
Dim i As Long
Dim X1 As Single
Dim X2 As Single
'X軸の始点のX座標を求める(一番左側の目盛りの縦線）
For i = 20 To 100
If GetPixel(Picture1.hdc, i, 50) = 0 Then
X1 = i
Exit For
End If
Next i
'X軸の終点のX座標を求める(一番右側の目盛りの縦線）
For i = Picture1.ScaleWidth - 40 To Picture1.ScaleWidth - 150 Step -1
If GetPixel(Picture1.hdc, i, 50) = 0 Then
X2 = i
Exit For
End If
Next i
'生徒名1人当たりの幅を取得
Picture1.DrawStyle = 6
Dim XPos As Single
XPos = (X2 - X1) / MSChart1.RowCount
ReDim LPos(MSChart1.RowCount) As Single
For i = 0 To MSChart1.RowCount
LPos(i) = X1 + (i * XPos) '各ラベルの左側の座標位置を取得
Next i
'目盛りの始点のY座標を求める(グラフの 0点の横ラインの位置）
Dim MinPos As Long
For i = Picture1.ScaleHeight - 30 To Picture1.ScaleHeight - 80 Step -1
If GetPixel(Picture1.hdc, 60, i) = 0 Then
MinPos = i '目盛り 0 の位置のY座標
Exit For
End If
Next i
'目盛りの最大点のY座標を求める(グラフの 100点の横ラインの位置）
Dim MaxPos As Long
For i = Picture1.ScaleTop + 10 To Picture1.ScaleTop + 80
If GetPixel(Picture1.hdc, 60, i) = 0 Then
MaxPos = i '目盛り 100 の位置のY座標
Exit For
End If
Next i
'これで縦棒の位置と間隔が求められます。
Dim co As Long
Dim b(10) As Long
Dim n As Long
For i = LPos(0) To LPos(1)
If co <> GetPixel(Picture1.hdc, i, 370) Then
b(n) = i - LPos(0) - 1
' Debug.Print b(n)
n = n + 1
End If
co = Picture1.Point(i, 370)
Next i
' 以上の事が解れば個々のグラフの表示位置が計算すれば求められます。
End Sub
Private Sub Picture1_MouseMove(Button As Integer, _
Shift As Integer, x As Single, y As Single)
'マウス位置のデータをToolTipTextで表示
Picture1.ToolTipText = ""
With MSChart1
Select Case x
Case LPos(0) To LPos(1)
If Picture1.Point(x, y) = RGB(255, 0, 0) Then
Picture1.ToolTipText = .ChartData(1, 0) & "さんの" & _
.ChartData(0, 1) & "の点数は" & _
.ChartData(1, 1) & "点です。"
End If
If Picture1.Point(x, y) = RGB(0, 255, 0) Then
Picture1.ToolTipText = .ChartData(1, 0) & "さんの" & _
.ChartData(0, 2) & "の点数は" & _
.ChartData(1, 2) & "点です。"
End If
If Picture1.Point(x, y) = RGB(0, 0, 255) Then
Picture1.ToolTipText = .ChartData(1, 0) & "さんの" & _
.ChartData(0, 3) & "の点数は" & _
.ChartData(1, 3) & "点です。"
End If
Case LPos(1) To LPos(2)
If Picture1.Point(x, y) = RGB(255, 0, 0) Then
Picture1.ToolTipText = .ChartData(2, 0) & "さんの" & _
.ChartData(0, 1) & "の点数は" & _
.ChartData(2, 1) & "点です。"
End If
If Picture1.Point(x, y) = RGB(0, 255, 0) Then
Picture1.ToolTipText = .ChartData(2, 0) & "さんの" & _
.ChartData(0, 2) & "の点数は" & _
.ChartData(2, 2) & "点です。"
End If
If Picture1.Point(x, y) = RGB(0, 0, 255) Then
Picture1.ToolTipText = .ChartData(2, 0) & "さんの" & _
.ChartData(0, 3) & "の点数は" & _
.ChartData(2, 3) & "点です。"
End If
Case LPos(2) To LPos(3)
If Picture1.Point(x, y) = RGB(255, 0, 0) Then
Picture1.ToolTipText = .ChartData(3, 0) & "さんの" & _
.ChartData(0, 1) & "の点数は" & _
.ChartData(3, 1) & "点です。"
End If
If Picture1.Point(x, y) = RGB(0, 255, 0) Then
Picture1.ToolTipText = .ChartData(3, 0) & "さんの" & _
.ChartData(0, 2) & "の点数は" & _
.ChartData(3, 2) & "点です。"
End If
If Picture1.Point(x, y) = RGB(0, 0, 255) Then
Picture1.ToolTipText = .ChartData(3, 0) & "さんの" & _
.ChartData(0, 3) & "の点数は" & _
.ChartData(3, 3) & "点です。"
End If
Case LPos(3) To LPos(4)
If Picture1.Point(x, y) = RGB(255, 0, 0) Then
Picture1.ToolTipText = .ChartData(4, 0) & "さんの" & _
.ChartData(0, 1) & "の点数は" & _
.ChartData(4, 1) & "点です。"
End If
If Picture1.Point(x, y) = RGB(0, 255, 0) Then
Picture1.ToolTipText = .ChartData(4, 0) & "さんの" & _
.ChartData(0, 2) & "の点数は" & _
.ChartData(4, 2) & "点です。"
End If
If Picture1.Point(x, y) = RGB(0, 0, 255) Then
Picture1.ToolTipText = .ChartData(4, 0) & "さんの" & _
.ChartData(0, 3) & "の点数は" & _
.ChartData(4, 3) & "点です。"
End If
Case LPos(4) To LPos(5)
If Picture1.Point(x, y) = RGB(255, 0, 0) Then
Picture1.ToolTipText = .ChartData(5, 0) & "さんの" & _
.ChartData(0, 1) & "の点数は" & _
.ChartData(5, 1) & "点です。"
End If
If Picture1.Point(x, y) = RGB(0, 255, 0) Then
Picture1.ToolTipText = .ChartData(5, 0) & "さんの" & _
.ChartData(0, 2) & "の点数は" & _
.ChartData(5, 2) & "点です。"
End If
If Picture1.Point(x, y) = RGB(0, 0, 255) Then
Picture1.ToolTipText = .ChartData(5, 0) & "さんの" & _
.ChartData(0, 3) & "の点数は" & _
.ChartData(5, 3) & "点です。"
End If
Case Else
Picture1.ToolTipText = ""
End Select
End With
'---------------------------------------------------------------------
' 折れ線グラフのような場合は下記でもいいかな。
' With MSChart1
' Select Case X
' Case LPos(0) To LPos(1)
' Picture1.ToolTipText = .ChartData(1, 0) & "さんの" & _
' .ChartData(0, 1) & "の点数は" & _
' .ChartData(1, 1) & "点で" & vbCrLf & _
' .ChartData(0, 2) & "の点数は" & _
' .ChartData(1, 2) & "点で" & vbCrLf & _
' .ChartData(0, 3) & "の点数は" & _
' .ChartData(1, 3) & "点です。"
'--------------------- 以下 省略 --------------------------
End Sub
'----------------- 以下のコードは No.27 のサンプルと同様です -----------------------
Private Sub Form_Load()
'フォームのサイズを設定(好みで変更してください)
Me.Visible = False
Form1.Move 0, 0, 10400, 7000
'MSChart コントロールの表示サイズを設定
MSChart1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
Picture1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
Call sDataOpen 'データの読み込み
Call sChartViewSet 'グラフの表示設定
Form1.ScaleMode = vbPixels 'スケールモードをピクセル単位に設定
'ピクチャーボックスのプロパティの初期設定
With Picture1
.ScaleMode = vbPixels 'スケールモードをピクセル単位に設定
.BorderStyle = 0
.AutoRedraw = True
.Visible = True
.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End With
Me.Visible = True
End Sub
Private Sub sChartViewSet()
With MSChart1
.chartType = VtChChartType2dBar 'デフォルトのグラフタイプ（2D棒）
.ShowLegend = True '凡例を表示する
'背景を塗っておく(この色の部分はクリックしても塗りつぶさない）
.Backdrop.Fill.Brush.Style = VtBrushStyleSolid
.Backdrop.Fill.Brush.FillColor.Set 255, 255, 255
End With
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 sDataOpen()
'グラフ用のデータを作成及び読み込み
Dim Dat(0 To 5, 0 To 3) As Variant
Dat(0, 1) = "国語"
Dat(0, 2) = "数学"
Dat(0, 3) = "英語"
Dat(1, 0) = "浅野"
Dat(1, 1) = 69 '国語の点数
Dat(1, 2) = 81 '数学の点数
Dat(1, 3) = 73 '英語の点数
Dat(2, 0) = "安室"
Dat(2, 1) = 87
Dat(2, 2) = 80
Dat(2, 3) = 72
Dat(3, 0) = "加藤"
Dat(3, 1) = 74
Dat(3, 2) = 82
Dat(3, 3) = 96
Dat(4, 0) = "斉藤"
Dat(4, 1) = 71
Dat(4, 2) = 69
Dat(4, 3) = 81
Dat(5, 0) = "鈴木"
Dat(5, 1) = 84
Dat(5, 2) = 86
Dat(5, 3) = 75
'グラフに表示する配列データを設定する
MSChart1.ChartData = Dat()
End Sub
----------------------------------------------------------------------------------
上記の実行図です。
http://hanatyan.sakura.ne.jp/samplepic/chartno33-1.gif
|
MSChartコントロールの色々なグラフの表示座標を取得する(VB6.0)