www.pudn.com > drawcube.rar > 骰子转起来.frm, change:2013-08-21,size:3449b


VERSION 5.00 
Begin VB.Form Form1  
   BackColor       =   &H00E0E0E0& 
   Caption         =   "模拟骰子旋转" 
   ClientHeight    =   6345 
   ClientLeft      =   120 
   ClientTop       =   450 
   ClientWidth     =   7230 
   LinkTopic       =   "Form1" 
   MaxButton       =   0   'False 
   ScaleHeight     =   6345 
   ScaleWidth      =   7230 
   StartUpPosition =   2  '屏幕中心 
   Begin VB.Timer Timer1  
      Left            =   2640 
      Top             =   4680 
   End 
   Begin VB.Label Label1  
      BackStyle       =   0  'Transparent 
      Caption         =   "单击控制骰子动止,鼠标距离控制运动速度" 
      ForeColor       =   &H00FF0000& 
      Height          =   375 
      Left            =   1680 
      TabIndex        =   0 
      Top             =   120 
      Width           =   3855 
   End 
End 
Attribute VB_Name = "Form1" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Const lg = 1000  '正方体长度的一半 
Dim X(8) As Double, Y(8) As Double  '存储正方体的八个顶点(实际位置) 
Dim a(8) As Double, b(8) As Double '存储正方体的八个顶点(平面位置,采用斜二测画法) 
Dim angle As Double '旋转角度 
Dim dx(8) As Double, dy(8) As Double 
Const p = 45 / 180 * 3.1415926 
Dim Is_stop As Boolean 
'Download by http://www.codefans.net 
Private Sub Form_Load() 
Me.DrawWidth = 3 
Me.Scale (-3000, 3000)-(3000, -3000) 
Is_stop = False 
'八个顶点的实际位置 
dx(7) = 0 
dy(7) = 0 
dx(3) = -2 ^ (1 / 2) * lg 
dy(3) = -6 ^ (1 / 2) / 3 * lg 
dx(8) = 2 ^ (1 / 2) * lg 
dy(8) = -6 ^ (1 / 2) / 3 * lg 
dx(5) = 0 
dy(5) = 6 ^ (1 / 2) * 2 / 3 * lg 
dx(1) = dx(3) 
dy(1) = -dy(3) 
dx(4) = dx(5) 
dy(4) = -dy(5) 
dx(6) = dx(8) 
dy(6) = -dy(8) 
dx(2) = 0 
dy(2) = 0 
End Sub 
Private Sub DrawCube(n) 
Me.Cls 
'八个顶点的平面位置 
For i = 1 To 8 
    X(i) = dx(i) * Cos(n) - dy(i) * Sin(n)  '旋转变换 
    Y(i) = dx(i) * Sin(n) + dy(i) * Cos(n) 
Next i 
 
' 
For i = 1 To 8 
    a(i) = X(i) 
Next 
b(7) = Y(7) 
b(2) = Y(2) + 2 * 3 ^ (1 / 2) * lg 
 
b(3) = Y(3) * Sin(p) / 2 + 2 * 3 ^ (1 / 2) / 3 * lg 
b(5) = Y(5) * Sin(p) / 2 + 2 * 3 ^ (1 / 2) / 3 * lg 
b(8) = Y(8) * Sin(p) / 2 + 2 * 3 ^ (1 / 2) / 3 * lg 
 
b(1) = Y(1) * Sin(p) / 2 + 4 * 3 ^ (1 / 2) / 3 * lg 
b(4) = Y(4) * Sin(p) / 2 + 4 * 3 ^ (1 / 2) / 3 * lg 
b(6) = Y(6) * Sin(p) / 2 + 4 * 3 ^ (1 / 2) / 3 * lg 
'调整一下高度 
For i = 1 To 8 
    b(i) = b(i) - 1500 
Next 
 
'画好12条棱,构成一个正方体 
Line (a(1), b(1))-(a(2), b(2)), vbBlue 
Line (a(1), b(1))-(a(3), b(3)), vbBlue 
Line (a(1), b(1))-(a(5), b(5)), vbBlue 
Line (a(4), b(4))-(a(2), b(2)), vbBlue 
Line (a(6), b(6))-(a(2), b(2)), vbBlue 
Line (a(7), b(7))-(a(3), b(3)), vbBlue 
Line (a(7), b(7))-(a(5), b(5)), vbBlue 
Line (a(7), b(7))-(a(8), b(8)), vbBlue 
Line (a(8), b(8))-(a(4), b(4)), vbBlue 
Line (a(8), b(8))-(a(6), b(6)), vbBlue 
Line (a(3), b(3))-(a(4), b(4)), vbBlue 
Line (a(5), b(5))-(a(6), b(6)), vbBlue 
End Sub 
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
If Is_stop = False Then 
    Timer1.Enabled = False 
    Is_stop = True 
Else 
    Is_stop = False 
    Timer1.Enabled = True 
End If 
End Sub 
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
If X >= 0 And X < 6000 Then Timer1.Interval = Int(X / 6000 * 1000) 
End Sub 
 
Private Sub Timer1_Timer() 
angle = angle + 30 / 180 * 3.1415926 
Call DrawCube(angle) 
End Sub