Mr .gif ? Solution simple ? [RESOLU]

[Shinao]

Hello it's me again !

J'aurais voulu savoir (car j'ai recherché avant), si il existait un code assez simple ou une méthode pour avoir un .gif dans mon programme ?

Merci d'avance

Edit: je viens de voir ça : http://www.purebasic.fr/english/viewtopic.php?p=302432
Cependant dans ma 4.5, ce n'a pas été implémenté (je ne sais pas ce que veux dire implémenté mais ça le fait!)

[Mindphazer]

KCC avait fait ça : http://forums.purebasic.com/french/view ... f=6&t=8718

[Shinao]

Malheureusement, je l'avais vu, j'ai copié le code (sans le lire), et cela a bien évidemment lamentablement foiré.

Après j'ai regardé (car je suis coriace) et j'ai vu que c'est du VB, so, quel intérêt ? On peut intégrer du VB au PB ?

[Mindphazer]

Ah oui, sorry. My mistake.

[Shinao]

Ca mérite le fouet...

Quelqu'un a des idées ?
Personne n'a jamais eu envi d'avoir une image animé dans son programme ?

Je voudrais faire un Wait logo, d'autre méthode existe peut-être.

En attendant mon héros...

Edit: j'ai testé une méthode qui marche un peu barbare, le WebGadget avec une url de gif... m'enfin c'est assez moche faut l'avouer.

[Mindphazer]

Je voudrais faire un Wait logo, d'autre méthode existe peut-être.

Pourquoi ne pas utiliser le format PNG ?

[gnozal]

Un example avec GDI+

Code : Tout sélectionner

;
; Load GIF [Using GDI Plus]
;
; Uses GDI+ (windows XP, 2003 , Vista, Se7en).
;
#GDIPLUS_OK = 0

;-Structures
Structure GdiplusStartupInput
  GdiPlusVersion.l
  *DebugEventCallback.DebugEventProc
  SuppressBackgroundThread.l
  SuppressExternalCodecs.l
EndStructure

;-Imports
Import "gdiplus.lib" ; polib /out:gdiplus.lib gdiplus.dll, copy to \PureLibraries\Windows\Libraries\
  GdiplusStartup(token, *input.GdiplusStartupInput, output) As "GdiplusStartup"
  GdipCreateBitmapFromFile(filename.p-unicode, *bitmap) As "GdipCreateBitmapFromFile"
  GdipGetImageWidth(*image, *width) As "GdipGetImageWidth"
  GdipGetImageHeight(*image, *height) As "GdipGetImageHeight"
  GdipCreateFromHDC(hdc.l, *graphics) As "GdipCreateFromHDC"
  GdipDrawImageRectI(*graphics, *image, x.l, y.l, width.l, height.l) As "GdipDrawImageRectI"
  GdipDeleteGraphics(*graphics) As "GdipDeleteGraphics"
  GdipDisposeImage(image) As "GdipDisposeImage"
  GdiplusShutdown(token) As "GdiplusShutdown"
EndImport

Procedure.l LoadGif(filename$) ; Returns PB ID [#Null if error]
  Protected result, width, height
  Protected Input.GdiplusStartupInput, token, image, imageID, hdc, graphics
  Input\GdiPlusVersion = 1
  GdiplusStartup(@token, @Input, #Null)
  If token
    If GdipCreateBitmapFromFile(filename$, @image) = #GDIPLUS_OK
      GdipGetImageWidth(image, @width)
      GdipGetImageHeight(image, @height)
      imageID = CreateImage(#PB_Any, width, height, 32)
      If imageID
        hdc = StartDrawing(ImageOutput(imageID))
          If hdc
            GdipCreateFromHDC(hdc, @graphics)
            If graphics
              GdipDrawImageRectI(graphics, image, 0, 0, width, height)
              GdipDeleteGraphics(graphics)
              result = imageID     
            EndIf
          StopDrawing() 
        EndIf
      EndIf
      GdipDisposeImage(image)
    EndIf
    ;Tidy up.
    GdiplusShutdown(token)
  EndIf
  ProcedureReturn result
EndProcedure
;
ImageNum = LoadGif("c:\purebasic460\Program\Test.gif") 
If ImageNum
  If OpenWindow(0, 450, 200, 402, 402, "GIF", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar)
    ImageGadget(0, 13, 17, 373, 367, ImageID(ImageNum), #PB_Image_Border)
    Repeat
      Event = WaitWindowEvent()
      Select Event
        Case #PB_Event_CloseWindow
          CloseWindow(0)
          Break
      EndSelect
    ForEver
  EndIf
Else
  Debug "Image NOT loaded !"
EndIf

[Ar-S]

Pour qu'il soit animé je suppose.

Et un webgadget ?

[gnozal]

Sans GDI+

Code : Tout sélectionner

;
; Load GIF [Using GDI Plus]
;
;
;
; Load GIF image
;
; This code loads 1/4/8-bit gif files. It is based on code by John Findlay.
; I have removed the constants and globals and created a structure to hold
; the "class" variables used in the procedures. I have reduced the number 
; of procedures to 3. LoadGIF() returns a DIB and then LoadGIF_() creates 
; a DDB from the DIB. 
;

;- Structures 

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 

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.l _LoadGif(filename.s) 
  ;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 
  
  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 
  
  ;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 
  
  CloseFile(file) ;Close the file 
  FreeMemory(lpBUFF) 
  ProcedureReturn hDIB 
  
EndProcedure 

Procedure.l LoadGif(filename.s) 
  
  Protected *dib.BITMAPINFOHEADER 
  Protected Bits.l,hDC.l,hBitmap.l 
  
  *dib=_LoadGif(filename) 
  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(*dib) ;Free the DIB 
  ProcedureReturn hBitmap 
  
EndProcedure 

ImageID = LoadGif("c:\purebasic460\Program\Test.gif") 
If ImageID
  If OpenWindow(0, 450, 200, 402, 402, "GIF", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar)
    ImageGadget(0, 13, 17, 373, 367, ImageID, #PB_Image_Border)
    Repeat
      Event = WaitWindowEvent()
      Select Event
        Case #PB_Event_CloseWindow
          CloseWindow(0)
          Break
      EndSelect
    ForEver
  EndIf
Else
  Debug "Image NOT loaded !"
EndIf

[Shinao]

@Mindphazer
Car un .png Wait, on dirait que le programme a planté...

@gnozal
Je n'arrive pas a trouver la lib, toujours des 404, un lien ?

Sinon, j'ai essayé avec un "Veuillez patienter" avec les 3 petits points dynamiques, cependant, comment faire une boucle sans qu'elle soit infinie ? Je n'arrive pas a gérer les Events en dehors de mon programme principal


Merci d'avance

[gnozal]

Via OLE :

Code : Tout sélectionner

;
; Load GIF Image Via OLE
;
Procedure LoadGIF(image,szFile.s)
  ;
  hFile = CreateFile_(szFile, #GENERIC_READ, 0, #Null, #OPEN_EXISTING, 0, #Null) 
  If hFile 
    dwFileSize = GetFileSize_(hFile, #Null) 
    hGlobal    = GlobalAlloc_(#GMEM_MOVEABLE, dwFileSize) 
    If hGlobal 
      pvData = GlobalLock_(hGlobal) 
      
      bRead = ReadFile_(hFile, pvData, dwFileSize, @dwBytesRead, #Null) 
      GlobalUnlock_(hGlobal) 
      
      If bRead 
        If CreateStreamOnHGlobal_(hGlobal, #True, @pstm.IStream) = #S_OK 
          If OleLoadPicture_(pstm, dwFileSize, #False,?IID_IPicture, @Bild.IPicture) = #S_OK 
            Bild\get_Height(@Height) 
            Bild\get_Width(@width) 
            hdc = GetDC_(GetDesktopWindow_()) 
            ScreenPixels_X = GetDeviceCaps_(hdc,#LOGPIXELSX) 
            ScreenPixels_Y = GetDeviceCaps_(hdc,#LOGPIXELSY) 
            ReleaseDC_(GetDesktopWindow_(),hdc) 
            PicHeight = (Height * ScreenPixels_X) / 2540 
            PicWidth  = (width  * ScreenPixels_Y) / 2540 
            result = CreateImage(image,PicWidth,PicHeight,24) 
            If result 
              hdc = StartDrawing(ImageOutput(image)) 
                Bild\Render(hdc,0,PicHeight,PicWidth,-PicHeight,0,0,width,Height,0) 
              StopDrawing() 
            EndIf 
            Bild\Release() 
          EndIf 
          pstm\Release() 
        EndIf 
      EndIf 
    EndIf 
    CloseHandle_(hFile) 
  EndIf 
  ProcedureReturn image
  ;
  DataSection 
    IID_IPicture: 
    Data.l $7BF80980 
    Data.w $BF32,$101A 
    Data.b $8B,$BB,$00,$AA,$00,$30,$0C,$AB 
  EndDataSection 
  ;
EndProcedure 

LoadGIF(0, "c:\purebasic460\Program\Test.gif")

If IsImage(0)
  If OpenWindow(0, 450, 200, 402, 402, "GIF", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar)
    ImageGadget(0, 13, 17, 373, 367, ImageID(0), #PB_Image_Border)
    Repeat
      Event = WaitWindowEvent()
      Select Event
        Case #PB_Event_CloseWindow
          CloseWindow(0)
          Break
      EndSelect
    ForEver
  EndIf
Else
  Debug "Image NOT loaded !"
EndIf

[gnozal]

@gnozal
Je n'arrive pas a trouver la lib, toujours des 404, un lien ?

Créer la lib d'import : polib /out:gdiplus.lib gdiplus.dll

Copier gdiplus.lib vers \PureLibraries\Windows\Libraries\

[Shinao]

@gnozal
2/3 des codes que j'arrive à faire fonctionner, le .gif n'est pas dynamique, et c'est le seul intérêt que j'ai à afficher un .gif

@Ar-S
Déjà dis et testé, le rendu est pas terrible car les bords sont en blanc, le temps d'attente est assez long et si la machine n'a pas internet, c'est encore pire...

@gnozal
Je ne comprend pas tes instructions, je suis débutant.

[gnozal]

GIF animé (à améliorer)

Code : Tout sélectionner

;
; Animated GIF control
;
; I am not very happy with it, but this seems to be the best way to deal
; with the GIF control. The control uses window properties to store a
; structure that contains the number of frames, the current rendered frame,
; and all the bitmaps of the GIF stored in a static array.
; Currently, I have the maximum number of frames set to 600.
; I can see no way anyone would need more than 600 frames.
; I have a GIf created from ULEAD Cool3D that is 12 seconds long,
; and is 200 frames. it is 5 megs compressed as a GIF.
; Unless you REALLY want to push your CPU during load time, 600 is plenty.
;

;- 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

[Ar-S]

Via un simple webgadget donc.

Code : Tout sélectionner

Enumeration
  #Window_0
EndEnumeration
Enumeration
  #Web_0
  #BT
EndEnumeration
Procedure OpenWindow_Window_0()
  If OpenWindow(#Window_0, 450, 200, 174, 257, "GIF", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar)
    WebGadget(#Web_0, 5, 5, 180, 210, GetCurrentDirectory()+"gif.html")
    ButtonGadget(#BT, 30, 225, 115, 25, "go")
    HideGadget(#Web_0,1)   
  EndIf
EndProcedure

go=#False
OpenWindow_Window_0()

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Web_0
        Case #BT
          Select go
            Case #True
              HideGadget(#Web_0,1)
              go-1
            Case #False
              HideGadget(#Web_0,0)
              go+1
          EndSelect
          
      EndSelect
    Case #PB_Event_CloseWindow
      Select EventWindow()
        Case #Window_0
          CloseWindow(#Window_0)
          Break
      EndSelect
  EndSelect
ForEver

créer dans le même répertoire un fichier gif.html contenant la source.

Code : Tout sélectionner

<img src='http://erdsjb.free.fr/PureStorage/Gif/Schtroumpfcadeau.gif' alt='Image'>