Der Code beinhaltet noch das ein oder andere nützliche. Ich habe mir mal diese Sprite3D struktur für die 3D Befehle erstellt um diese besser zu händeln.
ZB sollten Sprites 2^n Pixel breit/hoch sein. Darum kümmern sich die gewrappten Funktionen selbst, so dass man sich um das lästige zeug nicht weiter kümmern muss

Das ganze ist wahrscheinlich mehr als du brauchen wirst, also kannst du dir entweder das benötigte rauspicken (sollte sehr einfach gehen, ansonsten frag mich) oder die Struktur als ganzes übernehmen (was einem mehr arbeit abnimmt als man denkt).
Ich habe schlichtweg die meisten Sprite3D befehle gewrappt, sprich erweitert und angepasst für mich. Zum beispiel ist Transparenz 0 = vollkommen sichtbar und Transparenz = 255 unsichtbar. Mir war die Definition von PB da irgendwie gegen meine Intuition.
Die Beispiel Datei
Code: Alles auswählen
EnableExplicit
IncludeFile "vector2d.pbi"
IncludeFile "mySprite3D.pbi"
InitSprite()
InitSprite3D()
OpenWindow(0,0,0,800,600,"mySprite3D")
OpenWindowedScreen(WindowID(0),0,0,800,600,0,0,0)
myinitialize3D()
Define sprite1.mySprites
Define tempSprite = CreateSprite(#PB_Any, 100, 140, #PB_Sprite_Texture)
StartDrawing(SpriteOutput(tempSprite))
Box(0,0,100,140,$0000FF)
LineXY(0,0,100,140,RGB(255,255,0))
LineXY(100,0,0,140,RGB(255,255,0))
StopDrawing()
myLoadSprite3DMem(sprite1,tempSprite)
Define t.l
Define event.l
Repeat
  
  Repeat
    Event = WindowEvent()
    Select Event 
      Case #PB_Event_CloseWindow
        End 
    EndSelect
  Until Event = 0
  
  Start3D()
  
  myTransformSprite3D_YZ(sprite1, 0, 0, t)
  myDisplaySprite3D(sprite1,   0, 0, 0, 1)
  
  myTransformSprite3D_YZ(sprite1, 0, 0, 0)
  myDisplaySprite3D(sprite1, 120, 0, 120, 1)
 
  myTransformSprite3D_YZ(sprite1, 0, t, t)
  myDisplaySprite3D(sprite1, 240, 0, 0, 1)
  
  myTransformSprite3D_YZ(sprite1, t, 0,0)
  myDisplaySprite3D(sprite1, 360, 0, 0, 1)
  
  myTransformSprite3D_XZ(sprite1, 0, t, t)
  myDisplaySprite3D(sprite1, 480, 0, 0, 1)
  
  myTransformSprite3D_XZ(sprite1, 0, 0, 0, t)
  myDisplaySprite3D(sprite1, 600, 0, 0, 1)
  
  Stop3D()
  
  t+1
  
  Delay(1)  
  
  FlipBuffers() 
  ClearScreen(RGB(0, 0, 0))
ForEverCode: Alles auswählen
Structure mySprites
  
  Sprite2d.l
  Sprite3d.l
  SpriteOriginal.l
  x.l
  y.l
  Width.l
  Height.l
  Size.l
  
EndStructure
Procedure myinitialize3D()
  
  Protected a.l
  
  Global Dim myPow.l(15)
  
  For a=0 To 15
    myPow(a) = Pow(2,a)
  Next
  
  TransparentSpriteColor(#PB_Any, RGB(0,255,0))
  
EndProcedure
Procedure myLoadSprite3D(*ptr.mySprites, File.s)
  
  Protected tempSpriteSquare.l
  
  Protected tempSpriteWidth.l
  Protected tempSpriteHeight.l
  
  Protected a.l
  
  *ptr\SpriteOriginal.l = LoadSprite(#PB_Any, File)
  If *ptr\SpriteOriginal
    
    tempSpriteWidth  = SpriteWidth(*ptr\SpriteOriginal)
    tempSpriteHeight = SpriteHeight(*ptr\SpriteOriginal)
    
    For a=0 To 15
      
      If myPow(a) => tempSpriteWidth And myPow(a) => tempSpriteHeight
        
        *ptr\Sprite2d    = CreateSprite(#PB_Any, myPow(a), myPow(a), #PB_Sprite_Texture)
        tempSpriteSquare = CreateSprite(#PB_Any, myPow(a), myPow(a))
        
        *ptr\x      = (myPow(a) - tempSpriteWidth) / 2
        *ptr\y      = (myPow(a) - tempSpriteHeight) / 2
        *ptr\Width  = tempSpriteWidth
        *ptr\Height = tempSpriteHeight
        *ptr\Size   = myPow(a)
        
        StartDrawing(SpriteOutput(tempSpriteSquare))
        Box(0,0,myPow(a),myPow(a),RGB(0,255,0))
        StopDrawing()
        
        UseBuffer(*ptr\Sprite2d)
        DisplaySprite(tempSpriteSquare,0,0)
        DisplaySprite(*ptr\SpriteOriginal, *ptr\x, *ptr\y)
        UseBuffer(#PB_Default)
        
        *ptr\Sprite3d = CreateSprite3D(#PB_Any, *ptr\Sprite2d)
        
        FreeSprite(tempSpriteSquare)
        
        Break
        
      EndIf
    Next
    
  Else
    
    Debug "FEHLER: " + File
    
  EndIf
  
  
EndProcedure
Procedure myCatchSprite3DMem(*ptr.mySprites, spriteSource.l)
  
  Protected tempSpriteSquare.l
  
  Protected tempSpriteWidth.l
  Protected tempSpriteHeight.l
  
  Protected a.l
  
  *ptr\SpriteOriginal = CatchSprite(#PB_Any, spriteSource, #PB_Sprite_Texture)
  
  If *ptr\SpriteOriginal
    
    tempSpriteWidth  = SpriteWidth(*ptr\SpriteOriginal)
    tempSpriteHeight = SpriteHeight(*ptr\SpriteOriginal)
    
    For a=0 To 10
      
      If myPow(a) => tempSpriteWidth And myPow(a) => tempSpriteHeight
        
        *ptr\Sprite2d    = CreateSprite(#PB_Any, myPow(a), myPow(a), #PB_Sprite_Texture)
        tempSpriteSquare = CreateSprite(#PB_Any, myPow(a), myPow(a))
        
        *ptr\x      = (myPow(a) - tempSpriteWidth) / 2
        *ptr\y      = (myPow(a) - tempSpriteHeight) / 2
        *ptr\Width  = tempSpriteWidth
        *ptr\Height = tempSpriteHeight
        *ptr\Size   = myPow(a)
        
        StartDrawing(SpriteOutput(tempSpriteSquare))
        Box(0,0,myPow(a),myPow(a),RGB(0,255,0))
        StopDrawing()
        
        UseBuffer(*ptr\Sprite2d)
        DisplaySprite(tempSpriteSquare,0,0)
        DisplaySprite(*ptr\SpriteOriginal, *ptr\x, *ptr\y)
        UseBuffer(#PB_Default)
        
        *ptr\Sprite3d = CreateSprite3D(#PB_Any, *ptr\Sprite2d)
        
        FreeSprite(tempSpriteSquare)
        
        Break
        
      EndIf
    Next
    
  Else
    
    Debug "FEHLER: @" + Str(spriteSource)
    
  EndIf
  
EndProcedure
Procedure myLoadSprite3DMem(*ptr.mySprites, spriteSource.l)
  
  Protected tempSpriteSquare.l
  
  Protected tempSpriteWidth.l
  Protected tempSpriteHeight.l
  
  Protected a.l
  *ptr\SpriteOriginal = CopySprite(spriteSource, #PB_Any, #PB_Sprite_Texture)
  
  If *ptr\SpriteOriginal
    
    tempSpriteWidth  = SpriteWidth(*ptr\SpriteOriginal)
    tempSpriteHeight = SpriteHeight(*ptr\SpriteOriginal)
    
    For a=0 To 10
      
      If myPow(a) => tempSpriteWidth And myPow(a) => tempSpriteHeight
        
        *ptr\Sprite2d    = CreateSprite(#PB_Any, myPow(a), myPow(a), #PB_Sprite_Texture)
        tempSpriteSquare = CreateSprite(#PB_Any, myPow(a), myPow(a))
        
        *ptr\x      = (myPow(a) - tempSpriteWidth) / 2
        *ptr\y      = (myPow(a) - tempSpriteHeight) / 2
        *ptr\Width  = tempSpriteWidth
        *ptr\Height = tempSpriteHeight
        *ptr\Size   = myPow(a)
        
        StartDrawing(SpriteOutput(tempSpriteSquare))
        Box(0,0,myPow(a),myPow(a),RGB(0,255,0))
        StopDrawing()
        
        UseBuffer(*ptr\Sprite2d)
        DisplaySprite(tempSpriteSquare,0,0)
        DisplaySprite(*ptr\SpriteOriginal, *ptr\x, *ptr\y)
        UseBuffer(#PB_Default)
        
        *ptr\Sprite3d = CreateSprite3D(#PB_Any, *ptr\Sprite2d)
        
        FreeSprite(tempSpriteSquare)
        
        Break
        
      EndIf
    Next
    
  Else
    
    Debug "FEHLER: @" + Str(spriteSource)
    
  EndIf
  
EndProcedure 
Procedure myShareSprite3D(*ptrSource.mySprites, *ptrTarget.mySprites)
  
  *ptrTarget\Sprite2d       = *ptrSource\Sprite2d
  *ptrTarget\Sprite3d       = *ptrSource\Sprite3d
  *ptrTarget\SpriteOriginal = *ptrSource\SpriteOriginal
  *ptrTarget\x              = *ptrSource\x
  *ptrTarget\y              = *ptrSource\y
  *ptrTarget\Width          = *ptrSource\Width
  *ptrTarget\Height         = *ptrSource\Height
  *ptrTarget\Size           = *ptrSource\Size
  
EndProcedure
Procedure myDisplaySprite3D(*ptr.mySprites, x, y, transparency.l = 0, mode.l = 0)
  If mode = 1
    DisplaySprite3D(*ptr\Sprite3d, x-*ptr\x, y-*ptr\y, 255-transparency)
  Else
    DisplaySprite3D(*ptr\Sprite3d, x-*ptr\Size/2, y-*ptr\Size/2, 255-transparency)
  EndIf
  
EndProcedure
Procedure myZoomSprite3D(*ptr.mySprites,Width.l,Height.l)
  ZoomSprite3D(*ptr\Sprite3d,Width,Height)
  
EndProcedure
Procedure myRotateSprite3D(*ptr.mySprites, angle.l, mode.l) ;0=Reset, 1=Stay
  
  RotateSprite3D(*ptr\Sprite3d, angle, mode)
  
EndProcedure
Procedure myTransformSprite3D_XZ(*ptr.mySprites, z.f, zRotate.f, xRotate.f, newWidth.l = -1, newHeight.l = -1)
  
  Protected Dim Corner.Vector2D(4)
  Protected i.l
  Protected x1.f, x2.f, x3.f, x4.f
  Protected y1.f, y2.f, y3.f, y4.f
  Protected z1.f, z2.f, z3.f, z4.f
  
  Protected wFac.f = 1
  Protected hFac.f = 1
  
  If newWidth >= 0
    wFac = newWidth  / *ptr\Width
  EndIf
  If newHeight >= 0
    hFac = newHeight / *ptr\Height
  EndIf
  
  zRotate * #PI/180
  xRotate * #PI/180
  
  z = *ptr\Size*2 - z
  
  SetVector2D(Corner(1), -*ptr\Size/2 * wFac, -*ptr\Size/2 * hFac)
  SetVector2D(Corner(2),  *ptr\Size/2 * wFac, -*ptr\Size/2 * hFac)
  SetVector2D(Corner(3),  *ptr\Size/2 * wFac,  *ptr\Size/2 * hFac)
  SetVector2D(Corner(4), -*ptr\Size/2 * wFac,  *ptr\Size/2 * hFac)
  
  For i = 1 To 4 : RotateVector2D(Corner(i), zRotate) : Next
  z1.f = Corner(1)\y*Sin(xRotate)+z
  z2.f = Corner(2)\y*Sin(xRotate)+z
  z3.f = Corner(3)\y*Sin(xRotate)+z
  z4.f = Corner(4)\y*Sin(xRotate)+z
  Corner(1)\y * Cos(xRotate)
  Corner(2)\y * Cos(xRotate)
  Corner(3)\y * Cos(xRotate)
  Corner(4)\y * Cos(xRotate)
  
  x1 = Corner(1)\x/z1**ptr\Size*2  : y1 = Corner(1)\y/z1**ptr\Size*2 
  x2 = Corner(2)\x/z2**ptr\Size*2  : y2 = Corner(2)\y/z2**ptr\Size*2 
  x3 = Corner(3)\x/z3**ptr\Size*2  : y3 = Corner(3)\y/z3**ptr\Size*2 
  x4 = Corner(4)\x/z4**ptr\Size*2  : y4 = Corner(4)\y/z4**ptr\Size*2 
  TransformSprite3D(*ptr\Sprite3d, x1+*ptr\Size/2, y1+*ptr\Size/2, z1, x2+*ptr\Size/2, y2+*ptr\Size/2, z2, x3+*ptr\Size/2, y3+*ptr\Size/2, z3, x4+*ptr\Size/2, y4+*ptr\Size/2, z4)
  
EndProcedure
Procedure myTransformSprite3D_YZ(*ptr.mySprites, z.f, zRotate.f, yRotate.f, newWidth.l = -1, newHeight.l = -1)
  
  Protected Dim Corner.Vector2D(4)
  Protected i.l
  Protected x1.f, x2.f, x3.f, x4.f
  Protected y1.f, y2.f, y3.f, y4.f
  Protected z1.f, z2.f, z3.f, z4.f
  
  Protected wFac.f = 1
  Protected hFac.f = 1
  If newWidth >= 0
    wFac = newWidth  / *ptr\Width
  EndIf
  If newHeight >= 0
    hFac = newHeight / *ptr\Height
  EndIf
  
  zRotate * #PI/180
  yRotate * #PI/180
  
  z = *ptr\Size*2 - z
  
  SetVector2D(Corner(1), -*ptr\Size/2 * wFac, -*ptr\Size/2 * hFac)
  SetVector2D(Corner(2),  *ptr\Size/2 * wFac, -*ptr\Size/2 * hFac)
  SetVector2D(Corner(3),  *ptr\Size/2 * wFac,  *ptr\Size/2 * hFac)
  SetVector2D(Corner(4), -*ptr\Size/2 * wFac,  *ptr\Size/2 * hFac)
  
  For i = 1 To 4 : RotateVector2D(Corner(i), zRotate) : Next
  z1.f = Corner(1)\x*Sin(yRotate)+z
  z2.f = Corner(2)\x*Sin(yRotate)+z
  z3.f = Corner(3)\x*Sin(yRotate)+z
  z4.f = Corner(4)\x*Sin(yRotate)+z
  Corner(1)\x * Cos(yRotate)
  Corner(2)\x * Cos(yRotate)
  Corner(3)\x * Cos(yRotate)
  Corner(4)\x * Cos(yRotate)
  
  x1 = Corner(1)\x/z1**ptr\Size*2  : y1 = Corner(1)\y/z1**ptr\Size*2 
  x2 = Corner(2)\x/z2**ptr\Size*2  : y2 = Corner(2)\y/z2**ptr\Size*2 
  x3 = Corner(3)\x/z3**ptr\Size*2  : y3 = Corner(3)\y/z3**ptr\Size*2 
  x4 = Corner(4)\x/z4**ptr\Size*2  : y4 = Corner(4)\y/z4**ptr\Size*2 
  
  TransformSprite3D(*ptr\Sprite3d, x1+*ptr\Size/2, y1+*ptr\Size/2, z1, x2+*ptr\Size/2, y2+*ptr\Size/2, z2, x3+*ptr\Size/2, y3+*ptr\Size/2, z3, x4+*ptr\Size/2, y4+*ptr\Size/2, z4)
  
EndProcedure
 
Procedure myIsSprite3D(*ptr.mySprites)
  If IsSprite(*ptr\SpriteOriginal) And IsSprite(*ptr\Sprite2d) And IsSprite3D(*ptr\Sprite3d)
    
    ProcedureReturn #True
    
  EndIf
  
  ProcedureReturn #False
  
EndProcedure
Procedure myFreeSprite3D(*ptr.mySprites)
  
  If myIsSprite3D(*ptr)
    
    FreeSprite(*ptr\SpriteOriginal)
    FreeSprite3D(*ptr\Sprite3d)
    FreeSprite(*ptr\Sprite2d)
    
  EndIf
  
EndProcedure
Code: Alles auswählen
;|¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
;|  Titel....: 2-Dimensionale Vektoren
;|  Datei....: Vector2D.pbi
;|  Datum....: 26.07.2008
;|  Inhalt...: * Macros und Proceduren für 2-Dimensionale Vektorberechungen
;|________________________________________________________________________________________________
; Vorrausgesetzte Includes
;XIncludeFile "Math.pbi"
; Konstanten
; Structure eines 2D-Vektors
Structure Vector2D
 x.f
 y.f
EndStructure
; Structure eines 2D-Punkts
Structure Point2D 
 x.f
 y.f
EndStructure
; Setzt die Werte (x,y) in den Vektor ein 
Macro SetVector2D(Vector2D, xValue, yValue)
 Vector2D\x = xValue
 Vector2D\y = yValue
EndMacro
; Setzt die Werte (x,y) in den Punkt ein 
Macro SetPoint2D(Point2D, xValue, yValue)
 Point2D\x = xValue
 Point2D\y = yValue
EndMacro
; Gibt den Vektor als String aus
Macro GetVector2D(Vector2D)
 "( "+StrF(Vector2D\x)+" | "+StrF(Vector2D\y)+" )"
EndMacro
; Gibt den Punkt als String aus
Macro GetPoint2D(Point2D)
 "( "+StrF(Point2D\x)+" | "+StrF(Point2D\y)+" )"
EndMacro
; Umrechnung von Vektor zu Winkel
Macro Vector2DToAngle(Vector2D, Angle)
 Angle = ATan(Vector2D\y/Vector2D\x) 
 If Vector2D\x < 0 : Angle + #PI : EndIf 
EndMacro
; Umrechnung von Winkel zu normiertem Vektor
Macro AngleToVector2D(Angle, Vector2D)
 Vector2D\x = Cos(Angle)
 Vector2D\y = Sin(Angle)
EndMacro
; Gibt die Länge des Vektors zurück
Macro Vector2DLength(Vector2D)
 Sqr( Vector2D\x*Vector2D\x+Vector2D\y*Vector2D\y)
EndMacro
; Gibt die quadratische Länge des Vektors zurück
Macro Vector2DQuaLength(Vector2D)
 ( Qua(Vector2D\x)+Qua(Vector2D\y) )
EndMacro
; Berechnet den normierten Vektor zu einem Vektor
Procedure Vector2DNorm(*Vector2D.Vector2D, *NormVector2D.Vector2D)
 Protected length.f = Vector2DLength(*Vector2D)
 If length
  *NormVector2D\x = *Vector2D\x / length
  *NormVector2D\y = *Vector2D\y / length
 Else
  *NormVector2D\x = 0
  *NormVector2D\y = 0
 EndIf
EndProcedure
; Gibt das Skalarprodukt zweier Vektoren zurück
Macro Vector2DScalar(Vector2D_1, Vector2D_2)
 (Vector2D_1\x * Vector2D_2\x + Vector2D_1\y * Vector2D_2\y)
EndMacro
; Gibt das Kreuzprodukt zweier Vektoren zurück
Macro Vector2DCross(Vector2D_1, Vector2D_2)
 (Vector2D_1\x * Vector2D_2\y - Vector2D_1\y * Vector2D_2\x)
EndMacro
; Gibt den Winkel zwischen zwei Vektoren zurück
Macro Vector2DAngle(Vector2D_1, Vector2D_2)
 ACos( Vector2DScalar(Vector2D_1, Vector2D_2) / (Vector2DLength(Vector2D_1)*Vector2DLength(Vector2D_2)) )
EndMacro
; Berechnet die Summe zweier Vektor
Macro Vector2DAdd(Vector2D_1, Vector2D_2, ResultVector2D)
 ResultVector2D\x = Vector2D_1\x + Vector2D_2\x
 ResultVector2D\y = Vector2D_1\y + Vector2D_2\y
EndMacro
; Berechnet die Differenz zweier Vektor
Macro Vector2DSub(Vector2D_1, Vector2D_2, ResultVector2D)
 ResultVector2D\x = Vector2D_1\x - Vector2D_2\x
 ResultVector2D\y = Vector2D_1\y - Vector2D_2\y
EndMacro
; Multipliziert ein Vektor mit einem Faktor
Macro Vector2DMul(Vector2D, Factor, ResultVector2D)
 ResultVector2D\x = Factor * Vector2D\x
 ResultVector2D\y = Factor * Vector2D\y
EndMacro
; Addiert zu einem Vektor einen anderen hinzu
Macro MoveVector2D(Vector2D, MoveVector2D)
 Vector2D\x + MoveVector2D\x
 Vector2D\y + MoveVector2D\y
EndMacro
; Ändert die Länge des Vektor um einen Faktor
Macro RaiseVector2D(Vector2D, Factor)
 Vector2D\x * Factor
 Vector2D\y * Factor
EndMacro
; Normiert einen Vektor
Procedure NormVector2D(*Vector2D.Vector2D)
 Protected length.f = Vector2DLength(*Vector2D)
 If length
  *Vector2D\x / length
  *Vector2D\y / length
 Else
  *Vector2D\x = 0
  *Vector2D\y = 0
 EndIf
EndProcedure
; Rotiert einen Vektor (relativ)
Procedure RotateVector2D(*Vector2D.Vector2D, Angle.f)
 Protected x.f, y.f
 x = *Vector2D\x : y = *Vector2D\y
 *Vector2D\x = Cos(Angle)*x - Sin(Angle)*y
 *Vector2D\y = Sin(Angle)*x + Cos(Angle)*y
EndProcedure
; Kopiert einen Vektor
Macro CopyVector2D(SourceVector2D, NewVector2D)
 NewVector2D\x = SourceVector2D\x
 NewVector2D\y = SourceVector2D\y
EndMacro
; Kopiert einen Punkt
Macro CopyPoint2D(SourcePoint2D, NewPoint2D)
 NewPoint2D\x = SourcePoint2D\x
 NewPoint2D\y = SourcePoint2D\y
EndMacro
; Vergleicht zwei Vektoren auf gleichheit
Procedure CompareVector2D(*Vector2D_1.Vector2D, *Vector2D_2.Vector2D)
 If *Vector2D_1\x = *Vector2D_2\x And *Vector2D_1\y = *Vector2D_2\y
  ProcedureReturn #True
 Else
  ProcedureReturn #False
 EndIf
EndProcedure
 
; Tauscht zwei Vektoren miteinander
Macro SwapVector2D(Vector2D_1, Vector2D_2)
 Swap Vector2D_1\x , Vector2D_2\x
 Swap Vector2D_1\y , Vector2D_2\y
EndMacro
  
; Gibt den Abstand zwischen zwei Punkte zurück
Macro DistancePoint2DPoint2D(Point2D_1, Point2D_2)
 Sqr( Qua(Point2D_1\x-Point2D_2\x)+Qua(Point2D_1\y-Point2D_2\y) )
EndMacro
; Gibt den quadratischen Abstand zwischen zwei Punkte zurück
Macro QuaDistancePoint2DPoint2D(Point2D_1, Point2D_2)
 ( Qua(Point2D_1\x-Point2D_2\x)+Qua(Point2D_1\y-Point2D_2\y) )
EndMacro
; Stellt einen Vektor an Position (x,y) dar
Procedure DrawVector2D(*Vector2D.Vector2D, x, y, Color=-1)
 If *Vector2D
  If Color > -1
   Line(x, y, *Vector2D\x, *Vector2D\y, Color)
  Else
   Line(x, y, *Vector2D\x, *Vector2D\y)
  EndIf
 EndIf
EndProcedure

 
 
