模仿屏保星星模块 Public Type Stars x As Double y As Integer AddX As Integer AddY As Integer End TypePublic Star(1000) As Stars Public Accelarate As BooleanDeclare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private W As Integer Private H As Integer Private Sub Command1_Click() Label1.Visible = False MoveTo = move_forward Command1.Visible = False Accelarate = False WindowState = 2 W = ScaleWidth H = ScaleHeight
For i = 1 To 150
Star(i).x = W / 2 Star(i).y = H / 2 RandomX: Randomize Star(i).AddX = Int(Rnd * 29) - Int(Rnd * 29) If Star(i).AddX = 0 Then GoTo RandomX RandomY: Star(i).AddY = Int(Rnd * 19) - Int(Rnd * 19) If Star(i).AddY = 0 Then GoTo RandomY
NextEnd SubPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyEscape Then End End IfIf KeyCode = vbKeySpace Then Accelarate = True If KeyCode = vbKeyF1 Then ChDir App.Path Shell "NOTEPAD.EXE 3Dstarfield.txt", vbMaximizedFocus End IfEnd SubPrivate Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)If KeyCode = vbKeySpace Then Accelarate = FalseEnd SubPrivate Sub Form_Load()Move Screen.Width / 2 - Width / 2, Screen.Height / 2 - Height / 2 Command1.Move ScaleWidth / 2 - Command1.Width / 2, ScaleHeight / 4 - Command1.Height / 2 Label1.Move ScaleWidth / 2 - Label1.Width / 2, ScaleHeight / 2 - Label1.Height / 2End SubPrivate Sub Timer1_Timer() If Command1.Visible = True Then Exit SubFor i = 1 To 150
SetPixel hdc, W / 2, H / 2, &H404040
Select Case Abs(W / 2 - (Star(i).x)) Case Is < 20 col = &H0& Size = 1 Case Is < 80 col = &H404040 Size = 1 Case Is < 150 col = &H808080 Size = 2 Case Is < 200 col = &HC0C0C0 Size = 3 Case Is < 250 col = &HFFFFFF Size = 4 Case Else col = &HFFFFFF Size = 5 End Select Select Case Abs(H / 2 - (Star(i).y)) Case Is < 20 If Size = 0 Then Size = 1 col = back5 End If Case Is < 80 If Size = 0 Then col = &H404040 Size = 1 End If Case Is < 150 If Size < 2 Then Size = 2 col = &H808080 End If Case Is < 200 If Size < 3 Then Size = 3 col = &HC0C0C0 End If Case Is < 250 If Size < 4 Then Size = 4 col = &HFFFFFF End If Case Else If Size < 5 Then Size = 5 col = &HFFFFFF End If
End Select SetPixel hdc, W / 2, H / 2, colSelect Case Size Case 1 SetPixel Me.hdc, Star(i).x, Star(i).y, &H0& SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y + Star(i).AddY, col Case 2 SetPixel Me.hdc, Star(i).x, Star(i).y, &H0& SetPixel Me.hdc, Star(i).x - 1, Star(i).y, &H0& SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y + Star(i).AddY, col SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y + Star(i).AddY, col Case 3 SetPixel Me.hdc, Star(i).x, Star(i).y, &H0& SetPixel Me.hdc, Star(i).x - 1, Star(i).y, &H0& SetPixel Me.hdc, Star(i).x - 1, Star(i).y - 1, &H0& SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y + Star(i).AddY, col SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y + Star(i).AddY, col SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y - 1 + Star(i).AddY, col Case 4 SetPixel Me.hdc, Star(i).x, Star(i).y, &H0& SetPixel Me.hdc, Star(i).x - 1, Star(i).y, &H0& SetPixel Me.hdc, Star(i).x - 1, Star(i).y - 1, &H0& SetPixel Me.hdc, Star(i).x, Star(i).y - 1, &H0& SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y + Star(i).AddY, col SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y + Star(i).AddY, col SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y - 1 + Star(i).AddY, col SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y - 1 + Star(i).AddY, col Case 5 SetPixel Me.hdc, Star(i).x + a, Star(i).y, &H0& SetPixel Me.hdc, Star(i).x - 1 + a, Star(i).y, &H0& SetPixel Me.hdc, Star(i).x - 1 + a, Star(i).y - 1, &H0& SetPixel Me.hdc, Star(i).x + a, Star(i).y - 1, &H0& SetPixel Me.hdc, Star(i).x + a, Star(i).y - 2, &H0& SetPixel Me.hdc, Star(i).x - 1 + a, Star(i).y - 2, &H0& SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y + Star(i).AddY, col SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y + Star(i).AddY, col SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y - 1 + Star(i).AddY, col SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y - 1 + Star(i).AddY, col SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y - 2 + Star(i).AddY, col SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y - 2 + Star(i).AddY, col End Select Star(i).x = Star(i).x + Star(i).AddX Star(i).y = Star(i).y + Star(i).AddY Star(i).AddX = Star(i).AddX + Sgn(Star(i).AddX) * (Size / 5) Star(i).AddY = Star(i).AddY + Sgn(Star(i).AddY) * (Size / 5) If Accelarate Then Star(i).AddX = Star(i).AddX + Sgn(Star(i).AddX) * Size Star(i).AddY = Star(i).AddY + Sgn(Star(i).AddY) * Size End IfIf Star(i).x < 0 Or Star(i).x > ScaleWidth Or Star(i).y < 0 Or Star(i).y > ScaleHeight Then Star(i).x = W / 2 Star(i).y = H / 2 RandomX: Randomize Star(i).AddX = Int(Rnd * 29) - Int(Rnd * 29) If Star(i).AddX = 0 Then GoTo RandomX RandomY: Star(i).AddY = Int(Rnd * 19) - Int(Rnd * 19) If Star(i).AddY = 0 Then GoTo RandomY End IfNextEnd Sub
用鼠标实现立方体旋转 Private X(8) As Integer Private y(8) As Integer 'Integer arrays that hold the actual 2D coordinates of the '8 corners of the cube.These are the values used to plot 'the cube on the form after the X,Y,Z coordinates of each cube 'corner have been converted to 2 dimensinal X and Y coordinates. Private Const Pi = 3.14159265358979 'Constant used to convert degrees to radians Private CenterX As Integer Private CenterY As Integer 'The center of the 3 dimensional plane,where it's 'X=0 , Y=0 , Z=0 Private Const SIZE = 250 'The length of the cube achmes,therefore also adjusts the overall 'size. Private Radius As Integer 'The radius of the rotation.Each one of the 8 corners of the cube 'rotates around the vertical Y axis with the same angular speed and radius 'of rotation. Private Angle As Integer 'The value of this variable loops from 0 to 360 and it is passed 'as an argument to the COS and SIN functions (sine and cosine) 'that return the changing Z and X coordinates of each corner 'as the cube rotates around the Y axis Private CurX As Integer Private CurY As Integer 'Variables that hold the current mouse position on the form. Private CubeCorners(1 To 8, 1 To 3) As Integer 'The array that holds the X,Y and Z coordinates of the 8 corners 'of the cube.Here's how the 8 corners are numbered: ' ' 7___________8 ' /| /| | ' /_|________/ | | / ' |3| 4| | | / ' | | | | |/ ' | |________|_| ------|---------------> x(+) ' | /5 | /6 /| ' |/_________|/ / | ' 1 2 Z(+)/ | ' \|/ Y(+) ' 'The center of the 3D plane is right on the center of the cube. 'So ,if SIZE the length of one achmes,it's: ' 'CenterCube(1,1) = SIZE/2 ' X coordinate of 1st corner 'CenterCube(1,2) = SIZE/2 ' Y coordinate 'CenterCube(1,3) = SIZE/2 ' Z coordinate ' 'Actually,we only need to give a value for the Y coordinates 'of each corner since that will never change during the rotation 'as all corners rotate around the Y axis ,with only their Z and X 'coordinates changing periodically. Private Sub Form_Load() Show With Picture1 .Width = Label1.Width .Height = Label1.Height End With Picture1.Move ScaleWidth / 2 - Picture1.ScaleWidth / 2, Picture1.Height CenterX = ScaleWidth / 2 CenterY = ScaleHeight / 2 'Set the center of the 3D plane to reflect the center of the 'form. Angle = 0 Radius = Sqr(2 * (SIZE / 2) ^ 2) 'Give a value to the radius of the rotation.This is 'the Pythagorean theorem that returns the length of the 'hypotenuse of a right triangle as the square root 'of the sum of the other two sides raised to the 2nd power. CubeCorners(1, 2) = SIZE / 2 CubeCorners(2, 2) = SIZE / 2 CubeCorners(3, 2) = -SIZE / 2 CubeCorners(4, 2) = -SIZE / 2 CubeCorners(5, 2) = SIZE / 2 CubeCorners(6, 2) = SIZE / 2 CubeCorners(7, 2) = -SIZE / 2 CubeCorners(8, 2) = -SIZE / 2 'Assign a value to the Y coordinates of each cube.This 'will never change through out the rotation since the cube 'rotates around the Y axis.Play around with these if you like 'but the 3D prism will no longer resemble a cube :) End SubPrivate Sub DrawCube() Cls For i = 1 To 8 X(i) = CenterX + CubeCorners(i, 1) + CubeCorners(i, 3) / 8 y(i) = CenterY + CubeCorners(i, 2) + Sgn(CubeCorners(i, 2)) * CubeCorners(i, 3) / 8 'These two lines contain the algorith that converts the 'coordinates of a point on the 3D plane (x,y,z) ,into 2 'dimensional X and Y coordinates that can be used to plot 'a point on the form.Play around with the 8's and see 'what happens... Next Line (X(3), y(3))-(X(4), y(4)) Line (X(4), y(4))-(X(8), y(8)) Line (X(3), y(3))-(X(7), y(7)) Line (X(7), y(7))-(X(8), y(8)) Line (X(1), y(1))-(X(3), y(3)) Line (X(1), y(1))-(X(2), y(2)) Line (X(5), y(5))-(X(6), y(6)) Line (X(5), y(5))-(X(1), y(1)) Line (X(5), y(5))-(X(7), y(7)) Line (X(6), y(6))-(X(8), y(8)) Line (X(2), y(2))-(X(4), y(4)) Line (X(2), y(2))-(X(6), y(6)) Line (X(1), y(1))-(X(4), y(4)) Line (X(2), y(2))-(X(3), y(3))Line (X(4), y(4))-(X(8), y(8)) Line (X(3), y(3))-(X(7), y(7)) 'The plotting of the cube onto the form. 'We have to draw each achmes seperately and then ' "connect" the bottom square with the top square. DoEvents End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single) CurX = X CurY = y 'Store the current position of the mouse cursor into 'the variable CurX,CurY. End SubPrivate Sub Timer1_Timer() Select Case CurX Case Is > ScaleWidth / 2 Angle = Angle + Abs(CurX - ScaleWidth / 2) / 20 If Angle = 360 Then Angle = 0 Case Else Angle = Angle - Abs(CurX - ScaleWidth / 2) / 20 If Angle = 0 Then Angle = 360 End Select 'Change the direction and the angular speed of the rotation 'according to the position of the mouse cursor.If it's near 'the left edge of the form then the rotation will be 'anti-clockwise ,it's near the right edge it will be 'clockwise. The closer to the center of the form the 'cursor is,the slower the cube rotates. 'The angular speed of the rotation is controlled by the 'pace at which 'Angle' (the value that we pass to the '(COS and SIN functions) increases or decreases (increases 'for anti-clockwise rotation and decreases for clockwise 'rotation). For i = 1 To 3 Step 2 CubeCorners(i, 3) = Radius * Cos((Angle) * Pi / 180) CubeCorners(i, 1) = Radius * Sin((Angle) * Pi / 180) Next For i = 2 To 4 Step 2 CubeCorners(i, 3) = Radius * Cos((Angle + 2 * 45) * Pi / 180) CubeCorners(i, 1) = Radius * Sin((Angle + 2 * 45) * Pi / 180) Next For i = 5 To 7 Step 2 CubeCorners(i, 3) = Radius * Cos((Angle + 6 * 45) * Pi / 180) CubeCorners(i, 1) = Radius * Sin((Angle + 6 * 45) * Pi / 180) Next For i = 6 To 8 Step 2 CubeCorners(i, 3) = Radius * Cos((Angle + 4 * 45) * Pi / 180) CubeCorners(i, 1) = Radius * Sin((Angle + 4 * 45) * Pi / 180) Next 'Give the new values to the X and Z coordinates of each one 'of the 8 cube corners by using the COS and SIN mathematical 'functions.Notice that corners 1 and 3 always have the same 'X and Z coordinates, as well as 2 and 4, 5 and 7,6 & 8. 'Take a look at the little scetch on the top of the form 'to see how this is explained (imagine the cube rotating 'around the Y axis) DrawCube End Sub 要加一个TIMER、一个PICTURE
可以参考这个代码
http://www.21code.com/codebase/?pos=down&id=55如果可以用DX或者OpenGL
那就简单了吧～
绝对可以保证速度和质量DX的资料Google找得到很多
OpenGL的话
下面这页的倒数第二个代码不错～http://www.applevb.com/sourcecode/sdirectx.htm
Public Type Stars
x As Double
y As Integer
AddX As Integer
AddY As Integer
End TypePublic Star(1000) As Stars
Public Accelarate As BooleanDeclare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private H As Integer
Private Sub Command1_Click()
Label1.Visible = False
MoveTo = move_forward
Command1.Visible = False
Accelarate = False
WindowState = 2
W = ScaleWidth
H = ScaleHeight
For i = 1 To 150
Star(i).x = W / 2
Star(i).y = H / 2
RandomX:
Randomize
Star(i).AddX = Int(Rnd * 29) - Int(Rnd * 29)
If Star(i).AddX = 0 Then GoTo RandomX
RandomY:
Star(i).AddY = Int(Rnd * 19) - Int(Rnd * 19)
If Star(i).AddY = 0 Then GoTo RandomY
NextEnd SubPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
End
End IfIf KeyCode = vbKeySpace Then Accelarate = True
If KeyCode = vbKeyF1 Then
ChDir App.Path
Shell "NOTEPAD.EXE 3Dstarfield.txt", vbMaximizedFocus
End IfEnd SubPrivate Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)If KeyCode = vbKeySpace Then Accelarate = FalseEnd SubPrivate Sub Form_Load()Move Screen.Width / 2 - Width / 2, Screen.Height / 2 - Height / 2
Command1.Move ScaleWidth / 2 - Command1.Width / 2, ScaleHeight / 4 - Command1.Height / 2
Label1.Move ScaleWidth / 2 - Label1.Width / 2, ScaleHeight / 2 - Label1.Height / 2End SubPrivate Sub Timer1_Timer()
If Command1.Visible = True Then Exit SubFor i = 1 To 150
SetPixel hdc, W / 2, H / 2, &H404040
Select Case Abs(W / 2 - (Star(i).x))
Case Is < 20
col = &H0&
Size = 1
Case Is < 80
col = &H404040
Size = 1
Case Is < 150
col = &H808080
Size = 2
Case Is < 200
col = &HC0C0C0
Size = 3
Case Is < 250
col = &HFFFFFF
Size = 4
Case Else
col = &HFFFFFF
Size = 5 End Select
Select Case Abs(H / 2 - (Star(i).y)) Case Is < 20
If Size = 0 Then
Size = 1
col = back5
End If
Case Is < 80
If Size = 0 Then
col = &H404040
Size = 1
End If
Case Is < 150
If Size < 2 Then
Size = 2
col = &H808080
End If
Case Is < 200
If Size < 3 Then
Size = 3
col = &HC0C0C0
End If
Case Is < 250
If Size < 4 Then
Size = 4
col = &HFFFFFF
End If
Case Else
If Size < 5 Then
Size = 5
col = &HFFFFFF
End If
End Select
SetPixel hdc, W / 2, H / 2, colSelect Case Size
Case 1
SetPixel Me.hdc, Star(i).x, Star(i).y, &H0&
SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y + Star(i).AddY, col
Case 2
SetPixel Me.hdc, Star(i).x, Star(i).y, &H0&
SetPixel Me.hdc, Star(i).x - 1, Star(i).y, &H0&
SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y + Star(i).AddY, col
SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y + Star(i).AddY, col
Case 3
SetPixel Me.hdc, Star(i).x, Star(i).y, &H0&
SetPixel Me.hdc, Star(i).x - 1, Star(i).y, &H0&
SetPixel Me.hdc, Star(i).x - 1, Star(i).y - 1, &H0&
SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y + Star(i).AddY, col
SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y + Star(i).AddY, col
SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y - 1 + Star(i).AddY, col
Case 4
SetPixel Me.hdc, Star(i).x, Star(i).y, &H0&
SetPixel Me.hdc, Star(i).x - 1, Star(i).y, &H0&
SetPixel Me.hdc, Star(i).x - 1, Star(i).y - 1, &H0&
SetPixel Me.hdc, Star(i).x, Star(i).y - 1, &H0&
SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y + Star(i).AddY, col
SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y + Star(i).AddY, col
SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y - 1 + Star(i).AddY, col
SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y - 1 + Star(i).AddY, col
Case 5
SetPixel Me.hdc, Star(i).x + a, Star(i).y, &H0&
SetPixel Me.hdc, Star(i).x - 1 + a, Star(i).y, &H0&
SetPixel Me.hdc, Star(i).x - 1 + a, Star(i).y - 1, &H0&
SetPixel Me.hdc, Star(i).x + a, Star(i).y - 1, &H0&
SetPixel Me.hdc, Star(i).x + a, Star(i).y - 2, &H0&
SetPixel Me.hdc, Star(i).x - 1 + a, Star(i).y - 2, &H0&
SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y + Star(i).AddY, col
SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y + Star(i).AddY, col
SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y - 1 + Star(i).AddY, col
SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y - 1 + Star(i).AddY, col
SetPixel Me.hdc, Star(i).x + Star(i).AddX, Star(i).y - 2 + Star(i).AddY, col
SetPixel Me.hdc, Star(i).x - 1 + Star(i).AddX, Star(i).y - 2 + Star(i).AddY, col
End Select
Star(i).x = Star(i).x + Star(i).AddX
Star(i).y = Star(i).y + Star(i).AddY
Star(i).AddX = Star(i).AddX + Sgn(Star(i).AddX) * (Size / 5)
Star(i).AddY = Star(i).AddY + Sgn(Star(i).AddY) * (Size / 5)
If Accelarate Then
Star(i).AddX = Star(i).AddX + Sgn(Star(i).AddX) * Size
Star(i).AddY = Star(i).AddY + Sgn(Star(i).AddY) * Size
End IfIf Star(i).x < 0 Or Star(i).x > ScaleWidth Or Star(i).y < 0 Or Star(i).y > ScaleHeight Then
Star(i).x = W / 2
Star(i).y = H / 2
RandomX:
Randomize
Star(i).AddX = Int(Rnd * 29) - Int(Rnd * 29)
If Star(i).AddX = 0 Then GoTo RandomX
RandomY:
Star(i).AddY = Int(Rnd * 19) - Int(Rnd * 19)
If Star(i).AddY = 0 Then GoTo RandomY
End IfNextEnd Sub
Private Sub DrawPart()
R = HScroll2.Value
X = HScroll1.Value
Y = VScroll1.ValueAngle1 = DTOR(R)
Angle2 = DTOR(Y)
Angle3 = DTOR(X)
Text1.Text = "A1= " & Format(X, "0.00000")
Text2.Text = "A2= " & Format(Y, "0.00000")
Text3.Text = "R1= " & Format(R, "0.00000")Pic1.Clsd1x = -20: d1y = -20: d1z = 20
d2x = -20: d2y = 20: d2z = 20
d3x = 20: d3y = 20: d3z = 20
d4x = 20: d4y = -20: d4z = 20
d5x = -40: d5y = -40: d5z = -40
d6x = -40: d6y = 40: d6z = -40
d7x = 40: d7y = 40: d7z = -40
d8x = 40: d8y = -40: d8z = -40
XROT = (d1x * Cos(Angle1)) - (d1y * Sin(Angle1))
YROT = (d1x * Sin(Angle1)) + (d1y * Cos(Angle1))
ZROT = d1z
XROT1 = XROT
YROT1 = (YROT * Cos(Angle2)) - (ZROT * Sin(Angle2))
ZROT1 = (YROT * Sin(Angle2)) + (ZROT * Cos(Angle2))
p1x = (XROT1 * Cos(Angle3)) - (ZROT1 * Sin(Angle3))
p1y = YROT1
p1z = (XROT1 * Sin(Angle3)) + (ZROT1 * Cos(Angle3))
XROT = (d2x * Cos(Angle1)) - (d2y * Sin(Angle1))
YROT = (d2x * Sin(Angle1)) + (d2y * Cos(Angle1))
ZROT = d2z
XROT1 = XROT
YROT1 = (YROT * Cos(Angle2)) - (ZROT * Sin(Angle2))
ZROT1 = (YROT * Sin(Angle2)) + (ZROT * Cos(Angle2))
p2x = (XROT1 * Cos(Angle3)) - (ZROT1 * Sin(Angle3))
p2y = YROT1
p2z = (XROT1 * Sin(Angle3)) + (ZROT1 * Cos(Angle3))XROT = (d3x * Cos(Angle1)) - (d3y * Sin(Angle1))
YROT = (d3x * Sin(Angle1)) + (d3y * Cos(Angle1))
ZROT = d3z
XROT1 = XROT
YROT1 = (YROT * Cos(Angle2)) - (ZROT * Sin(Angle2))
ZROT1 = (YROT * Sin(Angle2)) + (ZROT * Cos(Angle2))
p3x = (XROT1 * Cos(Angle3)) - (ZROT1 * Sin(Angle3))
p3y = YROT1
p3z = (XROT1 * Sin(Angle3)) + (ZROT1 * Cos(Angle3))XROT = (d4x * Cos(Angle1)) - (d4y * Sin(Angle1))
YROT = (d4x * Sin(Angle1)) + (d4y * Cos(Angle1))
ZROT = d4z
XROT1 = XROT
YROT1 = (YROT * Cos(Angle2)) - (ZROT * Sin(Angle2))
ZROT1 = (YROT * Sin(Angle2)) + (ZROT * Cos(Angle2))
p4x = (XROT1 * Cos(Angle3)) - (ZROT1 * Sin(Angle3))
p4y = YROT1
p4z = (XROT1 * Sin(Angle3)) + (ZROT1 * Cos(Angle3))XROT = (d5x * Cos(Angle1)) - (d5y * Sin(Angle1))
YROT = (d5x * Sin(Angle1)) + (d5y * Cos(Angle1))
ZROT = d5z
XROT1 = XROT
YROT1 = (YROT * Cos(Angle2)) - (ZROT * Sin(Angle2))
ZROT1 = (YROT * Sin(Angle2)) + (ZROT * Cos(Angle2))
p5x = (XROT1 * Cos(Angle3)) - (ZROT1 * Sin(Angle3))
p5y = YROT1
p5z = (XROT1 * Sin(Angle3)) + (ZROT1 * Cos(Angle3))XROT = (d6x * Cos(Angle1)) - (d6y * Sin(Angle1))
YROT = (d6x * Sin(Angle1)) + (d6y * Cos(Angle1))
ZROT = d6z
XROT1 = XROT
YROT1 = (YROT * Cos(Angle2)) - (ZROT * Sin(Angle2))
ZROT1 = (YROT * Sin(Angle2)) + (ZROT * Cos(Angle2))
p6x = (XROT1 * Cos(Angle3)) - (ZROT1 * Sin(Angle3))
p6y = YROT1
p6z = (XROT1 * Sin(Angle3)) + (ZROT1 * Cos(Angle3))XROT = (d7x * Cos(Angle1)) - (d7y * Sin(Angle1))
YROT = (d7x * Sin(Angle1)) + (d7y * Cos(Angle1))
ZROT = d7z
XROT1 = XROT
YROT1 = (YROT * Cos(Angle2)) - (ZROT * Sin(Angle2))
ZROT1 = (YROT * Sin(Angle2)) + (ZROT * Cos(Angle2))
p7x = (XROT1 * Cos(Angle3)) - (ZROT1 * Sin(Angle3))
p7y = YROT1
p7z = (XROT1 * Sin(Angle3)) + (ZROT1 * Cos(Angle3))XROT = (d8x * Cos(Angle1)) - (d8y * Sin(Angle1))
YROT = (d8x * Sin(Angle1)) + (d8y * Cos(Angle1))
ZROT = d8z
XROT1 = XROT
YROT1 = (YROT * Cos(Angle2)) - (ZROT * Sin(Angle2))
ZROT1 = (YROT * Sin(Angle2)) + (ZROT * Cos(Angle2))
p8x = (XROT1 * Cos(Angle3)) - (ZROT1 * Sin(Angle3))
p8y = YROT1
p8z = (XROT1 * Sin(Angle3)) + (ZROT1 * Cos(Angle3))
Pic1.Line (p1x, p1y)-(p2x, p2y), RGB(255, 0, 0)
Pic1.Line (p2x, p2y)-(p3x, p3y), RGB(255, 0, 0)
Pic1.Line (p3x, p3y)-(p4x, p4y), RGB(255, 0, 0)
Pic1.Line (p4x, p4y)-(p1x, p1y), RGB(255, 0, 0)Pic1.Line (p5x, p5y)-(p6x, p6y), RGB(0, 255, 0)
Pic1.Line (p6x, p6y)-(p7x, p7y), RGB(0, 255, 0)
Pic1.Line (p7x, p7y)-(p8x, p8y), RGB(0, 255, 0)
Pic1.Line (p8x, p8y)-(p5x, p5y), RGB(0, 255, 0)Pic1.Line (p1x, p1y)-(p5x, p5y), RGB(0, 0, 255)
Pic1.Line (p2x, p2y)-(p6x, p6y), RGB(0, 0, 255)
Pic1.Line (p3x, p3y)-(p7x, p7y), RGB(0, 0, 255)
Pic1.Line (p4x, p4y)-(p8x, p8y), RGB(0, 0, 255)Pic1.Line (p1x, p1y)-(0, 0), RGB(255, 0, 0)
Pic1.Line (p2x, p2y)-(0, 0), RGB(255, 0, 0)
Pic1.Line (p3x, p3y)-(0, 0), RGB(255, 0, 0)
Pic1.Line (p4x, p4y)-(0, 0), RGB(255, 0, 0)
Pic1.Line (p5x, p5y)-(0, 0), RGB(0, 255, 0)
Pic1.Line (p6x, p6y)-(0, 0), RGB(0, 255, 0)
Pic1.Line (p7x, p7y)-(0, 0), RGB(0, 255, 0)
Pic1.Line (p8x, p8y)-(0, 0), RGB(0, 255, 0)Pic1.Line (0, 0)-(X, Y)DoEventsEnd SubPrivate Function DTOR(X)
DTOR = X * (3.1415 / 180)
End FunctionPrivate Sub HScroll1_Change()
DrawPart
End SubPrivate Sub HScroll1_Scroll()
DrawPart
End Sub
Private Sub HScroll2_Change()
DrawPart
End SubPrivate Sub HScroll2_Scroll()
DrawPart
End Sub
Private Sub Pic1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If X > 90 Then X = 90
If X < -90 Then X = -90
If Y > 90 Then Y = 90
If Y < -90 Then Y = -90
HScroll1.Value = X
VScroll1.Value = Y
End If
If Button = 2 Then
If X > 90 Then X = 90
If X < -90 Then X = -90
HScroll2.Value = X
End If
End Sub
Private Sub VScroll1_Change()
DrawPart
End Sub
Private Sub VScroll1_Scroll()
DrawPart
End Sub
Private X(8) As Integer
Private y(8) As Integer
'Integer arrays that hold the actual 2D coordinates of the
'8 corners of the cube.These are the values used to plot
'the cube on the form after the X,Y,Z coordinates of each cube
'corner have been converted to 2 dimensinal X and Y coordinates.
Private Const Pi = 3.14159265358979
'Constant used to convert degrees to radians
Private CenterX As Integer
Private CenterY As Integer
'The center of the 3 dimensional plane,where it's
'X=0 , Y=0 , Z=0
Private Const SIZE = 250
'The length of the cube achmes,therefore also adjusts the overall
'size.
Private Radius As Integer
'The radius of the rotation.Each one of the 8 corners of the cube
'rotates around the vertical Y axis with the same angular speed and radius
'of rotation.
Private Angle As Integer
'The value of this variable loops from 0 to 360 and it is passed
'as an argument to the COS and SIN functions (sine and cosine)
'that return the changing Z and X coordinates of each corner
'as the cube rotates around the Y axis
Private CurX As Integer
Private CurY As Integer
'Variables that hold the current mouse position on the form.
Private CubeCorners(1 To 8, 1 To 3) As Integer
'The array that holds the X,Y and Z coordinates of the 8 corners
'of the cube.Here's how the 8 corners are numbered:
'
' 7___________8
' /| /| |
' /_|________/ | | /
' |3| 4| | | /
' | | | | |/
' | |________|_| ------|---------------> x(+)
' | /5 | /6 /|
' |/_________|/ / |
' 1 2 Z(+)/ |
' \|/ Y(+)
'
'The center of the 3D plane is right on the center of the cube.
'So ,if SIZE the length of one achmes,it's:
'
'CenterCube(1,1) = SIZE/2 ' X coordinate of 1st corner
'CenterCube(1,2) = SIZE/2 ' Y coordinate
'CenterCube(1,3) = SIZE/2 ' Z coordinate
'
'Actually,we only need to give a value for the Y coordinates
'of each corner since that will never change during the rotation
'as all corners rotate around the Y axis ,with only their Z and X
'coordinates changing periodically.
Private Sub Form_Load()
Show
With Picture1
.Width = Label1.Width
.Height = Label1.Height
End With
Picture1.Move ScaleWidth / 2 - Picture1.ScaleWidth / 2, Picture1.Height
CenterX = ScaleWidth / 2
CenterY = ScaleHeight / 2
'Set the center of the 3D plane to reflect the center of the
'form.
Angle = 0
Radius = Sqr(2 * (SIZE / 2) ^ 2)
'Give a value to the radius of the rotation.This is
'the Pythagorean theorem that returns the length of the
'hypotenuse of a right triangle as the square root
'of the sum of the other two sides raised to the 2nd power.
CubeCorners(1, 2) = SIZE / 2
CubeCorners(2, 2) = SIZE / 2
CubeCorners(3, 2) = -SIZE / 2
CubeCorners(4, 2) = -SIZE / 2
CubeCorners(5, 2) = SIZE / 2
CubeCorners(6, 2) = SIZE / 2
CubeCorners(7, 2) = -SIZE / 2
CubeCorners(8, 2) = -SIZE / 2
'Assign a value to the Y coordinates of each cube.This
'will never change through out the rotation since the cube
'rotates around the Y axis.Play around with these if you like
'but the 3D prism will no longer resemble a cube :)
End SubPrivate Sub DrawCube()
Cls
For i = 1 To 8
X(i) = CenterX + CubeCorners(i, 1) + CubeCorners(i, 3) / 8
y(i) = CenterY + CubeCorners(i, 2) + Sgn(CubeCorners(i, 2)) * CubeCorners(i, 3) / 8
'These two lines contain the algorith that converts the
'coordinates of a point on the 3D plane (x,y,z) ,into 2
'dimensional X and Y coordinates that can be used to plot
'a point on the form.Play around with the 8's and see
'what happens...
Next
Line (X(3), y(3))-(X(4), y(4))
Line (X(4), y(4))-(X(8), y(8))
Line (X(3), y(3))-(X(7), y(7))
Line (X(7), y(7))-(X(8), y(8))
Line (X(1), y(1))-(X(3), y(3))
Line (X(1), y(1))-(X(2), y(2))
Line (X(5), y(5))-(X(6), y(6))
Line (X(5), y(5))-(X(1), y(1))
Line (X(5), y(5))-(X(7), y(7))
Line (X(6), y(6))-(X(8), y(8))
Line (X(2), y(2))-(X(4), y(4))
Line (X(2), y(2))-(X(6), y(6))
Line (X(1), y(1))-(X(4), y(4))
Line (X(2), y(2))-(X(3), y(3))Line (X(4), y(4))-(X(8), y(8))
Line (X(3), y(3))-(X(7), y(7))
'The plotting of the cube onto the form.
'We have to draw each achmes seperately and then
' "connect" the bottom square with the top square.
DoEvents
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
CurX = X
CurY = y
'Store the current position of the mouse cursor into
'the variable CurX,CurY.
End SubPrivate Sub Timer1_Timer()
Select Case CurX
Case Is > ScaleWidth / 2
Angle = Angle + Abs(CurX - ScaleWidth / 2) / 20
If Angle = 360 Then Angle = 0
Case Else
Angle = Angle - Abs(CurX - ScaleWidth / 2) / 20
If Angle = 0 Then Angle = 360
End Select
'Change the direction and the angular speed of the rotation
'according to the position of the mouse cursor.If it's near
'the left edge of the form then the rotation will be
'anti-clockwise ,it's near the right edge it will be
'clockwise. The closer to the center of the form the
'cursor is,the slower the cube rotates.
'The angular speed of the rotation is controlled by the
'pace at which 'Angle' (the value that we pass to the
'(COS and SIN functions) increases or decreases (increases
'for anti-clockwise rotation and decreases for clockwise
'rotation).
For i = 1 To 3 Step 2
CubeCorners(i, 3) = Radius * Cos((Angle) * Pi / 180)
CubeCorners(i, 1) = Radius * Sin((Angle) * Pi / 180)
Next
For i = 2 To 4 Step 2
CubeCorners(i, 3) = Radius * Cos((Angle + 2 * 45) * Pi / 180)
CubeCorners(i, 1) = Radius * Sin((Angle + 2 * 45) * Pi / 180)
Next
For i = 5 To 7 Step 2
CubeCorners(i, 3) = Radius * Cos((Angle + 6 * 45) * Pi / 180)
CubeCorners(i, 1) = Radius * Sin((Angle + 6 * 45) * Pi / 180)
Next
For i = 6 To 8 Step 2
CubeCorners(i, 3) = Radius * Cos((Angle + 4 * 45) * Pi / 180)
CubeCorners(i, 1) = Radius * Sin((Angle + 4 * 45) * Pi / 180)
Next
'Give the new values to the X and Z coordinates of each one
'of the 8 cube corners by using the COS and SIN mathematical
'functions.Notice that corners 1 and 3 always have the same
'X and Z coordinates, as well as 2 and 4, 5 and 7,6 & 8.
'Take a look at the little scetch on the top of the form
'to see how this is explained (imagine the cube rotating
'around the Y axis)
DrawCube
End Sub
要加一个TIMER、一个PICTURE