OSDM Beta Updates

[Bobo]

Hallo!
Ich habe mich die letzen Tage mal etwas mit dem OSDM beschäftigt und mal geschaut was alles so geht, bzw was nicht. Ich habe dazu mal den OSDM auch mal mit der einzigen Alternative verglichen ( Game Maker ).

Game Maker ist ein ein Programm mit dem Spiele erstellt werden können. Mit dem Tool wurden viele Retrogames umgesetzt. Dabei ist mir folgende Sachen aufgefallen die sich vieleicht im OSDM gut machen würden :

1. Import von Grafiken. Hier möchte der OSDM gerne vorbearbeitet Grafiken. Der "GM" arbeitet bei dem Verarbeiten der Grafiken genau wie der OSDM, aber durch die Import-Funktionen der Grafiken werden die z.B. Gifs automatisch in Frames umgerechnet. Damit würde das "Gif-Problem" erstmal aus der Welt geschaft.

2. Der OSDM hat eine tolle Scriptsprache mit der ne ganze Menge möglich ist. Ein Script ist im "GM" auch mit enthalten, aber er wird etwas anders eingesetzt. Und zwar kann man hier auf jedes Objekt einen Script legen, womit ne ganze Menge mehr Effekte zu erstellen sind. Ausserdem hat der "Raum" ( Im OSDM die Demo ) selber noch einen Script. Ich denke es sollte kein Problem sein einen Script auf jedes Objekt zu legen. Ich meine Logo,Sprites und so... Den Globalen Script hat der OSDM ja bereits. Ist vieleicht etwas Fummelei, sollte aber möglich sein.

3. Im "GM" gibt es Räume, wobei man jeden Raum mit einem Hintergrund belegen kann ( Tile ). Beim OSDM wäre das halt die Demo. Ich hätte einen schönes Code da, damit der OSDM auch mit Tilen arbeiten kann. Da durch würde das Problem von großen Grafiken wegfallen.

4. Das Speichersystem der Resourcen in den Demos. Durch das Speichersystem "Platzhalter" ist man sehr eingeschränkt. Ich hatte ja schonmal den Vorschlag gemacht das ganz in den Resourcen der Demo zu Speichern. Der "GM" verwendet eine ähnliche Engine, und zwar wird am Ende der Exe eine Art Inhaltsverzeichnis gemacht wo halt die Größen der einzelnen Dateien gespeichert werden. Die Inhalte werden dann auch einfach hinter die Exe gehängt. Ich finde das System sogar einfacher umzusetzen, da der OSDM ja sowieso die Grafiken an bestimmten Stellen in der Exe speichert. Man müsste halt nur ein "Inhaltsverzeichnis" dranhängen und dann nicht "IN" der Demo sondern "HINTER" der Demo speichern. Durch das System wären alle Limits auf einmal aufgehoben. Die Limits sind meiner Meinung nach das größte Problem beim OSDM, da mit mehr Grafiken auch viel aufwendiger Sachen gemacht werden können. Die Leistung sollte hier nicht das Problem sein, da PB sehr viele Sprites auf einmal darstellen kann.

5. 3D Funktionen. Der OSDM soll ja kein Aufwendiges 3D-System haben, wird ja auch nicht gebraucht.... Aber.... Der OSDM nutzt die S3DR Lib und Damit ist es möglich mal "auf die schnelle" 3D Objekte zu erzeugen oder nen Sprite als Textur zu nutzen. Hier sollte man vieleicht versuchen die S3DR Zeichenbefehle einfach im Script zu übernehmen oder besser durch zuschleifen. Damit könnten Effekte wie "Weltkugel" oder ähnlich selber per Script programmiert werden und der OSDM müsste für solche kleinen "Spielerein" nicht Erweitert oder Umgebaut werden.

6. Fonts. Wildcop hat sich sehr viel Arbeit mit den Fonts gemacht (Klasse !! ) , hier hätte ich noch ne besondere Idee.... Und zwar um die Demo klein zu halten eine Möglichkeit zum einbinden von TTF Fonts. Die Bitmapfont müsste dann halt beim Starten der Demo erzeugt werden.

Naja, das sind halt die Sachen die mir beim groben Vergleichen mit dem "GM" aufgefallen sind. Die Ideen bzw. die Verbesserungen hören sich zwar nach einem größeren Eingriff in den OSDM an, sind aber alle recht einfach umzusetzen da die Grundfunktionen ja bereits da sind. Wer möchte kann ja selber mal einen Blick auf den "GM" werfen, dann versteht ihr vieleicht meine Vorschläge besser ( http://www.yoyogames.com/make )

Ich habe um mal zu Testen versucht einen Scroller im "GM" umzusetzen, wer möchte, dann ja mal schauen ( http://www.chatnes.de/GM.rar ). Is nix Wildes... halt nur mal ein Test...

cu
Jens

[RoySAC]

Hoert sich fuer mich alles sehr gut an. Ich habe die sachen mal mit in die Suggestions page in der OSDM Wiki mit eingebaut. http://forum.deltaforceteam.de/wiki/dok ... uggestions

[Peace]

Hallo Bobo,

den GameMaker werde ich mir noch genauer ansehen, hatte ihn zwar vor einigen Jahren mal "ausprobiert" aber seither nicht mehr berücksichtigt...

Zu Deinen Ideen:

1. Leider ist es seit dem Windows ServicePack XP2 (jedenfalls bei mir) nicht mehr möglich Anim GIF in PB als MovieFiles abzuspielen. In den ersten Versionen vom OSDM konnte man dieses noch: GIF (AVI, MPG...) als Movie zeitverzögert auf einen Sprite rendern und mit UseBuffer/GrabSprite im Speicher ablegen. Das Ganze zog die FPS dann bei Echtzeit so richtig in den Keller, aber vorgerenderte Sprites ließen sich umsetzen, naja ist leider so nicht mehr möglich. Eine Entpackfunktion für das GIF ist zwar umsetzbar aber das führt zu größeren Exports weshalb es ja den Umweg mit den Frames gibt, zudem sind hierbei mehr als nur 256 (8Bit) Farben möglich, aber... der Nachteil sind eben die "unmöglichen" Dimensionen bei umfangreicheren Animationen. Ich habe mich heute nochmal an das Tool FAC herangemacht und eine FrameOrder Blockwise eingebaut, hier das AnimFrame Beispiel aus dem Demo Critizize:

<- Vertical und Blockwise ->

Jedenfalls werden so die Breite/Höhe eines Bildes nicht unbedingt die Maße von > 4000 Pixel überschreiten (Roy\SAC hatte u.a. dabei massive Probleme ein Demo darzustellen). Wenn es hierbei keine Probleme im OSDM geben sollte würde ich weiterhin die Frame Lösung vorziehen, weil Grafiken so leichter nachbearbeitet werden könnten... ich glaub' das war jetzt 'ne Ausrede .

2. Danke für den Hinweis mit der Script-Sprache, wie gesagt, werde mir den GM näher ansehen und evtl. etwas Ideen-mopsen begehen

3. Auf jedenfall muss noch eine Tile-Engine im OSDM eingebaut werden, wenn Du mir da helfen könntest währe ich Dir dankbar, einen Editor (wenn Du ihn noch nich hast) könnte ich evtl. dazu erstellen, ggf. auch an die Einschränkungen von PB3.94 anpassen, aber das sollte mit ein wenig Aufwand möglich sein.

4. Das Verfahren die Daten nachträglich HINTER der Exe anzuhängen verwendet ja schon die OSDM Option Megatro! Ein maßgeblicher Nachteil hierbei ist, daß bisher jeder Exe-Packer (UPX, UPack, ANDpakk...) diese Daten einfach "abschneidet", also nicht mitpackt! Nur als gepacktes Archiv (RAR,ZIP,7ZIP) ist es bisher möglich die Exports in der Größe zu komprimieren ohne Datenverlusst. Aber evtl. hab' ich auch was bei den Parametern übersehen

5. Hast recht! Warum alles nochmal von vorne beginnen wenn die Möglichkeiten vorhanden sind. Dachte nur das sowenig wie möglich auf UserLibs zugegriffen wird um irgendwann einmal einen vollständig "unabhängigen" OSDM zu kompilieren, aber werde mich nochmal mit den Möglichkeiten der S3DR-Lib von Stefan Moebius beschäftigen. Hier aber dann wenigstens der (unfertige) Source zu der Weltkugel:

  Code:

;************************************
;* Textured Sphere (Rotating)
;* Fixed/Speedup by Peace^TST 8/2010
;************************************

InitSprite()
InitSprite3D()
InitKeyboard()

; UsePNGImageDecoder()

#SCR_W   =  640
#SCR_H   =  480

#SCR_CX  =  #SCR_W   *  0.5   ; CenterScreen X
#SCR_CY  =  #SCR_H   *  0.5   ; CenterScreen Y

#DEGREE  =  #PI/180           ; Bogenmaß
#POLY    =  8                 ; Polygonanzahl 2,4,6,8,12 -> Int(96/#POLY)!

#I$      =  "quantized.bmp"   ; *** Your Texture (400x200) ***

Structure P
   Spr.l
   Px.l
   Py.l
   x.f
   y.f
EndStructure   :  NewList P.P()

r.f   =  100   ; Radius in Pixel
q.f   =  36.0 / #POLY * 0.25 * 10.0 ; x/y Faktor

; Main: Sphere
OpenScreen(#SCR_W, #SCR_H, 32, "Sphere", #PB_Screen_SmartSynchronization)

n  =  CatchImage(#PB_Any, ?L_IMG)
CreateSprite(0, 400, 200)
w  =  SpriteWidth(0)
h  =  SpriteHeight(0)
StartDrawing(SpriteOutput(0))
DrawImage(ImageID(n), 0, 0, w, h)
StopDrawing()
FreeImage(n)

DisplaySprite(0, 0, 0)
FreeSprite(0)

; Texture Map erstellen
n  =  -1
For x = 0 To #POLY * 4
   For y = 0 To #POLY * 2
      Repeat   :  n  +  1  :  Until IsSprite(n) =  #False
      AddElement(P())
      P()\Spr  =  n
      GrabSprite(n, x*w/#POLY*0.25, y*h/#POLY*0.5, h/#POLY*0.5, h/#POLY*0.5, #PB_Sprite_Texture)
      CreateSprite3D(n, n)
      TransparentSpriteColor(n, #Magenta)
   Next
Next

; Erstellen der Vektoren-Punkte auf der Kugel
ResetList(P())
With  P()
   For x = 0 To #POLY * 4
      For y = -#POLY To #POLY
         NextElement(P())
         \Px   =  x                          ; X-Sprite(0 .. 36)
         \Py   =  y  +  #POLY                ; Y-Sprite(0 .. 18)
         \x    =  10 *  (x*36.0/#POLY*0.25)  ; Winkel  (0 .. 360)
         \y    =  10 *  (y*36.0/#POLY*0.25)  ; Höhe    (-r.. r)
      Next
   Next
EndWith

Repeat

   Spin.f   +  1.00  ; Rotationsgeschwindigkeit
   If Spin  >= 360   :  Spin  -  360   :  EndIf

   ClearScreen(#Magenta)

   ResetList(P())
   Start3D()
   While NextElement(P())
      With  P()
         If \Px < #POLY * 4
            ; Berechung der 4 (x,y) Punkte für TransformSprite3D
            x1 = #SCR_CX   +  Sin((\x+Spin  )*#DEGREE)   *  Sqr(Pow(r,2)-Pow(Sin((\y  )*#DEGREE)*r,2))
            x2 = #SCR_CX   +  Sin((\x+Spin+q)*#DEGREE)   *  Sqr(Pow(r,2)-Pow(Sin((\y  )*#DEGREE)*r,2))
            x3 = #SCR_CX   +  Sin((\x+Spin+q)*#DEGREE)   *  Sqr(Pow(r,2)-Pow(Sin((\y+q)*#DEGREE)*r,2))
            x4 = #SCR_CX   +  Sin((\x+Spin  )*#DEGREE)   *  Sqr(Pow(r,2)-Pow(Sin((\y+q)*#DEGREE)*r,2))
            y1 = #SCR_CY   +  Sin((\y  )*#DEGREE)*r
            y3 = #SCR_CY   +  Sin((\y+q)*#DEGREE)*r
            TransformSprite3D(\Spr, x1, y1, x2, y1, x3, y3, x4, y3)
            DisplaySprite3D(\Spr, 0, 0, 255)
         EndIf
      EndWith
   Wend
   Stop3D()

   ;Keyboard
   ExamineKeyboard()
   If       KeyboardPushed(#PB_Key_Up)       ; Zoom out
      r  -  2  :  If r  <  -#SCR_H  :  r  =  -#SCR_H  :  EndIf
   ElseIf   KeyboardPushed(#PB_Key_Down)     ; Zoom in
      r  +  2  :  If r  >  #SCR_H   :  r  =  #SCR_H   :  EndIf
   ElseIf   KeyboardPushed(#PB_Key_Return)   ; Restore
      r  =  100
   ElseIf   KeyboardPushed(#PB_Key_Space)    ; Save screenshot
      n  =  GrabSprite(#PB_Any, 0, 0, #SCR_W, #SCR_H) :  Delay(1000)
      SaveSprite(n, "C:\Shot_3D.bmp")                 :  Delay(1000)
      FreeSprite(n)
   EndIf

   ;Info
   StartDrawing(ScreenOutput())
   FrontColor(#Black)
   DrawingMode(#PB_2DDrawing_Transparent)
   DrawText(8, 8, "Sprites:" + Str(ListSize(P())))
   DrawText(8,24, "Texture:" + Str(w) + "/" + Str(h))
   DrawText(8,56, "Angle:" + StrF(Spin,2))
   DrawText(8,72, "Distance:" + Str(r))
   StopDrawing()

   FlipBuffers()

Until KeyboardPushed(#PB_Key_Escape)

CloseScreen()

Delay(1000)

End

DataSection
   L_IMG:   IncludeBinary  #I$
EndDataSection

6. Hatte es vor einiger Zeit versucht BitmapFonts mittels TTF Fonts im OSDM Demo selbst zu erstellen (Cracktro 002) leider konnten aber nicht alle das ausführbare Beispiel starten (glaube Roy\SAC war auch dabei hehehe), weshalb ich mich nicht mehr damit beschäftigt hatte, aber für Hilfe und Tipps bin ich immer dankbar!

viele Grüße (bis dahin), Peace

PS: Dein GM-Beispiel find' ich klasse, richtig oldschool!

[Bobo]

Hallo!
Also Gifs also Movie und dann per Frame auf nen Sprite kopieren ging mal, ja.. aber da gibts ne bessere Möglichkeit.

  Code:

;- Structures

Structure ANGIF
  numberframes.l
  framenumber.l
  hBitmap.l[600]
EndStructure

Structure GIFHEADER ;Header
  ghSig.b[6] ;Signature & Version
  ghWidth.w ;Logical Screen Width
  ghHeight.w ;Logical Screen Height
  ghPkFields.b ;Global Color Table Flag
  ghBkColIndex.b ;Background Color Index
  ghAspRatio.b ;Pixel Aspect Ratio
EndStructure

Structure GIFIMAGE ;Image Descriptor
  imSep.b ;Image Separator
  imLeft.w ;Image Left Position
  imTop.w ;Image Top Position
  imWidth.w ;Image Width
  imHeight.w ;Image Height
  impkFields.b ;Local Color Table Flag
EndStructure

Structure GIFCLASS ;This is instead of using globals
  *lpBytes.Byte ;Pointer to next byte in block
  Pass.l ;First pass for interlaced images in OutLineGIF()
  Line.l ;Offset for addressing the bits in OutLineGIF()
  lpBits.l ;Scanline for bits
  pitch.l ;Bytes are rounded up for image lines
  CurrCodeSize.l ;The current code size
  BitsLeft.l ;Used in NextCodeGIF()
  BytesLeft.l ;Used in NextCodeGIF()
  CurrByte.l ;Current byte
  bUseGlobalColMap.b ;Is the color table global
  GlobColRes.l ;Color Resolution, bits '6' '5' '4'
  bImInterLace.b ;Is the image interlaced
  ImgColRes.l ;Color Resolution
EndStructure

Procedure OutLineGIF(lpPixels.l,LineLen.l,height.l,*cl.GIFCLASS)
  ;Outputs the pixel color index data to the DIB
  ;lpPixels -> Memory block that holds the color index value
  ;LineLen -> Length of the line of pixels
  ;Height -> im\imHeight
  ;Gif images are 2, 16 or 256 colors, poking the values into memory
  ;requires a different method for each case. If gif is interlaced,
  ;that is dealt with here.
 
  Protected ib.l,pixel.l,byte.l,BitCnt.l,CntBk.l,ColRes.l,Bits.l
 
  Bits=*cl\lpBits-(*cl\Line * *cl\pitch) ;Pointer to bits
 
  If *cl\bUseGlobalColMap
    ColRes=*cl\GlobColRes
  Else
    ColRes=*cl\ImgColRes
  EndIf
 
  Select ColRes
   
    Case 1
      byte=0
      For pixel=0 To LineLen-1 Step 8
        ib=0
        CntBk=7
        For BitCnt=0 To 8-1
          If PeekB(lpPixels+BitCnt+pixel)
            ib=ib | (1 << CntBk)
          EndIf
          CntBk-1
        Next
        PokeB(Bits+byte,ib)
        byte+1
      Next
     
    Case 4
      byte=0
      For pixel=0 To LineLen-1 Step 2
        ib=((PeekB(lpPixels+pixel) & 255) << 4)
        ib | (PeekB(lpPixels+pixel+1) & 255)
        PokeB(Bits+byte,ib)
        byte+1
      Next
     
    Case 8
      For pixel=0 To LineLen-1
        ib=PeekB(lpPixels+pixel) & 255
        PokeB(Bits+pixel,ib)
      Next
     
  EndSelect
 
  If *cl\bImInterLace ;Set Line for different passes when Interlaced
   
    Select *cl\Pass
     
      Case 0 ;Pass 1
        If *cl\Line<height-8
          *cl\Line+8
        Else
          *cl\Line=4 : *cl\Pass+1 ;Set Line for second pass
        EndIf
       
      Case 1 ;Pass 2
        If *cl\Line<height-8
          *cl\Line+8
        Else
          *cl\Line=2 : *cl\Pass+1 ;Set Line for third pass
        EndIf
       
      Case 2 ;Pass 3
        If *cl\Line<height-4
          *cl\Line+4
        Else
          *cl\Line=1 : *cl\Pass+1 ;Set Line for fourth pass
        EndIf
       
      Case 3 ;Pass 4
        If *cl\Line<height-2
          *cl\Line+2
        EndIf
       
    EndSelect
   
  Else ;When not Interlaced increment Line
   
    *cl\Line+1
   
  EndIf
 
EndProcedure

#PB_LoadGifFIle=$6000

Procedure.l NextCodeGIF(file.l, Array CharBuff.b(1), Array CodeMask.l(1),*cl.GIFCLASS)
  ;Reads the next code from the data stream
  ;Returns the LZW CODE or ERROR
 
  Protected count.l,Char.l,ret.l
 
  If *cl\BitsLeft=0 ;Any bits left in byte?
   
    If *cl\BytesLeft<=0 ;If not get another block
     
      *cl\lpBytes=@CharBuff(0) ;Set byte pointer
      *cl\BytesLeft=ReadByte(file) & 255
     
      If *cl\BytesLeft<0
        ProcedureReturn *cl\BytesLeft ;Return if error
      ElseIf *cl\BytesLeft
        For count=0 To *cl\BytesLeft-1
          Char=ReadByte(file) & 255
          If Char<0 : ProcedureReturn Char : EndIf
          CharBuff(count)=Char ;Fill the char buffer with the new block
        Next
      EndIf
     
    EndIf
   
    *cl\CurrByte=*cl\lpBytes\b & 255 ;Get a byte
    *cl\lpBytes+1 ;Increment index pointer
    *cl\BitsLeft=8 ;Set bits left in the byte
    *cl\BytesLeft-1 ;Decrement the bytes left counter
   
  EndIf
 
  ;Shift off any previously used bits
  ret=*cl\CurrByte >> (8-*cl\BitsLeft)
 
  While *cl\CurrCodeSize>*cl\BitsLeft
   
    If *cl\BytesLeft<=0
     
      ;Out of bytes in current block
      *cl\lpBytes=@CharBuff(0) ;Set byte pointer
      *cl\BytesLeft=ReadByte(file) & 255
     
      If *cl\BytesLeft<0
        ProcedureReturn *cl\BytesLeft ;Return if error
      ElseIf *cl\BytesLeft
        For count=0 To *cl\BytesLeft-1
          Char=ReadByte(file) & 255
          If Char<0 : ProcedureReturn Char : EndIf
          CharBuff(count)=Char ;Fill the char buffer with the current block
        Next
      EndIf
     
    EndIf
   
    *cl\CurrByte=*cl\lpBytes\b & 255 ;Get a byte
    *cl\lpBytes+1 ;Increment index pointer
    ret | (*cl\CurrByte << *cl\BitsLeft) ;Add remaining bits to return
    *cl\BitsLeft+8 ;Set bit counter
    *cl\BytesLeft-1 ;Decrement bytesleft counter
   
  Wend
 
  *cl\BitsLeft-*cl\CurrCodeSize ;Subtract the code size from bitsleft
  ret & CodeMask(*cl\CurrCodeSize) ;Mask off the right number of bits
  ProcedureReturn ret
 
EndProcedure

Procedure DrawTransparentImage(DC, bitmap, x, y, width, height, TransparentColor)
 
  ; First, create some DC's. These are our gateways To associated
  ; bitmaps in RAM
  maskDC = CreateCompatibleDC_(DC)
  tempDC = CreateCompatibleDC_(DC)
 
  SourceDC = CreateCompatibleDC_(DC)
  SelectObject_(SourceDC, bitmap)
 
 
  ; Then, we need the bitmaps. Note that we create a monochrome
  ; bitmap here!
  ; This is a trick we use For creating a mask fast enough.
  hMaskBmp = CreateBitmap_(width, height, 1, 1, 0)
  hTempBmp = CreateCompatibleBitmap_(DC, width, height)
 
  ; Then we can assign the bitmaps to the DCs
  ;
  hMaskBmp = SelectObject_(maskDC, hMaskBmp)
  hTempBmp = SelectObject_(tempDC, hTempBmp)
 
  ; Now we can create a mask. First, we set the background color
  ; To the transparent color; then we copy the image into the
  ; monochrome bitmap.
  ; When we are done, we reset the background color of the
  ; original source.
  TransparentColor= SetBkColor_(SourceDC, TransparentColor)
  BitBlt_ (maskDC, 0, 0, width, height, SourceDC, 0, 0, #SRCCOPY)
  SetBkColor_(SourceDC, TransparentColor)
 
  ; The first we do with the mask is To MergePaint it into the
  ; destination.
  ; This will punch a WHITE hole in the background exactly were
  ; we want the graphics To be painted in.
  BitBlt_ (tempDC, 0, 0, width, height, maskDC, 0, 0, #SRCCOPY)
  BitBlt_ (DC, x, y, width, height, tempDC, 0, 0, #MERGEPAINT)
 
  ; Now we delete the transparent part of our source image. To do
  ; this, we must invert the mask And MergePaint it into the
  ; source image. The transparent area will now appear as WHITE.
  BitBlt_ (maskDC, 0, 0, width, height, maskDC, 0, 0, #NOTSRCCOPY)
  BitBlt_ (tempDC, 0, 0, width, height, SourceDC, 0, 0, #SRCCOPY)
  BitBlt_ (tempDC, 0, 0, width, height, maskDC, 0, 0, #MERGEPAINT)
 
  ; Both target And source are clean. All we have To do is To And
  ; them together!
  BitBlt_ (DC, x, y, width, height, tempDC, 0, 0, #SRCAND)
 
  ; Now all we have To do is To clean up after us And free system
  ; resources..
  DeleteObject_ (hMaskBmp)
  DeleteObject_ (hTempBmp)
  DeleteDC_ (maskDC)
  DeleteDC_ (tempDC)
  DeleteDC_ (SourceDC)
 
EndProcedure

Procedure.l LoadGIFframes(filename.s,Array imageArray.l(1))
  ;From "loadgif.c" for ImageShop32 by John Findlay
  ;Loads LZW Graphics Interchange Format files
  ;Uses NextCodeGIF() and OutLineGIF()
 
  Protected Dim stack.b(4096) ;Stack for storing pixels
  Protected Dim suffix.b(4096) ;Suffix table, max number of LZW codes
  Protected Dim prefix.l(4096) ;Prefix linked list (these are longs)
  Protected Dim CharBuff.b(279) ;Current block
  Protected Dim GlobalCols.l(256) ;Global colors of gif
  Protected Dim localCols.l(256) ;Local image colors of gif
  Protected Dim CodeMask.l(16) ;Masks for LZW compression algorithm
  Protected gh.GIFHEADER
  Protected im.GIFIMAGE
  Protected cl.GIFCLASS
  Protected bi.BITMAPINFOHEADER
  Protected *pal.RGBQUAD
  Protected *lpSP.Byte ;Pointer to stack
  Protected *lpBuffPtr.Byte ;Pointer to buffer
  Protected bGlobColsSorted.b ;Sort Flag  bit '3' (this is unused)
  Protected file.l,sig.s,PkFields.l,bGlobColTable.b,GlobColBytes.l
  Protected GlobColors.l,count.l,Red.l,Green.l,Blue.l
  Protected width.l,height.l,impkFields.l,bImColsSorted.b
  Protected bImColTable.b,ImgColBytes.l,LZWCodeSize.l,TopSlot.l
  Protected ClearCode.l,ImgColors.l,EndingCode.l,NewCodes.l,Slot.l
  Protected lpBUFF.l,TempOldCode.l,OldCode.l,BufCnt.l,bitcount.l
  Protected ncolors.l,Len.l,hDIB.l,cc.l,code.l
  Protected *dib.BITMAPINFOHEADER
 
  CodeMask( 0)=$0000 : CodeMask( 1)=$0001
  CodeMask( 2)=$0003 : CodeMask( 3)=$0007
  CodeMask( 4)=$000F : CodeMask( 5)=$001F
  CodeMask( 6)=$003F : CodeMask( 7)=$007F
  CodeMask( 8)=$00FF : CodeMask( 9)=$01FF
  CodeMask(10)=$03FF : CodeMask(11)=$07FF
  CodeMask(12)=$0FFF : CodeMask(13)=$1FFF
  CodeMask(14)=$3FFF : CodeMask(15)=$7FFF
 
  ;Open the file
  file=ReadFile(#PB_Any,filename)
  If file=0
    MessageRequester("LOAD ERROR","File could not be opened")
    ProcedureReturn #False
  EndIf
 
  ;Read the file header and logical screen descriptor
  ReadData(file,gh,SizeOf(gh))
 
  sig=PeekS(@gh\ghSig,6) ;Get the header version string
  If sig<>"GIF89a" And sig<>"GIF87a"
    CloseFile(file)
    MessageRequester("LOAD ERROR","Not a valid gif file")
    ProcedureReturn #False ;NOT_VALID
  EndIf
 
  realwidth=gh\ghWidth
  realheight=gh\ghHeight
 
  ;Store gh\ghPkFields for bit manipulation
  PkFields=gh\ghPkFields & 255
 
  ;Global Color Table Flag bit '7'
  bGlobColTable=(PkFields & (1 << 7)) >> 7
 
  If bGlobColTable
    cl\bUseGlobalColMap=#True
   
    GlobColBytes=3*(1 << ((PkFields & $07)+1)) ;Table size in bytes
    GlobColors=GlobColBytes/3 ;Number of colors
   
    ;Some gif encoders do not follow the gif spec very well,
    ;so make cl\GlobColRes from GlobColors.
    ;Also gif's are used on different platforms, which do
    ;have different bits per pixel. i.e. 32 colors is 5 bits/pixel.
    If GlobColors<=2
      cl\GlobColRes=1
    ElseIf GlobColors<=16
      cl\GlobColRes=4
    Else
      cl\GlobColRes=8
    EndIf
   
    For count=0 To GlobColors-1 ;Get the global screen colors
      Red=ReadByte(file) & 255
      Green=ReadByte(file) & 255
      Blue=ReadByte(file) & 255
      GlobalCols(count)=RGB(Red,Green,Blue)
    Next
  EndIf
 
  count=0
  While count<>$2C ;Search for im\imSep
    count=ReadByte(file) & 255
  Wend
  FileSeek(file,Loc(file)-1) ;Seek to im\imSep
 
  ReadData(file,im,SizeOf(im)) ;Read the image descriptor
 
  ;Store im\imPkFields for bit manipulation
  impkFields=im\impkFields & 255
 
  ;Is the image interlaced
  cl\bImInterLace=(impkFields & (1 << 6)) >> 6
 
  ;Is the local color table sorted
  bImColsSorted=(impkFields & (1 << 5)) >> 5
 
  ;Is there a local color table
  bImColTable=(impkFields & (1 << 7)) >> 7
 
  If bImColTable
    cl\bUseGlobalColMap=#False
   
    ImgColBytes=3*(1 << ((impkFields & $07)+1)) ;Table size in bytes
    ImgColors=ImgColBytes/3 ;Number of colors
   
    If ImgColors<=2 ;Make sure image bit depth is 1, 4 or 8
      cl\ImgColRes=1
    ElseIf ImgColors<=16
      cl\ImgColRes=4
    Else
      cl\ImgColRes=8
    EndIf
   
    For count=0 To ImgColors-1 ;Get the local image colors
      Red=ReadByte(file) & 255
      Green=ReadByte(file) & 255
      Blue=ReadByte(file) & 255
      localCols(count)=RGB(Red,Green,Blue)
    Next
  Else ;No local color table
    If cl\bUseGlobalColMap=#False ;No global color table
      CloseFile(file)
      MessageRequester("LOAD ERROR","No color table")
      ProcedureReturn #False ;NO_COLORTABLE
    EndIf
  EndIf
 
  width=im\imWidth & $FFFF ;Image width
  height=im\imHeight & $FFFF ;Image height
 
  ;Get the first byte of the new block of image data.
  ;Should be the bit size
  LZWCodeSize=ReadByte(file) & 255
 
  ;Bit size is normally the same as the color resolution.
  ;i.e. 8 for 256 colors
  If LZWCodeSize<2 Or LZWCodeSize>8
    CloseFile(file)
    MessageRequester("LOAD ERROR","LZW code size is not valid")
    ProcedureReturn #False ;BAD_CODE_SIZE
  EndIf
 
  ;Initialise the variables for the decoder for reading a new image.
  cl\CurrCodeSize=LZWCodeSize+1
  TopSlot=1 << cl\CurrCodeSize ;Highest code for current size
  ClearCode=1 << LZWCodeSize ;Value for a clear code
  EndingCode=ClearCode+1 ;Value for an ending code
  NewCodes=ClearCode+2 ;First available code
  Slot=NewCodes ;Last read code
  cl\BitsLeft=0
  cl\BytesLeft=0
 
  ;Just in case...
  TempOldCode=0 : OldCode=0
 
  ;Allocate space for the decode buffer
  lpBUFF=AllocateMemory(width+8) ;+8 just in case
 
  ;Set up the stack pointer, decode buffer pointer and line counter
  *lpSP=@stack(0)
  *lpBuffPtr=lpBUFF
  BufCnt=width ;Count for pixel line length
 
  ;Start creating the DIB
  If cl\bUseGlobalColMap ;Global color table
    bitcount=cl\GlobColRes
  Else ;Local color table
    bitcount=cl\ImgColRes
  EndIf
 
  bi\biSize=SizeOf(bi)
  bi\biWidth=width
  bi\biHeight=height
  bi\biPlanes=1
  bi\biBitCount=bitcount ;BitCount will be 1, 4 or 8
  bi\biCompression=#BI_RGB
  bi\biSizeImage=0
  bi\biXPelsPerMeter=0
  bi\biYPelsPerMeter=0
  If cl\bUseGlobalColMap ;Global color table
    bi\biClrUsed=GlobColors
  Else ;Local color table
    bi\biClrUsed=ImgColors
  EndIf
  bi\biClrImportant=0
 
  ;With the BITMAPINFO format headers, the size of the palette is
  ;in biClrUsed, whereas in the BITMAPCORE - style headers, it is
  ;dependent on the Bits per pixel (2 to the power of bitsperpixel).
  If bi\biClrUsed<>0
    ncolors=bi\biClrUsed
  Else ;We don't have an optimal palette
    ncolors=1 << bi\biBitCount
  EndIf
 
  cl\pitch=(((bitcount*width)+31) >> 5) << 2 ;Bytes per line
  Len=bi\biSize+(ncolors*4)+(cl\pitch*height) ;Size of DIB
 
  bi\biSizeImage=cl\pitch*height ;Fill in biSizeImage
 
  ;Allocate memory block to store our DIB
  hDIB=AllocateMemory(Len)
  If hDIB=0
    FreeMemory(lpBUFF)
    ;CloseFile(file)
    MessageRequester("LOAD ERROR","Memory allocation failed")
    ProcedureReturn #False ;NO_DIB
  EndIf
 
  ;Fill first part of DIB with the BITMAPINFOHEADER
  CopyMemory(bi,hDIB,SizeOf(bi))
 
  ;Set the colors in the DIB (or masks for the new DIB formats)
  *pal=hDIB+SizeOf(bi)
  If cl\bUseGlobalColMap
    For count=0 To bi\biClrUsed-1
      *pal\rgbBlue=Blue(GlobalCols(count))
      *pal\rgbGreen=Green(GlobalCols(count))
      *pal\rgbRed=Red(GlobalCols(count))
      *pal+4
    Next
  Else
    For count=0 To bi\biClrUsed-1
      *pal\rgbBlue=Blue(localCols(count))
      *pal\rgbGreen=Green(localCols(count))
      *pal\rgbRed=Red(localCols(count))
      *pal+4
    Next
  EndIf
 
  cl\Line=0 ;Set address offset for OutLineGIF()
  cl\Pass=0 ;For interlaced images in OutLineGIF()
 
  ;Image data bits of DIB
  cl\lpBits=hDIB+bi\biSize+(ncolors*4)+(cl\pitch*(height-1))
 
  ;This is the main loop. For each code we get we pass through the
  ;linked list of prefix codes, pushing the corresponding "character"
  ;for each code onto the stack. When the list reaches a single
  ;"character" we push that on the stack too, and then start
  ;unstacking each character for output in the correct order.
  ;Special handling is included for the clear code, and the whole
  ;thing ends when we get an ending code.
  While cc<>EndingCode
   
    cc=NextCodeGIF(file,CharBuff(),CodeMask(),cl)
   
    If cc<0 ;If a file error, return without completing the decode
      FreeMemory(lpBUFF)
      ;CloseFile(file)
      MessageRequester("LOAD ERROR","Not a valid LZW code")
      ProcedureReturn #False ;FILE_ERROR
    EndIf
   
    ;If the code is a clear code, re-initialise all necessary items.
    If cc=ClearCode
     
      cl\CurrCodeSize=LZWCodeSize+1
      Slot=NewCodes
      TopSlot=1 << cl\CurrCodeSize
     
      ;Continue reading codes until we get a non-clear code
      ;(another unlikely, but possible case...)
      While cc=ClearCode
        cc=NextCodeGIF(file,CharBuff(),CodeMask(),cl)
      Wend
     
      ;If we get an ending code immediately after a clear code
      ;(yet another unlikely case), then break out of the loop.
      If cc=EndingCode
        Break ;end loop
      EndIf
     
      ;Finally, if the code is beyond the range of already set codes,
      ;(This one had better not happen, I have no idea what will
      ;result from this, but I doubt it will look good)
      ;then set it to color zero.
      If cc>=Slot
        cc=0
      EndIf
     
      OldCode=cc
      TempOldCode=OldCode
     
      ;And let us not forget to put the char into the buffer, and if,
      ;on the off chance, we were exactly one pixel from the end of
      ;the line, we have to send the buffer to the OutLineGIF() routine
      *lpBuffPtr\b=cc
      *lpBuffPtr+1
      BufCnt-1
     
      If BufCnt=0
        OutLineGIF(lpBUFF,width,height,cl)
        *lpBuffPtr=lpBUFF
        BufCnt=width
      EndIf
     
    Else
     
      ;In this case, it's not a clear code or an ending code, so it
      ;must be a code code. So we can now decode the code into a
      ;stack of character codes (Clear as mud, right?).
      code=cc
     
      If code=Slot
        code=TempOldCode
        *lpSP\b=OldCode
        *lpSP+1
      EndIf
     
      ;Here we scan back along the linked list of prefixes, pushing
      ;helpless characters (i.e. suffixes) onto the stack as we do so.
      While code>=NewCodes
        *lpSP\b=suffix(code)
        *lpSP+1
        code=prefix(code)
      Wend
     
      ;Push the last character on the stack, and set up the new
      ;prefix and suffix, and if the required slot number is greater
      ;than that allowed by the current bit size, increase the bit
      ;size. (Note - if we are all full, we *don't* save the new
      ;suffix and prefix. I'm not certain if this is correct,
      ;it might be more proper to overwrite the last code.
      *lpSP\b=code
      *lpSP+1
     
      If Slot<TopSlot
        OldCode=code
        suffix(Slot)=OldCode
        prefix(Slot)=TempOldCode
        Slot+1
        TempOldCode=cc
      EndIf
     
      If Slot>=TopSlot
        If cl\CurrCodeSize<12
          TopSlot=TopSlot << 1
          cl\CurrCodeSize+1
        EndIf
      EndIf
     
      ;Now that we've pushed the decoded string (in reverse order)
      ;onto the stack, lets pop it off and put it into our decode
      ;buffer, and when the decode buffer is full, write another line.
      While *lpSP>@stack(0)
        *lpSP-1
        *lpBuffPtr\b=*lpSP\b
        *lpBuffPtr+1
        BufCnt-1
       
        If BufCnt=0
          OutLineGIF(lpBUFF,width,height,cl)
          *lpBuffPtr=lpBUFF
          BufCnt=width
        EndIf
      Wend
     
    EndIf
  Wend
 
  If BufCnt<>width ;If there are any left, output the bytes
    OutLineGIF(lpBUFF,width-BufCnt-1,height,cl)
  EndIf
  *dib=hDIB
  If *dib=0 ;Avoid errors
    ProcedureReturn #False
  EndIf
 
  Bits=*dib+*dib\biSize+(*dib\biClrUsed*4) ;Pointer to bits
 
  ;Create the DDB bitmap
  hdc=GetDC_(#Null)
  hBitmap=CreateDIBitmap_(hdc,*dib,#CBM_INIT,Bits,*dib,#DIB_RGB_COLORS)
  FreeMemory(hDIB)
  imageArray(0)=hBitmap
  numberimages=1
 
  ;- continue to other frames
  Macro GetBit(Value, bit)
    (Value&(1<<bit))>>bit  ;Translates as 'value' ANDed with 2^bit and shifted back to bitposition 0
  EndMacro
 
  ; Read through the various image blocks
  NotatEnd=1
  While NotatEnd=1
    While n<>$2C
      n=ReadByte(file) & 255
      If n=$3B
        NotatEnd=0
        CloseFile(file)
        FreeMemory(lpBUFF)
        ProcedureReturn numberimages
      ElseIf n=$F9
        ;Graphics control extension
        n=ReadByte(file) & 255
        Size=n
        n=ReadByte(file) ;& 255
        packedfields.b=n &$FF
        ;Debug Bin(n&$FF)
        disposalmethod= (n & %00011100) >>2
        ;Debug disposalmethod
        tflag= GetBit(n,0) ;n& %00000001
        ;Debug tflag
        delaytime.w=ReadWord(file)
       
        ;Debug delaytime &  $FFFF
        transparent.b=ReadByte(file)
        globtranscolor=GlobalCols(transparent& $FF)
      ElseIf n=$FF
        ;application extension
      ElseIf n=$FE
        ;comment extention
        n=ReadByte(file) & 255
        FileSeek(file,Loc(file)+n)
      ElseIf n= $01
        ;"plain text extention"
        Debug "text"
        ; n=ReadByte(file) & 255
        ;FileSeek(file,Loc(file)+n& $FF)
      ElseIf n =$21
        ;"A Extension_block
      EndIf
    Wend
    n=0
   
    ; done with reading the image blocks for this frame
  FileSeek(file,Loc(file)-1)
  count=0
  While count<>$2C ;Search for im\imSep
    count=ReadByte(file) & 255
  Wend
  FileSeek(file,Loc(file)-1) ;Seek to im\imSep
 
  ReadData(file,im,SizeOf(im)) ;Read the image descriptor
 
  ;Store im\imPkFields for bit manipulation
  impkFields=im\impkFields & 255
 
  ;Is the image interlaced
  cl\bImInterLace=(impkFields & (1 << 6)) >> 6
 
  ;Is the local color table sorted
  bImColsSorted=(impkFields & (1 << 5)) >> 5
 
  ;Is there a local color table
  bImColTable=(impkFields & (1 << 7)) >> 7
 
  If bImColTable
    cl\bUseGlobalColMap=#False
   
    ImgColBytes=3*(1 << ((impkFields & $07)+1)) ;Table size in bytes
    ImgColors=ImgColBytes/3 ;Number of colors
   
    If ImgColors<=2 ;Make sure image bit depth is 1, 4 or 8
      cl\ImgColRes=1
    ElseIf ImgColors<=16
      cl\ImgColRes=4
    Else
      cl\ImgColRes=8
    EndIf
   
    For count=0 To ImgColors-1 ;Get the local image colors
      Red=ReadByte(file) & 255
      Green=ReadByte(file) & 255
      Blue=ReadByte(file) & 255
      localCols(count)=RGB(Red,Green,Blue)
    Next
    loctranscolor=localCols(transparent& $FF)
  Else ;No local color table
    If cl\bUseGlobalColMap=#False ;No global color table
      CloseFile(file)
      MessageRequester("LOAD ERROR","No color table")
      ProcedureReturn #False ;NO_COLORTABLE
    EndIf
  EndIf
 
  width=im\imWidth & $FFFF ;Image width
  height=im\imHeight & $FFFF ;Image height
 
  ;Get the first byte of the new block of image data.
  ;Should be the bit size
  LZWCodeSize=ReadByte(file) & 255
 
  ;Bit size is normally the same as the color resolution.
  ;i.e. 8 for 256 colors
  If LZWCodeSize<2 Or LZWCodeSize>8
    CloseFile(file)
    MessageRequester("LOAD ERROR","LZW code size is not valid")
    ProcedureReturn #False ;BAD_CODE_SIZE
  EndIf
 
  ;Initialise the variables for the decoder for reading a new image.
  cl\CurrCodeSize=LZWCodeSize+1
  TopSlot=1 << cl\CurrCodeSize ;Highest code for current size
  ClearCode=1 << LZWCodeSize ;Value for a clear code
  EndingCode=ClearCode+1 ;Value for an ending code
  NewCodes=ClearCode+2 ;First available code
  Slot=NewCodes ;Last read code
  cl\BitsLeft=0
  cl\BytesLeft=0
 
  ;Just in case...
  TempOldCode=0 : OldCode=0
 
  ;Allocate space for the decode buffer
  lpBUFF=AllocateMemory(width+8) ;+8 just in case
 
  ;Set up the stack pointer, decode buffer pointer and line counter
  *lpSP=@stack(0)
  *lpBuffPtr=lpBUFF
  BufCnt=width ;Count for pixel line length
 
  ;Start creating the DIB
  If cl\bUseGlobalColMap ;Global color table
    bitcount=cl\GlobColRes
  Else ;Local color table
    bitcount=cl\ImgColRes
  EndIf
 
  bi\biSize=SizeOf(bi)
  bi\biWidth=width
  bi\biHeight=height
  bi\biPlanes=1
  bi\biBitCount=bitcount ;BitCount will be 1, 4 or 8
  bi\biCompression=#BI_RGB
  bi\biSizeImage=0
  bi\biXPelsPerMeter=0
  bi\biYPelsPerMeter=0
  If cl\bUseGlobalColMap ;Global color table
    bi\biClrUsed=GlobColors
  Else ;Local color table
    bi\biClrUsed=ImgColors
  EndIf
  bi\biClrImportant=0
 
  ;With the BITMAPINFO format headers, the size of the palette is
  ;in biClrUsed, whereas in the BITMAPCORE - style headers, it is
  ;dependent on the Bits per pixel (2 to the power of bitsperpixel).
  If bi\biClrUsed<>0
    ncolors=bi\biClrUsed
  Else ;We don't have an optimal palette
    ncolors=1 << bi\biBitCount
  EndIf
 
  cl\pitch=(((bitcount*width)+31) >> 5) << 2 ;Bytes per line
  Len=bi\biSize+(ncolors*4)+(cl\pitch*height) ;Size of DIB
 
  bi\biSizeImage=cl\pitch*height ;Fill in biSizeImage
 
  ;Allocate memory block to store our DIB
  hDIB=AllocateMemory(Len)
  If hDIB=0
    FreeMemory(lpBUFF)
    CloseFile(file)
    MessageRequester("LOAD ERROR","Memory allocation failed")
    ProcedureReturn #False ;NO_DIB
  EndIf
 
  ;Fill first part of DIB with the BITMAPINFOHEADER
  CopyMemory(bi,hDIB,SizeOf(bi))
 
  ;Set the colors in the DIB (or masks for the new DIB formats)
  *pal=hDIB+SizeOf(bi)
  If cl\bUseGlobalColMap
    For count=0 To bi\biClrUsed-1
      *pal\rgbBlue=Blue(GlobalCols(count))
      *pal\rgbGreen=Green(GlobalCols(count))
      *pal\rgbRed=Red(GlobalCols(count))
      *pal+4
    Next
  Else
    For count=0 To bi\biClrUsed-1
      *pal\rgbBlue=Blue(localCols(count))
      *pal\rgbGreen=Green(localCols(count))
      *pal\rgbRed=Red(localCols(count))
      *pal+4
    Next
  EndIf
 
  cl\Line=0 ;Set address offset for OutLineGIF()
  cl\Pass=0 ;For interlaced images in OutLineGIF()
 
  ;Image data bits of DIB
  cl\lpBits=hDIB+bi\biSize+(ncolors*4)+(cl\pitch*(height-1))
 
  ;This is the main loop. For each code we get we pass through the
  ;linked list of prefix codes, pushing the corresponding "character"
  ;for each code onto the stack. When the list reaches a single
  ;"character" we push that on the stack too, and then start
  ;unstacking each character for output in the correct order.
  ;Special handling is included for the clear code, and the whole
  ;thing ends when we get an ending code.
  cc=0
 
  While cc<>EndingCode
   
    cc=NextCodeGIF(file,CharBuff(),CodeMask(),cl)
   
    If cc<0 ;If a file error, return without completing the decode
      FreeMemory(lpBUFF)
      CloseFile(file)
      MessageRequester("LOAD ERROR","Not a valid LZW code")
      ProcedureReturn #False ;FILE_ERROR
    EndIf
   
    ;If the code is a clear code, re-initialise all necessary items.
    If cc=ClearCode
     
      cl\CurrCodeSize=LZWCodeSize+1
      Slot=NewCodes
      TopSlot=1 << cl\CurrCodeSize
     
      ;Continue reading codes until we get a non-clear code
      ;(another unlikely, but possible case...)
      While cc=ClearCode
        cc=NextCodeGIF(file,CharBuff(),CodeMask(),cl)
      Wend
     
      ;If we get an ending code immediately after a clear code
      ;(yet another unlikely case), then break out of the loop.
      If cc=EndingCode
        Break ;end loop
      EndIf
     
      ;Finally, if the code is beyond the range of already set codes,
      ;(This one had better not happen, I have no idea what will
      ;result from this, but I doubt it will look good)
      ;then set it to color zero.
      If cc>=Slot
        cc=0
      EndIf
     
      OldCode=cc
      TempOldCode=OldCode
     
      ;And let us not forget to put the char into the buffer, and if,
      ;on the off chance, we were exactly one pixel from the end of
      ;the line, we have to send the buffer to the OutLineGIF() routine
      *lpBuffPtr\b=cc
      *lpBuffPtr+1
      BufCnt-1
     
      If BufCnt=0
        OutLineGIF(lpBUFF,width,height,cl)
        *lpBuffPtr=lpBUFF
        BufCnt=width
      EndIf
     
    Else
     
      ;In this case, it's not a clear code or an ending code, so it
      ;must be a code code. So we can now decode the code into a
      ;stack of character codes (Clear as mud, right?).
      code=cc
     
      If code=Slot
        code=TempOldCode
        *lpSP\b=OldCode
        *lpSP+1
      EndIf
     
      ;Here we scan back along the linked list of prefixes, pushing
      ;helpless characters (i.e. suffixes) onto the stack as we do so.
      While code>=NewCodes
        *lpSP\b=suffix(code)
        *lpSP+1
        code=prefix(code)
      Wend
     
      ;Push the last character on the stack, and set up the new
      ;prefix and suffix, and if the required slot number is greater
      ;than that allowed by the current bit size, increase the bit
      ;size. (Note - if we are all full, we *don't* save the new
      ;suffix and prefix. I'm not certain if this is correct,
      ;it might be more proper to overwrite the last code.
      *lpSP\b=code
      *lpSP+1
     
      If Slot<TopSlot
        OldCode=code
        suffix(Slot)=OldCode
        prefix(Slot)=TempOldCode
        Slot+1
        TempOldCode=cc
      EndIf
     
      If Slot>=TopSlot
        If cl\CurrCodeSize<12
          TopSlot=TopSlot << 1
          cl\CurrCodeSize+1
        EndIf
      EndIf
     
      ;Now that we've pushed the decoded string (in reverse order)
      ;onto the stack, lets pop it off and put it into our decode
      ;buffer, and when the decode buffer is full, write another line.
      While *lpSP>@stack(0)
        *lpSP-1
        *lpBuffPtr\b=*lpSP\b
        *lpBuffPtr+1
        BufCnt-1
       
        If BufCnt=0
          OutLineGIF(lpBUFF,width,height,cl)
          *lpBuffPtr=lpBUFF
          BufCnt=width
        EndIf
      Wend
     
    EndIf
   
  Wend
 
  If BufCnt<>width ;If there are any left, output the bytes
    OutLineGIF(lpBUFF,width-BufCnt-1,height,cl)
  EndIf
 
  ;Create the DDB bitmap
  *dib=hDIB
  If *dib=0 ;Avoid errors
    ProcedureReturn #False
  EndIf
 
  Bits=*dib+*dib\biSize+(*dib\biClrUsed*4) ;Pointer to bits
 
  ;- create the bitmap
  ;Create the DDB bitmap
  hdc=GetDC_(#Null)
  hBitmap=CreateDIBitmap_(hdc,*dib,#CBM_INIT,Bits,*dib,#DIB_RGB_COLORS)
  pbimage=CreateImage(#PB_Any,realwidth,realheight)
  drawdc=StartDrawing(ImageOutput(pbimage))
  ; For some retarded reason, we have to draw and redraw the GIF frames over the previous image imagenumber-1
 
  If bImColTable ; if a local color table, then draw previous image in array, and then dray new hbitmap with transparency
    DrawImage(imageArray(numberimages-1),0,0)
    DrawTransparentImage(drawdc,hBitmap,im\imLeft,im\imTop,im\imWidth,im\imHeight,loctranscolor)
  Else
    If tflag And disposalmethod <=1
      DrawImage(imageArray(numberimages-1),0,0)
      DrawTransparentImage(drawdc,hBitmap,im\imLeft,im\imTop,im\imWidth,im\imHeight,globtranscolor)
    Else
      DrawImage(imageArray(numberimages-1),0,0)
      DrawImage(hBitmap,im\imLeft,im\imTop)
    EndIf
  EndIf
  StopDrawing()
  FreeMemory(hDIB) ;Free the DIB
  imageArray(numberimages)=ImageID(pbimage)
  numberimages=numberimages+1
Wend
ProcedureReturn numberimages
EndProcedure


;Procedure TimerProc(hwnd,
Procedure GIFTimerProc(hwnd,msg,wParam,lParam)
  Select msg
    Case #PB_LoadGifFIle
      *GIFframe.ANGIF=GetProp_(hwnd,"frameinfo")
      If *GIFframe
        For d=0 To *GIFframe\numberframes-1
          DeleteObject_(*GIFframe\hBitmap[d])
        Next
        FreeMemory(*GIFframe)
      EndIf
      *frame.ANGIF=AllocateMemory(SizeOf(ANGIF))
      Dim GIFarray.l(600)
      string.s=PeekS(lParam)
      numberframes=LoadGIFframes(string.s,GIFarray())
      ReDim GIFarray.l(numberframes-1)
      SendMessage_(hwnd,#STM_SETIMAGE,#IMAGE_BITMAP,GIFarray(0))
      SetTimer_(hwnd,200,100,0)
      *frame\numberframes=numberframes
      *frame\framenumber=0
      For a=0 To numberframes-1
        *frame\hBitmap[a]=GIFarray(a)
      Next
      SetProp_(hwnd,"frameinfo",*frame.ANGIF)
     
    Case #WM_TIMER
      *GIFframe.ANGIF=GetProp_(hwnd,"frameinfo") ; get the image array pointer
      framenumber=*GIFframe\framenumber ; get the frame index
      KillTimer_(hwnd,200) ; stop the timer
      *GIFframe\framenumber=*GIFframe\framenumber+1; increase the frame count
      If *GIFframe\framenumber=*GIFframe\numberframes
        *GIFframe\framenumber=0
      EndIf
      hBitmap=*GIFframe\hBitmap[framenumber] ; get the bitmap
      ;delaytime=PeekW(*ptr+(frame*SizeOf(ANGIF))+4) ; get the delaytime
      SendMessage_(hwnd,#STM_SETIMAGE,#IMAGE_BITMAP,hBitmap); set the new bitmap
     
      SetTimer_(hwnd,200,100,0) ; set the new timer
      SetProp_(hwnd,"frameinfo",*GIFframe.ANGIF); reset the window props
      ;FreeMemory(*GIFframe)
  EndSelect
  ProcedureReturn CallWindowProc_(GetProp_(hwnd,"oldproc"),hwnd,msg,wParam,lParam)
EndProcedure

Procedure GifStaticControl(id.l,x.l,y.l,width.l,height.l)
  StaticCtl=ImageGadget(id,x.l,y.l,width.l,height,0)
  If id=#PB_Any
    PBreturn=StaticCtl
    hwnd=GadgetID(StaticCtl)
  Else
    PBreturn=GadgetID(id)
    hwnd=GadgetID(id)
  EndIf
  SetProp_(hwnd,"oldproc",SetWindowLong_(hwnd,#GWL_WNDPROC,@GIFTimerProc())) ; subclass
EndProcedure

If OpenWindow(0, 0, 0, 800, 600, "MDIGadget", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget)
  If CreateGadgetList(WindowID(0)) And CreateMenu(0, WindowID(0))
    MenuTitle("File")
    MenuItem(0, "Open GIF")
    MenuItem(1, "Exit")
    MenuTitle("MDI windows menu")
    ;MDIGadget(0, 0, 0, 0, 0, 1, 2, #PB_MDI_AutoSize)
    GifStaticControl(50,100,100,200,200)
  EndIf
EndIf
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
         
      EndSelect
    Case #PB_Event_Menu
      Select EventMenu()
        Case 0
          Pattern.s="All Supported Formats|*.gif"
          filename.s=OpenFileRequester("Choose An Image File To Open","",Pattern,0)
          If filename
            SendMessage_(GadgetID(50),#PB_LoadGifFIle,0,filename)
            ;Dim myarray(800)
            ;numberGIFs=LoadGIFframes(filename,myarray())
            ; UseGadgetList(WindowID(0))
            ; GifStaticControl(50,100,100,200,200,myarray.ANGIF())
            ; For a=1 To numberGIFs
              ; AddGadgetItem(0,a,"GIF Frame " + Str(a))
              ; CreateGadgetList(WindowID(a))
              ; ImageGadget(a*10,0,0,0,0,0)
              ; SendMessage_(GadgetID(a*10),#STM_SETIMAGE,#IMAGE_BITMAP,myarray(a-1))
            ; Next
            ;
          EndIf
        Case 1
          End
      EndSelect
    Case #PB_Event_CloseWindow
      End
  EndSelect
ForEver


Ich habe das mal so als Gadget gelassen, aber mit der Engine kannste schön die einzelnen Frames aus einem Gif ziehen. Der Code ist lauffähig unter PB 4.50 , sollte er unter PB 3.. nicht laufen, wirste warscheinlich nur die Arrays aus den Proceduren löschen müssen

[Peace]

Super danke für den Code Bobo,

klappt wunderbar mit den extrahieren von AnimGIF's ( PB4.3 - 4.5 ), bei PB3.94 werden ja keine Array Parameter für Proceduren unterstützt, weshalb wahrscheinlich wieder etwas "rumgetrickst" werden muss. Jedenfalls musste nur bei TransparentFlag und Cropped Images einwenig abgeändert werden da Teilbereiche einzelner Frames sich überlagern (ist dadurch sogar noch etwas fixer im extrahieren).

Werde Dein Beispiel zunächst im FrameAnimCrator (FAC) einbauen und dann hier einstellen wenn's OK ist...