用VB画圆、正方形、长方形、球、正方体、长方体

画圆
VERSION 5.00
Begin VB.Form FMain
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 5205
ClientLeft = 45
ClientTop = 330
ClientWidth = 7035
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5205
ScaleWidth = 7035
StartUpPosition = 2 '屏幕中心
Begin VB.CheckBox chkA
Caption = "自动反转"
Height = 375
Left = 5280
TabIndex = 5
Top = 3600
Width = 1695
End
Begin VB.CheckBox chkAuto
Caption = "自动旋转"
Height = 255
Left = 5280
TabIndex = 4
Top = 3240
Width = 1575
End
Begin VB.Timer tmrTurn
Enabled = 0 'False
Interval = 100
Left = 5280
Top = 4080
End
Begin VB.PictureBox picDraw
Height = 5000
Left = 120
ScaleHeight = 4935
ScaleWidth = 4935
TabIndex = 3
Top = 120
Width = 5000
End
Begin VB.CommandButton cmdTurnAnti
Caption = "正向"
Height = 495
Left = 5280
TabIndex = 2
Top = 1200
Width = 1575
End
Begin VB.TextBox txtAngle
Height = 375
Left = 5280
TabIndex = 1
Text = "30"
Top = 120
Width = 1575
End
Begin VB.CommandButton cmdTurn
Caption = "反向"
Height = 495
Left = 5280
TabIndex = 0
Top = 600
Width = 1575
End
End
Attribute VB_Name = "FMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const rPI As Single = 3.14159265358979
Private iAngle As Integer '转过角度
Private Sub chkAuto_Click()
tmrTurn.Enabled = chkAuto.Value
End Sub
Private Sub cmdTurn_Click()
iAngle = iAngle + Val(txtAngle.Text)
Call Draw
End Sub
Private Sub cmdTurnAnti_Click()
iAngle = iAngle - Val(txtAngle.Text)
Call Draw
End Sub
Private Sub Form_Load()
picDraw.Scale (-1, 1)-(1, -1) '中心设为原点
picDraw.DrawWidth = 5 '加粗
End Sub
Private Sub Draw()
picDraw.Cls
picDraw.Line (0, 0)-(Cos(iAngle / 180 * rPI), Sin(iAngle / 180 * rPI))
End Sub
Private Sub tmrTurn_Timer()
If chkA.Value = 0 Then
Call cmdTurnAnti_Click
Else
Call cmdTurn_Click
End If
End Sub
矩形
Public Sub DrawRectangle(ByVal Width As Long, ByVal Height As Long, Optional Top As Long, Optional Left As Long)
Line (Left, Top)-(Left + Width, Top)
Line (Left, Top)-(Left, Top + Height)
Line (Left, Top + Height)-(Left + Width, Top + Height)
Line (Left + Width, Top)-(Left + Width, Top + Height)
End Sub
球
定义一个数组记录某一个值是不是已经被使用
比如有10个数供选择,那就定义a[10],赋初值0,表示没有使用,当抽取一个号码后,比如是5,那就令a[5-1]=1,求救已经使用,每次取数时判断一下取得的数i对应的a[i]是否等于0就可以了.
长方体
Private Type xyz '定义3D坐标类型
y As Single
z As Single
End Type
Private xyz1() As xyz
Public x0 As Single, y0 As Single, x1 As Single, y1 As Single
Private Sub Check1_Click()
If x1 = 0 Or y1 = 0 Then
Exit Sub
End If
If Check1.Value = 1 Then '如果选择显示空间坐标轴,就画出空间坐标轴
Line (x1, y1)-(x1, y1 - 6400)
Line (x1, y1)-(x1 + 6400, y1)
Line (x1, y1)-(x1 - 4050, y1 + 4050)
Line (x1, y1 - 6400)-(x1 - 200, y1 - 6200)
Line (x1, y1 - 6400)-(x1 + 200, y1 - 6200)
Line (x1 + 6400, y1)-(x1 + 6200, y1 + 200)
Line (x1 + 6400, y1)-(x1 + 6200, y1 - 200)
Line (x1 - 4050, y1 + 4050)-(x1 - 4050, y1 + 3850)
Line (x1 - 4050, y1 + 4050)-(x1 - 3850, y1 + 4050)
Else
Cls
End If
End Sub
Private Sub Command1_Click()
drawpnt Val(Text1.Text), Val(Text2.Text), Val(Text3.Text) '这是在三维空间画点的事件
End Sub
Private Sub Command2_Click()
Call VScroll1_Change(0) '画长方体
End Sub
Private Sub Command3_Click()
dmove 0, 500, 0 '移动
End Sub
Private Sub Command4_Click()
dmove -500, 0, 0 '移动
End Sub
Private Sub Command5_Click()
dmove 500, 0, 0 '移动
End Sub
Private Sub Command6_Click()
dmove 0, -500, 0 '移动
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Cls
x0 = x
y0 = y
x1 = x
y1 = y
Call Check1_Click
ReDim xyz1(0 To 1)
xyz1(0).y = x
xyz1(0).z = y
PSet (x, y)
'在程序上点击鼠标画出空间坐标轴,并记录原点
End Sub
Sub drawpnt(dx As Single, dy As Single, dz As Single)
Dim dxy As Single
dxy = Fix(dx * Sqr(2) / 2)
xyz1(0).y = x0 - dxy + dy
xyz1(0).z = y0 + dxy - dz
PSet (xyz1(0).y, xyz1(0).z)
'画点的过程
End Sub
Sub dline(dx1 As Single, dy1 As Single, dz1 As Single, dx2 As Single, dy2 As Single, dz2 As Single)
Dim dxy1 As Single, dxy2 As Single
dxy1 = Fix(dx1 * Sqr(2) / 2)
dxy2 = Fix(dx2 * Sqr(2) / 2)
xyz1(0).y = x0 - dxy1 + dy1
xyz1(0).z = y0 + dxy1 - dz1
xyz1(1).y = x0 - dxy2 + dy2
xyz1(1).z = y0 + dxy2 - dz2
Line (xyz1(0).y, xyz1(0).z)-(xyz1(1).y, xyz1(1).z)
'划线的过程
End Sub
Private Sub VScroll1_Change(index As Integer)
If x0 = 0 Or y0 = 0 Then
Exit Sub
End If
Cls
Call Check1_Click
Dim a As Single, b As Single, c As Single
a = VScroll1(0).Value * 900
b = VScroll1(1).Value * 900
c = VScroll1(2).Value * 900
square a, b, c
'根据a,b,c(长,宽,高)来画长方体的过程
End Sub
Sub square(a As Single, b As Single, c As Single)
dline 0, 0, 0, a, 0, 0
dline 0, 0, 0, 0, b, 0
dline 0, 0, 0, 0, 0, c
dline a, 0, 0, a, b, 0
dline a, 0, 0, a, 0, c
dline 0, b, 0, a, b, 0
dline 0, b, 0, 0, b, c
dline 0, 0, c, a, 0, c
dline 0, 0, c, 0, b, c
dline a, b, c, a, b, 0
dline a, b, c, a, 0, c
dline a, b, c, 0, b, c
End Sub
Sub dmove(dx As Single, dy As Single, dz As Single)
If x0 = 0 Or y0 = 0 Then
Exit Sub
End If
Cls
Call Check1_Click
x0 = x0 + dx
y0 = y0 - dy
Call VScroll1_Change(0)
'移动长方体的过程
End Sub
正方体和长方体的原理一样,写不动啦!