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

      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