3 Boyutlu Küp Tasarlamak ( Visual Basic 6 )

heavenskhan: Mesaj Sayısı : 120
İtibar : 0
Kayıt tarihi : 31/05/10
Yaş : 32
Nerden : Adapazarı

Post n°1

3 Boyutlu Küp Tasarlamak ( Visual Basic 6 )

Mesaj tarafından heavenskhan Ptsi Mayıs 31, 2010 12:58 pm

Forma 2 Adet Combo 1 Adet Timer ekleyin ve
işi aşağıdaki koda bırakın...

Kod:

Option Explicit

Private CenterX As Integer
Private CenterY As Integer
Private Size As Integer
Private renk As Boolean
Private Radius As Integer
Private Winkel As Integer
Private CurX As Integer
Private CurY As Integer
Private Pi As Double
Private Ecke(1 To 8, 1 To 3) As Integer
Private X(8) As Integer
Private Y(8) As Integer

Private Sub Form_Load()
With Me
.ForeColor = RGB(255, 255, 255)
.BackColor = RGB(143, 143, 143)
.AutoRedraw = True
.DrawWidth = 1
.ScaleMode = vbPixels
CenterX = .ScaleWidth / 2
CenterY = .ScaleHeight / 2
.Show
End With
With Combo1
.AddItem "Renk"
.AddItem "Kirmizi"
.AddItem "Yesil"
.AddItem "Mavi"
.AddItem "Sari"
.AddItem "Lila"
.AddItem "Beyaz"
End With
Combo1.ListIndex = 4
renk = False

With Combo2
.AddItem "1"
.AddItem "2"
.AddItem "3"
.AddItem "4"
.AddItem "5"
.AddItem "6"
End With
Combo2.ListIndex = 1

Size = 200
Winkel = 0
Radius = Sqr(2 * (Size / 2) ^ 2)
Pi = Atn(1) * 4

Ecke(1, 2) = Size / 2
Ecke(2, 2) = Size / 2
Ecke(3, 2) = -Size / 2
Ecke(4, 2) = -Size / 2
Ecke(5, 2) = Size / 2
Ecke(6, 2) = Size / 2
Ecke(7, 2) = -Size / 2
Ecke(8, 2) = -Size / 2

Timer1.Interval = 1
End Sub

Private Sub WuerfelDrehen()
Dim i As Integer

Me.Cls

For i = 1 To 8
X(i) = CenterX + Ecke(i, 1) + Ecke(i, 3) / 8
Y(i) = CenterY + Ecke(i, 2) + Sgn(Ecke(i, 2)) * Ecke(i, 3) / 8
Next i

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(4), Y(4))-(X(8), Y(8))
Line (X(3), Y(3))-(X(7), Y(7))

DoEvents
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
CurX = X
CurY = Y
If renk Then
Randomize Timer
Me.ForeColor = RGB(256 * Rnd, 256 * Rnd, 256 * Rnd)
End If
End Sub

Private Sub Timer1_Timer()
Dim i As Integer

Select Case CurX
Case Is > ScaleWidth / 2
Winkel = Winkel + Abs(CurX - ScaleWidth / 2) / 20
If Winkel = 360 Then Winkel = 0
Case Else
Winkel = Winkel - Abs(CurX - ScaleWidth / 2) / 20
If Winkel = 0 Then Winkel = 360
End Select

For i = 1 To 3 Step 2
Ecke(i, 3) = Radius * Cos((Winkel) * Pi / 180)
Ecke(i, 1) = Radius * Sin((Winkel) * Pi / 180)
Next i

For i = 2 To 4 Step 2
Ecke(i, 3) = Radius * Cos((Winkel + 2 * 45) * Pi / 180)
Ecke(i, 1) = Radius * Sin((Winkel + 2 * 45) * Pi / 180)
Next i

For i = 5 To 7 Step 2
Ecke(i, 3) = Radius * Cos((Winkel + 6 * 45) * Pi / 180)
Ecke(i, 1) = Radius * Sin((Winkel + 6 * 45) * Pi / 180)
Next i

For i = 6 To 8 Step 2
Ecke(i, 3) = Radius * Cos((Winkel + 4 * 45) * Pi / 180)
Ecke(i, 1) = Radius * Sin((Winkel + 4 * 45) * Pi / 180)
Next i

Call WuerfelDrehen
End Sub

Private Sub Combo1_Click()
Select Case Combo1.ListIndex
Case 0
renk = True
Case 1
renk = False
Me.ForeColor = vbRed
Case 2
renk = False
Me.ForeColor = vbGreen
Case 3
renk = False
Me.ForeColor = vbBlue
Case 4
renk = False
Me.ForeColor = vbYellow
Case 5
renk = False
Me.ForeColor = vbMagenta
Case 6
renk = False
Me.ForeColor = vbWhite
End Select
End Sub

Private Sub Combo2_Click()
Me.DrawWidth = Combo2.ListIndex + 1
End Sub

3 Boyutlu Küp Tasarlamak ( Visual Basic 6 )

3 Boyutlu Küp Tasarlamak ( Visual Basic 6 )

Similar topics

Similar topics