AnimProcs - Sprites aus FrameSet animieren

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Antworten
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

AnimProcs - Sprites aus FrameSet animieren

Beitrag von Kaeru Gaman »

AnimProcs

diese proceduren ermöglichen ein komfortables animieren von sprites
aus einem 'FrameSet', also einer bitmap die alle Frames enthält.

ich hoffe, der Code ist nicht zu kompliziert geworden, ich konnte nicht widerstehen,
eine vernünftige Fehlerbehandlung einzubauen...

wenn man nur den Kern in eigene Programme einbauen will,
kann alles zwischen

Code: Alles auswählen

    ;*************************** Beginn Fehler-Pufferung
und

Code: Alles auswählen

    ;*************************** Ende Fehler-Pufferung
einfach weggelassen werden...

vor dem rumprobieren bitte die Anleitung lesen,
diese ist im Paket enthalten,
ebenso eine kleine Demo mit selbstgemachten FrameSets,
diese werden als Freeware deklariert.

Download Paket:
http://filehost.bas-x.de/download.php?id=12

Hier mal der Code ausgeschrieben:

Code: Alles auswählen

; *******************************************************************

Declare FreeAnim()      ; muss vordeklariert werden,
                        ; weil auch von InitAnim benutzt

; *******************************************************************

Procedure InitAnim(No_of_Anims.l)

    ;*************************** Beginn Fehler-Pufferung
Static AnimReInit
    If AnimReInit = 1           ; erneuter Aufruf?
        FreeAnim()              ; Speicherplatz freigeben.
    Else                        ; erster Aufruf?
    ;*************************** Ende Fehler-Pufferung

        Structure Animat        ; Struktur definieren
            PosX.l              ; X-Position im Screen
            Posy.l              ; Y-Position im Screen
            FraW.l              ; Breite eines Einzelframes
            FraH.l              ; Höhe eines Einzelframes.
            SetW.l              ; Anzahl Frames in einer Reihe des Sets
            SetH.l              ; Anzahl Reihen im Set
            Fram.l              ; Aktueller Frame
            NoFr.l              ; Anzahl Frames gesamt
            Mode.l              ; Verzögerungs-Modus
            Dely.l              ; Aktuelle Verzögerung
            msBf.l              ; Millisekunden-Buffer
            cont.l              ; counter für frame-verzögerung
        EndStructure
        
        Global AnimErrorTxt.s   ; FehlerNummer
        Global AnimErrorNr.l    ; FehlerText
        Global AnimCount.l      ; Anzahl Anims
        Global SetOffset.l         ; Erste Sprite-Nr.

    ;*************************** Beginn Fehler-Pufferung
    EndIf
    AnimReInit = 1
    ;*************************** Ende Fehler-Pufferung

    AnimCount = No_of_Anims

    SetOffset = 7000        ; hier verändern, wenn gewünscht

    Dim Anim.Animat(No_of_Anims)
     
EndProcedure

; *******************************************************************

Procedure.l FreeAnim()

    ;*************************** Beginn Fehler-Pufferung
    If AnimCount > 0    ; sind Anims vorhanden?
    ;*************************** Ende Fehler-Pufferung

    For n=1 To AnimCount
        If IsSprite(SetOffset+n)     ; alle benutzten sprites
            FreeSprite(SetOffset+n)  ; werden freigegeben
        EndIf
    Next
    Dim Anim.Animat(0)          ; Array-Speicher freigeben
    AnimCount = 0

    ;*************************** Beginn Fehler-Pufferung
        ProcedureReturn 1   ; FreeAnim erfolgreich
    Else
        ProcedureReturn 0   ; FreeAnim fehlgeschlagen
    EndIf 
    ;*************************** Ende Fehler-Pufferung

EndProcedure

; *******************************************************************

Procedure.l CreateAnim(Nr.l, File.s, Mode.l, Width.l, Height.l, TRed.l, TGrn.l, TBlu.l)

    SetNr = SetOffset+Nr

    ;*************************** Beginn Fehler-Pufferung
    AnimErrorNr = 0 : AnimErrorTxt = ""

    If AnimCount = 0
        AnimErrorNr = 1 : AnimErrorTxt = "Nicht initialsiert"
    EndIf

    If LoadSprite(SetNr, File, 0) = 0
        AnimErrorNr = 2 : AnimErrorTxt = "Ladefehler"
    EndIf

    If Height = 0 Or Width = 0
        AnimErrorNr = 3 : AnimErrorTxt = "Null-Größe"
    EndIf

    If Nr > AnimCount Or Nr < 1
        AnimErrorNr = 4 : AnimErrorTxt = "Ungültige Anim"
    EndIf

    If TRed<0 Or TRed>255 Or TGrn<0 Or TGrn>255 Or TBlu<0 Or TBlu>255
        AnimErrorNr = 6 : AnimErrorTxt = "Ungültiger Farbwert"
    EndIf

    If AnimErrorNr = 0  ; nur ausführen, wenn kein Fehler aufgetreten ist
    ;*************************** Ende Fehler-Pufferung

        SetWi = SpriteWidth(SetNr)
        SetHe = SpriteHeight(SetNr)

        If Mode = 0
            Anim(Nr)\FraW = Width           ; Sprite-Größe ist angegeben
            Anim(Nr)\FraH = Height
            Anim(Nr)\SetW = SetWi/Width     ; Set-Größe wird ermittelt
            Anim(Nr)\SetH = SetHe/Height
        Else
            Anim(Nr)\FraW = SetWi/Width     ; Sprite-Größe wird ermittelt
            Anim(Nr)\FraH = SetHe/Height
            Anim(Nr)\SetW = Width           ; Set-Größe ist angegeben
            Anim(Nr)\SetH = Height
        EndIf

        Anim(Nr)\NoFr = Anim(Nr)\SetW * Anim(Nr)\SetH
        
        TransparentSpriteColor(SetNr, TRed, TGrn, TBlu)

    ;*************************** Beginn Fehler-Pufferung
        ProcedureReturn 1   ; fehlerfrei
    Else
        ProcedureReturn 0   ; fehlgeschlagen
    EndIf
    ;*************************** Ende Fehler-Pufferung

EndProcedure

; *******************************************************************

Procedure SetAnimTransparence(Nr.l, TRed.l, TGrn.l, TBlu.l)

    SetNr = SetOffset+Nr

    ;*************************** Beginn Fehler-Pufferung
    AnimErrorNr = 0 : AnimErrorTxt = ""

    If AnimCount = 0
        AnimErrorNr = 1 : AnimErrorTxt = "Nicht initialsiert"
    EndIf

    If Nr > AnimCount Or Nr < 1 Or IsSprite(SetNr)=0
        AnimErrorNr = 4 : AnimErrorTxt = "Ungültige Anim"
    EndIf

    If TRed<0 Or TRed>255 Or TGrn<0 Or TGrn>255 Or TBlu<0 Or TBlu>255
        AnimErrorNr = 6 : AnimErrorTxt = "Ungültiger Farbwert"
    EndIf

    If AnimErrorNr = 0  ; nur ausführen, wenn kein Fehler aufgetreten ist
    ;*************************** Ende Fehler-Pufferung

        TransparentSpriteColor(SetNr, TRed, TGrn, TBlu)

    ;*************************** Beginn Fehler-Pufferung
        ProcedureReturn 1   ; fehlerfrei
    Else
        ProcedureReturn 0   ; fehlgeschlagen
    EndIf
    ;*************************** Ende Fehler-Pufferung

EndProcedure

; *******************************************************************

Procedure.l SetAnimDelay(Nr.l, Mode.l, Value.l)

    SetNr = SetOffset+Nr

    ;*************************** Beginn Fehler-Pufferung
    AnimErrorNr = 0 : AnimErrorTxt = ""

    If AnimCount = 0
        AnimErrorNr = 1 : AnimErrorTxt = "Nicht initialsiert"
    EndIf

    If Nr > AnimCount Or Nr < 1 Or IsSprite(SetNr)=0
        AnimErrorNr = 4 : AnimErrorTxt = "Ungültige Anim"
    EndIf

    If Value < 0
        AnimErrorNr = 5 : AnimErrorTxt = "Ungültiges Delay"
    EndIf

    If AnimErrorNr = 0  ; nur ausführen, wenn kein Fehler aufgetreten ist
    ;*************************** Ende Fehler-Pufferung

        Anim(Nr)\Mode = Mode
        Anim(Nr)\Dely = Value

    ;*************************** Beginn Fehler-Pufferung
        ProcedureReturn 1   ; fehlerfrei
    Else
        ProcedureReturn 0   ; fehlgeschlagen
    EndIf
    ;*************************** Ende Fehler-Pufferung

EndProcedure

; *******************************************************************

Procedure.l ShowAnim(Nr.l, AX.l, AY.l)

    SetNr = SetOffset+Nr

    ;*************************** Beginn Fehler-Pufferung
    AnimErrorNr = 0 : AnimErrorTxt = ""

    If AnimCount = 0
        AnimErrorNr = 1 : AnimErrorTxt = "Nicht initialsiert"
    EndIf

    If Nr > AnimCount Or Nr < 1 Or IsSprite(SetNr)=0
        AnimErrorNr = 4 : AnimErrorTxt = "Ungültige Anim"
    EndIf

    If AnimErrorNr = 0  ; nur ausführen, wenn kein Fehler aufgetreten ist
    ;*************************** Ende Fehler-Pufferung

    If Anim(Nr)\Mode = 1                            ; nach Millisekunden
        ActTim = ElapsedMilliseconds()
        If ActTim<0 And Anim(Nr)\msBf > 0           ; dies dient zum vermeiden
            Anim(Nr)\msBf = ActTim+Anim(Nr)\Dely    ; eines Hängenbleibens, falls
        EndIf                                       ; der Rechner 14 Tage läuft
        
        If ActTim >= Anim(Nr)\msBf                  ; wenn die zeit verstrichen,
            Anim(Nr)\msBf = ActTim+Anim(Nr)\Dely    ; timer aktualisieren
            Animate = 1                             ; animieren erlauben
        EndIf
    Else                                            ; nach Frames
        Anim(Nr)\cont +1
        If Anim(Nr)\cont > Anim(Nr)\Dely            ; wenn anzahl frames vorbei,
            Anim(Nr)\cont = 0                       ; counter auf null
            Animate = 1                             ; animieren erlauben
        EndIf
    EndIf

    If Animate = 1                                  ; wenn animieren
        Anim(Nr)\Fram +1                            ; nächstes Bild
        If Anim(Nr)\Fram >= Anim(Nr)\NoFr           ; nach letztem?
            Anim(Nr)\Fram = 0                       ; also erstes
        EndIf
    EndIf

    FrOfY = Anim(Nr)\Fram/Anim(Nr)\SetW
    FrOfX = Anim(Nr)\Fram-Anim(Nr)\SetW*FrOfY
    ClipSprite(SetNr,FrOfX*Anim(Nr)\FraW,FrOfY*Anim(Nr)\FraH,Anim(Nr)\FraW,Anim(Nr)\FraH)
    Anim(Nr)\PosX = AX
    Anim(Nr)\PosY = AY
    DisplayTransparentSprite(SetNr, AX, AY)

    ;*************************** Beginn Fehler-Pufferung
        ProcedureReturn 1   ; fehlerfrei
    Else
        ProcedureReturn 0   ; fehlgeschlagen
    EndIf
    ;*************************** Ende Fehler-Pufferung

EndProcedure

; *******************************************************************

Procedure.l MoveAnim(Nr.l, XM.l, YM.l)

    SetNr = SetOffset+Nr

    ;*************************** Beginn Fehler-Pufferung
    AnimErrorNr = 0 : AnimErrorTxt = ""

    If AnimCount = 0
        AnimErrorNr = 1 : AnimErrorTxt = "Nicht initialsiert"
    EndIf

    If Nr > AnimCount Or Nr < 1 Or IsSprite(SetNr)=0
        AnimErrorNr = 4 : AnimErrorTxt = "Ungültige Anim"
    EndIf

    If AnimErrorNr = 0  ; nur ausführen, wenn kein Fehler aufgetreten ist
    ;*************************** Ende Fehler-Pufferung

    If Anim(Nr)\Mode = 1                            ; nach Millisekunden
        ActTim = ElapsedMilliseconds()
        If ActTim<0 And Anim(Nr)\msBf > 0           ; dies dient zum vermeiden
            Anim(Nr)\msBf = ActTim+Anim(Nr)\Dely    ; eines Hängenbleibens, falls
        EndIf                                       ; der Rechner 14 Tage läuft
        
        If ActTim >= Anim(Nr)\msBf                  ; wenn die zeit verstrichen,
            Anim(Nr)\msBf = ActTim+Anim(Nr)\Dely    ; timer aktualisieren
            Animate = 1                             ; animieren erlauben
        EndIf
    Else                                            ; nach Frames
        Anim(Nr)\cont +1
        If Anim(Nr)\cont > Anim(Nr)\Dely            ; wenn anzahl frames vorbei,
            Anim(Nr)\cont = 0                       ; counter auf null
            Animate = 1                             ; animieren erlauben
        EndIf
    EndIf

    If Animate = 1                                  ; wenn animieren
        Anim(Nr)\Fram +1                            ; nächstes Bild
        If Anim(Nr)\Fram >= Anim(Nr)\NoFr           ; nach letztem?
            Anim(Nr)\Fram = 0                       ; also erstes
        EndIf
    EndIf

    FrOfY = Anim(Nr)\Fram/Anim(Nr)\SetW
    FrOfX = Anim(Nr)\Fram-Anim(Nr)\SetW*FrOfY
    ClipSprite(SetNr,FrOfX*Anim(Nr)\FraW,FrOfY*Anim(Nr)\FraH,Anim(Nr)\FraW,Anim(Nr)\FraH)
    AX = Anim(Nr)\PosX + XM
    AY = Anim(Nr)\PosY + YM
    DisplayTransparentSprite(SetNr, AX, AY)

    ;*************************** Beginn Fehler-Pufferung
        ProcedureReturn 1   ; fehlerfrei
    Else
        ProcedureReturn 0   ; fehlgeschlagen
    EndIf
    ;*************************** Ende Fehler-Pufferung

EndProcedure

; *******************************************************************
DieseZeileDientDazuDieForumSeiteBreiterZuMachenDamitInDemCodeKeineZeilenUmbrücheStehenOKJetztIstGenug
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Nach oben
Benutzeravatar
#NULL
Beiträge: 2237
Registriert: 20.04.2006 09:50

Beitrag von #NULL »

bin grad durch zufall auf deinen code gestoßen
und hab das paket mal nach PB-4.02 gebracht. sowas muss ja nicht im
keller liegen :)
http://www.wannabephoenix.de/others/KG/animPB4.zip
my pb stuff..
Bild..jedenfalls war das mal so.
Nach oben
Antworten

Zurück zu „Code, Tipps und Tricks“