📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 8490
ClientLeft = 165
ClientTop = 555
ClientWidth = 8970
DrawWidth = 2
LinkTopic = "Form1"
ScaleHeight = 8490
ScaleWidth = 8970
StartUpPosition = 3 'Windows Default
Begin VB.Frame Frame2
Caption = "直线"
Height = 1695
Left = 7200
TabIndex = 4
Top = 120
Width = 1575
Begin VB.CommandButton Command2
Caption = "Bresenham"
Height = 615
Left = 240
TabIndex = 6
Top = 960
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "DDA"
Height = 615
Left = 240
TabIndex = 5
Top = 240
Width = 1215
End
End
Begin VB.Frame Frame1
Caption = "圆"
Height = 2055
Left = 7200
TabIndex = 2
Top = 1800
Width = 1575
Begin VB.CommandButton Command6
Caption = "Bresenham"
Height = 495
Left = 120
TabIndex = 8
Top = 1440
Width = 1335
End
Begin VB.CommandButton Command5
Caption = "极坐标法"
Height = 495
Left = 120
TabIndex = 7
Top = 840
Width = 1335
End
Begin VB.CommandButton Command4
Caption = "直角坐标法"
Height = 495
Left = 120
TabIndex = 3
Top = 240
Width = 1335
End
End
Begin VB.CommandButton Command3
Caption = "Cls"
Height = 495
Left = 4440
TabIndex = 1
Top = 7920
Width = 1215
End
Begin VB.PictureBox Picture1
BackColor = &H80000008&
DrawWidth = 3
FillColor = &H0000FFFF&
ForeColor = &H000000FF&
Height = 7815
Left = 0
ScaleHeight = 7755
ScaleWidth = 7035
TabIndex = 0
Top = 0
Width = 7095
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim xa!, xb!, ya!, yb!, x!, y!, steps!
Dim dl_x!, dl_y!
Dim n%
Private Sub Command1_Click()
Me.Cls
Dim dx!, dy!
dx = xb - xa
dy = yb - ya
If Abs(dx) > Abs(dy) Then
steps = Abs(dx)
Else
steps = Abs(dy)
End If
dl_x = dx / steps
dl_y = dy / steps
x = xa
y = ya
Dim i!
For i = 0 To steps
x = x + dl_x
y = y + dl_y
Print dl_x, y
Picture1.PSet (x, y), vbRed
Next
End Sub
'这个程序中的直线应该理解为矢量
Private Sub Command2_Click()
Me.Cls
Dim inc_y!, temp!
Dim dx!, dy!, p1!, pi!, c1!, c2!
dx = xb - xa
dy = yb - ya
'判断y的增量
If dx * dy >= 0 Then
inc_y = 1 '斜率大于零
Else
inc_y = -1
End If
'判断属于哪一个象限
If Abs(dx) > Abs(dy) Then
'1a 2b 3a 4b
If dx < 0 Then '方向反向
temp = xa
xa = xb
xb = temp
temp = ya
ya = yb
yb = temp
dx = -dx
dy = -dy
End If
'判断第几象限
If dy > 0 Then
p1 = 2 * dy - dx
c1 = 2 * dy
c2 = 2 * (dy - dx)
x = xa
y = ya
Picture1.PSet (x, y) '画出第一个点
Do While (x < xb)
x = x + 1
If p1 < 0 Then
pi = p1 + c1
Else
pi = p1 + c2
y = y + inc_y
End If
p1 = pi
Picture1.PSet (x, y)
Loop
'*******************************************************************************
Else
p1 = 2 * dy + dx
c1 = 2 * dy
c2 = 2 * (dy + dx)
x = xa
y = ya
Picture1.PSet (x, y) '画出第一个点
Do While (x < xb)
x = x + 1
If p1 < 0 Then
pi = p1 - c1
Else
pi = p1 - c2
y = y + inc_y
End If
p1 = pi
Picture1.PSet (x, y)
Loop
End If
'/////////////////////////////////////////////////////////////////////////////////
Else
If dy < 0 Then
temp = xa
xa = xb
xb = temp
temp = ya
ya = yb
yb = temp
dx = -dx
dy = -dy
End If
If dx > 0 Then
p1 = 2 * dx - dy
c1 = 2 * dx
c2 = 2 * (dx - dy)
x = xa
y = ya
Picture1.PSet (x, y) '画出第一个点
Do While (y < yb)
y = y + 1
If p1 < 0 Then
pi = p1 + c1
Else
pi = p1 + c2
x = x + inc_y
End If
p1 = pi
Picture1.PSet (x, y)
Loop
'****************************************************************************************
Else
p1 = 2 * dx + dy
c1 = 2 * dx
c2 = 2 * (dx + dy)
x = xa
y = ya
Picture1.PSet (x, y) '画出第一个点
Do While (y < yb)
y = y + 1
If p1 < 0 Then
pi = p1 - c1
Else
pi = p1 - c2
x = x + inc_y
End If
p1 = pi
Picture1.PSet (x, y)
Loop
End If
End If
End Sub
Private Sub Command3_Click()
Picture1.Cls
End Sub
Private Sub Command4_Click()
Dim r!
Dim xc!, yc!, x!, y!
xc = 0
yc = 0
x = -20
r = 20
Do While (x < 20)
y = 0 + Sqr(r ^ 2 - x ^ 2)
Picture1.PSet (x, y)
y = 0 - Sqr(r ^ 2 - x ^ 2)
Picture1.PSet (x, y)
x = x + 1
Loop
End Sub
Private Sub Command5_Click()
Dim r!, a!, k!
Dim xc!, yc!, x!, y!
r = 20
k = 3.1415926 / 180
Do While (a < 360)
x = r * Cos(a * k)
y = r * Sin(a * k)
Picture1.PSet (x, y)
a = a + 3
Loop
End Sub
'圆的生成
Private Sub Command6_Click()
Dim p1!, p2!
Dim r!
Dim x1!, y1!, x!, y!
r = 20
x = 0
y = r
x1 = x
y1 = y
p1 = 3 - 2 * r
Do While (x1 < r * Sin(3.1415926 / 4))
If p1 < 0 Then
y1 = y
p2 = p1 + 4 * x + 6
Else
y1 = y - 1
p2 = p1 + 4 * (x - y) + 10
End If
y = y1
x = x1
p1 = p2
Picture1.PSet (x, y)
Picture1.PSet (-x, y)
Picture1.PSet (y, x), vbYellow
Picture1.PSet (y, -x)
Picture1.PSet (x, -y), vbYellow
Picture1.PSet (-x, -y)
Picture1.PSet (-y, x), vbYellow
Picture1.PSet (-y, -x)
x1 = x1 + 1
Loop
End Sub
Private Sub Form_Load()
Picture1.Scale (-40, 40)-(40, -40)
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If n = 0 Then
xa = x
ya = y
n = 1
Else
xb = x
yb = y
n = 0
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -