rotatingcube.frm

几何图形学小程序 物体明暗效应的事例 消隐 两个立方体旋转 两个光源

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "Mscomctl.ocx"
Begin VB.Form frmMain 
   AutoRedraw      =   -1  'True
   Caption         =   "旋转立方体"
   ClientHeight    =   9225
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   13815
   DrawWidth       =   3
   FillColor       =   &H00C0C0C0&
   ForeColor       =   &H00FF0000&
   LinkTopic       =   "Form1"
   ScaleHeight     =   615
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   921
   StartUpPosition =   3  '窗口缺省
   WindowState     =   2  'Maximized
   Begin VB.CommandButton Command4 
      Caption         =   "球"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   11640
      TabIndex        =   9
      Top             =   8160
      Width           =   2055
   End
   Begin MSComctlLib.Slider Slider1 
      Height          =   615
      Left            =   11760
      TabIndex        =   8
      Top             =   3000
      Width           =   2775
      _ExtentX        =   4895
      _ExtentY        =   1085
      _Version        =   393216
      LargeChange     =   10
      Min             =   1
      Max             =   30
      SelStart        =   1
      Value           =   1
   End
   Begin VB.CommandButton Command3 
      Caption         =   "退出"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   11640
      TabIndex        =   4
      Top             =   9000
      Width           =   2055
   End
   Begin VB.CommandButton Command2 
      Caption         =   "旋转"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   11640
      TabIndex        =   2
      Top             =   6480
      Width           =   2055
   End
   Begin VB.CommandButton Command1 
      Caption         =   "碰撞"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   11640
      TabIndex        =   1
      Top             =   7320
      Width           =   2055
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   1080
      Top             =   240
   End
   Begin VB.PictureBox Picture2 
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000007&
      FillStyle       =   0  'Solid
      Height          =   9375
      Left            =   360
      ScaleHeight     =   621
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   725
      TabIndex        =   0
      Top             =   960
      Width           =   10935
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   0
      Top             =   240
   End
   Begin VB.Label Label6 
      Caption         =   "小"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   11520
      TabIndex        =   6
      Top             =   3120
      Width           =   240
   End
   Begin VB.Label Label5 
      Caption         =   "大"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   14520
      TabIndex        =   7
      Top             =   3120
      Width           =   240
   End
   Begin VB.Label Label4 
      Caption         =   "调节立方体的大小"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   11520
      TabIndex        =   5
      Top             =   2280
      Width           =   2775
   End
   Begin VB.Label Label1 
      Caption         =   "向图象框的边缘移动鼠标来控制旋转的方向和速度"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   21.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   525
      Left            =   2640
      TabIndex        =   3
      Top             =   240
      Width           =   9975
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private x(8) As Double
Private y(8) As Double
Private Const Pi = 3.1415926
Private Const Ireda = 241
Private Const Igreena = 3
Private Const Ibluea = 16
Private Const Iredl = 10
Private Const Igreenl = 242
Private Const Ibluel = 239
Private Ipr As Double
Private Ipg As Double
Private Ipb As Double
Private CenterX As Double
Private CenterY As Double
Private SIZE As Double
Private Radius As Double
Private Angle As Double
Private Hx As Double
Private CurX As Double
Private CurY As Double
Private Moveforward As Double
Private updown As Double
Private CubeCorners(1 To 8, 1 To 3) As Double
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long


Private Sub Command1_Click()
Select Case Command1.Caption
Case "碰撞"              'DEMO=碰撞
Timer2.Enabled = True
Command1.Caption = "停止" 'OFF=停止
Case Else
Timer2.Enabled = False
Command1.Caption = "碰撞"
End Select
End Sub

Private Sub Command2_Click()
Select Case Command2.Caption
Case "旋转"                   'ON=旋转
Timer1.Enabled = True
Command2.Caption = "停止"     'OFF=停止
Case Else
Timer1.Enabled = False
Command2.Caption = "旋转"
End Select
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Command4_Click()
Form1.Show
End Sub

Private Sub Form_Load()
CenterX = Picture2.ScaleWidth / 2
CenterY = Picture2.ScaleHeight / 2
Angle = 0
Moveforward = 1
updown = 1
End Sub

Private Sub DrawCube()
Picture2.Cls
ends = 255
Start = 210
Inc = (ends - Start) / 200
For ipixel = 0 To Picture2.ScaleHeight
Picture2.Line (0, ipixel)-(Picture2.ScaleWidth, ipixel), RGB(ends - Inc * ipixel, ends - Inc * ipixel, ends - Inc * ipixel)
Next ipixel
Dim g As Double
For i = 2 To 7
x(i) = CenterX - 100 + CubeCorners(i, 1)
y(i) = CenterY + CubeCorners(i, 2)
Next i
x(1) = CenterX - 100
y(1) = CenterY + ((SIZE * Sqr(3)) / 2)
x(8) = CenterX - 100
y(8) = CenterY - ((SIZE * Sqr(3)) / 2)
r = Sqr(Radius * Radius + ((SIZE * Sqr(3)) / 6) * ((SIZE * Sqr(3)) / 6))
If CubeCorners(7, 3) > 0 Then          '(1 ,2 ,7 ,6) 面1 书上有
    c1 = 0
    c2 = (Abs(CubeCorners(2, 3))) / r
    c6 = (Abs(CubeCorners(6, 3))) / r
    I1r = Ireda + Iredl * c1
    I1g = Igreena + Igreenl * c1
    I1b = Ibluea + Ibluel * c1
    I2r = Ireda + Iredl * c2
    I2g = Igreena + Igreenl * c2
    I2b = Ibluea + Ibluel * c2
    I6r = Ireda + Iredl * c6
    I6g = Igreena + Igreenl * c6
    I6b = Ibluea + Ibluel * c6
    For i = y(1) - 0.1 To y(2) Step -0.2
     IAr = I1r + (I6r - I1r) * (i - y(1)) / (y(6) - y(1))
     IAg = I1g + (I6g - I1g) * (i - y(1)) / (y(6) - y(1))
     IAb = I1b + (I6b - I1b) * (i - y(1)) / (y(6) - y(1))
     IBr = I1r + (I2r - I1r) * (i - y(1)) / (y(2) - y(1))
     IBg = I1g + (I2g - I1g) * (i - y(1)) / (y(2) - y(1))
     IBb = I1b + (I2b - I1b) * (i - y(1)) / (y(2) - y(1))
     xa = x(1) + (x(2) - x(1)) * (i - y(1)) / (y(2) - y(1))
     xb = x(1) + (x(6) - x(1)) * (i - y(1)) / (y(6) - y(1))
     For j = xb To xa Step 1
      dIpr = (IBr - IAr) / (xb - xa)
      dIpg = (IBg - IAg) / (xb - xa)
      dIpb = (IBb - IAb) / (xb - xa)
      Ipr = IAr + dIpr * (j - xa)
      Ipg = IAg + dIpg * (j - xa)
      Ipb = IAb + dIpb * (j - xa)
     SetPixelV Picture2.hdc, j, i, RGB(Ipr, Ipg, Ipb)
     Next j
    Next i
    
    c7 = (Abs(CubeCorners(7, 3))) / r
    c2 = (Abs(CubeCorners(2, 3))) / r
    c6 = (Abs(CubeCorners(6, 3))) / r
    I7r = Ireda + Iredl * c7
    I7g = Igreena + Igreenl * c7
    I7b = Ibluea + Ibluel * c7
    I2r = Ireda + Iredl * c2
    I2g = Igreena + Igreenl * c2
    I2b = Ibluea + Ibluel * c2
    I6r = Ireda + Iredl * c6
    I6g = Igreena + Igreenl * c6
    I6b = Ibluea + Ibluel * c6
    For i = y(7) + 0.1 To y(2) Step 0.2
     IAr = I7r + (I6r - I7r) * (i - y(7)) / (y(6) - y(7))
     IAg = I7g + (I6g - I7g) * (i - y(7)) / (y(6) - y(7))
     IAb = I7b + (I6b - I7b) * (i - y(7)) / (y(6) - y(7))
     IBr = I7r + (I2r - I7r) * (i - y(7)) / (y(2) - y(7))
     IBg = I7g + (I2g - I7g) * (i - y(7)) / (y(2) - y(7))
     IBb = I7b + (I2b - I7b) * (i - y(7)) / (y(2) - y(7))
     xa = x(7) + (x(2) - x(7)) * (i - y(7)) / (y(2) - y(7))
     xb = x(7) + (x(6) - x(7)) * (i - y(7)) / (y(6) - y(7))
     For j = xb To xa
      dIpr = (IBr - IAr) / (xb - xa)
      dIpg = (IBg - IAg) / (xb - xa)
      dIpb = (IBb - IAb) / (xb - xa)
      Ipr = IAr + dIpr * (j - xa)
      Ipg = IAg + dIpg * (j - xa)
      Ipb = IAb + dIpb * (j - xa)
      SetPixelV Picture2.hdc, j, i, RGB(Ipr, Ipg, Ipb)
     Next j
    Next i                  '(1 ,2 ,7 ,6) 面1 书上有
End If


If CubeCorners(4, 3) > 0 Then          '(3 ,4 ,5 ,8) 面2
    c8 = 0
    c3 = (Abs(CubeCorners(3, 3))) / r
    c5 = (Abs(CubeCorners(5, 3))) / r
    I8r = Ireda + Iredl * c8
    I8g = Igreena + Igreenl * c8
    I8b = Ibluea + Ibluel * c8
    I3r = Ireda + Iredl * c3
    I3g = Igreena + Igreenl * c3
    I3b = Ibluea + Ibluel * c3
    I5r = Ireda + Iredl * c5
    I5g = Igreena + Igreenl * c5
    I5b = Ibluea + Ibluel * c5
    For i = y(8) + 0.1 To y(3) Step 0.2
     IAr = I8r + (I5r - I8r) * (i - y(8)) / (y(5) - y(8))
     IAg = I8g + (I5g - I8g) * (i - y(8)) / (y(5) - y(8))
     IAb = I8b + (I5b - I8b) * (i - y(8)) / (y(5) - y(8))
     IBr = I8r + (I3r - I8r) * (i - y(8)) / (y(3) - y(8))
     IBg = I8g + (I3g - I8g) * (i - y(8)) / (y(3) - y(8))
     IBb = I8b + (I3b - I8b) * (i - y(8)) / (y(3) - y(8))
     xa = x(8) + (x(3) - x(8)) * (i - y(8)) / (y(3) - y(8))
     xb = x(8) + (x(5) - x(8)) * (i - y(8)) / (y(5) - y(8))
     For j = xb To xa Step -1
      dIpr = (IBr - IAr) / (xb - xa)
      dIpg = (IBg - IAg) / (xb - xa)
      dIpb = (IBb - IAb) / (xb - xa)
      Ipr = IAr + dIpr * (j - xa)
      Ipg = IAg + dIpg * (j - xa)
      Ipb = IAb + dIpb * (j - xa)
      SetPixelV Picture2.hdc, j, i, RGB(Ipr, Ipg, Ipb)
     Next j
    Next i
    
    c4 = (Abs(CubeCorners(4, 3))) / r
    c3 = (Abs(CubeCorners(3, 3))) / r
    c5 = (Abs(CubeCorners(5, 3))) / r
    I4r = Ireda + Iredl * c4
    I4g = Igreena + Igreenl * c4
    I4b = Ibluea + Ibluel * c4
    I3r = Ireda + Iredl * c3
    I3g = Igreena + Igreenl * c3
    I3b = Ibluea + Ibluel * c3
    I5r = Ireda + Iredl * c5
    I5g = Igreena + Igreenl * c5
    I5b = Ibluea + Ibluel * c5
    For i = y(4) - 0.1 To y(3) Step -0.2
     IAr = I4r + (I5r - I4r) * (i - y(4)) / (y(5) - y(4))
     IAg = I4g + (I5g - I4g) * (i - y(4)) / (y(5) - y(4))
     IAb = I4b + (I5b - I4b) * (i - y(4)) / (y(5) - y(4))
     IBr = I4r + (I3r - I4r) * (i - y(4)) / (y(3) - y(4))
     IBg = I4g + (I3g - I4g) * (i - y(4)) / (y(3) - y(4))
     IBb = I4b + (I3b - I4b) * (i - y(4)) / (y(3) - y(4))
     xa = x(4) + (x(3) - x(4)) * (i - y(4)) / (y(3) - y(4))
     xb = x(4) + (x(5) - x(4)) * (i - y(4)) / (y(5) - y(4))
     For j = xb To xa Step -1
      dIpr = (IBr - IAr) / (xb - xa)
      dIpg = (IBg - IAg) / (xb - xa)
      dIpb = (IBb - IAb) / (xb - xa)
      Ipr = IAr + dIpr * (j - xa)
      Ipg = IAg + dIpg * (j - xa)
      Ipb = IAb + dIpb * (j - xa)
      SetPixelV Picture2.hdc, j, i, RGB(Ipr, Ipg, Ipb)
     Next j
    Next i
End If



If CubeCorners(3, 3) > 0 Then          '(1 ,2 ,3 ,4) 面3
    c1 = (Abs(CubeCorners(1, 3))) / r
    c4 = (Abs(CubeCorners(4, 3))) / r
    c2 = (Abs(CubeCorners(2, 3))) / r
    I1r = Ireda + Iredl * c1
    I1g = Igreena + Igreenl * c1
    I1b = Ibluea + Ibluel * c1
    I2r = Ireda + Iredl * c2
    I2g = Igreena + Igreenl * c2
    I2b = Ibluea + Ibluel * c2
    I4r = Ireda + Iredl * c4
    I4g = Igreena + Igreenl * c4
    I4b = Ibluea + Ibluel * c4
    For i = y(1) - 0.1 To y(2) Step -0.2
     IAr = I1r + (I4r - I1r) * (i - y(1)) / (y(4) - y(1))
     IAg = I1g + (I4g - I1g) * (i - y(1)) / (y(4) - y(1))
     IAb = I1b + (I4b - I1b) * (i - y(1)) / (y(4) - y(1))
     IBr = I1r + (I2r - I1r) * (i - y(1)) / (y(2) - y(1))
     IBg = I1g + (I2g - I1g) * (i - y(1)) / (y(2) - y(1))
     IBb = I1b + (I2b - I1b) * (i - y(1)) / (y(2) - y(1))
     xa = x(1) + (x(2) - x(1)) * (i - y(1)) / (y(2) - y(1))
     xb = x(1) + (x(4) - x(1)) * (i - y(1)) / (y(4) - y(1))
     For j = xb To xa Step -1
      dIpr = (IBr - IAr) / (xb - xa)
      dIpg = (IBg - IAg) / (xb - xa)
      dIpb = (IBb - IAb) / (xb - xa)
      Ipr = IAr + dIpr * (j - xa)
      Ipg = IAg + dIpg * (j - xa)