Question

用VB如何画曲线,并求代码.

Answer 1

Option Explicit
Private Const X_Axe = 0.5 'X轴原点位于窗口的水平位置比例
Private Const Y_Axe = 0.6 'Y轴原点位于窗口的垂直位置比例
Private Const ScaleRate = 30 '多少像素代表一个单位长度
Private Const DrawColor = vbRed '曲线颜色
Private ErrExp As Boolean '当表达式发生错误时，会置True(比如函数在此点无有效值)
Private Sub Form_Load()
Me.Show
Me.Cls

Call DrawAxe
Call DrawCoordinate
End Sub

Private Function Expression(ByVal X As Double) As Double '公式函数可以是任意内容
ErrExp = False '进入时，必须重置此标志为False

If X > 0 Then '这里代码任意，也可以是Expression = 2 * X ^ 2 + 2 * X + 1之类的
Expression = Log(X)
Else
Expression = 0
ErrExp = True
End If
End Function

Private Sub DrawCoordinate() '绘制曲线过程
Dim i As Long
Dim Last(1 To 2) As Long, This(1 To 2) As Long
Dim X_offset As Long
Dim Y_offset As Long

Me.ScaleMode = vbPixels

X_offset = Me.ScaleWidth * X_Axe
Y_offset = Me.ScaleHeight * Y_Axe

'设置一个初始值
Last(1) = 0
Last(2) = -Expression((0 - X_offset) / ScaleRate) * ScaleRate

i = 0
While i <= Me.ScaleWidth

'取下一点的值
This(1) = i
This(2) = -Expression((i - X_offset) / ScaleRate) * ScaleRate

'判断表达式是否出错
If ErrExp = True Then
'出错的情况下，循环直到没有错误或者超出范围为止
While ErrExp = True And i <= Me.ScaleWidth
i = i + 1
This(1) = i
This(2) = -Expression((i - X_offset) / ScaleRate) * ScaleRate
Wend
'重置起点
Last(1) = This(1)
Last(2) = This(2)
End If

'画线
Me.Line (Last(1), Last(2) + Y_offset)-(This(1), This(2) + Y_offset), DrawColor
Last(1) = This(1)
Last(2) = This(2)
i = i + 1
Wend
End Sub

Private Sub DrawAxe() '绘制坐标的过程
Dim X_offset As Long
Dim Y_offset As Long
Dim i As Long

Me.ScaleMode = vbPixels '取单位长度为像素

X_offset = Me.ScaleWidth * X_Axe '计算坐标轴轴位置
Y_offset = Me.ScaleHeight * Y_Axe

'绘制坐标轴
Me.Line (X_offset, 0)-(X_offset, Me.ScaleHeight)
Me.Line (0, Y_offset)-(Me.ScaleWidth, Y_offset)

'绘制坐标线
For i = X_offset + ScaleRate To Me.ScaleWidth Step ScaleRate
Me.Line (i, 0)-(i, Me.ScaleHeight), vbWhite
Next i

For i = X_offset - ScaleRate To 0 Step -ScaleRate
Me.Line (i, 0)-(i, Me.ScaleHeight), vbWhite
Next i

For i = Y_offset + ScaleRate To Me.ScaleHeight Step ScaleRate
Me.Line (0, i)-(Me.ScaleWidth, i), vbWhite
Next i

For i = Y_offset - ScaleRate To 0 Step -ScaleRate
Me.Line (0, i)-(Me.ScaleWidth, i), vbWhite
Next i
End Sub

Private Sub Form_Resize()
Me.Cls
Call DrawAxe
Call DrawCoordinate
End Sub

Answer 2

Private Sub Form_Load()
MSChart1.chartType = VtChChartType2dLine '设置为二维曲线
Dim a(6, 0) As Integer '声明一个数组
For i = 1 To 6 '遍历循环
a(i, 0) = i * i * i '为每一个数组的元素赋值
Next i
MSChart1.ChartData = a '把数组的数据赋值给MSChart对象的ChartData属性
For i = 1 To 7 '设置8个数据点
MSChart1.Row = i '移动位置,指向第i个位置
MSChart1.RowLabel = i '设置行标签内容
Next i
End Sub

Private Sub Command1_Click()
With MSChart1
.chartType = VtChChartType2dLine '设置为二维曲线
.ColumnCount = 1 '只要一条曲线
.RowCount = 7 '设置8个数据点
For i = 1 To 7 '遍历循环
.Row = i '移动位置,指向第i个位置
.RowLabel = i '设置行标签内容
.Data = i ^ 2 '赋值
Next
End With
End Sub

Private Sub Command2_Click()
Dim cn As New ADODB.Connection
'声明一个新的连接
Dim rst As New ADODB.Recordset
'声明一个新的记录集
Dim SqlStr As String
'声明一个字符串
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb;Mode=ReadWrite;Persist Security Info=False;Jet OLEDB:Database Password=111"
'打开连接
SqlStr = "Select 收入 From 收入表"
'设置SQL语句
rst.CursorLocation = adUseClient
'设置记录集游标的位置
rst.Open SqlStr, cn, adOpenDynamic, adLockOptimistic, adCmdText '打开记录集
Set MSChart1.DataSource = rst '给MSChart1修改数据源
End Sub