Option Explicit
Private Declare Function Polygon& Lib "gdi32" (ByVal hdc&, lpPoint As PointAPI, _
  ByVal nCount&)
Private Type PointAPI
  X As Long
  Y As Long
End Type
 
Private Sub Form_Activate()
 
Dim i%, j%, m%, n%, VH%, LR%, OU%, Breite%, Höhe%, Tiefe%
Dim PX!, PY!, PZ!, Figur(3) As PointAPI, Ecke%(5, 3)
Dim FpZ!, q!, XP!(7), YP!(7), FiSt%, Versatz%
 
'Maße für Quader
Breite = 100
Höhe = 150
Tiefe = 180
Versatz = 50
FpZ = 1000 'Fluchtpunkt
Me.ScaleMode = 3
FiSt = IIf(MsgBox("Ausgefüllt?", vbYesNo, "Quader") = vbYes, 0, 1)
i = 0
For VH = 0 To 1
  For OU = 0 To 1
    For LR = 0 To 1
      PX = Breite * (LR Xor OU) - Breite \ 2 + Versatz * VH
      PY = Höhe * OU - Höhe \ 2 - Versatz * VH
      PZ = -Tiefe * VH
      q = 1 - PZ / FpZ
      XP(i) = PX / q + Me.ScaleWidth \ 2
      YP(i) = PY / q + Me.ScaleHeight \ 2
      i = i + 1
    Next LR
  Next OU
Next VH
For i = 0 To 3
  Ecke(i, 0) = i
  Ecke(i, 1) = (i + 1) And 3
  Ecke(i, 2) = ((i + 1) And 3) + 4
  Ecke(i, 3) = i + 4
Next i
For i = 0 To 1
  For j = 0 To 3
    Ecke(i + 4, j) = i * 4 + j
  Next j
Next i
Me.ForeColor = vbBlack
Me.AutoRedraw = True
Me.FillStyle = FiSt
Me.Cls
For i = 0 To 2 + 3 * FiSt
  If FiSt = 0 Then
    Me.FillColor = Choose(i + 1, vbBlue, vbRed, vbYellow)
  End If
  m = Val(Mid("401235", i + 1, 1))
  For j = 0 To 3
    n = Ecke(m, j)
    Figur(j).X = XP(n)
    Figur(j).Y = YP(n)
  Next j
  Polygon Me.hdc, Figur(0), 4
Next i
 
End Sub