使用mschart控件实现对数图表并且保存图像

作者:独木舟日期:2009-02-06

字体大小: 小中大

Private Declare Function SendMessage Lib "user32" Alias _
       "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
        ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_PAINT = &HF
      Private Const WM_PRINT = &H317
      Private Const PRF_CLIENT = &H4&    ' Draw the window's client area.
      Private Const PRF_CHILDREN = &H10& ' Draw all visible child windows.
      Private Const PRF_OWNED = &H20&    ' Draw all owned windows.

Private Sub Command1_Click()
Dim wav(2500) As Single
Dim drt As Boolean

Dim dd(1 To 1152, 1 To 4) As Variant

'读取红外波段波长
i = 0
Open "d:\lowe\swavd.txt" For Input As #1
Do While Not EOF(1)
i = i + 1
Input #1, wav(i)
Loop
Close #1
For i = 1 To 1151
dd(i, 1) = wav(i)
dd(i, 3) = wav(i)

Next i

dd(1, 1) = "R"
dd(1, 3) = "T"
Open App.Path & "\daor.txt" For Input As #1
For i = 2 To 1151
Input #1, dd(1153 - i, 2)
Next i
Close #1

Open App.Path & "\daot.txt" For Input As #1
For i = 2 To 1151
Input #1, dd(1153 - i, 4)
Next i
Close #1
If Option1 = True Then
drt = drw(dd, 3)
Else
drt = drw(dd, 30)
End If

End Sub

Private Sub Command3_Click()
         Dim rv As Long
    
         With Picture1
         .AutoRedraw = True

rv = SendMessage(MSChart1.hwnd, WM_PAINT, .hdc, 0)
         Picture1.Line (0, 0)-(Picture1.Width - 100, Picture1.Height - 100), vbBlack, B
         .Picture = .Image
         .AutoRedraw = False
         ' Sent the picture to the clipboard.
         Clipboard.Clear
         Clipboard.SetData .Image, vbCFBitmap
         .Visible = True
         End With

' Save the picture on disk.
         'SavePicture Form1.Picture1.Picture, "c:\testpic.bmp"
      End Sub

Private Sub Form_Load()
' Make sure picturebox is same size as the chart.
         With Picture1
            .Height = MSChart1.Height
            .Width = MSChart1.Width
             Form1.Width = .Width
            .Top = 0
            .Left = 0
            .DrawWidth = 1
         End With

End Sub

Function drw(arrdata() As Variant, bound As Long) As Boolean
Dim j As Long
Dim maxdata As Long
Dim max_div As Long
Dim min_div As Long

maxdata = bound
If maxdata = 3 Then
max_div = 4
min_div = 2
Else
max_div = 8
min_div = 1
End If
MSChart1.ChartData = arrdata

'图形不能拖动
MSChart1.AllowSelections = False
'使用自定义绘图区比例
MSChart1.Plot.UniformAxis = False '该值指定图表的所有值坐标轴的单位刻度是否一致
MSChart1.Plot.AutoLayout = False '该值决定 Plot 对象是采用人工还是自动的布局方式
 '设置绘图区域范围
 With MSChart1.Plot.LocationRect
      .Min.x = -300
      .Min.y = -100
      .Max.x = MSChart1.Width + 100
      .Max.y = MSChart1.Height + 100
 End With
'设置图形背景颜色
MSChart1.Backdrop.Fill.Brush.Style = VtBrushStyleSolid
MSChart1.Backdrop.Fill.Brush.FillColor.Set 255, 255, 255
MSChart1.Backdrop.Frame.Style = VtFrameStyleSingleLine
MSChart1.Backdrop.Frame.FrameColor.Set 0, 0, 0

' 从 scale 转换到 log
MSChart1.Plot.Axis(VtChAxisIdX).AxisScale.Type = VtChScaleTypeLogarithmic
' 从 scale 转换到 log 时必须特别指定一个 LogBase。基数可以设为
' 2 到 200 间的任意值。
MSChart1.Plot.Axis(VtChAxisIdX).AxisScale.LogBase = 10

'设置x轴刻度最大，最小值，主要刻度，次要刻度,刻度线向内
MSChart1.Plot.Axis(VtChAxisIdX).ValueScale.Auto = False

MSChart1.Plot.Axis(VtChAxisIdX).ValueScale.Maximum = maxdata
MSChart1.Plot.Axis(VtChAxisIdX).ValueScale.Minimum = 0.3
MSChart1.Plot.Axis(VtChAxisIdX).ValueScale.MajorDivision = max_div
MSChart1.Plot.Axis(VtChAxisIdX).ValueScale.MinorDivision = min_div
MSChart1.Plot.Axis(VtChAxisIdX).Tick.Style = VtChAxisTickStyleInside
MSChart1.Plot.Axis(VtChAxisIdX).AxisTitle = "Wavelengh(μm)"

'设置y轴刻度最大，最小值，主要刻度，次要刻度,刻度线向内
MSChart1.Plot.Axis(VtChAxisIdY).ValueScale.Auto = False
MSChart1.Plot.Axis(VtChAxisIdY).ValueScale.Maximum = 100
MSChart1.Plot.Axis(VtChAxisIdY).ValueScale.Minimum = 0
MSChart1.Plot.Axis(VtChAxisIdY).ValueScale.MajorDivision = 5
MSChart1.Plot.Axis(VtChAxisIdY).ValueScale.MinorDivision = 4
MSChart1.Plot.Axis(VtChAxisIdY).Tick.Style = VtChAxisTickStyleInside
MSChart1.Plot.Axis(VtChAxisIdY).AxisTitle = "R&T(%)"

MSChart1.Plot.Axis(VtChAxisIdY).AxisTitle.TextLayout.Orientation = VtOrientationUp

MSChart1.Legend.Location.LocationType = VtChLocationTypeRight
MSChart1.Legend.Backdrop.Fill.Style = VtFillStyleBrush
MSChart1.Legend.Backdrop.Fill.Brush.FillColor.Set 255, 255, 255
MSChart1.Legend.Location.Visible = True
Call Command3_Click

End Function

文章来自: 本站原创

引用通告: 查看所有引用 | 我要引用此文章

Tags: Code

相关日志:

评论: 1 | 引用: 0 | 查看次数: -

独木舟[2009-02-06 08:25 PM |

]

MSChart保存图片还有一种更简单方法
MSChart1.EditCopy
SavePicture Clipboard.GetData(), "d:\vb6\draw\11.bmp"

但此法可能导致保存图片图例不正确,参见http://support.microsoft.com/kb/197487/zh-cn

发表评论

昵　称:
密　码:	游客发言不需要密码.
内　容:	正在加载编辑器...
验证码:
选　项:	禁止表情转换禁止自动转换链接禁止自动转换关键字

虽然发表评论不用注册，但是为了保护您的发言权，建议您注册帐号.

使用mschart控件实现对数图表并且保存图像

作者:独木舟 日期:2009-02-06

作者:独木舟日期:2009-02-06