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
正方體和長方體的原理壹樣，寫不動啦！！！！