📄 rotatingcube.frm
字号:
Ipb = IAb + dIpb * (j - xa)
SetPixelV Picture2.hdc, j, i, RGB(Ipr, Ipg, Ipb)
Next j
Next i
c3 = (Abs(CubeCorners(3, 3))) / r
c4 = (Abs(CubeCorners(4, 3))) / r
c2 = (Abs(CubeCorners(2, 3))) / r
I3r = Ireda + Iredl * c3
I3g = Igreena + Igreenl * c3
I3b = Ibluea + Ibluel * c3
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(3) + 0.1 To y(2) Step 0.2
IAr = I3r + (I4r - I3r) * (i - y(3)) / (y(4) - y(3))
IAg = I3g + (I4g - I3g) * (i - y(3)) / (y(4) - y(3))
IAb = I3b + (I4b - I3b) * (i - y(3)) / (y(4) - y(3))
IBr = I3r + (I2r - I3r) * (i - y(3)) / (y(2) - y(3))
IBg = I3g + (I2g - I3g) * (i - y(3)) / (y(2) - y(3))
IBb = I3b + (I2b - I3b) * (i - y(3)) / (y(2) - y(3))
xa = x(3) + (x(2) - x(3)) * (i - y(3)) / (y(2) - y(3))
xb = x(3) + (x(4) - x(3)) * (i - y(3)) / (y(4) - y(3))
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(6, 3) > 0 Then '(5 ,6 ,7 ,8) 面3
c8 = 0
c5 = (Abs(CubeCorners(5, 3))) / r
c7 = (Abs(CubeCorners(7, 3))) / r
I8r = Ireda + Iredl * c8
I8g = Igreena + Igreenl * c8
I8b = Ibluea + Ibluel * c8
I5r = Ireda + Iredl * c5
I5g = Igreena + Igreenl * c5
I5b = Ibluea + Ibluel * c5
I7r = Ireda + Iredl * c7
I7g = Igreena + Igreenl * c7
I7b = Ibluea + Ibluel * c7
For i = y(8) + 0.1 To y(5) Step 0.2
IAr = I8r + (I7r - I8r) * (i - y(8)) / (y(7) - y(8))
IAg = I8g + (I7g - I8g) * (i - y(8)) / (y(7) - y(8))
IAb = I8b + (I7b - I8b) * (i - y(8)) / (y(7) - y(8))
IBr = I8r + (I5r - I8r) * (i - y(8)) / (y(5) - y(8))
IBg = I8g + (I5g - I8g) * (i - y(8)) / (y(5) - y(8))
IBb = I8b + (I5b - I8b) * (i - y(8)) / (y(5) - y(8))
xa = x(8) + (x(5) - x(8)) * (i - y(8)) / (y(5) - y(8))
xb = x(8) + (x(7) - x(8)) * (i - y(8)) / (y(7) - 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
c6 = (Abs(CubeCorners(6, 3))) / r
c5 = (Abs(CubeCorners(5, 3))) / r
c7 = (Abs(CubeCorners(7, 3))) / r
I6r = Ireda + Iredl * c6
I6g = Igreena + Igreenl * c6
I6b = Ibluea + Ibluel * c6
I5r = Ireda + Iredl * c5
I5g = Igreena + Igreenl * c5
I5b = Ibluea + Ibluel * c5
I7r = Ireda + Iredl * c7
I7g = Igreena + Igreenl * c7
I7b = Ibluea + Ibluel * c7
For i = y(6) - 0.1 To y(5) Step -0.2
IAr = I6r + (I7r - I6r) * (i - y(6)) / (y(7) - y(6))
IAg = I6g + (I7g - I6g) * (i - y(6)) / (y(7) - y(6))
IAb = I6b + (I7b - I6b) * (i - y(6)) / (y(7) - y(6))
IBr = I6r + (I5r - I6r) * (i - y(6)) / (y(5) - y(6))
IBg = I6g + (I5g - I6g) * (i - y(6)) / (y(5) - y(6))
IBb = I6b + (I5b - I6b) * (i - y(6)) / (y(5) - y(6))
xa = x(6) + (x(5) - x(6)) * (i - y(6)) / (y(5) - y(6))
xb = x(6) + (x(7) - x(6)) * (i - y(6)) / (y(7) - y(6))
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(2, 3) > 0 Then '(2 ,3 ,8 ,7) 面5
c8 = 0
c3 = (Abs(CubeCorners(3, 3))) / r
c7 = (Abs(CubeCorners(7, 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
I7r = Ireda + Iredl * c7
I7g = Igreena + Igreenl * c7
I7b = Ibluea + Ibluel * c7
For i = y(8) + 0.1 To y(3) Step 0.2
IAr = I8r + (I7r - I8r) * (i - y(8)) / (y(7) - y(8))
IAg = I8g + (I7g - I8g) * (i - y(8)) / (y(7) - y(8))
IAb = I8b + (I7b - I8b) * (i - y(8)) / (y(7) - 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(7) - x(8)) * (i - y(8)) / (y(7) - 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
c2 = (Abs(CubeCorners(2, 3))) / r
c3 = (Abs(CubeCorners(3, 3))) / r
c7 = (Abs(CubeCorners(7, 3))) / r
I2r = Ireda + Iredl * c2
I2g = Igreena + Igreenl * c2
I2b = Ibluea + Ibluel * c2
I3r = Ireda + Iredl * c3
I3g = Igreena + Igreenl * c3
I3b = Ibluea + Ibluel * c3
I7r = Ireda + Iredl * c7
I7g = Igreena + Igreenl * c7
I7b = Ibluea + Ibluel * c7
For i = y(2) - 0.1 To y(3) Step -0.2
IAr = I2r + (I7r - I2r) * (i - y(2)) / (y(7) - y(2))
IAg = I2g + (I7g - I2g) * (i - y(2)) / (y(7) - y(2))
IAb = I2b + (I7b - I2b) * (i - y(2)) / (y(7) - y(2))
IBr = I2r + (I3r - I2r) * (i - y(2)) / (y(3) - y(2))
IBg = I2g + (I3g - I2g) * (i - y(2)) / (y(3) - y(2))
IBb = I2b + (I3b - I2b) * (i - y(2)) / (y(3) - y(2))
xa = x(2) + (x(3) - x(2)) * (i - y(2)) / (y(3) - y(2))
xb = x(2) + (x(7) - x(2)) * (i - y(2)) / (y(7) - y(2))
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(5, 3) > 0 Then '(1 ,4 ,5 ,6 面5
c1 = 0
c4 = (Abs(CubeCorners(4, 3))) / r
c6 = (Abs(CubeCorners(6, 3))) / r
I1r = Ireda + Iredl * c1
I1g = Igreena + Igreenl * c1
I1b = Ibluea + Ibluel * c1
I4r = Ireda + Iredl * c4
I4g = Igreena + Igreenl * c4
I4b = Ibluea + Ibluel * c4
I6r = Ireda + Iredl * c6
I6g = Igreena + Igreenl * c6
I6b = Ibluea + Ibluel * c6
For i = y(1) - 0.1 To y(4) 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 + (I4r - I1r) * (i - y(1)) / (y(4) - y(1))
IBg = I1g + (I4g - I1g) * (i - y(1)) / (y(4) - y(1))
IBb = I1b + (I4b - I1b) * (i - y(1)) / (y(4) - y(1))
xa = x(1) + (x(4) - x(1)) * (i - y(1)) / (y(4) - 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
c5 = (Abs(CubeCorners(5, 3))) / r
c4 = (Abs(CubeCorners(4, 3))) / r
c6 = (Abs(CubeCorners(6, 3))) / r
I5r = Ireda + Iredl * c5
I5g = Igreena + Igreenl * c5
I5b = Ibluea + Ibluel * c5
I4r = Ireda + Iredl * c4
I4g = Igreena + Igreenl * c4
I4b = Ibluea + Ibluel * c4
I6r = Ireda + Iredl * c6
I6g = Igreena + Igreenl * c6
I6b = Ibluea + Ibluel * c6
For i = y(5) + 0.1 To y(4) Step 0.2
IAr = I5r + (I6r - I5r) * (i - y(5)) / (y(6) - y(5))
IAg = I5g + (I6g - I5g) * (i - y(5)) / (y(6) - y(5))
IAb = I5b + (I6b - I5b) * (i - y(5)) / (y(6) - y(5))
IBr = I5r + (I4r - I5r) * (i - y(5)) / (y(4) - y(5))
IBg = I5g + (I4g - I5g) * (i - y(5)) / (y(4) - y(5))
IBb = I5b + (I4b - I5b) * (i - y(5)) / (y(4) - y(5))
xa = x(5) + (x(4) - x(5)) * (i - y(5)) / (y(4) - y(5))
xb = x(5) + (x(6) - x(5)) * (i - y(5)) / (y(6) - y(5))
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
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)
If CubeCorners(7, 3) > 0 Then
g = (CubeCorners(7, 3)) / Radius
ReDim poly(1 To 4) As POINTAPI
NumCoords = 4
Picture2.ScaleMode = 3
poly(1).x = x(1)
poly(1).y = y(1)
poly(2).x = x(2)
poly(2).y = y(2)
poly(3).x = x(7)
poly(3).y = y(7)
poly(4).x = x(6)
poly(4).y = y(6)
hBrush = CreateSolidBrush(RGB(100 * g + 100, 100 * g + 100, 100 * g + 100))
hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
FillRgn Picture2.hdc, hRgn, hBrush
DeleteObject hBrush
DeleteObject hRgn
End If
If CubeCorners(4, 3) > 0 Then
g = Abs(CubeCorners(4, 3)) / Radius
ReDim poly(1 To 4) As POINTAPI
NumCoords = 4
Picture2.ScaleMode = 3
poly(1).x = x(3)
poly(1).y = y(3)
poly(2).x = x(4)
poly(2).y = y(4)
poly(3).x = x(5)
poly(3).y = y(5)
poly(4).x = x(8)
poly(4).y = y(8)
hBrush = CreateSolidBrush(RGB(110 * g + 110, 110 * g + 110, 130 * g + 130))
hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
FillRgn Picture2.hdc, hRgn, hBrush
DeleteObject hBrush
DeleteObject hRgn
End If
If CubeCorners(3, 3) > 0 Then
g = Abs(CubeCorners(3, 3)) / Radius
ReDim poly(1 To 4) As POINTAPI
NumCoords = 4
Picture2.ScaleMode = 3
poly(1).x = x(1)
poly(1).y = y(1)
poly(2).x = x(2)
poly(2).y = y(2)
poly(3).x = x(3)
poly(3).y = y(3)
poly(4).x = x(4)
poly(4).y = y(4)
hBrush = CreateSolidBrush(RGB(110 * g + 110, 100 * g + 100, 120 * g + 120))
hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
FillRgn Picture2.hdc, hRgn, hBrush
DeleteObject hBrush
DeleteObject hRgn
End If
If CubeCorners(6, 3) > 0 Then
g = Abs(CubeCorners(6, 3)) / Radius
ReDim poly(1 To 4) As POINTAPI
NumCoords = 4
Picture2.ScaleMode = 3
poly(1).x = x(5)
poly(1).y = y(5)
poly(2).x = x(6)
poly(2).y = y(6)
poly(3).x = x(7)
poly(3).y = y(7)
poly(4).x = x(8)
poly(4).y = y(8)
hBrush = CreateSolidBrush(RGB(100 * g + 100, 75 * g + 75, 100 * g + 100))
hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE) '100, 150, 100)
FillRgn Picture2.hdc, hRgn, hBrush
DeleteObject hBrush
DeleteObject hRgn
End If
If CubeCorners(5, 3) > 0 Then
g = Abs(CubeCorners(5, 3)) / Radius
ReDim poly(1 To 4) As POINTAPI
NumCoords = 4
Picture2.ScaleMode = 3
poly(1).x = x(1)
poly(1).y = y(1)
poly(2).x = x(6)
poly(2).y = y(6)
poly(3).x = x(5)
poly(3).y = y(5)
poly(4).x = x(4)
poly(4).y = y(4)
hBrush = CreateSolidBrush(RGB(0, 110 * g + 110, 130 * g + 110))
hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
FillRgn Picture2.hdc, hRgn, hBrush
DeleteObject hBrush
DeleteObject hRgn
End If
If CubeCorners(2, 3) > 0 Then
g = Abs(CubeCorners(2, 3)) / Radius
ReDim poly(1 To 4) As POINTAPI
NumCoords = 4
Picture2.ScaleMode = 3
poly(1).x = x(8)
poly(1).y = y(8)
poly(2).x = x(7)
poly(2).y = y(7)
poly(3).x = x(2)
poly(3).y = y(2)
poly(4).x = x(3)
poly(4).y = y(3)
hBrush = CreateSolidBrush(RGB(100 * g + 110, 0, 110 * g + 110)) '100, 150, 150
hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
FillRgn Picture2.hdc, hRgn, hBrush
DeleteObject hBrush
DeleteObject hRgn
End If
DoEvents
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
CurX = x
CurY = y
End Sub
Private Sub Timer1_Timer()
Radius = (SIZE * Sqr(6)) / 3
Hx = (SIZE * Sqr(3)) / 2
SIZE = Slider1.Value * Slider1.LargeChange
CubeCorners(1, 2) = (SIZE * Sqr(3)) / 2
CubeCorners(2, 2) = (SIZE * Sqr(3)) / 6
CubeCorners(3, 2) = -(SIZE * Sqr(3)) / 6
CubeCorners(4, 2) = (SIZE * Sqr(3)) / 6
CubeCorners(5, 2) = -(SIZE * Sqr(3)) / 6
CubeCorners(6, 2) = (SIZE * Sqr(3)) / 6
CubeCorners(7, 2) = -(SIZE * Sqr(3)) / 6
CubeCorners(8, 2) = -(SIZE * Sqr(3)) / 2
Select Case CurX
Case Is > Picture2.ScaleWidth / 2
Angle = Angle + Abs(CurX - Picture2.ScaleWidth / 2) / 20
If Angle = 360 Then Angle = 0
Case Else
Angle = Angle - Abs(CurX - Picture2.ScaleWidth / 2) / 20
If Angle = 0 Then Angle = 360
End Select
For i = 2 To 7
CubeCorners(i, 3) = Radius * Cos((Angle + (i - 2) * 60) * Pi / 180)
CubeCorners(i, 1) = Radius * Sin((Angle + (i - 2) * 60) * Pi / 180)
Next i
DrawCube
End Sub
Private Sub Timer2_Timer()
Radius = (SIZE * Sqr(6)) / 3
Hx = (SIZE * Sqr(3)) / 2
SIZE = Slider1.Value * Slider1.LargeChange
CubeCorners(1, 2) = (SIZE * Sqr(3)) / 2
CubeCorners(2, 2) = (SIZE * Sqr(3)) / 6
CubeCorners(3, 2) = -(SIZE * Sqr(3)) / 6
CubeCorners(4, 2) = (SIZE * Sqr(3)) / 6
CubeCorners(5, 2) = -(SIZE * Sqr(3)) / 6
CubeCorners(6, 2) = (SIZE * Sqr(3)) / 6
CubeCorners(7, 2) = -(SIZE * Sqr(3)) / 6
CubeCorners(8, 2) = -(SIZE * Sqr(3)) / 2
If Moveforward = 1 And CenterX <= Picture2.ScaleWidth - Radius - 100 Then
CenterX = CenterX + 3
If CenterX > Picture2.ScaleWidth - Radius - 100 Then
Moveforward = 0
End If
End If
If Moveforward = 0 And CenterX >= Radius + 100 Then
CenterX = CenterX - 3
If CenterX < Radius + 100 Then
Moveforward = 1
End If
End If
If updown = 1 And CenterY <= Picture2.ScaleHeight - Hx Then
CenterY = CenterY + 3
If CenterY > Picture2.ScaleHeight - Hx Then
updown = 0
End If
End If
If updown = 0 And CenterY >= Hx Then
CenterY = CenterY - 3
If CenterY < Hx Then
updown = 1
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -