Tipp 0205 3D-Würfel-Rotation
Autor/Einsender:
Datum:
  Michael Werner
28.02.2002
Entwicklungsumgebung:   VB 5
Dieses Beispiel zeigt, wie man mit der VB-Funktion Line einen 3D-Würfel erstellt, und diesen über Berechnungen mit Pi, Sinus u. Kosinus in einer 3D-Ansicht zum Rotieren bringen kann.
 
Option Explicit

Private CenterX As Integer
Private CenterY As Integer
Private Size As Integer
Private ZufallsFarbe 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 "Zufallsfarbe"
    .AddItem "rot"
    .AddItem "grün"
    .AddItem "blau"
    .AddItem "gelb"
    .AddItem "lila"
    .AddItem "weiß"
  End With
  Combo1.ListIndex = 4
  ZufallsFarbe = False

  With Combo2
    .AddItem "Strichstärke 1"
    .AddItem "Strichstärke 2"
    .AddItem "Strichstärke 3"
    .AddItem "Strichstärke 4"
    .AddItem "Strichstärke 5"
    .AddItem "Strichstärke 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 ZufallsFarbe 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
      ZufallsFarbe = True
    Case 1
      ZufallsFarbe = False
      Me.ForeColor = vbRed
    Case 2
      ZufallsFarbe = False
      Me.ForeColor = vbGreen
    Case 3
      ZufallsFarbe = False
      Me.ForeColor = vbBlue
    Case 4
      ZufallsFarbe = False
      Me.ForeColor = vbYellow
    Case 5
      ZufallsFarbe = False
      Me.ForeColor = vbMagenta
    Case 6
      ZufallsFarbe = False
      Me.ForeColor = vbWhite
  End Select
End Sub

Private Sub Combo2_Click()
  Me.DrawWidth = Combo2.ListIndex + 1
End Sub
 
Weitere Links zum Thema
2D-Rotation
Kreise und Linien zeichnen
Objekte zeichnen und verschieben
Polygone zeichnen

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (3 kB) Downloads bisher: [ 4732 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Dienstag, 27. September 2011