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