PureBasic

Voici un petit bout de code que j'ai créé mardi pour mon éditeur graphique GGraphEditor, commenté aujourd'hui spécialement pour vous bande de veinard. Soyez indulgents c'est mon premier tutorial !

Code : Tout sélectionner

; ********************************************************************************************
; ********************************** Tutorial par Gratteur  **********************************
; ****** Comment sauvegarder une image en format bmp 256 couleurs avec palette indexée  ******
; *** N'oubliez pas de désactiver le débogueur pour tester la performance d'un algorithme  ***
; ******************************** Version du 9 décembre 2005 ********************************
; ********************************************************************************************

; On définit la largeur et la hauteur de l'image
#largeur = 800
#hauteur = 600
repertoire.s = "imagetest.bmp" ; Le répertoire de l'image
; On crée un tableau dans lequel on stock les 256 couleurs de la palette (ici aléatoires)
Dim palette.l(255)
For y=0 To 15
  For x=0 To 15
    palette(i) = RGB(Random(255), Random(255), Random(255))
    i+1
  Next x
Next y
; On crée une image avec des valeures prises dans la palette
imageID = CreateImage(#PB_Any, #largeur, #hauteur)
StartDrawing(ImageOutput())
For y=0 To #hauteur-1
  For x=0 To #largeur-1
    Plot(x, y, palette(Random(255)))
  Next x
Next y
StopDrawing()

; Procedure d'encodage de l'image (fichier.s doit se terminer par .bmp)
; Tout ce qui prend comme valeur $00 comme les champs réservés et autres octets pour le codage RLE et dont on ne se sert pas ne sont pas détaillés pour simplifier
Procedure SaveBmp8bit(ImageID, largeur, hauteur, fichier.s)
  fileID = CreateFile(#PB_Any, fichier.s) ; On crée le fichier dans lequel seront stockées les données
  If fileID
    While (largeur+d)%4 > 0 ; Dans la zone des donnees, la largeur de chaque ligne en octet doit être un multiple de 4
      d+1
    Wend
     ; Premiere entete (BITMAPFILEHEADER)
    *MemoryID = AllocateMemory(112) ; On alloue une zone mémoire de 14*8 bit pour le premier entête
    If *MemoryID
      PokeB(*MemoryID, $42) ; $424D est le code d'un Bitmap Windows (2 octets)
      PokeB(*MemoryID+1, $4D)
      PokeL(*MemoryID+2, 54+((largeur+d)*hauteur)) ; Taille totale du fichier (4 octets)
      PokeL(*MemoryID+10, 54+1024) ; Offset de l'image (4 octets)
      WriteData(*MemoryID, 14) ; On écrit dans le fichier les 14 octets du premier entête
      FreeMemory(*MemoryID) ; On libère la zone mémoire pour ne pas l'encombrer
    EndIf
    ; Deuxieme entete (BITMAPINFOHEADER)
    *MemoryID = AllocateMemory(320) ; On alloue une zone mémoire de 40*8 bit pour le second entête
    If *MemoryID
      PokeL(*MemoryID, $28) ; $28 pour Windows, ($0C pour OS/2 1.x, $F0 pour OS/2 2.x) (1 octet)
      PokeL(*MemoryID+4, largeur) ; La largeur de l'image (4 octets)
      PokeL(*MemoryID+8, hauteur) ; La hauteur de l'image (4 octets)
      PokeW(*MemoryID+12, 1) ; Le nombre de plans (1 dans tous les cas) (1 octet)
      PokeW(*MemoryID+14, 8) ; La profondeur des couleurs, ici 8 pour 8bit soit 256 couleurs (2 octets)
      WriteData(*MemoryID, 40) ; On écrit dans le fichier les 40 octets du second entête
      FreeMemory(*MemoryID) ; On libère la zone mémoire pour ne pas l'encombrer
    EndIf
    ; Palette (RGBQUAD)
    *MemoryID = AllocateMemory(8192) ; On alloue une zone mémoire de 1024*8 bit pour la palette indexée
    If *MemoryID
      For i=0 To 255 ; On fait défiler les 256 couleurs contenues dans notre tableau
        PokeB(*MemoryID+(i*4), Blue(palette(i))) ; On écrit la composante "blue" de la couleur (1 octet)
        PokeB(*MemoryID+1+(i*4), Green(palette(i))) ; On écrit la composante "green" de la couleur (1 octet)
        PokeB(*MemoryID+2+(i*4), Red(palette(i))) ; On écrit la composante "red" de la couleur (1 octet)
      Next i
      WriteData(*MemoryID, 1024) ; On écrit dans le fichier les 1024 octets de la palette
      FreeMemory(*MemoryID) ; On libère la zone mémoire pour ne pas l'encombrer
    EndIf
    ; Zone de donnees
    UseImage(ImageID) ; On utilise la bonne image (on ne sait jamais)
    StartDrawing(ImageOutput()) ; On commence le dessin
    For y=hauteur-1 To 0 Step -1 ; On écrit les données de l'image de bas en haut
      *MemoryID = AllocateMemory((largeur+d)*8) ; On alloue une zone mémoire de (largeur+d)*8 bit (cf plus haut pour le d)
      If *MemoryID
        For x=0 To largeur-1 ; On écrit ensuite les données de l'image de gauche à droite
          c = Point(x, y) ; On récupère la couleur du point de coordonnées (x,y) de l'image
          For i=0 To 255 ; On cherche la couleur de ce point parmis les 256 possibilités de la palette
            If c = palette(i) ; Si on trouve la couleur (attention la réduction d'une image en 24 bit n'est pas traitée dans ce tutorial)
              PokeB(*MemoryID+x, i) ; On écrit l'index de la couleur correspondante (1 octet)
              Break ; On casse la boucle pas la peine de tester des valeurs innutiles
            EndIf
          Next i
        Next x
        WriteData(*MemoryID, largeur+d)
        FreeMemory(*MemoryID) ; On libère la zone mémoire pour ne pas l'encombrer de plus de largeur+d octets
      EndIf ; (Une image 5000*5000 en 24bit prend 72Mo dans la mémoire, vous comprenez pourquoi on la vide au fur et à mesure maintenant ;p)
    Next y
    StopDrawing() ; On arrete le dessin
    CloseFile(fileID) ; On ferme le fichier
  EndIf
EndProcedure

temps1 = ElapsedMilliseconds()
SaveBmp8bit(imageID, #largeur, #hauteur, repertoire.s) ; Ne pas oublier de créer une palette dans le tableau palette(255)
temps2 = ElapsedMilliseconds()

;N'oubliez pas de désactiver le débogueur pour tester la vitesse réelle
MessageRequester("N'oubliez pas de désactiver le débogueur", "L'image en format bmp 8bit (256 couleurs) à été codé en "+Str(temps2-temps1)+" ms", #PB_MessageRequester_Ok)

Qu'en pensez-vous ?

Peek & Poke & collégramme

Ah ça on peut dire qu'il y a de la couleur

Ma foi cela a marché

Le code serait peut-être plus "joli"et lisible avec le coloriseur de Dobro ?:D

je ne sais où est exactement le code de la dernière version ?

Sur son site ?
Avec celui-là cela marche

Quel peinturlureur ce Dobro

http://michel.dobro.free.fr/bidouilles/colorer.rar

Par contre l'indentation est présente (remplacée par des "?") dans la version test.Html, a sauté dans le resultat final

Dobro y a encore un bug vicieux qui traine!

; ********************************************************************************************
; ********************************** Tutorial par Gratteur **********************************
; ****** Comment sauvegarder une image en format bmp 256 couleurs avec palette indexée ******
; *** N'oubliez pas de désactiver le débogueur pour tester la performance d'un algorithme ***
; ******************************** Version du 9 décembre 2005 ********************************
; ********************************************************************************************

; On définit la largeur et la hauteur de l'image
#largeur = 800
#hauteur = 600
repertoire.s = "imagetest.bmp" ; Le répertoire de l'image
; On crée un tableau dans lequel on stock les 256 couleurs de la palette (ici aléatoires)
Dim palette.l(255)
For y=0 To 15
For x=0 To 15
palette(i) = RGB ( Random (255), Random (255), Random (255))
i+1
Next x
Next y
; On crée une image avec des valeures prises dans la palette
imageID = CreateImage ( #PB_Any , #largeur , #hauteur )
StartDrawing ( ImageOutput ())
For y=0 To #hauteur -1
For x=0 To #largeur -1
Plot (x, y, palette( Random (255)))
Next x
Next y
StopDrawing ()

; Procedure d'encodage de l'image (fichier.s doit se terminer par .bmp)
; Tout ce qui prend comme valeur $00 comme les champs réservés et autres octets pour le codage RLE et dont on ne se sert pas ne sont pas détaillés pour simplifier
Procedure SaveBmp8bit( ImageID , largeur, hauteur, fichier.s)
fileID = CreateFile ( #PB_Any , fichier.s) ; On crée le fichier dans lequel seront stockées les données
If fileID
While (largeur+d)%4 > 0 ; Dans la zone des donnees, la largeur de chaque ligne en octet doit être un multiple de 4
d+1
Wend
; Premiere entete (BITMAPFILEHEADER)
*MemoryID = AllocateMemory (112) ; On alloue une zone mémoire de 14*8 bit pour le premier entête
If *MemoryID
PokeB (*MemoryID, $42) ; $424D est le code d'un Bitmap Windows (2 octets)
PokeB (*MemoryID+1, $4D)
PokeL (*MemoryID+2, 54+((largeur+d)*hauteur)) ; Taille totale du fichier (4 octets)
PokeL (*MemoryID+10, 54+1024) ; Offset de l'image (4 octets)
WriteData (*MemoryID, 14) ; On écrit dans le fichier les 14 octets du premier entête
FreeMemory (*MemoryID) ; On libère la zone mémoire pour ne pas l'encombrer
EndIf
; Deuxieme entete (BITMAPINFOHEADER)
*MemoryID = AllocateMemory (320) ; On alloue une zone mémoire de 40*8 bit pour le second entête
If *MemoryID
PokeL (*MemoryID, $28 ) ; $28 pour Windows, ($0C pour OS/2 1.x, $F0 pour OS/2 2.x) (1 octet)
PokeL (*MemoryID+4, largeur) ; La largeur de l'image (4 octets)
PokeL (*MemoryID+8, hauteur) ; La hauteur de l'image (4 octets)
PokeW (*MemoryID+12, 1) ; Le nombre de plans (1 dans tous les cas) (1 octet)
PokeW (*MemoryID+14, 8 ) ; La profondeur des couleurs, ici 8 pour 8bit soit 256 couleurs (2 octets)
WriteData (*MemoryID, 40) ; On écrit dans le fichier les 40 octets du second entête
FreeMemory (*MemoryID) ; On libère la zone mémoire pour ne pas l'encombrer
EndIf
; Palette (RGBQUAD)
*MemoryID = AllocateMemory (8192) ; On alloue une zone mémoire de 1024*8 bit pour la palette indexée
If *MemoryID
For i=0 To 255 ; On fait défiler les 256 couleurs contenues dans notre tableau
PokeB (*MemoryID+(i*4), Blue (palette(i))) ; On écrit la composante "blue" de la couleur (1 octet)
PokeB (*MemoryID+1+(i*4), Green (palette(i))) ; On écrit la composante "green" de la couleur (1 octet)
PokeB (*MemoryID+2+(i*4), Red (palette(i))) ; On écrit la composante "red" de la couleur (1 octet)
Next i
WriteData (*MemoryID, 1024) ; On écrit dans le fichier les 1024 octets de la palette
FreeMemory (*MemoryID) ; On libère la zone mémoire pour ne pas l'encombrer
EndIf
; Zone de donnees
UseImage ( ImageID ) ; On utilise la bonne image (on ne sait jamais)
StartDrawing ( ImageOutput ()) ; On commence le dessin
For y=hauteur-1 To 0 Step -1 ; On écrit les données de l'image de bas en haut
*MemoryID = AllocateMemory ((largeur+d)*8 ) ; On alloue une zone mémoire de (largeur+d)*8 bit (cf plus haut pour le d)
If *MemoryID
For x=0 To largeur-1 ; On écrit ensuite les données de l'image de gauche à droite
c = Point (x, y) ; On récupère la couleur du point de coordonnées (x,y) de l'image
For i=0 To 255 ; On cherche la couleur de ce point parmis les 256 possibilités de la palette
If c = palette(i) ; Si on trouve la couleur (attention la réduction d'une image en 24 bit n'est pas traitée dans ce tutorial)
PokeB (*MemoryID+x, i) ; On écrit l'index de la couleur correspondante (1 octet)
Break ; On casse la boucle pas la peine de tester des valeurs innutiles
EndIf
Next i
Next x
WriteData (*MemoryID, largeur+d)
FreeMemory (*MemoryID) ; On libère la zone mémoire pour ne pas l'encombrer de plus de largeur+d octets
EndIf ; (Une image 5000*5000 en 24bit prend 72Mo dans la mémoire, vous comprenez pourquoi on la vide au fur et à mesure maintenant ;p)
Next y
StopDrawing () ; On arrete le dessin
CloseFile (fileID) ; On ferme le fichier
EndIf
EndProcedure

temps1 = ElapsedMilliseconds ()
SaveBmp8bit(imageID, #largeur , #hauteur , repertoire.s) ; Ne pas oublier de créer une palette dans le tableau palette(256)
temps2 = ElapsedMilliseconds ()

;N'oubliez pas de désactiver le débogueur pour tester la vitesse réelle
MessageRequester ( "N'oubliez pas de désactiver le débogueur" , "L'image en format bmp 8bit (256 couleurs) à été codé en " + Str (temps2-temps1)+ " ms" , #PB_MessageRequester_Ok )

Par contre l'indentation est présente

l'indentation ne fonctionne QU'AVEC INTERNET EXPLORER !!!
c'est independant de ma volonté , Mozilla et compagnie Bouffent le Charactere asci 160 !!

T'es sûr ?
Je viens de recharger cette même page
http://purebasic.hmt-forum.com/viewtopic.php?t=4097
sous IE, elle n'y ait pas non plus, l'indentation

Tu la vois toi ?
A moins qu'il me la bouffe dès le départ, l'indentation ?
Non car quand je colle dans le bloc Note, pour vérification, elle y est !

J'ai tout retesté, au départ, à l'arrivée, après la colorisation, l'indentation est là, avec vérification dans le bloc Note
Donc, c'est ailleurs que celà foire

Ou alors IE la bouffe aussi!

Et je vois très bien les indentations dans ton thread sur le colorisateur avec Firefox

http://purebasic.hmt-forum.com/viewtopi ... &start=135

Bon je viens de refaire toute la manip sous IE
On la voit l'indentation

C'est donc au moment du collage dans l'éditeur de texte Sous Firfox que cela se produit la non prise en compte de ce fichu caractère ASC 160?
Et tu peux pas mettre un caractère bidon en couleur blanche pour palier ce défaut du renard roux ?

Blanc sur blanc c'est plus qu'invisible dans les 2 navigateurs

Ni vu ni connu, je t'embrouille

faut même pas y penser tout le monde n'a pas un fond blanc...
J'ai pas testé le code mais au premier coup d'oeil je peux dire qu'on pourrait faire beaucoup plus propre que tous ces peek/poke...

Dri

Très sympa ton tut et très bien commenté .

c'est vrai que tu pourrais remplacer les peek et les poke , d'autant plus que tu as indiqué les structures à utiliser .
L'intérêt d'utiliser les structures c'est que tu n'as pas compter les octets , genre

PokeL(*MemoryID+4,xx)

. tu as vite fait de te gourrer de quelques octets en faisant comme ça .

Bon j'ai pas testé , mais ça pourrait donner un truc de ce genre

Code : Tout sélectionner

; ********************************************************************************************
; ********************************** Tutorial par Gratteur  **********************************
; ****** Comment sauvegarder une image en format bmp 256 couleurs avec palette indexée  ******
; *** N'oubliez pas de désactiver le débogueur pour tester la performance d'un algorithme  ***
; ******************************** Version du 9 décembre 2005 ********************************
; ********************************************************************************************

; On définit la largeur et la hauteur de l'image
#largeur = 800
#hauteur = 600
repertoire.s = "imagetest.bmp" ; Le répertoire de l'image
; On crée un tableau dans lequel on stock les 256 couleurs de la palette (ici aléatoires)
Dim palette.l(255)
For y=0 To 15
  For x=0 To 15
    palette(i) = RGB(Random(255), Random(255), Random(255))
    i+1
  Next x
Next y
; On crée une image avec des valeures prises dans la palette
imageID = CreateImage(#PB_Any, #largeur, #hauteur)
StartDrawing(ImageOutput())
For y=0 To #hauteur-1
  For x=0 To #largeur-1
    Plot(x, y, palette(Random(255)))
  Next x
Next y
StopDrawing()

; Procedure d'encodage de l'image (fichier.s doit se terminer par .bmp)
; Tout ce qui prend comme valeur $00 comme les champs réservés et autres octets pour le codage RLE et dont on ne se sert pas ne sont pas détaillés pour simplifier
Procedure SaveBmp8bit(ImageID, largeur, hauteur, fichier.s)
  fileID = CreateFile(#PB_Any, fichier.s) ; On crée le fichier dans lequel seront stockées les données
  If fileID
    While (largeur+d)%4 > 0 ; Dans la zone des donnees, la largeur de chaque ligne en octet doit être un multiple de 4
      d+1
    Wend
     ; Premiere entete (BITMAPFILEHEADER)
    *MemoryID = AllocateMemory(112) ; On alloue une zone mémoire de 14*8 bit pour le premier entête
      
    If *MemoryID
    	*Entete.BITMAPFILEHEADER=*MemoryID
      *Entete\bfType=$424D                    ; $424D est le code d'un Bitmap Windows (2 octets)
      *Entete\bfSize=54+((largeur+d)*hauteur) ; Taille totale du fichier (4 octets)
      *Entete\bfOffBits=54+1024               ; Offset de l'image (4 octets)
      WriteData(*MemoryID, 14) ; On écrit dans le fichier les 14 octets du premier entête
      FreeMemory(*MemoryID) ; On libère la zone mémoire pour ne pas l'encombrer
    EndIf
    ; Deuxieme entete (BITMAPINFOHEADER)
    *MemoryID = AllocateMemory(320) ; On alloue une zone mémoire de 40*8 bit pour le second entête
    If *MemoryID
      *Info.BITMAPINFOHEADER=*MemoryID
      *Info\biSize=$28       ; $28 pour Windows, ($0C pour OS/2 1.x, $F0 pour OS/2 2.x) (1 octet)
      *Info\biWidth=largeur  ; La largeur de l'image (4 octets)
      *Info\biHeight=hauteur ; La hauteur de l'image (4 octets)
      *Info\biPlanes=1       ; Le nombre de plans (1 dans tous les cas) (1 octet)
      *Info\biBitCount=8     ; La profondeur des couleurs, ici 8 pour 8bit soit 256 couleurs (2 octets)
      WriteData(*MemoryID, 40) ; On écrit dans le fichier les 40 octets du second entête
      FreeMemory(*MemoryID) ; On libère la zone mémoire pour ne pas l'encombrer
    EndIf
    ; Palette (RGBQUAD)
    *MemoryID = AllocateMemory(8192) ; On alloue une zone mémoire de 1024*8 bit pour la palette indexée
    If *MemoryID
    	*Palette.RGBQUAD=*MemoryID
      For i=0 To 255 ; On fait défiler les 256 couleurs contenues dans notre tableau
        *palette\rgbBlue=Blue(palette(i))  ; On écrit la composante "blue" de la couleur (1 octet)
        *palette\rgbGreen=Green(palette(i)); On écrit la composante "green" de la couleur (1 octet)
        *palette\rgbRed=Red(palette(i))    ; On écrit la composante "red" de la couleur (1 octet)
        *palette + SizeOf(RGBQUAD)
      Next i
      WriteData(*MemoryID, 1024) ; On écrit dans le fichier les 1024 octets de la palette
      FreeMemory(*MemoryID) ; On libère la zone mémoire pour ne pas l'encombrer
    EndIf
    ; Zone de donnees
    UseImage(ImageID) ; On utilise la bonne image (on ne sait jamais)
    StartDrawing(ImageOutput()) ; On commence le dessin
    For y=hauteur-1 To 0 Step -1 ; On écrit les données de l'image de bas en haut
      *MemoryID = AllocateMemory((largeur+d)*8) ; On alloue une zone mémoire de (largeur+d)*8 bit (cf plus haut pour le d)
      If *MemoryID
        For x=0 To largeur-1 ; On écrit ensuite les données de l'image de gauche à droite
          c = Point(x, y) ; On récupère la couleur du point de coordonnées (x,y) de l'image
          For i=0 To 255 ; On cherche la couleur de ce point parmis les 256 possibilités de la palette
            If c = palette(i) ; Si on trouve la couleur (attention la réduction d'une image en 24 bit n'est pas traitée dans ce tutorial)
              PokeB(*MemoryID+x, i) ; On écrit l'index de la couleur correspondante (1 octet)
              Break ; On casse la boucle pas la peine de tester des valeurs innutiles
            EndIf
          Next i
        Next x
        WriteData(*MemoryID, largeur+d)
        FreeMemory(*MemoryID) ; On libère la zone mémoire pour ne pas l'encombrer de plus de largeur+d octets
      EndIf ; (Une image 5000*5000 en 24bit prend 72Mo dans la mémoire, vous comprenez pourquoi on la vide au fur et à mesure maintenant ;p)
    Next y
    StopDrawing() ; On arrete le dessin
    CloseFile(fileID) ; On ferme le fichier
  EndIf
EndProcedure

temps1 = ElapsedMilliseconds()
SaveBmp8bit(imageID, #largeur, #hauteur, repertoire.s) ; Ne pas oublier de créer une palette dans le tableau palette(255)
temps2 = ElapsedMilliseconds()

;N'oubliez pas de désactiver le débogueur pour tester la vitesse réelle
MessageRequester("N'oubliez pas de désactiver le débogueur", "L'image en format bmp 8bit (256 couleurs) à été codé en "+Str(temps2-temps1)+" ms", #PB_MessageRequester_Ok)

Ca revient au même en terme de vitesse mais c'est vrai que c'est plus clair.

C'est probablement plus rapide parce qu'il n'y a pas d'appel de fonction... Sinon c'est bien à ca que je pensais

Dri

C'est plus simple d'allouer un espace mémoire mémoire en faisant référence à la taille de la structure ,et c'est aussi plus parlant.

C'est la dernière proposition :p

Code : Tout sélectionner

     ; Premiere entete (BITMAPFILEHEADER)
    *Entete.BITMAPFILEHEADER = AllocateMemory(SizeOf(BITMAPFILEHEADER)) ; On alloue une zone mémoire pour le premier entête
     
    If *Entete
      *Entete\bfType=$4D42                    ; $424D est le code d'un Bitmap Windows (2 octets)
      *Entete\bfSize=54+((largeur+d)*hauteur) ; Taille totale du fichier (4 octets)
      *Entete\bfOffBits=54+1024               ; Offset de l'image (4 octets)
      WriteData(*Entete, SizeOf(BITMAPFILEHEADER)) ; On écrit dans le fichier les 14 octets du premier entête
      FreeMemory(*Entete) ; On libère la zone mémoire pour ne pas l'encombrer
    EndIf
    
    ; Deuxieme entete (BITMAPINFOHEADER)
    *Info.BITMAPINFOHEADER= AllocateMemory(SizeOf(BITMAPINFOHEADER)) ; On alloue une zone mémoire pour le second entête
    If *Info
      *Info\biSize=$28       ; $28 pour Windows, ($0C pour OS/2 1.x, $F0 pour OS/2 2.x) (1 octet)
      *Info\biWidth=largeur  ; La largeur de l'image (4 octets)
      *Info\biHeight=hauteur ; La hauteur de l'image (4 octets)
      *Info\biPlanes=1       ; Le nombre de plans (1 dans tous les cas) (1 octet)
      *Info\biBitCount=8     ; La profondeur des couleurs, ici 8 pour 8bit soit 256 couleurs (2 octets)
      WriteData(*Info, SizeOf(BITMAPINFOHEADER)) ; On écrit dans le fichier les 40 octets du second entête
      FreeMemory(*Info) ; On libère la zone mémoire pour ne pas l'encombrer
    EndIf
    
    ; Palette (RGBQUAD)
    *Palette.RGBQUAD = AllocateMemory(256*SizeOf(RGBQUAD)) ; On alloue une zone mémoire pour la palette indexée
    *pPalette.RGBQUAD = *Palette
    If *Palette
      For i=0 To 255 ; On fait défiler les 256 couleurs contenues dans notre tableau
        *pPalette\rgbBlue=Blue(palette(i))  ; On écrit la composante "blue" de la couleur (1 octet)
        *pPalette\rgbGreen=Green(palette(i)); On écrit la composante "green" de la couleur (1 octet)
        *pPalette\rgbRed=Red(palette(i))    ; On écrit la composante "red" de la couleur (1 octet)
        *pPalette + SizeOf(RGBQUAD)
      Next i
      WriteData(*Palette, 256*SizeOf(RGBQUAD)) ; On écrit dans le fichier les 1024 octets de la palette
      FreeMemory(*Palette) ; On libère la zone mémoire pour ne pas l'encombrer
    EndIf

C'est beaucoup plus joli mais bizarement ca me rend un temps légèrement plus élevé qu'avec des Poke. En tout cas je te remercie du conseil, c'est la première fois que je bosse avec des AllocateMemory() et dans la doc ca ne parlait pas de ta méthode.

Edit : Après vérifiation ca prend exactement le même temps mais la méthode de comtois est meilleure surtout dans des cas plus compliqués ^^

Au final le code complet donne ça :

Code : Tout sélectionner

; On définit la largeur et la hauteur de l'image
#largeur = 800
#hauteur = 600
repertoire.s = "imagetest.bmp" ; Le répertoire de l'image
; On crée un tableau dans lequel on stock les 256 couleurs de la palette (ici aléatoires)
Dim palette.l(255)
For y=0 To 15
  For x=0 To 15
    palette(i) = RGB(Random(255), Random(255), Random(255))
    i+1
  Next x
Next y
; On crée une image avec des valeures prises dans la palette
imageID = CreateImage(#PB_Any, #largeur, #hauteur)
StartDrawing(ImageOutput())
For y=0 To #hauteur-1
  For x=0 To #largeur-1
    Plot(x, y, palette(Random(255)))
  Next x
Next y
StopDrawing()

; Procedure d'encodage de l'image (fichier.s doit se terminer par .bmp)
; Tout ce qui prend comme valeur $00 comme les champs réservés et autres octets pour le codage RLE et dont on ne se sert pas ne sont pas détaillés pour simplifier
Procedure SaveBmp8bit(ImageID, largeur, hauteur, fichier.s)
  fileID = CreateFile(#PB_Any, fichier.s) ; On crée le fichier dans lequel seront stockées les données
  If fileID
    While (largeur+d)%4 > 0 ; Dans la zone des donnees, la largeur de chaque ligne en octet doit être un multiple de 4
      d+1
    Wend
     ; Premiere entete (BITMAPFILEHEADER)
    *Entete.BITMAPFILEHEADER = AllocateMemory(SizeOf(BITMAPFILEHEADER)) ; On alloue une zone mémoire pour le premier entête
    If *Entete
      *Entete\bfType = $4D42                    ; $424D est le code d'un Bitmap Windows (2 octets)
      *Entete\bfSize = 54+((largeur+d)*hauteur) ; Taille totale du fichier (4 octets)
      *Entete\bfOffBits = 54+1024               ; Offset de l'image (4 octets)
      WriteData(*Entete, SizeOf(BITMAPFILEHEADER)) ; On écrit dans le fichier les 14 octets du premier entête
      FreeMemory(*Entete) ; On libère la zone mémoire pour ne pas l'encombrer
    EndIf
    ; Deuxieme entete (BITMAPINFOHEADER)
    *Info.BITMAPINFOHEADER = AllocateMemory(SizeOf(BITMAPINFOHEADER)) ; On alloue une zone mémoire pour le second entête
    If *Info
      *Info\biSize = $28       ; $28 pour Windows, ($0C pour OS/2 1.x, $F0 pour OS/2 2.x) (1 octet)
      *Info\biWidth = largeur  ; La largeur de l'image (4 octets)
      *Info\biHeight = hauteur ; La hauteur de l'image (4 octets)
      *Info\biPlanes = 1       ; Le nombre de plans (1 dans tous les cas) (1 octet)
      *Info\biBitCount = 8     ; La profondeur des couleurs, ici 8 pour 8bit soit 256 couleurs (2 octets)
      WriteData(*Info, SizeOf(BITMAPINFOHEADER)) ; On écrit dans le fichier les 40 octets du second entête
      FreeMemory(*Info) ; On libère la zone mémoire pour ne pas l'encombrer
    EndIf
    ; Palette (RGBQUAD)
    *Palette.RGBQUAD = AllocateMemory(256*SizeOf(RGBQUAD)) ; On alloue une zone mémoire pour la palette indexée
    If *Palette
      For i=0 To 255 ; On fait défiler les 256 couleurs contenues dans notre tableau
        *Palette\rgbBlue = Blue(palette(i))  ; On écrit la composante "blue" de la couleur (1 octet)
        *Palette\rgbGreen = Green(palette(i)); On écrit la composante "green" de la couleur (1 octet)
        *Palette\rgbRed = Red(palette(i))    ; On écrit la composante "red" de la couleur (1 octet)
        *Palette + SizeOf(RGBQUAD)
      Next i
      *Palette-(256*SizeOf(RGBQUAD))
      WriteData(*Palette, 256*SizeOf(RGBQUAD)) ; On écrit dans le fichier les 1024 octets de la palette
      FreeMemory(*Palette) ; On libère la zone mémoire pour ne pas l'encombrer
    EndIf
    ; Zone de donnees
    UseImage(ImageID) ; On utilise la bonne image (on ne sait jamais)
    StartDrawing(ImageOutput()) ; On commence le dessin
    For y=hauteur-1 To 0 Step -1 ; On écrit les données de l'image de bas en haut
      *MemoryID = AllocateMemory((largeur+d)*8) ; On alloue une zone mémoire de (largeur+d)*8 bit (cf plus haut pour le d)
      If *MemoryID
        For x=0 To largeur-1 ; On écrit ensuite les données de l'image de gauche à droite
          c = Point(x, y) ; On récupère la couleur du point de coordonnées (x,y) de l'image
          For i=0 To 255 ; On cherche la couleur de ce point parmis les 256 possibilités de la palette
            If c = palette(i) ; Si on trouve la couleur (attention la réduction d'une image en 24 bit n'est pas traitée dans ce tutorial)
              PokeB(*MemoryID+x, i) ; On écrit l'index de la couleur correspondante (1 octet)
              Break ; On casse la boucle pas la peine de tester des valeurs innutiles
            EndIf
          Next i
        Next x
        WriteData(*MemoryID, largeur+d)
        FreeMemory(*MemoryID) ; On libère la zone mémoire pour ne pas l'encombrer de plus de largeur+d octets
      EndIf ; (Une image 5000*5000 en 24bit prend 72Mo dans la mémoire, vous comprenez pourquoi on la vide au fur et à mesure maintenant ;p)
    Next y
    StopDrawing() ; On arrete le dessin
    CloseFile(fileID) ; On ferme le fichier
  EndIf
EndProcedure

temps1 = ElapsedMilliseconds()
SaveBmp8bit(imageID, #largeur, #hauteur, repertoire.s) ; Ne pas oublier de créer une palette dans le tableau palette(255)
temps2 = ElapsedMilliseconds()

;N'oubliez pas de désactiver le débogueur pour tester la vitesse réelle
MessageRequester("N'oubliez pas de désactiver le débogueur", "L'image en format bmp 8bit (256 couleurs) à été codé en "+Str(temps2-temps1)+" ms", #PB_MessageRequester_Ok)

PureBasic

[Tuto] Enregistrer une image en format bmp 256 couleur

[Tuto] Enregistrer une image en format bmp 256 couleur