Sauver une image bitmap

En GFA-Basic
Accueil

Cette procédure permet de sauvegarder une image précédemment créée avec un GET ou un LOADBMP au format BMP quelquesoit le mode de couleur 4,8,16,24 ou 32 bits. Attention, car pour un souci de simplicité le fichier écrit est toujours en 32 bits couleurs. Ceci n'est pas gênant pour le fonctionnement mais il faut le savoir.
Pour utiliser cette procédure suivez cet exemple :
LISTING en GFA-Basic
Faites un copier-coller
PROCEDURE sauver_bmp(bmp%,fic$)
 LOCAL a$,LX%,LY%,x%,y%,BITPP%,Ligne%,sf%,L_O%,L_OFFSET_4%
 ' Lire la taille et le nombre de bits par pixel du bitmap á sauver
 a$ = SPACE$(40)
 VOID GetObject(bmp%,40,V:a$)
 LX% = WORD{V:a$ + 2}          ' Largeur
 LY% = WORD{V:a$ + 4}          ' Hauteur
 BITPP% = BYTE{V:a$ + 9}       ' Bits par pixel
 ' Calcul de la taille en octets occupêe par une ligne du bitmap original
 IF BITPP% = 32
   Ligne% = LX% * 4
 ELSE IF BITPP% = 24
   Ligne% = LX% * 3
   Ligne% = MUL(DIV(Ligne% + 1,2),2)
 ELSE IF BITPP% = 16
   Ligne% = LX% * 2
   Ligne% = MUL(DIV(Ligne% + 1,2),2)
 ELSE IF BITPP% = 8
   DIM SAUVER_BMP_PAL%(255)
   VOID GetPaletteEntries(_PAL(1),0,256,V:SAUVER_BMP_PAL%(0))
   Ligne% = LX%
   Ligne% = MUL(DIV(Ligne% + 1,2),2)
 ELSE IF BITPP% = 4
   DIM SAUVER_BMP_PAL%(15)
   VOID GetPaletteEntries(_PAL(1),0,16,V:SAUVER_BMP_PAL%(0))
   Ligne% = DIV(SUCC(LX%),2)
   Ligne% = MUL(DIV(Ligne% + 1,2),2)
 ENDIF
 sf% = LY% * Ligne%
 DIM sauver_bmp_o|(sf%)
 VOID GetBitmapBits(bmp%,sf%,V:sauver_bmp_o|(0))

 OPEN "o",#1,fic$
 'HEADER
 OUT& #1,19778  ' Signature ficher BMP ("BM")
 OUT% #1,12 + 40 + LY% * LX% * 4 ' Taille du fichier en octets, á calculer !
 OUT& #1,0 ' Rêservê
 OUT& #1,0 ' Rêservê
 OUT% #1,54 'Offset de l'image, á calculer
 ' BITMAP INFO
 OUT% #1,40 + (bitpp& = 8 * -1024) ' Taille de la zone BITMAP INFO
 OUT% #1,LX%  ' Largeur en pixels
 OUT% #1,LY%  ' Hauteur en pixels
 OUT& #1,1 ' Nombre de plans
 OUT& #1,32 ' Bit par pixel 1=monochrome 4=16 couleurs 8=256 24=16 millions
 OUT% #1,0  ' 0=non compressê 1= RLE8 2= RLE4
 OUT% #1,LY% * LX% * 4 ' Taille de l'image en octets
 OUT% #1,5000 ' pixels par métre en largeur
 OUT% #1,5000 ' pixels par métre en hauteur
 OUT% #1,0 ' Nombre de couleurs
 OUT% #1,0 ' couleurs importantes
 FOR y% = PRED(LY%) DOWNTO 0
   ' L_O% correspond au dêplacement par rapport au dêbut de l'image
   ' pour lire la ligne y%
   L_O% = MUL(y%,Ligne%)
   CLR L_OFFSET_4%
   FOR x% = 0 TO PRED(LX%)
     ' Lire les composantes RGB de chaques pixels
      IF BITPP% = 32
       r% = sauver_bmp_o|(L_O% + 2),g% = sauver_bmp_o|(L_O% + 1),b% = sauver_bmp_o|(L_O%)
       ADD L_O%,4
     ELSE IF BITPP% = 24
       r% = sauver_bmp_o|(L_O% + 2),g% = sauver_bmp_o|(L_O% + 1),b% = sauver_bmp_o|(L_O%)
       ADD L_O%,3
     ELSE IF BITPP% = 16
       v% = ADD(sauver_bmp_o|(L_O%) , SHL(sauver_bmp_o|(SUCC(L_O%)),8))
       r% = SHR(AND(v%,&X1111100000000000),11) * 8.225
       g% = SHR(AND(v%,&X0000011111100000),5) * 4.047
       b% = AND(v%,&X0000000000011111) * 8.225
       ADD L_O%,2
     ELSE IF BITPP% = 8
       v% = SAUVER_BMP_PAL%(sauver_bmp_o|(L_O%))
       b% = PEEK(V:v%),g% = PEEK(V:v% + 1),r% = PEEK(V:v% + 2)
       INC L_O%
     ELSE IF BITPP% = 4
       L_OFFSET_4% = NOT L_OFFSET_4%
       IF L_OFFSET_4% = TRUE
         v% = SAUVER_BMP_PAL%(MOD(sauver_bmp_o|(L_O%),16))
         INC L_O%
       ELSE
         v% = SAUVER_BMP_PAL%(DIV(sauver_bmp_o|(L_O%),16))
       ENDIF
       b% = PEEK(V:v%),g% = PEEK(V:v% + 1),r% = PEEK(V:v% + 2)
     ENDIF
     OUT| #1,b%,g%,r%,0  ' êcrit un pixel (on est en mode 32 bits uniquement)
   NEXT x%
 NEXT y%
 CLOSE #1
 ERASE sauver_bmp_o|()
 IF BITPP% = 8 OR BITPP% = 4
   ERASE SAUVER_BMP_PAL%()
 ENDIF
RETURN