完整实现过程+源码 | 只需输入二次函数系数,应用VB编程即可动态生成函数图像!

'定义X,Y坐标轴和绘图常量Private Const X_MIN As Double = -10   ' X轴最小值Private Const X_MAX As Double = 10    ' X轴最大值Private Const Y_MIN As Double = -10   ' Y轴最小值Private Const Y_MAX As Double = 10    ' Y轴最大值Private Const GRID_SPACING As Integer = 1  ' 网格间距'根据输入的系数，生成二次函数Private Function QuadraticFunc(a As Double, b As Double, c As Double, x As Double) As Double    QuadraticFunc = a * x * x + b * x + cEnd Function' 绘制坐标系Private Sub DrawCoordinateSystem()    Dim centerX As Long, centerY As Long    Dim i As Integer    Dim pixelX As Long, pixelY As Long    ' 清空图片框    picGraph.Cls    ' 设置坐标系（数学坐标系）    picGraph.Scale (X_MIN, Y_MAX)-(X_MAX, Y_MIN)    ' 绘制坐标轴    picGraph.ForeColor = vbBlack    picGraph.DrawWidth = 2    ' X轴    picGraph.Line (X_MIN, 0)-(X_MAX, 0)    ' Y轴    picGraph.Line (0, Y_MIN)-(0, Y_MAX)    ' 绘制箭头    picGraph.Line (X_MAX - 0.5, 0.5)-(X_MAX, 0)    picGraph.Line (X_MAX - 0.5, -0.5)-(X_MAX, 0)    picGraph.Line (0.5, Y_MAX - 0.5)-(0, Y_MAX)    picGraph.Line (-0.5, Y_MAX - 0.5)-(0, Y_MAX)    ' 绘制网格    picGraph.ForeColor = &HE0E0E0    picGraph.DrawWidth = 1    '垂直网格线    For i = Int(X_MIN) To Int(X_MAX)        If i <> 0 Then            picGraph.Line (i, Y_MIN)-(i, Y_MAX)        End If    Next i    '水平网格线    For i = Int(Y_MIN) To Int(Y_MAX)        If i <> 0 Then            picGraph.Line (X_MIN, i)-(X_MAX, i)        End If    Next i    '绘制刻度    picGraph.ForeColor = vbBlack    picGraph.FontSize = 8    'X轴刻度    For i = Int(X_MIN) To Int(X_MAX)        If i <> 0 And i Mod 2 = 0 Then            picGraph.Line (i, -0.3)-(i, 0.3)            picGraph.CurrentX = i - 0.2            picGraph.CurrentY = -0.8            picGraph.Print CStr(i)        End If    Next i    'Y轴刻度    For i = Int(Y_MIN) To Int(Y_MAX)        If i <> 0 And i Mod 2 = 0 Then            picGraph.Line (-0.3, i)-(0.3, i)            picGraph.CurrentX = 0.4            picGraph.CurrentY = i - 0.2            picGraph.Print CStr(i)        End If    Next i    '绘制坐标轴标签    picGraph.FontSize = 12    picGraph.CurrentX = X_MAX - 0.8    picGraph.CurrentY = -0.8    picGraph.Print "X"    picGraph.CurrentX = 0.5    picGraph.CurrentY = Y_MAX - 0.8    picGraph.Print "Y"End Sub' 绘制二次函数图像Private Sub DrawQuadraticFunction(a As Double, b As Double, c As Double)    Dim x As Double    Dim y As Double    Dim prevX As Double, prevY As Double    Dim firstPoint As Boolean    Dim stepSize As Double    ' 设置绘图样式    picGraph.ForeColor = vbRed    picGraph.DrawWidth = 2    '计算步长（根据显示范围调整）    stepSize = (X_MAX - X_MIN) / picGraph.Width * 10    firstPoint = True    '绘制曲线    For x = X_MIN To X_MAX Step stepSize        y = QuadraticFunc(a, b, c, x)        ' 检查Y值是否在显示范围内        If y >= Y_MIN And y <= Y_MAX Then            If firstPoint Then                firstPoint = False            Else                '绘制线段连接相邻点                picGraph.Line (prevX, prevY)-(x, y)            End If            prevX = x            prevY = y        Else            firstPoint = True        End If    Next x    ' 绘制顶点和交点    DrawSpecialPoints a, b, cEnd Sub'绘制特殊点（顶点、与坐标轴交点）Private Sub DrawSpecialPoints(a As Double, b As Double, c As Double)    Dim vertexX As Double, vertexY As Double    Dim discriminant As Double    Dim x1 As Double, x2 As Double    Dim yIntercept As Double    ' 计算顶点    If a <> 0 Then        vertexX = -b / (2 * a)        vertexY = QuadraticFunc(a, b, c, vertexX)        '绘制顶点        picGraph.ForeColor = vbRed        picGraph.FillColor = vbRed        picGraph.FillStyle = 0 ' Solid        picGraph.Circle (vertexX, vertexY), 0.2        picGraph.CurrentX = vertexX + 0.3        picGraph.CurrentY = vertexY + 0.3        picGraph.Print "(" & Format(vertexX, "0.00") & "," & Format(vertexY, "0.00") & ")"    End If    '计算Δ的值，根据Δ的值情况，可以知道X轴交点    discriminant = b * b - 4 * a * c    If discriminant >= 0 And a <> 0 Then        x1 = (-b + Sqr(discriminant)) / (2 * a)        x2 = (-b - Sqr(discriminant)) / (2 * a)        ' 绘制交点        picGraph.ForeColor = &HFF0080        picGraph.FillColor = &HFF0080        If discriminant > 0 Then '两个不同实根            picGraph.Circle (x1, 0), 0.2            picGraph.Circle (x2, 0), 0.2            picGraph.CurrentX = x1 + 0.3            picGraph.CurrentY = 0.5            picGraph.Print "x1=" & Format(x1, "0.00")            picGraph.CurrentX = x2 + 0.3            picGraph.CurrentY = -0.5            picGraph.Print "x2=" & Format(x2, "0.00")        Else '两个相同的根            picGraph.Circle (x1, 0), 0.2            picGraph.CurrentX = x1 + 0.3            picGraph.CurrentY = 0.5            picGraph.Print "x=" & Format(x1, "0.00")        End If    End If    ' 绘制与Y轴交点    yIntercept = c    picGraph.ForeColor = vbMagenta    picGraph.FillColor = vbMagenta    picGraph.Circle (0, yIntercept), 0.2    picGraph.CurrentX = 0.5    picGraph.CurrentY = yIntercept + 0.3    picGraph.Print "y=" & Format(yIntercept, "0.00")End SubPrivate Sub Command1_Click() '一键计算二次函数的对称轴、顶点、根    a = txtA '将文本框A    b = txtB    c = txtC    '计算对称轴    vertexX = -(b / (2 * a))    '计算顶点坐标    vertexY = (4 * a * c - b * b) / (4 * a)    Text1 = "x=" & vertexX    Text2 = "(" & vertexX & "," & vertexY & ")"    '计算Δ，判断根的情况    discriminant = b * b - 4 * a * c    If discriminant >= 0 And a <> 0 Then        x1 = (-b + Sqr(discriminant)) / (2 * a)        x2 = (-b - Sqr(discriminant)) / (2 * a)        If discriminant > 0 Then ' 两个不同实根            Text3 = "x1=" & Format(x1, "0.00") & ",x2=" & Format(x2, "0.00")        Else ' 重根            Text3 = "x=" & Format(x1, "0.00")        End If    End IfEnd Sub' 窗体加载Private Sub Form_Load()    ' 设置默认值    txtA.Text = "1"    txtB.Text = "0"    txtC.Text = "0"    '设置图片框属性    picGraph.BackColor = vbWhite    picGraph.ScaleMode = 3    picGraph.BorderStyle = 1    ' 绘制初始坐标系    DrawCoordinateSystemEnd Sub' 系数输入框变化时动态生成实时图像预览Private Sub txtA_Change()    If Val(txtA.Text) <> 0 Then        If IsNumeric(txtA.Text) And IsNumeric(txtB.Text) And IsNumeric(txtC.Text) Then            DrawCoordinateSystem            DrawQuadraticFunction CDbl(txtA.Text), CDbl(txtB.Text), CDbl(txtC.Text)        End If    End IfEnd SubPrivate Sub txtB_Change()    If IsNumeric(txtA.Text) And IsNumeric(txtB.Text) And IsNumeric(txtC.Text) Then        DrawCoordinateSystem        DrawQuadraticFunction CDbl(txtA.Text), CDbl(txtB.Text), CDbl(txtC.Text)    End IfEnd SubPrivate Sub txtC_Change()    If IsNumeric(txtA.Text) And IsNumeric(txtB.Text) And IsNumeric(txtC.Text) Then        DrawCoordinateSystem        DrawQuadraticFunction CDbl(txtA.Text), CDbl(txtB.Text), CDbl(txtC.Text)    End If    Label8.Caption = "y=" & txtA & "x^2+" & txtB & "x+" & txtCEnd Sub'图片框大小改变时重绘Private Sub picGraph_Resize()    If txtA.Text <> "" And IsNumeric(txtA.Text) Then        DrawCoordinateSystem        DrawQuadraticFunction CDbl(txtA.Text), CDbl(txtB.Text), CDbl(txtC.Text)    Else        DrawCoordinateSystem    End IfEnd Sub

跟我学VB编程研发中心

认真钻研计算机技术

分享实用的编程知识

解决各类编程难题

祝大家学习进步！