Threaded Animation (crossplattform)

[ts-soft]

Hier mal ein kleines Beispiel, wie man eine Animation erzeugen kann, die in einem Thread abläuft, ohne globale Variablen!
Threadsafe Compilerflag ist nicht erforderlich!

Code: Alles auswählen

EnableExplicit

UsePNGImageDecoder()

Structure ParaAnimation
  semaphore.i
  ImgGad.i
  Interval.i
  Array Pics.i(0)  
EndStructure

; der böse Thread ;-)
Procedure Show_Animation(*para.ParaAnimation)
  ; alle übergebenen Parameter lokal kopieren
  Protected semaphore = *para\semaphore
  Protected ImgGad = *para\ImgGad
  Protected Interval = *para\Interval
  Dim Pics.i(0)
  CopyArray(*para\Pics(), Pics())
  Protected count = ArraySize(Pics())
  Protected time = ElapsedMilliseconds()
  Protected act = 0
  Repeat
    If IsGadget(ImgGad) And IsImage(Pics(act))
      If GadgetType(ImgGad) = #PB_GadgetType_Image
        SetGadgetState(ImgGad, ImageID(Pics(act)))
      EndIf
    EndIf
    While time + Interval > ElapsedMilliseconds()
      Delay(1)
    Wend
    time = ElapsedMilliseconds()
    act + 1
    If act > count : act = 0 : EndIf
  Until TrySemaphore(semaphore) ; Thread beenden, wenn Signal anliegt
  ; hier kann aufgeräumt werden, aber wir werden nur das Bild der Animation entfernen
  If IsGadget(ImgGad) And IsImage(Pics(act))
    If GadgetType(ImgGad) = #PB_GadgetType_Image
      SetGadgetState(ImgGad, 0)
    EndIf
  EndIf
EndProcedure

; Frames der Animation vorbereiten
Procedure CreateAniPics(Img, Array Pic(1), size)
  ; Bilder müssen quadratisch sein und hintereinander gesetzt!
  Protected i, count = ImageWidth(Img) / ImageHeight(Img)
  Dim Pic(count - 1)
  ResizeImage(Img, size * count, size)
  For i = 0 To count - 1
    Pic(i) = GrabImage(Img, #PB_Any, i * size, 0, size, size)
  Next
  ProcedureReturn count
EndProcedure

; Beispiel
InitNetwork()
Define imgpath.s = GetTemporaryDirectory() + "loading_circle.png"

If ReceiveHTTPFile("http://dl.dropbox.com/u/3086026/loading_circle.png", imgpath) = 0
  Debug "Datei konnte nicht geladen werden!"
  End
EndIf

LoadImage(0, imgpath)
Dim MyPics(0)
If Not CreateAniPics(0, MyPics(), 100) 
  Debug "Fehler beim erstellen der Frames"
  End
EndIf

Define Ani.ParaAnimation
Define Thread

With Ani
  \semaphore = CreateSemaphore()
  \ImgGad = 0
  \Interval = 250
  \Pics() = MyPics()
EndWith

OpenWindow(0, #PB_Ignore, #PB_Ignore, 220, 120, "")
ImageGadget(0, 10, 10, 100, 100, 0, #PB_Image_Border)
ButtonGadget(1, 120, 30, 90, 25, "Start Animation")
ButtonGadget(2, 120, 70, 90, 25, "Stop Animation")
DisableGadget(2, #True)

Repeat
  Select WaitWindowEvent(100)
    Case #PB_Event_CloseWindow
      Break
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          If IsThread(Thread) = 0
            DisableGadget(1, #True)
            Thread = CreateThread(@Show_Animation(), @Ani)
            If Thread
              DisableGadget(2, #False)
            EndIf
          EndIf
        Case 2
          SignalSemaphore(Ani\semaphore)
          DisableGadget(1, #False)
          DisableGadget(2, #True)
      EndSelect
  EndSelect
ForEver

DeleteFile(imgpath)

Vielleicht kann es ja jemand für seine Zwecke anpassen.

Gruß
Thomas