lisp语言画阿基米德线_如何用VB语言Line方法绘制阿基米德螺线

展开全部

我是用picturebox实现的

(1)先用打开notepad，粘贴下面e69da5e887aa3231313335323631343130323136353331333236393832的代码，并保存为graph.frm文件

VERSION 5.00

Begin VB.Form Graph

AutoRedraw = -1 'True

Caption = "Graph"

ClientHeight = 5160

ClientLeft = 4200

ClientTop = 2985

ClientWidth = 6105

LinkTopic = "Form1"

ScaleHeight = 5160

ScaleWidth = 6105

Begin VB.CommandButton cmdGraph

Caption = "Graph"

Height = 375

Left = 4800

TabIndex = 1

Top = 4680

Width = 1215

End

Begin VB.PictureBox Picture1

AutoRedraw = -1 'True

AutoSize = -1 'True

Height = 4335

Left = 0

ScaleHeight = 4275

ScaleWidth = 6075

TabIndex = 0

Top = 0

Width = 6135

End

End

Attribute VB_Name = "Graph"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

'Option Explicit

Private Sub cmdGraph_Click()

Dim i As Integer

Dim arr() As Single

Const PI = 3.1415926

Picture1.Cls

Call GetPic(Picture1)

Call SetGraphAxis(-10, 10, -10, 10, vbWhite)

Picture1.ForeColor = RGB(0, 255, 0)

'Picture1.Circle (0, 0), 3

rows = CInt(2 * PI * 10) + 1

ReDim arr(1 To rows, 2)

For i = 0 To CInt(2 * PI * 10)

arr(i + 1, 1) = 0.1 * i * Cos(0.1 * i)

arr(i + 1, 2) = 0.1 * i * Sin(0.1 * i)

Next

'Call GetPicGraph(Picture1)

Call plot(arr, vbMagenta)

'dim1 = DimofArray(arr)

SavePicture Picture1.Image, App.Path & "\temp.bmp"

End Sub

Private Sub Form_Load()

Picture1.BackColor = RGB(0, 0, 0)

End Sub

Private Sub Form_Resize()

'// Picture1

Picture1.Top = 0

Picture1.Left = 0

Picture1.Width = Me.ScaleWidth

Picture1.Height = Me.ScaleHeight - 500

'// cmdGraph

cmdGraph.Top = Picture1.Height + 100

cmdGraph.Left = Me.ScaleWidth - 1200

cmdGraph.Width = 1000

cmdGraph.Height = 300

'//

Picture1.Cls

Call cmdGraph_Click

Picture1.Refresh

'//

End Sub

(2)打开notepad，粘贴下面的代码，并保存为mdlGraph.bas文件

Attribute VB_Name = "mdlGraph"

Option Base 1

Private P As PictureBox

Public Type Point

x As Single

y As Single

End Type

Dim xedge As Single, yedge As Single

Public Sub GetPic(ByRef Pic As PictureBox)

Set P = Pic

End Sub

Public Sub SetGraphAxis(ByVal x1 As Single, ByVal x2 As Single, _

ByVal y1 As Single, ByVal y2 As Single, _

ByVal Color As Long)

Dim N As Integer

N = 20

xedge = (x2 - x1) * 800 / P.Width

yedge = (y2 - y1) * 500 / P.Height

P.Scale (x1 - xedge, y2 + yedge)-(x2 + xedge, y1 - yedge) '设立坐标刻度范围

P.Line (x1, 0)-(x2, 0), Color '建立x,y轴

P.Line (0, y2)-(0, y1), Color

'x 刻度

For i = x1 + (x2 - x1) / N To x2 - (x2 - x1) / N Step (x2 - x1) / N

P.Line (i, 0)-(i, xedge * 0.15), Color

Next

P.Line (x2, 0)-(x2 - 0.4 * xedge, xedge * 0.15), Color

P.Line (x2, 0)-(x2 - 0.4 * xedge, -xedge * 0.15), Color

'y 刻度

For i = y1 + (y2 - y1) / N To y2 - (y2 - y1) / N Step (y2 - y1) / N

P.Line (0, i)-(yedge * 0.1, i), Color

Next

P.Line (0, y2)-(yedge * 0.1, y2 - 0.4 * yedge), Color

P.Line (0, y2)-(-yedge * 0.1, y2 - 0.4 * yedge), Color

End Sub

Public Sub plot(ByRef Data() As Single, ByVal Color As Long)

Dim rows As Long, columns As Long

Dim dblData() As Double

rows = UBound(Data, 1)

'columns = UBound(Data, 2)

'ReDim dblData(1 To LengthofArray, 1 To 3)

'For i = 1 To rows

'dblData(i) = CDbl(Data(i))

'Next

If DimofArray(Data) = 1 Then

For i = 1 To rows - 1

P.Line (i - 1, Data(i))-(i, Data(i + 1)), Color

Next

ElseIf DimofArray(Data) = 2 Then

For i = 1 To rows - 1

P.Line (Data(i, 1), Data(i, 2))-(Data(i + 1, 1), Data(i + 1, 2)), Color

Next

ElseIf DimofArray(Data) >= 3 Then

MsgBox "plot 无法进行三维绘图"

End If

End Sub

Public Function DimofArray(ByRef arr() As Single) As Integer

Dim Dimension(1 To 10) As Integer

On Error GoTo Err

i = 1

Do While i < 10

Dimension(i) = UBound(arr, i)

i = i + 1

Loop

Err:

DimofArray = i - 1

End Function

(3)在VB6 IDE中创建一个空的工程，添加上面的的两个文件，运行即可

你可以试试

本回答由提问者推荐

已赞过

已踩过<

你对这个回答的评价是？

评论

收起