VB-fun.de - Mini 3D-Engine (Tipp 0056)

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

98/SE

2000

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: [ 5374 ]

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