Pure Basic 4.60

[Backup]

Pure Basic 4.60 dispo sur vos comptes

[Cool Dji]

Géniale !

Une fonction 3D openMesh multiformat !!!

[case]

même pas je vais voir

[Cls]

Et moi, j'suis allé voir...

[Kwai chang caine]

même pas je vais voir

Vous casser pas la tete la premiere burne qui a été voir c'est moi, pour une fois que j'etais le premier
J'ai meme eu le temps de repondre a DOBRO...et j'ai réfléchi, "j'm'ai" dit si je repond que "j'me" suis fait n.... et ben les copains y vont pas y aller...et je serais estampiller 100% pur beurre dans le forum
Alors j'ai effacé le post et les remerciements que j'avais donné à DOBRO qui etaient dedans....et apres y va dire qu'il aime pas foutre la m....
Mais comme j'suis honnete...et que la mascarade est démasquée....la je suis solidaire des copains et j'avoue

Je veux pas encore "livé" ce post...mais j'ai toujours détesté ce genre de blague à l'ecole quand je me me promenais toute la journée avec un scotch et un bout de papier dans le dos.
En fait...j'ai jamais eu besoin d'accessoires pour qu'on se foute de ma gueule
Les boules de neige c'est la meme m.....j'ai jamais compris ce qui etait drole de se faire defoncer la tronche par un skud blanc glacé a 180 Km/h et se peler parce que la neige etait entrée dans le cou ...tout le monde riait...sauf moi

Enfin bon....pour DOBRO...faut bien que jeunesse se passe

[Ar-S]

On s'en doutait pas du tout... Surtout qu'il sort sans beta..
Une blagouse bien véreuse.

[Cool Dji]

J'avoue :
Je vois le message, d'emblée j'écris "Yeah, merci Dobro pour la news, je cours tester" et avant d'appuyer sur "Envoyer", je me dis attends, gros malin, on est le 1er Avril...
Vérification faite, grande était la déception car j'attends vraiment impatiemment cette nouvelle version...

Mais je dis que la blague est excellente...

Edit : j'ai hâte, mais j'ai hâte de voir la liste des nouvelles fonctions 3D et de tester la bête...

[Ar-S]

Tant que les futures nouvelles fonctions ne sont pas une blague.. ça se pardonne

[Backup]

Poisson D'avril !!!

[Cool Dji]

Oui, joli poisson

Comme toi Ar-S, le pardon sera proportionnel à la qualité des nouvelles fonctions

Bon sérieusement, personne n'a le moindre petit indice pour une date de sortie ?
D'habitude, entre la phase packaging et la version beta, y se passe beaucoup de temps ??

Là, ya quand même plus de 700.000 secondes qui se sont écoulées depuis le message de Fred => t'en fais des choses en tout ce temps

[flaith]

j'y ai même pas cru une seule seconde

[dayvid]

Bien moi si
mais j'ai lue les post avent donc voilà
bin sinon moi sa m'orais pas du tous fait rire mais bon

[Kwai chang caine]

Il est joli le gros poisson de DOBRO...il est fait dans un format qui est obsolete, inutile, ringard
Mais au fait....ça me rappelle une histoire de UseGIFImageDecoder() j'sais pas pourquoi

Et bin moi, j'suis drolement moins exigeant que vous au niveau du dessin, juste pouvoir travailler les GIFS en paix m'aurait suffit...et ça fait 2 ans que j'attend
Je parle meme pas des underscores..ça fait 5 ans

Ps:
Pour ceux qui auraient pas vu l'histoire :
http://www.purebasic.fr/english/viewtop ... 32#p302432

[Ar-S]

KCC tu as vu celui là ?

Code : Tout sélectionner

;- 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
    If count = $F9 
      ReadByte(file) 
      transparent = ReadByte(file) & 1 
      ReadWord(file) 
      transcolor = GlobalCols(ReadByte(file)) 
    EndIf
    
  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

If OpenWindow(0,0,0,640,480,"Load GIF",#PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
  ButtonGadget(0,10,10,80,20,"Open File")
  ImageGadget(1,10,50,300,300,0,#PB_Image_Border)
EndIf

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          Pattern.s="All Supported Formats|*.gif"
          filename.s=OpenFileRequester("Choose An Image File To Open","",Pattern,0)
          If filename
            hBitmap.l=LoadGIF_(filename)
            SendMessage_(GadgetID(1),#STM_SETIMAGE,#IMAGE_BITMAP,hBitmap)
          EndIf
      EndSelect
    Case #PB_Event_CloseWindow
      End
  EndSelect
ForEver

C'est pas encore le pied mais c'est déjà un bon début.

[Kwai chang caine]

Merci Ars
Je crois que je le connais, c'est celui de Hagibaba
http://www.purebasic.fr/english/viewtop ... 229#198229

Deja j'ai eu un bug avec l'ancien avatar de FLYPE, tu te rappelle le petit zozio qui tournait autour du chat sur fond blanc
Puis apres j'ai essayé avec daffy qui est sur la page ou j'ai donné le lien juste au dessus et la ça marche..
Enfin ça marche...c'est beaucoup dire parce que le canard il a gelé..y bouge plus

Moi je voulais un code qui les lis et qui bouge, mais surtout qui peut les enregistrer et les reproduire, pour pouvoir faire un createur de smileys, pour mettre dans Outlook

Parce que pour les lire, un webgadget suffit à la rigueur, mais pour les gerer.....