⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.frm

📁 The programm introduce how to choose points to create line_circle.
💻 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 + -