Tipp 0056 Mini 3D-Engine
Autor/Einsender:
Datum:
  Richard Schubert
11.05.2001
Entwicklungsumgebung:   VB 5
Diese Mini 3D-Engine zeigt eine Fläche aus Polygonen, die einen Kreis bilden. Man kann die Anzahl der Polygone des Objekts verändern und um alle 3 Achsen rotieren lassen, sowie den Sichtwinkel verändern, um Effekte wie Fischblick zu erzeugen. Die Engine benutzt ausschließlich VB-Routinen wie Line oder Print, es wird also keine Grafikoberfläche verwendet, und sie lässt sich ohne viel Arbeit auf Vierecke oder andere Polygone umschreiben.
Code im Codebereich des Moduls
 
Type MATRIX
  P3D(2, 2) As Double
  P2D(2, 1) As Double
End Type
 
Code im Codebereich der Form
 
Const PI = 3.14159
Const MaxPolys = 250

Dim NumPolys As Integer

Dim TLast As Single
Dim I As Integer
Dim FPS As Single

Dim rad As Single
Dim rd As Single
Dim Speed As Single

Dim Blickweite As Integer

Dim P(MaxPolys) As MATRIX
Dim PReal(MaxPolys) As MATRIX

Private Sub Form_Load()
  NumPolys = 40

  For n = 0 To NumPolys
    rd = rd + PI * 2 / (NumPolys)
    P(n).P3D(0, 0) = 0
    P(n).P3D(0, 1) = 0
    P(n).P3D(0, 2) = 0

    P(n).P3D(1, 0) = Sin(rd) * 180
    P(n).P3D(1, 1) = Cos(rd) * 180
    P(n).P3D(1, 2) = 0

    P(n).P3D(2, 0) = Sin(rd + PI * 2 / (NumPolys)) * 180
    P(n).P3D(2, 1) = Cos(rd + PI * 2 / (NumPolys)) * 180
    P(n).P3D(2, 2) = 0
  Next n

  Form1.Top = 0
  Blickweite = 500
  Speed = 0.01

  Me.Show

  Do
    Draw
    DoEvents
  Loop
End Sub

Sub Draw()
  If Check1.Value = 1 Then Picture1.Cls

  rad = rad + Speed
  Label1.Caption = "Speed:   " & Speed
  Label2.Caption = "Polygone:   " & NumPolys

  If I = 100 Then
    If TLast <> 0 Then FPS = 100 / (Timer - TLast)
    TLast = Timer
    I = 0
  End If
  I = I + 1
  Label3.Caption = "FPS: " & FPS

  For n = 0 To NumPolys
    For m = 0 To 2
      PReal(n).P3D(m, 0) = P(n).P3D(m, 0)
      PReal(n).P3D(m, 1) = P(n).P3D(m, 1)
      PReal(n).P3D(m, 2) = P(n).P3D(m, 2)
      If Option1.Value Then
        PReal(n).P3D(m, 1) = P(n).P3D(m, 2) * Sin(rad) + _
            P(n).P3D(m, 1) * Cos(rad)
        PReal(n).P3D(m, 2) = P(n).P3D(m, 2) * Cos(rad) - _
            P(n).P3D(m, 1) * Sin(rad)
      End If
      If Option2.Value Then
        PReal(n).P3D(m, 0) = P(n).P3D(m, 2) * Sin(rad) + _
            P(n).P3D(m, 0) * Cos(rad)
        PReal(n).P3D(m, 2) = P(n).P3D(m, 2) * Cos(rad) - _
            P(n).P3D(m, 0) * Sin(rad)
      End If
      If Option3.Value Then
        PReal(n).P3D(m, 0) = P(n).P3D(m, 0) * Cos(rad) - _
            P(n).P3D(m, 1) * Sin(rad)
        PReal(n).P3D(m, 1) = P(n).P3D(m, 0) * Sin(rad) + _
            P(n).P3D(m, 1) * Cos(rad)
      End If
    Next m
  Next n

  For n = 0 To NumPolys
    For m = 0 To 2
      P(n).P2D(m, 0) = PReal(n).P3D(m, 0) * Blickweite / _
          (PReal(n).P3D(m, 2) + Blickweite) + Picture1.Width / 2
      P(n).P2D(m, 1) = PReal(n).P3D(m, 1) * Blickweite / _
          (PReal(n).P3D(m, 2) + Blickweite) + Picture1.Height / 2
      If Check2.Value = 1 Then
        Picture1.PSet (P(n).P2D(m, 0), P(n).P2D(m, 1))
        Picture1.ForeColor = RGB(100 * m, 100 * m, 255 - 100 * m)
        Picture1.Print n & " / " & m
        Picture1.ForeColor = RGB(0, 0, 0)
      End If
    Next m
  Next n

  For n = 0 To NumPolys
    If n = 3 Then
      Picture1.ForeColor = RGB(255, 255, 255)
    Else
      Picture1.ForeColor = RGB(0, 0, 0)
    End If
    Picture1.Line (P(n).P2D(0, 0), P(n).P2D(0, 1))- _
        (P(n).P2D(1, 0), P(n).P2D(1, 1))
    Picture1.Line (P(n).P2D(1, 0), P(n).P2D(1, 1))- _
        (P(n).P2D(2, 0), P(n).P2D(2, 1))
    Picture1.Line (P(n).P2D(2, 0), P(n).P2D(2, 1))- _
        (P(n).P2D(0, 0), P(n).P2D(0, 1))
  Next n
  Picture1.ForeColor = RGB(0, 0, 0)

  For n = 0 To 10
    Picture1.PSet (Picture1.Width / 2, n * 100)
    Picture1.Print (n * 100)
    Picture1.Line (Picture1.Width / 2, 0)-(Picture1.Width / 2, _
        Picture1.Height)
 
    Picture1.PSet (n * 100, Picture1.Height / 2)
    Picture1.Print (n * 100)
    Picture1.Line (0, Picture1.Height / 2)-(Picture1.Width, _
        Picture1.Height / 2)
  Next
End Sub

Private Sub HScroll1_Change()
  Speed = HScroll1.Value / 10000
End Sub

Private Sub HScroll1_Scroll()
  Speed = HScroll1.Value / 10000
End Sub

Private Sub HScroll2_Change()
  NumPolys = HScroll2.Value
  For n = 0 To NumPolys
    rd = rd + PI * 2 / (NumPolys)
    P(n).P3D(0, 0) = 0
    P(n).P3D(0, 1) = 0
    P(n).P3D(0, 2) = 0

    P(n).P3D(1, 0) = Sin(rd) * 180
    P(n).P3D(1, 1) = Cos(rd) * 180
    P(n).P3D(1, 2) = 0

    P(n).P3D(2, 0) = Sin(rd + PI * 2 / (NumPolys)) * 180
    P(n).P3D(2, 1) = Cos(rd + PI * 2 / (NumPolys)) * 180
    P(n).P3D(2, 2) = 0
  Next n
End Sub

Private Sub HScroll2_Scroll()
  NumPolys = HScroll2.Value
  For n = 0 To NumPolys
    rd = rd + PI * 2 / (NumPolys)
    P(n).P3D(0, 0) = 0
    P(n).P3D(0, 1) = 0
    P(n).P3D(0, 2) = 0

    P(n).P3D(1, 0) = Sin(rd) * 180
    P(n).P3D(1, 1) = Cos(rd) * 180
    P(n).P3D(1, 2) = 0

    P(n).P3D(2, 0) = Sin(rd + PI * 2 / (NumPolys)) * 180
    P(n).P3D(2, 1) = Cos(rd + PI * 2 / (NumPolys)) * 180
    P(n).P3D(2, 2) = 0
  Next n
End Sub

Private Sub HScroll3_Change()
  Label4.Caption = "Sichtwinkel: " & HScroll3.Value & "°"
  Blickweite = 500 * (130 / Int(HScroll3.Value))
  Form1.Caption = Blickweite
End Sub

Private Sub HScroll3_Scroll()
  Label4.Caption = "Sichtwinkel: " & HScroll3.Value & "°"
  Blickweite = 500 * (130 / Int(HScroll3.Value))
End Sub

Private Sub Option1_Click()
  For n = 0 To NumPolys
    P(n).P3D(0, 0) = PReal(n).P3D(0, 0)
    P(n).P3D(0, 1) = PReal(n).P3D(0, 1)
    P(n).P3D(0, 2) = PReal(n).P3D(0, 2)

    P(n).P3D(1, 0) = PReal(n).P3D(1, 0)
    P(n).P3D(1, 1) = PReal(n).P3D(1, 1)
    P(n).P3D(1, 2) = PReal(n).P3D(1, 2)

    P(n).P3D(2, 0) = PReal(n).P3D(2, 0)
    P(n).P3D(2, 1) = PReal(n).P3D(2, 1)
    P(n).P3D(2, 2) = PReal(n).P3D(2, 2)
  Next n
  rad = 0
End Sub

Private Sub Option2_Click()
  For n = 0 To NumPolys
    P(n).P3D(0, 0) = PReal(n).P3D(0, 0)
    P(n).P3D(0, 1) = PReal(n).P3D(0, 1)
    P(n).P3D(0, 2) = PReal(n).P3D(0, 2)

    P(n).P3D(1, 0) = PReal(n).P3D(1, 0)
    P(n).P3D(1, 1) = PReal(n).P3D(1, 1)
    P(n).P3D(1, 2) = PReal(n).P3D(1, 2)

    P(n).P3D(2, 0) = PReal(n).P3D(2, 0)
    P(n).P3D(2, 1) = PReal(n).P3D(2, 1)
    P(n).P3D(2, 2) = PReal(n).P3D(2, 2)
  Next n
  rad = 0
End Sub

Private Sub Option3_Click()
  For n = 0 To NumPolys
    P(n).P3D(0, 0) = PReal(n).P3D(0, 0)
    P(n).P3D(0, 1) = PReal(n).P3D(0, 1)
    P(n).P3D(0, 2) = PReal(n).P3D(0, 2)

    P(n).P3D(1, 0) = PReal(n).P3D(1, 0)
    P(n).P3D(1, 1) = PReal(n).P3D(1, 1)
    P(n).P3D(1, 2) = PReal(n).P3D(1, 2)

    P(n).P3D(2, 0) = PReal(n).P3D(2, 0)
    P(n).P3D(2, 1) = PReal(n).P3D(2, 1)
    P(n).P3D(2, 2) = PReal(n).P3D(2, 2)
  Next n
  rad = 0
End Sub
 

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,4 kB) Downloads bisher: [ 5364 ]

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: Mittwoch, 31. August 2011