VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cls_Scene"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Klasse zum Verwalten einer Scene
'noch keinerlei Fehlerüberprüfung!!!
'masterk@arcor.de

'diese Klasse findet nur im Editor Verwendung! Die Klasse für die Spiel-S2D
'bekommt eigene Schnittstellen sowie erweitere Funktionen (verwalten mehrerer Scenes)

'erstes Element ist immer 1 !!!!!!

Option Explicit

Public Enum ESpriteProperty
    lXPos = 1
    lYPos = 2
    lImage = 3
    iAngle = 4
    bAlpha = 5
    lColor = 6
    bolEnabled = 7
    lZ = 8
End Enum

'die Types werden zum Schreiben und lesen genutzt
Private Type tFileHeader
    FileID As String * 2
    Version1 As Byte
    Version2 As Byte
End Type

Private Type TRaniHeader
    FrameDelay As Integer 'wieviele Frames zwischen 2 gezeigten Anmationsframes Delay
    Width As Integer
    Height As Integer
End Type

Private Type TPictureProperty
    FileName As String
    Width As Long
    Height As Long
End Type

Private Type TImageProperty
    Left As Long
    Top  As Long
    Bottom As Long
    Right As Long
    ImagePictureID As Long
End Type

Private Type TSpriteFrame 'speichert die Eigenschaften eines Sprite für einen Frame
    XPos As Long
    YPos As Long
    Image As Long
    Angle As Integer
    Alpha As Byte
    Color As Long
    Enabled As Boolean
    Z As Long
End Type

Private Type TSprite
    SpriteName As String
End Type

Private SceneSize As Point

Private PictureFileList() As TPictureProperty
Private PicturePathList As New Collection
Private PictureTextureIDList() As Long

'Private ImagePictureIDList As New Collection 'speichert die PicureID jedes Images

Private ImageList() As TImageProperty
Private ImageCount As Long

'Private ImageXList As New Collection 'dummes variantwasauchimmer, wird evtl doch besser
                                     'mit einem dynamischen Array gelöst
'Private ImageYList As New Collection
'Private ImageWidthList As New Collection
'Private ImageHeightList As New Collection

Private SpriteList() As TSprite
Private FrameList() As TSpriteFrame 'speichert die Daten jedes Sprites pro Frame
                                    'FrameList(frameanzahl, spriteanzahl)
Private SpriteCount As Integer
Private FrameCount As Integer
Private PictureCount As Integer

Private FileHeader As tFileHeader
Private RaniHeader As TRaniHeader

Private SceneActive As Boolean

Private i As Long
Private Q As Long, p As Long

Public FileName As String

Public AktlFrame As Integer
Private FrameDelay As Integer
Private ImgAktl As Integer

Public Interval As Integer
Private LastTimeCheckFrame As Long

Public S2D As cS2D_i

'***************************************************************************
'*                      allgemeine Funktionen
'***************************************************************************

Public Function Init(ByVal SizeX As Long, ByVal SizeY As Long) As Boolean
        
    RaniHeader.Width = SizeX
    RaniHeader.Height = SizeY
            
    For i = 1 To S2DLog.Count
        Debug.Print S2DLog.Item(i)
    Next i
    
    SceneSize.x = SizeX
    SceneSize.y = SizeY
    
    PictureCount = 0
    ImageCount = 0
    SpriteCount = 0
    FrameCount = 0
    RaniHeader.FrameDelay = 0
        
End Function

Public Function CheckInit() As Boolean
    'eine Scene ist Aktiv, wenn mind 1 Frame existiert
    
    CheckInit = SceneActive
End Function

Public Function SaveScene(ByVal strSceneFilePath As String) As Boolean
    
    Dim FileNr As Long
    
    SaveScene = False
    
    FileNr = FreeFile
    
    If Right(strSceneFilePath, 5) <> ".rani" Then
        strSceneFilePath = strSceneFilePath & ".rani"
    End If
    
    FileHeader.FileID = "RA"
    FileHeader.Version1 = 0
    FileHeader.Version2 = 2
    
    Open strSceneFilePath For Binary As #FileNr
        Put #FileNr, , FileHeader
        
        Put #FileNr, , RaniHeader
        
        Put #FileNr, , PictureCount
        For Q = 1 To PictureCount
            Put #FileNr, , PictureFileList(Q)
        Next Q
        
        Put #FileNr, , ImageCount
        For Q = 1 To ImageCount
            Put #FileNr, , ImageList(Q)
        Next Q
        
        Put #FileNr, , SpriteCount
        For Q = 1 To SpriteCount
            Put #FileNr, , SpriteList(Q)
        Next Q
        
        Put #FileNr, , FrameCount
        For Q = 1 To FrameCount
            For p = 1 To SpriteCount
                Put #FileNr, , FrameList(Q, p)
            Next p
        Next Q
    Close #1
    
    SaveScene = True
    
    Exit Function
errorhandler:
    Debug.Print "Fehler in SaveScene"
    Debug.Print "Fehlercode: " & Err.Number
    Debug.Print Err.Description
End Function

Public Function LoadScene(ByVal strSceneFilePath As String) As Boolean
    
    
    Dim FileNr As Long
    FileName = strSceneFilePath
    LoadScene = False
    
    FileNr = FreeFile
    
    If Right(strSceneFilePath, 5) <> ".rani" Then
        strSceneFilePath = strSceneFilePath & ".rani"
    End If
    
    'FileHeader.FileID = "RA"
    'FileHeader.Version1 = 0
    'FileHeader.Version2 = 2
    
    Open strSceneFilePath For Binary As #FileNr
        Get #FileNr, , FileHeader
        Get #FileNr, , RaniHeader
        
        Get #FileNr, , PictureCount
        ReDim PictureFileList(1 To PictureCount) As TPictureProperty
        ReDim PictureTextureIDList(1 To PictureCount) As Long
        For Q = 1 To PictureCount
            Get #FileNr, , PictureFileList(Q)
            PicturePathList.Add "images\" & PictureFileList(Q).FileName
        Next Q
        Debug.Print "pictures: " & Q
        
        Get #FileNr, , ImageCount
        ReDim ImageList(1 To ImageCount) As TImageProperty
        For Q = 1 To ImageCount
            Get #FileNr, , ImageList(Q)
        Next Q
        
        Get #FileNr, , SpriteCount
        ReDim SpriteList(1 To SpriteCount) As TSprite
        For Q = 1 To SpriteCount
            Get #FileNr, , SpriteList(Q)
        Next Q
        
        Get #FileNr, , FrameCount
        ReDim FrameList(1 To FrameCount, 1 To SpriteCount) As TSpriteFrame
        For Q = 1 To FrameCount
            
            For p = 1 To SpriteCount
                Get #FileNr, , FrameList(Q, p)
            Next p
        Next Q
    Close #FileNr
    
    For i = 1 To GetPictureCount
        SetPictureTextureID i, S2D.TexturePool.AddTexture(ProvideFile(GetPicturePath(i), False), rgb(255, 0, 255))
    Next i
    
    SceneSize.x = RaniHeader.Width
    SceneSize.y = RaniHeader.Height
    'frmMain.PictureDest.Left = frmMain.picContainer.Width / 2 - frmMain.PictureDest.Width / 2
    'frmMain.PictureDest.Top = frmMain.picContainer.Height / 2 - frmMain.PictureDest.Height / 2
    
    LoadScene = True
    SceneActive = True
    
    Exit Function
errorhandler:
    Debug.Print "Fehler in LoadScene"
    Debug.Print "Fehlercode: " & Err.Number
    Debug.Print Err.Description
End Function

Public Function SetFrameDelay(ByVal iValue As Integer) As Boolean

    RaniHeader.FrameDelay = CInt(iValue)

    Exit Function
errorhandler:
    Debug.Print "Fehler in SetFrameDelay"
    Debug.Print "Fehlercode: " & Err.Number
    Debug.Print Err.Description

End Function

Public Function GetFrameDelay() As Integer
    GetFrameDelay = RaniHeader.FrameDelay
End Function


'***************************************************************************
'*                      Funktionen zum Verwalten der Pictures
'***************************************************************************

Public Function AddPicture(ByVal strPictureFullPath As String, ByVal strPictureName As String, _
    ByVal textureID As Long, ByVal lWidth As Long, ByVal lHeight As Long) As Boolean
    'fügt eine Bilddatei (Textur) der PictureList hinzu
    'TextureID gibt eine externe Textur an (S2D.TexturePool)
    AddPicture = True
    For i = 1 To PicturePathList.Count
        If PicturePathList(i) = strPictureFullPath Then
            AddPicture = False
            Exit Function
        End If
    Next i
    
    PictureCount = PictureCount + 1
    ReDim Preserve PictureFileList(1 To PictureCount) As TPictureProperty
    ReDim Preserve PictureTextureIDList(1 To PictureCount) As Long
    
    'PictureNameList.Add strPictureName
    PictureFileList(PictureCount).FileName = strPictureName
    PictureFileList(PictureCount).Width = lWidth
    PictureFileList(PictureCount).Height = lHeight
    PicturePathList.Add strPictureFullPath
    PictureTextureIDList(PictureCount) = textureID
End Function

Public Function SetPictureTextureID(ByVal lPictureIndex As Long, ByVal lTextureID As Long) As Boolean
    PictureTextureIDList(lPictureIndex) = lTextureID
End Function

Public Function GetPictureCount() As Long
    GetPictureCount = PictureCount
End Function

Public Function GetPicturePath(ByVal lIndex As Long) As String
    GetPicturePath = PicturePathList(lIndex)
End Function

Public Function GetPictureName(ByVal lIndex As Long) As String
    GetPictureName = PictureFileList(lIndex).FileName
End Function

Public Function GetPictureID(ByVal strName As String) As Long
    GetPictureID = 0
    For i = 1 To PictureCount
        If strName = PictureFileList(i).FileName Then
            GetPictureID = i
        End If
    Next i
End Function

Public Function GetPictureTextureID(ByVal lIndex As Long) As Long
    GetPictureTextureID = PictureTextureIDList(lIndex)
End Function


'***************************************************************************
'*                      Funktionen zum Verwalten der Images
'***************************************************************************

Public Function AddImage(ByVal PictureID As Long, _
    ByVal ImageX As Long, ByVal ImageY As Long, _
    ByVal ImageWidth As Long, ByVal ImageHeight As Long) As Boolean
    'fügt ein neues Image der Imagelist hinzu
    'Imag eist definiert durch: PictureID und Position im Picture (textur)
    
    ImageCount = ImageCount + 1
    
    ReDim Preserve ImageList(1 To ImageCount) As TImageProperty
    
    ImageList(ImageCount).Left = ImageX
    ImageList(ImageCount).Top = ImageY
    ImageList(ImageCount).Right = ImageWidth
    ImageList(ImageCount).Bottom = ImageHeight
    ImageList(ImageCount).ImagePictureID = PictureID

End Function


Public Function SetImageRect(ByVal lIndex As Long, ByRef NewRect As RECT) As Boolean
    ImageList(lIndex).Left = NewRect.Left
    ImageList(lIndex).Right = NewRect.Right
    ImageList(lIndex).Top = NewRect.Top
    ImageList(lIndex).Bottom = NewRect.Bottom
End Function

Public Function ResetImageRect(ByVal lIndex As Long) As Boolean
    ImageList(lIndex).Left = 0
    ImageList(lIndex).Top = 0
    ImageList(lIndex).Right = PictureFileList(ImageList(lIndex).ImagePictureID).Width
    ImageList(lIndex).Bottom = PictureFileList(ImageList(lIndex).ImagePictureID).Height

End Function

Public Function GetImageCount()
    GetImageCount = ImageCount
End Function

Public Function GetImageDescription(ByVal lIndex As Long) As String
If lIndex <= 0 Then Exit Function
    'Imagebeschreibung:  "Picture (X,Y,Breite,Höhe)"
    'für die Listbox
    GetImageDescription = CStr(lIndex) & ". " & PictureFileList(ImageList(lIndex).ImagePictureID).FileName & "   (X: " & _
    CStr(ImageList(lIndex).Left) & " ,Y: " & CStr(ImageList(lIndex).Top) & " ,W: " & _
    CStr(ImageList(lIndex).Right) & " , H: " & CStr(ImageList(lIndex).Bottom) & ")"
    
End Function

Public Function GetImageTextureID(ByVal lIndex As Long) As Long
If lIndex <= 0 Then Exit Function
    'liefert die externe TexturID für das angegebene Image
    GetImageTextureID = PictureTextureIDList(ImageList(lIndex).ImagePictureID)
End Function

Public Function GetImageTexturePath(ByVal lIndex As Long) As String
If lIndex <= 0 Then Exit Function
    'liefert die externe TexturID für das angegebene Image
    GetImageTexturePath = PicturePathList(ImageList(lIndex).ImagePictureID)
End Function

'diese 4 funktionen, weil man keinen UDT direkt weiterverarbeiten kann
Public Function GetImageLeft(ByVal lIndex As Long) As Long
If lIndex <= 0 Then Exit Function
    GetImageLeft = ImageList(lIndex).Left
End Function

Public Function GetImageTop(ByVal lIndex As Long) As Long
If lIndex <= 0 Then Exit Function
    GetImageTop = ImageList(lIndex).Top
End Function

Public Function GetImageRight(ByVal lIndex As Long) As Long
If lIndex <= 0 Then Exit Function
    GetImageRight = ImageList(lIndex).Right
End Function

Public Function GetImageBottom(ByVal lIndex As Long) As Long
If lIndex <= 0 Then Exit Function
    GetImageBottom = ImageList(lIndex).Bottom
End Function

'***************************************************************************
'*                      Funktionen zum Verwalten der Sprites
'***************************************************************************

Public Function RemoveSprite(Index As Integer) As Boolean
    
    If SpriteCount > 0 Then
        
        SpriteCount = SpriteCount - 1
        If SpriteCount = 0 Then
            RemoveSprite = True
            Exit Function
        End If
        
        ReDim MyTempArray(1 To FrameCount, 1 To SpriteCount) As TSpriteFrame
         
        Dim Addi As Integer
        For i = 1 To FrameCount
            For Q = 1 To SpriteCount + 1
                If Q = Index Then Addi = 1: GoTo skip
                MyTempArray(i, Q - Addi) = FrameList(i, Q)
skip:
            Next Q
            Addi = 0
        Next i
        
        ReDim FrameList(1 To FrameCount, 1 To SpriteCount)
        For i = 1 To FrameCount
            For Q = 1 To SpriteCount
                FrameList(i, Q) = MyTempArray(i, Q)
            Next Q
        Next i
        
        Dim MyTempSprite() As TSprite
        ReDim MyTempSprite(1 To SpriteCount)
        
        Addi = 0
        For i = 1 To SpriteCount + 1
            If i = Index Then Addi = 1: GoTo skip2
            MyTempSprite(i - Addi) = SpriteList(i)
skip2:
        Next i
        
        ReDim SpriteList(1 To SpriteCount)
        For i = 1 To SpriteCount
            SpriteList(i) = MyTempSprite(i)
        Next i

        RemoveSprite = True
        
    End If
    
End Function

Public Function AddSprite(ByVal strSpriteName As String) As Boolean
    AddSprite = True
    
    For Q = 1 To SpriteCount
        If SpriteList(Q).SpriteName = strSpriteName Then
            AddSprite = False
            Exit Function
        End If
    Next Q
    SpriteCount = SpriteCount + 1
    ReDim Preserve SpriteList(1 To SpriteCount) As TSprite
    If FrameCount > 0 Then
        If SpriteCount > 1 Then
            ReDim MyTempArray(1 To FrameCount, 1 To SpriteCount - 1) As TSpriteFrame
            'Dim Q As Integer
            'Dim P As Integer

            'umständliches redimensionieren der FrameList, weil UDTs keine Variants schlucken
            MyTempArray = FrameList
       
            ReDim FrameList(1 To FrameCount, 1 To SpriteCount) As TSpriteFrame
            For Q = 1 To FrameCount
                   
                For p = 1 To SpriteCount - 1
           
                'If I <= iDimX And J <= iDimY Then
                    FrameList(Q, p) = MyTempArray(Q, p)
                    
                'End If
                Next p
                FrameList(Q, SpriteCount).Alpha = 255
                FrameList(Q, SpriteCount).Color = vbWhite
            Next Q
        Else
            ReDim FrameList(1 To FrameCount, 1 To SpriteCount) As TSpriteFrame
            For Q = 1 To FrameCount
                FrameList(Q, SpriteCount).Alpha = 255
                FrameList(Q, SpriteCount).Color = vbWhite
            Next Q
            
        End If
    End If
    SpriteList(SpriteCount).SpriteName = strSpriteName

    Exit Function
errorhandler:
    Debug.Print "Fehler in AddSprite"
    Debug.Print "Fehlercode: " & Err.Number
    Debug.Print Err.Description
End Function

Public Function GetSpriteCount() As Long
    GetSpriteCount = SpriteCount
End Function

Public Function GetSpriteName(ByVal lIndex As Long) As String
    If lIndex > 0 And lIndex <= SpriteCount Then
        GetSpriteName = SpriteList(lIndex).SpriteName
    Else
        GetSpriteName = ""
    End If
End Function

Public Function GetSpriteID(ByVal strSpriteName As String) As Long
    GetSpriteID = -1
    Debug.Print "spritecount: " & SpriteCount
    For Q = 1 To SpriteCount
        'Debug.Print "ok"
        'Debug.Print SpriteList(Q)
        If SpriteList(Q).SpriteName = strSpriteName Then GetSpriteID = Q
    Next Q
End Function

Public Function GetSpriteTextureID(ByVal lFrame As Long, ByVal lSpriteID As Long) As Long
    If FrameList(lFrame, lSpriteID).Image > 0 Then
        GetSpriteTextureID = PictureTextureIDList(ImageList(FrameList(lFrame, lSpriteID).Image).ImagePictureID)
    End If
End Function

Public Function GetSceneWidth() As Integer
GetSceneWidth = SceneSize.x
End Function

Public Function GetSceneHeight() As Integer
GetSceneHeight = SceneSize.y
End Function

Public Function GetSpriteProperty(ByVal lFrame As Long, ByVal lSprite As Long, _
    ByVal SpriteProperty As ESpriteProperty) As Variant
        
    Select Case SpriteProperty
        Case Is = 1
            GetSpriteProperty = FrameList(lFrame, lSprite).XPos
        Case Is = 2
            GetSpriteProperty = FrameList(lFrame, lSprite).YPos
        Case Is = 3
            GetSpriteProperty = FrameList(lFrame, lSprite).Image
        Case Is = 4
            GetSpriteProperty = FrameList(lFrame, lSprite).Angle
        Case Is = 5
            GetSpriteProperty = FrameList(lFrame, lSprite).Alpha
        Case Is = 6
            GetSpriteProperty = FrameList(lFrame, lSprite).Color
        Case Is = 7
            GetSpriteProperty = FrameList(lFrame, lSprite).Enabled
        Case Is = 8
            GetSpriteProperty = FrameList(lFrame, lSprite).Z
    End Select
End Function

Public Function SetSpriteProperty(ByVal lFrame As Long, ByVal lSprite As Long, _
    ByVal SpriteProperty As ESpriteProperty, ByVal vValue As Variant) As Boolean
    SetSpriteProperty = True
    Select Case SpriteProperty
        Case Is = 1
            FrameList(lFrame, lSprite).XPos = vValue
        Case Is = 2
            FrameList(lFrame, lSprite).YPos = vValue
        Case Is = 3
            FrameList(lFrame, lSprite).Image = vValue
        Case Is = 4
            FrameList(lFrame, lSprite).Angle = vValue
        Case Is = 5
            FrameList(lFrame, lSprite).Alpha = vValue
        Case Is = 6
            FrameList(lFrame, lSprite).Color = vValue
        Case Is = 7
            If FrameList(lFrame, lSprite).Image = 0 Then
                SetSpriteProperty = False
            Else
                FrameList(lFrame, lSprite).Enabled = vValue
                SetSpriteProperty = True
            End If
        Case Is = 8
            FrameList(lFrame, lSprite).Z = vValue
    End Select
End Function

'***************************************************************************
'*                      Funktionen zum Verwalten der Frames
'***************************************************************************

Public Function RemoveFrame(Index As Integer) As Boolean
    
    If FrameCount > 1 Then
        
        FrameCount = FrameCount - 1
        ReDim MyTempArray(1 To FrameCount, 1 To SpriteCount) As TSpriteFrame
         
        Dim Addi As Integer
        For i = 1 To FrameCount + 1
            If i = Index Then Addi = 1: GoTo skip
            For Q = 1 To SpriteCount
                MyTempArray(i - Addi, Q) = FrameList(i, Q)
            Next Q
skip:
        Next i
        
        ReDim FrameList(1 To FrameCount, 1 To SpriteCount)
        For i = 1 To FrameCount
            For Q = 1 To SpriteCount
                FrameList(i, Q) = MyTempArray(i, Q)
            Next Q
        Next i
        RemoveFrame = True
        
    End If
    
End Function

Public Function AddFrame() As Boolean

    FrameCount = FrameCount + 1
    SceneActive = True
    
    If SpriteCount > 0 Then
        ReDim MyTempArray(1 To FrameCount - 1, 1 To SpriteCount) As TSpriteFrame
        Dim Q As Integer
        Dim p As Integer
    
        'umständliches redimensionieren der FrameList, weil UDTs keine Variants schlucken
        MyTempArray = FrameList
        ReDim FrameList(1 To FrameCount, 1 To SpriteCount) As TSpriteFrame
    
        For Q = 1 To UBound(MyTempArray, 1)
            For p = 1 To UBound(MyTempArray, 2)
            'If I <= iDimX And J <= iDimY Then
                FrameList(Q, p) = MyTempArray(Q, p)
            'End If
            Next p
        Next Q
    End If
    For Q = 1 To SpriteCount
        'aktuellen spriteeigenschaften in die neuen übernehmen
        If FrameCount > 1 Then
            FrameList(FrameCount, Q) = FrameList(FrameCount - 1, Q)
            
        End If
    Next Q

    Exit Function
errorhandler:
    Debug.Print "Fehler in AddFrame"
    Debug.Print "Fehlercode: " & Err.Number
    Debug.Print Err.Description
        
End Function

Public Function GetFrameCount() As Long
    GetFrameCount = FrameCount
End Function


'***************************************************************************
'*                      Hilfsfunktionen
'***************************************************************************

Friend Sub ReDimEx(ByRef MyArray As Variant, _
  ByVal iDimX As Integer, _
  ByVal iDimY As Integer)
  'zum redimensioneiren von mehrdimensionalen Arrays
  'Funktion stammt von vbarchiv.de, die Idee war aber meine >:
  
  Dim MyTempArray As Variant
  Dim i As Integer
  Dim j As Integer
    
  MyTempArray = MyArray
  ReDim MyArray(1 To iDimX, 1 To iDimY)
    
  For i = LBound(MyTempArray, 1) To UBound(MyTempArray, 1)
    For j = LBound(MyTempArray, 2) To UBound(MyTempArray, 2)
      If i <= iDimX And j <= iDimY Then
        MyArray(i, j) = MyTempArray(i, j)
      End If
    Next j
  Next i
End Sub

Public Sub Render(Optional x As Double = 0, Optional y As Double = 0)

    Dim u As Integer

    Dim TexturID As Integer
    Dim DestX As Double, DestY As Double
    Dim SrcX As Integer, SrcY As Integer
    Dim SrcWidth As Integer, SrcHeight As Integer
    Dim TexturAngle As Integer
    Dim TexturAlpha As Integer
    Dim TexturColor As Long
    Dim TexturZ As Long
    
        FrameDelay = FrameDelay + 1
        If GetFrameDelay = 0 Or FrameDelay = GetFrameDelay Then
            AktlFrame = AktlFrame + 1
            If AktlFrame > GetFrameCount Then AktlFrame = 1
            FrameDelay = -1
        End If

        For i = 1 To GetSpriteCount
            
            If AktlFrame > 1 Then
            If GetSpriteProperty(AktlFrame, i, bolEnabled) Then
                TexturID = GetSpriteTextureID(AktlFrame, i)
                DestX = GetSpriteProperty(AktlFrame, i, lXPos)
                DestY = GetSpriteProperty(AktlFrame, i, lYPos)
                DestX = DestX + x
                DestY = DestY + y
                If GetSpriteProperty(AktlFrame, i, lImage) > 0 Then SrcX = GetImageRight(GetSpriteProperty(AktlFrame, i, lImage)) ' - GetImageLeft(GetSpriteProperty(AktlFrame, i, lImage))
                If GetSpriteProperty(AktlFrame, i, lImage) > 0 Then SrcY = GetImageBottom(GetSpriteProperty(AktlFrame, i, lImage)) ' - GetImageTop(GetSpriteProperty(AktlFrame, i, lImage))
                TexturAngle = GetSpriteProperty(AktlFrame, i, iAngle)
                TexturAlpha = GetSpriteProperty(AktlFrame, i, bAlpha)
                TexturColor = GetSpriteProperty(AktlFrame, i, lColor)
                TexturZ = GetSpriteProperty(AktlFrame, i, lZ)
                S2D.TexturePool.RenderTexture TexturID, DestX, DestY, SrcX, SrcY, SrcX, SrcY, GetImageLeft(GetSpriteProperty(AktlFrame, i, lImage)), GetImageTop(GetSpriteProperty(AktlFrame, i, lImage)), TexturAlpha / 3, TexturAngle, , , CInt(TexturZ), TexturColor
            End If
            
            If GetTickCount - LastTimeCheckFrame >= Interval Then
               LastTimeCheckFrame = GetTickCount
               
                If AktlFrame < GetFrameCount() Then
                   AktlFrame = AktlFrame + 1
                Else
                   AktlFrame = 1
                End If

            End If
            
            End If
        
            If GetSpriteProperty(AktlFrame, i, bolEnabled) Then
                TexturID = GetSpriteTextureID(AktlFrame, i)
                DestX = GetSpriteProperty(AktlFrame, i, lXPos)
                DestY = GetSpriteProperty(AktlFrame, i, lYPos)
                DestX = DestX + x
                DestY = DestY + y
                If GetSpriteProperty(AktlFrame, i, lImage) > 0 Then SrcX = GetImageRight(GetSpriteProperty(AktlFrame, i, lImage)) '- GetImageLeft(GetSpriteProperty(AktlFrame, i, lImage))
                If GetSpriteProperty(AktlFrame, i, lImage) > 0 Then SrcY = GetImageBottom(GetSpriteProperty(AktlFrame, i, lImage)) ' - GetImageTop(GetSpriteProperty(AktlFrame, i, lImage))
                TexturAngle = GetSpriteProperty(AktlFrame, i, iAngle)
                TexturAlpha = GetSpriteProperty(AktlFrame, i, bAlpha)
                TexturColor = GetSpriteProperty(AktlFrame, i, lColor)
                TexturZ = GetSpriteProperty(AktlFrame, i, lZ)
                S2D.TexturePool.RenderTexture TexturID, DestX, DestY, SrcX, SrcY, SrcX, SrcY, GetImageLeft(GetSpriteProperty(AktlFrame, i, lImage)), GetImageTop(GetSpriteProperty(AktlFrame, i, lImage)), TexturAlpha, TexturAngle, , , CInt(TexturZ), TexturColor
            End If
            
        Next i

End Sub

Private Sub Class_Initialize()
    SceneActive = False
    Interval = 250
End Sub
