Dessin de sprites ou d'icônes

' Création d'icônes ou de sprites
LABEL Quit,Appliq,Couleur,Transpar,Moddes,Clk,Annul,Coptopic,Pictocop,Decalim
LABEL Lire,Sauve,Zzm,Aide
DIM w%,h%,wg%,hg%,x%,y%,c%,r%,xc%(1000),yr%(1000),i%,j%,k%,cf%,ct%,rr%,gg%,bb%
DIM coul%(1000,1000),cx%,cc%,rc%,ra%,ga%,ba%,x1%,y1%,a$,b$,q$,v%(10),iv$
DIM ftm$,ftm1$
ftm$ = "C:\TEMP\Imgtmp.bmp"
ftm1$ = "C:\TEMP\ImgTmp1.bmp"
' iv$ = "C:\Progra~2\Irfanv~1\i_view64.exe"

w% = 24: h% = 24: ' dimensions de la grille (colonnes, rangées)
wg% = 16: hg% = 16: ' dimension des éléments (largeur, hauteur, en pixels)
cf% = 164: ' couleur de la grille
ct% = 210: ' couleur de transparence
BORDER_SMALL 0: CAPTION 0,"": FONT_NAME 0,"Arial": FONT_BOLD 0
    COLOR 0,180,255,255: ON_CLOSE 0,Quit
    CAPTION 0,"  -  CRÉATION  D ' ICÔNES  OU  SPRITES  -"
PICTURE 1: WIDTH 1,w%*wg%+1: HEIGHT 1,h%*wg%+1: COLOR 1,ct%,ct%,ct%
    ON_CLICK 1,Clk
PICTURE 100: WIDTH 100,w%: HEIGHT 100,h%: COLOR 100,ct%,ct%,ct%: ' image du Picture 1
    TOP 100,HEIGHT(1)+5: LEFT 100,5
2D_TARGET_IS 1: 2D_PEN_COLOR cf%-1,cf%,cf%+1: ' pour garder la grille
c% = 1
FOR x% = 0 TO WIDTH(1) STEP hg%
    2D_LINE x%,0,x%,HEIGHT(1)
    xc%(c%) = x%: c% = c%+1
NEXT x%
r% = 1
FOR y% = 0 TO HEIGHT(1) STEP hg%
    2D_LINE 0,y%,WIDTH(1),y%
    yr%(r%) = y%: r% = r%+1
NEXT y%
ALPHA 6: TOP 6,TOP(1)+HEIGHT(1)+2: LEFT 6,w%+10: FONT_COLOR 6,164,0,0: FONT_ITALIC 6
    FONT_SIZE 6,11: COLOR 6,255,255,128: CAPTION 6," Cliquer le point à colorer "
BUTTON 7: TOP 7,TOP(6)+20: WIDTH 7,90: LEFT 7,LEFT(6)
    HEIGHT 7,20: CAPTION 7,"Annul dernier": ON_CLICK 7,Annul
   
CONTAINER 10: LEFT 10,WIDTH(1)+5: WIDTH 10,220: HEIGHT 10,480: COLOR 10,255,255,200
ALPHA 24: PARENT 24,10: TOP 24,7: LEFT 24,5: CAPTION 24,"Img (JPG,BMP,ICO): "
    COLOR 24,255,255,0
EDIT 25: PARENT 25,10: TOP 25,TOP(24)+17: LEFT 25,2: WIDTH 25,WIDTH(10)-2
    COLOR 25,200,255,200: FONT_BOLD_OFF 25: TEXT 25," (clic)": ON_CLICK 25,Lire
CHECK 28: PARENT 28,10: WIDTH 28,65: TOP 28,TOP(24): LEFT 28, WIDTH(10)/2+10
    CAPTION 28,"Adapter"
OPEN_DIALOG 26: FILTER 26,"Image bitmap|*.bmp;*.jpg;*.ico"
BUTTON 27: PARENT 27,10: TOP 27,1: WIDTH 27,25: LEFT 27,WIDTH(10)-26: CAPTION 27,"?"
    ON_CLICK 27,Aide
   
ALPHA 11: PARENT 11,10: TOP 11,TOP(25)+27: LEFT 11,5: CAPTION 11," GRILLE : ": COLOR 11,255,255,0
ALPHA 12: PARENT 12,10: TOP 12,TOP(11)+20: LEFT 12,5
    CAPTION 12,"Colonnes:              Rangées:"
SPIN 13: PARENT 13,10: TOP 13,TOP(12)-3: LEFT 13,65: WIDTH 13,40
SPIN 14: PARENT 14,10: TOP 14,TOP(13): LEFT 14,LEFT(13)+100: WIDTH 14,WIDTH(13)
    POSITION 13,w%: POSITION 14,h%
   
ALPHA 15: PARENT 15,10: TOP 15,TOP(14)+30: LEFT 15,5
    CAPTION 15," UN ÉLÉMENT DE LA GRILLE (=1 pixel) : "
    COLOR 15,255,255,0
ALPHA 16: PARENT 16,10: TOP 16,TOP(15)+20: LEFT 16,5
    CAPTION 16,"  Largeur:                  Hauteur:"
SPIN 17: PARENT 17,10: TOP 17,TOP(16)-3: LEFT 17,LEFT(13): WIDTH 17,WIDTH(13)
SPIN 18: PARENT 18,10: TOP 18,TOP(17): LEFT 18,LEFT(14): WIDTH 18,WIDTH(14)
    POSITION 17,wg%: POSITION 18,hg%
BUTTON 20: PARENT 20,10: TOP 20,TOP(17)+25: LEFT 20,WIDTH(10)/2-80: WIDTH 20,150
    CAPTION 20,"Appliquer les paramètres": ON_CLICK 20,Appliq
   
ALPHA 29: PARENT 29,10: TOP 29,TOP(20)+35: LEFT 29,5: CAPTION 29," COULEUR PINCEAU : "
    COLOR 29,255,255,0
PICTURE 30: PARENT 30,10: TOP 30,TOP(29)+16: LEFT 30,5: WIDTH 30,WIDTH(10)-15
    HEIGHT 30,70
    2D_TARGET_IS 30: 2D_FILL_COLOR 1,1,1: 2D_RECTANGLE 5,3,45,40: ' couleur choisie
    i% = 60: j% = 5: k% = 16: 2D_FILL_COLOR 1,1,1: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = i%+18: 2D_FILL_COLOR 0,0,128: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = i%+18: 2D_FILL_COLOR 0,128,0: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = i%+18: 2D_FILL_COLOR 0,128,128: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = i%+18: 2D_FILL_COLOR 128,0,0: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = i%+18: 2D_FILL_COLOR 128,0,128: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = i%+18: 2D_FILL_COLOR 128,64,0: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = i%+18: 2D_FILL_COLOR 192,192,192: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = 60: j% = 23: 2D_FILL_COLOR 128,128,128: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = i%+18: 2D_FILL_COLOR 0,0,255: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = i%+18: 2D_FILL_COLOR 0,255,0: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = i%+18: 2D_FILL_COLOR 0,255,255: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = i%+18: 2D_FILL_COLOR 255,0,0: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = i%+18: 2D_FILL_COLOR 255,0,255: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = i%+18: 2D_FILL_COLOR 255,255,0: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = i%+18: 2D_FILL_COLOR 255,255,255: 2D_RECTANGLE i%,j%,i%+k%,j%+16
    i% = 60: j% = 45: 2D_FILL_COLOR ct%,ct%,ct%: 2D_RECTANGLE i%,j%,i%+25,j%+22: ' transp.
    ON_CLICK 30,Couleur
    PRINT_TARGET_IS 30
    PRINT_LOCATE i%+30,j%-3: PRINT "Gomme (transparence)"
    PRINT_LOCATE i%+30,j%+11: PRINT "R=G=B="
EDIT 32: PARENT 32,10: TOP 32,TOP(30)+HEIGHT(30)-17: LEFT 32,LEFT(30)+140
    WIDTH 32,30: HEIGHT 32,16: COLOR 32,255,210,210: TEXT 32,STR$(ct%)
BUTTON 33: PARENT 33,10: TOP 33,TOP(32): WIDTH 33,25: LEFT 33,LEFT(32)+WIDTH(32)+1
    HEIGHT 33,20: CAPTION 33,"OK": ON_CLICK 33,Transpar

ALPHA 40: PARENT 40,10: TOP 40,TOP(30)+HEIGHT(30)+10: LEFT 40,5
    CAPTION 40," ACTION :": COLOR 40,255,255,0
CONTAINER_OPTION 41: PARENT 41,10: TOP 41,TOP(40)+15: LEFT 41,5
    WIDTH 41,210: HEIGHT 41,48: COLOR 41,255,200,200
    OPTION 42: PARENT 42,41: TOP 42,8: LEFT 42,2: CAPTION 42,"Point": MARK_ON 42
    OPTION 43: PARENT 43,41: TOP 43,TOP(42): LEFT 43,LEFT(42)+48: CAPTION 43,"Trait"
    OPTION 44: PARENT 44,41: TOP 44,TOP(43): LEFT 44,LEFT(43)+48: CAPTION 44,"Rect."
    OPTION 45: PARENT 45,41: TOP 45,TOP(44): LEFT 45,LEFT(44)+48: CAPTION 45,"Remplir"
    OPTION 46: PARENT 46,41: TOP 46,TOP(42)+18: LEFT 46,LEFT(42): CAPTION 46,"Couleur pixel"
    FOR i% = 42 TO 46: ON_CLICK i%,Moddes: NEXT i%
EDIT 47: PARENT 47,10: TOP 47,TOP(41)+25: LEFT 47,102: HEIGHT 47,19: WIDTH 47,108

ALPHA 50: PARENT 50,10: TOP 50,TOP(41)+HEIGHT(41)+6: LEFT 50,5: CAPTION 50,"Décalage 1 pixel:"
i% = 30
BUTTON 51: PARENT 51,10: TOP 51,TOP(50)-4: WIDTH 51,i%: LEFT 51,95
BUTTON 52: PARENT 52,10: TOP 52,TOP(51): WIDTH 52,i%: LEFT 52,LEFT(51)+i%
BUTTON 53: PARENT 53,10: TOP 53,TOP(52): WIDTH 53,i%: LEFT 53,LEFT(52)+i%
BUTTON 54: PARENT 54,10: TOP 54,TOP(53): WIDTH 54,i%: LEFT 54,LEFT(53)+i%
FOR i% = 51 TO 54
    FONT_NAME i%,"Wingdings": CAPTION i%,CHR$(i%+180): ON_CLICK i%,Decalim
NEXT i%

ALPHA 60: PARENT 60,10: TOP 60,TOP(50)+30: LEFT 60,5
    CAPTION 60," SAUVEGARDE : ": COLOR 60,255,255,0
CONTAINER_OPTION 61: PARENT 61,10: TOP 61,TOP(60)+15: LEFT 61,20
    WIDTH 61,180: HEIGHT 61,28: COLOR 61,255,200,200: CAPTION 61,"Format:"
    OPTION 62: PARENT 62,61: TOP 62,8: LEFT 62,60: CAPTION 62,"BMP": MARK_ON 62
    OPTION 63: PARENT 63,61: TOP 63,TOP(62): LEFT 63,LEFT(62)+60: CAPTION 63,"ICO"
EDIT 65: PARENT 65,10: TOP 65,TOP(61)+HEIGHT(61)+2: LEFT 65,2: WIDTH 65,WIDTH(10)-4
    COLOR 65,200,255,200: FONT_BOLD_OFF 65: TEXT 65," (clic)": ON_CLICK 65,Sauve
SAVE_DIALOG 66

BUTTON 70: PARENT 70,10: TOP 70,HEIGHT(10)-30: LEFT 70,WIDTH(10)-80
    CAPTION 70,"Quitter": ON_CLICK 70,Quit
BUTTON 71: PARENT 71,10: TOP 71,TOP(70): LEFT 71,5: WIDTH 71,25: CAPTION 71,"Z x"
    HEIGHT 71,20: ON_CLICK 71,Zzm
EDIT 72: PARENT 72,10: TOP 72,TOP(71): LEFT 72,LEFT(71)+WIDTH(71)-1: WIDTH 72,20
    HEIGHT 72,HEIGHT(71): TEXT 72,"8"

FORM 80: HIDE 80: BORDER_HIDE 80: WIDTH 80,150: HEIGHT 80,90: COLOR 80,255,255,0
    LEFT 80,(WIDTH(1)-WIDTH(80))/2: TOP 80,(HEIGHT(1)-HEIGHT(80))/2
ALPHA 81: PARENT 81,80: FONT_COLOR 81,255,0,0: FONT_SIZE 81,32: FONT_BOLD 81
    COLOR 81,255,255,0: CAPTION 81,"MOM..."
ALPHA 82: PARENT 82,80: FONT_SIZE 82,16: TOP 82,55: LEFT 82,30

IMAGE 99

    2D_TARGET_IS 1
    rr% = 1: gg% = 1: bb% = 1
    x1% = -1: y1% = -1
WIDTH 0,WIDTH(1)+WIDTH(10)+25: HEIGHT 0,HEIGHT(1)+h%+50
IF HEIGHT(0)<(HEIGHT(10)+40) THEN HEIGHT 0,HEIGHT(10)+40
END
' ==============================================================================
Quit:
TERMINATE
' ==============================================================================
Appliq:
  ' Appliquer les paramètres: colonnes/rangées, dimensions des cases
  w% = POSITION(13): h% = POSITION(14): wg% = POSITION(17): hg% = POSITION(18)
  WIDTH 1,w%*wg%+1: HEIGHT 1,h%*hg%+1
  LEFT 10,WIDTH(1)+5
  WIDTH 0,WIDTH(1)+WIDTH(10)+25: HEIGHT 0,HEIGHT(1)+h%+55
  IF HEIGHT(0)<(HEIGHT(10)+40) THEN HEIGHT 0,HEIGHT(10)+40
  COLOR 1,ct%,ct%,ct%
  c% = 1
  FOR x% = 0 TO WIDTH(1) STEP wg%
      2D_LINE x%,0,x%,HEIGHT(1)
      xc%(c%) = x%: c% = c%+1
  NEXT x%
  r% = 1
  FOR y% = 0 TO HEIGHT(1) STEP hg%
      2D_LINE 0,y%,WIDTH(1),y%
      yr%(r%) = y%: r% = r%+1
  NEXT y%
  TOP 6,TOP(1)+HEIGHT(1)+2: LEFT 6,w%+10: TOP 7,TOP(6)+20: LEFT 7,LEFT(6)
  TOP 100,HEIGHT(1)+5: WIDTH 100,w%: HEIGHT 100,h%: COLOR 100,ct%,ct%,ct%
  LEFT 80,(WIDTH(1)-WIDTH(80))/2: TOP 80,(HEIGHT(1)-HEIGHT(80))/2
RETURN
' ==============================================================================
Couleur:
  ' Clic sur une couleur
  x% = MOUSE_X_LEFT_DOWN(30): y% = MOUSE_Y_LEFT_DOWN(30)
  rr% = COLOR_PIXEL_RED(30,x%,y%)
  gg% = COLOR_PIXEL_GREEN(30,x%,y%)
  bb% = COLOR_PIXEL_BLUE(30,x%,y%)
  2D_TARGET_IS 30: 2D_FILL_COLOR rr%,gg%,bb%: 2D_RECTANGLE 5,3,45,40
  2D_TARGET_IS 100: 2D_PEN_COLOR rr%,gg%,bb%
  2D_TARGET_IS 1
RETURN
' ==============================================================================
Transpar:
  ' Changement de la couleur de transparence
  cx% = ct%
  ct% = VAL(TEXT$(32)): 2D_TARGET_IS 30
  i% = 60: j% = 43: 2D_FILL_COLOR ct%,ct%,ct%: 2D_RECTANGLE i%,j%,i%+25,j%+22
  2D_TARGET_IS 1
  FOR r% = 1 TO h%
      FOR c% = 1 TO w%
          ra% = COLOR_PIXEL_RED(1,xc%(c%)+2,yr%(r%)+2)
          ga% = COLOR_PIXEL_GREEN(1,xc%(c%)+2,yr%(r%)+2)
          ba% = COLOR_PIXEL_BLUE(1,xc%(c%)+2,yr%(r%)+2)
          IF ra%=cx% AND ga%=cx% AND ba%=cx%
              2D_FLOOD xc%(c%)+2,yr%(r%)+2,ct%,ct%,ct%
          END_IF
      NEXT c%
  NEXT r%
  GOSUB Pictocop: ' mise à jour de l'image pixels
RETURN
' ==============================================================================
Moddes:
  i% = NUMBER_CLICK
  SELECT i%
      CASE 42: CAPTION 6," Cliquer la case à colorer "
      CASE 43: CAPTION 6," Cliquer le point de départ "
      CASE 44: CAPTION 6," Cliquer le coin supérieur gauche "
      CASE 45: CAPTION 6," Cliquer un point de la zone "
      CASE 46: CAPTION 6," Cliquer le point à mesurer "
  END_SELECT
  TEXT 47,""
RETURN
' ==============================================================================
Clk:
  ' Clic sur une case du dessin
  CLIPBOARD_COPY 1: ' sauvegarde
  x% = MOUSE_X_LEFT_DOWN(1): y% = MOUSE_Y_LEFT_DOWN(1)
  c% = 1+INT(x%/wg%): r% = 1+INT(y%/hg%): ' colonne, rangée
  i% = COLOR_PIXEL_RED(1,x%,y%): IF i% = cf%-1 THEN RETURN: ' clic sur la grille
  IF CHECKED(42) = 1
      2D_FLOOD x%,y%,rr%,gg%,bb%: ' colorier le point
  ELSE
      IF CHECKED(43) = 1 OR CHECKED(44) = 1: ' Trait ou Rectangle
          IF x1% = -1
              2D_FLOOD x%,y%,rr%,gg%,bb%: ' colorier le point de départ
              x1% = c%-1: y1% = r%-1: ' départ de ligne
              IF CHECKED(43) = 1
                  CAPTION 6," Cliquer le point d'arrivée "
              ELSE
                  CAPTION 6," Cliquer le coin inférieur droit "
              END_IF
          ELSE
              cc% = INT(x%/wg%): rc% = INT(y%/hg%): ' point d'arrivée
              2D_TARGET_IS 100: 2D_PEN_COLOR rr%,gg%,bb%
              IF CHECKED(43) = 1: ' Trait
                  2D_LINE x1%,y1%,cc%,rc%
                  2D_POINT cc%,rc%: ' +1 pour forcer le dernier point
              ELSE: ' Rectangle
                  2D_FILL_OFF: 2D_RECTANGLE x1%,y1%,cc%+1,rc%+1
              END_IF
              GOSUB Coptopic
              x1% = -1: y1% = -1
              IF CHECKED(43) = 1
                  CAPTION 6," Cliquer le point de départ "
              ELSE
                  CAPTION 6," Cliquer le coin supérieur gauche "
              END_IF
          END_IF
      ELSE
          IF CHECKED(45) = 1: ' remplir
              cc% = INT(x%/wg%): rc% = INT(y%/hg%)
              2D_TARGET_IS 100: 2D_FLOOD cc%,rc%,rr%,gg%,bb%
              GOSUB Coptopic
          ELSE
              IF CHECKED(46) = 1
                  i%=COLOR_PIXEL_RED(1,x%,y%): j%=COLOR_PIXEL_GREEN(1,x%,y%)
                  k%=COLOR_PIXEL_BLUE(1,x%,y%)
                  TEXT 47,"R="+STR$(i%)+" G="+STR$(j%)+" B="+STR$(k%): RETURN
              END_IF
          END_IF
      END_IF
  END_IF
  GOSUB Pictocop
RETURN
' ==============================================================================
Annul:
  CLIPBOARD_PASTE 1: GOSUB Pictocop
RETURN
' ==============================================================================
Coptopic:
  ' Recopie du picture auxiliaire dans le picture de travail
  SHOW 80
  2D_TARGET_IS 1
  FOR r% = 1 TO h%
      CAPTION 82,"Ligne: "+STR$(r%)
      FOR c% = 1 TO w%
          ra% = COLOR_PIXEL_RED(100,c%-1,r%-1)
          ga% = COLOR_PIXEL_GREEN(100,c%-1,r%-1)
          ba% = COLOR_PIXEL_BLUE(100,c%-1,r%-1)
          2D_FLOOD xc%(c%)+2,yr%(r%)+2,ra%,ga%,ba%
      NEXT c%
  NEXT r%
  HIDE 80
RETURN
' ==============================================================================
Pictocop:
  ' Copie du picture de travail dans le picture auxiliaire
  2D_TARGET_IS 100
  FOR r% = 1 TO h%
      FOR c% = 1 TO w%
          ra% = COLOR_PIXEL_RED(1,xc%(c%)+2,yr%(r%)+2)
          ga% = COLOR_PIXEL_GREEN(1,xc%(c%)+2,yr%(r%)+2)
          ba% = COLOR_PIXEL_BLUE(1,xc%(c%)+2,yr%(r%)+2)
          2D_PEN_COLOR ra%,ga%,ba%: 2D_POINT c%-1,r%-1
      NEXT c%
  NEXT r%
  2D_TARGET_IS 1
RETURN
' ==============================================================================
Decalim:
  ' Décalage de l'image d'un pixel
  CLIPBOARD_COPY 1
  2D_TARGET_IS 100
  k% = NUMBER_CLICK
  SELECT k%
      CASE 51: 2D_IMAGE_COPY 99,1,0,w%,h%: ' décalage à gauche
              CLS: COLOR 100,ct%,ct%,ct%: 2D_IMAGE_PASTE 99,0,0
      CASE 52: 2D_IMAGE_COPY 99,0,0,w%,h%: ' à droite
              CLS: COLOR 100,ct%,ct%,ct%: 2D_IMAGE_PASTE 99,1,0
      CASE 53: 2D_IMAGE_COPY 99,0,1,w%,h%: ' en haut
              CLS: COLOR 100,ct%,ct%,ct%: 2D_IMAGE_PASTE 99,0,0
      CASE 54: 2D_IMAGE_COPY 99,0,0,w%,h%: ' en bas
              CLS: COLOR 100,ct%,ct%,ct%: 2D_IMAGE_PASTE 99,0,1
  END_SELECT
  GOSUB Coptopic
RETURN
' ==============================================================================
Lire:
  ' chargement d'une image BMP ou ICO
  TEXT 25,"": a$ = FILE_NAME$(26): IF LEN(a$)<5 THEN RETURN
  FONT_BOLD 25: TEXT 25,a$
  b$ = UPPER$(FILE_EXTRACT_EXTENSION$(a$))
  IF b$ <> ".BMP"
      IF b$ = ".JPG"
          Jpg2Bmp(a$,ftm1$)
      ELSE
          IF b$ = ".ICO"
              IcoToBmp(a$,ftm1$)
          END_IF
      END_IF
      a$ = ftm1$
  END_IF
  b$ = ftm$
  IF CHECKED(28) = 1: ' adapter l'image à la grille (sans proportions...)
      w% = POSITION(13): h% = POSITION(14)
      Redimimg(a$,w%,h%,b$): ' adapte l'image à la grille
      a$ = b$
  END_IF
  FILEBIN_OPEN_READ 1,a$
      FILEBIN_POSITION 1,18: FILEBIN_BLOCK_READ 1,8,v%(0)
      w% = v%(0)+256*v%(1)+65536*v%(2)+16777216*v%(3)
      h% = v%(4)+256*v%(5)+65536*v%(6)+16777216*v%(7)
  FILEBIN_CLOSE 1
  POSITION 13,w%: POSITION 14,h%
  GOSUB Appliq: ' adapter la grille au fichier bmp
  FILE_LOAD 100,a$
  GOSUB Coptopic
  IF FILE_EXISTS(ftm$) = 1 THEN FILE_DELETE ftm$
  IF FILE_EXISTS(ftm1$) = 1 THEN FILE_DELETE ftm1$
RETURN
' ==============================================================================
Sauve:
  ' Sauvegarde dans un fichier BMP ou ICO
  TEXT 65,""
  IF CHECKED(62) = 1: ' bmp
      b$ = ".bmp"
      a$ = "Image bitmap|*"+b$
  ELSE: ' ico
      b$ = ".ico"
      a$ = "Image icône|*"+b$
  END_IF
  FILTER 66,a$
  a$ = FILE_NAME$(66): IF LEN(a$)<5 THEN RETURN
  IF FILE_EXTRACT_EXTENSION$(a$)="" THEN a$ = a$+b$
  FONT_BOLD 65: TEXT 65,a$
  GOSUB Pictocop
  IF CHECKED(62) = 1: ' bmp
      FILE_SAVE 100,a$
  ELSE
      FILE_SAVE 100,ftm$
      BmpToIco(ftm$,a$)
      FILE_DELETE ftm$
  END_IF
RETURN
' ==============================================================================
Zzm:
  ' Zoom, pour voir (tests)
  OFF_CLICK 61
  i% = VAL(TEXT$(72))
  Zoom(100,0,0,16,16,i%): ' pour tests
  ON_CLICK 61,Zzm
RETURN
' ==============================================================================
Aide:
q$ = CHR$(13)+CHR$(10)
a$ = "    -  DESSIN  D'ICONES  OU  DE  SPRITES  -"+q$+q$
a$=a$+"On peut créer des icônes carrées de type Windows de dimensions standards (16x16,"+q$
a$=a$+"24x24, 32x32, 48x48, 64x64), ou des sprites de dimensions quelconques."+q$
a$=a$+"On verra à l'usage qu'il est prudent de ne pas chercher à créer une image trop"+q$
a$=a$+"grande, pour des raisons de clarté d'affichage et de temps d'exécution."+q$
a$=a$+"On peut partir d'une image bmp déjà existante (créée antérieurement)."+q$+q$
a$=a$+"- Définir le format de l'image finale en pixels, et la dimensions de chaque carré"+q$
a$=a$+"  représentant un pixel, puis cliquer 'Appliquer les paramètres'."+q$
a$=a$+"  Dans le cas d'une image chargée, les paramètres Colonnes/Rangées seront"+q$
a$=a$+"  automatiquement adaptés à ses dimensions."+q$
a$=a$+"  SAUF: si l'option 'Adapter' est cochée, l'image sera redimensionnée aux"+q$
a$=a$+"              dimensions 'Colonnes/Rangées' existantes."+q$
a$=a$+"  Attention: le fait de modifier et valider ces paramètres réinitialise la zone"+q$
a$=a$+"  de dessin (RAZ)."+q$
a$=a$+"  La zone de dessin est une image agrandie de l'image finale."+q$
a$=a$+"- Pour dessiner, choisir la couleur du pinceau, la figure désirée (point, trait,"+q$
a$=a$+"  rectangle, remplissage), et cliquer le carré désiré."+q$
a$=a$+"- On peut également afficher sous forme numérique la couleur réelle d'un"+q$
a$=a$+"  carré du dessin (option 'Couleur pixel')."+q$
a$=a$+"- Couleur de transparence ('Gomme' transparence) : on peut la choisir en donnant"+q$
a$=a$+"  la valeur numérique d'une composante, les composantes R,G,B de transparence"+q$
a$=a$+"  étant arbitrairement identiques."+q$+q$
a$=a$+"CAS  DES  SPRITES :"+q$
a$=a$+"La couleur de transparence doit être le noir pur (à choisir dans la rubrique Gomme,"+q$
a$=a$+"en donnant la valeur 0). La couleur noire proposée dans la palette est en réalité 1,1,1"+q$
a$=a$+"On peut donc avoir deux noirs en apparence identiques, dont l'un est la couleur de"+q$
a$=a$+"transparence RGB = 0,0,0."+q$+q$
a$=a$+"CAS  DES  ICÔNES :"+q$
a$=a$+"La couleur de transparence sera celle indiquée dans la rubrique 'Gomme'."+q$
a$=a$+"On peut enregistrer l'image résultat au format BMP (donc utilisable comme sprite),"+q$
a$=a$+"ou bien au format ICO, comme icône Windows, avec la couleur de transparence indiquée."
MESSAGE a$
RETURN
' ==============================================================================
SUB Zoom(pict%,x%,y%,w%,h%,z%)
' Zoom x z% de la zone du picture p% en x%,y%, dimensions w%,h%
  IF LABEL("Ex") = 0 THEN LABEL Ex
  IF VARIABLE("fzoom%") = 0 THEN DIM fzoom%
  IF fzoom% = 1 THEN EXIT_SUB: ' déjà active
  fzoom% = 1
  DIM_LOCAL n2d%,ff%,f%,p%,i%,j%,xp%,yp%,r%,g%,b%
  f% = 900: p% = f%+1: ' variable ff% définie dans le programme appelant
  n2d% = NUMBER_2D_TARGET
  FORM f%: BORDER_SMALL f%: WIDTH f%,w%*z%+16: HEIGHT f%,h%*z%+35: ON_CLOSE f%,Ex
  PICTURE p%: PARENT p%,f%: FULL_SPACE p%
  2D_TARGET_IS p%
  yp% = 0
  FOR j% = y% TO y%+h%-1
      xp% = 0
      FOR i% = x% TO x%+w%-1
          r% = COLOR_PIXEL_RED(pict%,i%,j%): g% = COLOR_PIXEL_GREEN(pict%,i%,j%)
          b% = COLOR_PIXEL_BLUE(pict%,i%,j%)
          2D_PEN_COLOR r%,g%,b%: 2D_FILL_COLOR r%,g%,b%
          2D_RECTANGLE xp%,yp%,xp%+z%-1,yp%+z%-1
          xp% = xp%+z%
      NEXT i%
      yp% = yp%+z%
  NEXT j%
  2D_TARGET_IS n2d%
  CAPTION f%," ZOOM x "+STR$(z%)
  WHILE fzoom% = 1: PAUSE 50: TO_FOREGROUND f%: END_WHILE: DELETE f%: EXIT_SUB
Ex:
  fzoom% = 0
RETURN
END_SUB
' ==============================================================================
SUB BmpToIco(f$,fr$)
  ' Conversion image .BMP f$ en image .ICO fr$
  ' Taille Infoheader = 40
  ' Taille ANDBitmap = w x h x 3 (3 octets par pixel image)
  ' Taille XORBitmap = w * h / 4 (2 bits par pixel image)
  DIM_LOCAL wb%,hb%,v%(2000),et$,entr$,sz$,offs$,infh$,a$,lt%,of%,i%
  FILEBIN_OPEN_READ 1,f$: FILEBIN_OPEN_WRITE 2,fr$
  lt%=FILEBIN_SIZE(1): FILEBIN_POSITION 1,10: of%=FILEBIN_READ(1): ' offset
  lt%=lt%-of%: ' taille de la zone bitmap
  FILEBIN_POSITION 1,18: FILEBIN_BLOCK_READ 1,8,v%(0)
  wb% = v%(0)+256*v%(1)+65536*v%(2)+16777216*v%(3): ' dimensions de l'image bmp
  hb% = v%(4)+256*v%(5)+65536*v%(6)+16777216*v%(7)
  et$ = "0000"+"0100"+"0100": ' en-tête: réservé+type icône(=1)+nb d'images(=1)
  entr$ = RIGHT$("0"+HEX$(wb%),2)+RIGHT$("0"+HEX$(hb%),2): ' dimensions (w,h)
  entr$ = entr$+"00"+"00"+"0100"+"1800": ' nbcoul(0=256)+rés.+nb plans(=1)+bpp(=24)
  sz$ = RIGHT$("000"+HEX$(40 + wb%*hb%*3 + wb%*hb%/4),4)
  sz$ = MID$(sz$,3,2)+LEFT$(sz$,2)+"0000": ' Taille de Infoheader+ANDBitmap+XORBitmap
  offs$ = "16000000": ' offset début  du Infoheader
  entr$ = entr$+sz$+offs$
  infh$ = "28000000"+ RIGHT$("0"+HEX$(wb%),2)+"000000": ' InfoHeader
  infh$ = infh$+RIGHT$("0"+HEX$(2*hb%),2)+"000000"
  infh$ = infh$+"01001800"+STRING$(48,"0")
  a$ = et$+entr$+infh$
  FILEBIN_HEXA_WRITE 2,LEN(a$)/2,a$: ' écriture en-tête
  FOR i% = of% TO FILEBIN_SIZE(1) STEP 4
      FILEBIN_POSITION 1,i%: FILEBIN_HEXA_READ 1,3,a$: FILEBIN_HEXA_WRITE 2,3,a$
  NEXT i%
  i% = wb%*hb%/4: ' taille palette à la fin (4 bits par pixel) ?
  a$ = STRING$(i%*2,"0")
  FILEBIN_HEXA_WRITE 2,i%,a$
  FILEBIN_CLOSE 1: FILEBIN_CLOSE 2
END_SUB
' ==============================================================================
SUB IcoToBmp(f$,fr$)
  ' Conversion image .ICO f$ en image .BMP fr$
  DIM_LOCAL w%,h%,tt%,tp%,a$,nb%,i%
  FILEBIN_OPEN_READ 1,f$: FILEBIN_OPEN_WRITE 2,fr$
  FILEBIN_POSITION 1,6: FILEBIN_READ 1,w%: FILEBIN_READ 1,h%
  tt% = 54+w%*h%*4: ' taille totale du BMP (Header=54 + bitmap= 4 octets/pixel)
  a$ = RIGHT$("000"+HEX$(tt%),4)
  a$ = "424D"+RIGHT$(a$,2)+LEFT$(a$,2): ' 'BM' + taille
  a$ = a$+"0000000000003600000028000000"
  a$ = a$+HEX$(w%)+"000000"+HEX$(h%)+"000000"
  a$ = a$+"01002000000000000004000000000000000000000000000000000000"
  FILEBIN_HEXA_WRITE 2,54,a$: ' en-tête du bmp
  FILEBIN_POSITION 1,22: FILEBIN_READ 1,tp%: tp% = tp%+22: ' offset bitmap
  nb% = w%*h%*3
  FOR i% = tp% TO tp%+nb%-3 STEP 3
      FILEBIN_POSITION 1,i%: FILEBIN_HEXA_READ 1,3,a$: FILEBIN_HEXA_WRITE 2,4,a$+"00"
  NEXT i%
  FILEBIN_CLOSE 1: FILEBIN_CLOSE 2
END_SUB
' ==============================================================================
SUB Jpg2Bmp(fi$,fo$)
' Conversion d'une image Jpg (fi$) en Bmp (fo$)
' (volume multiplié par 4 ou 5...)
DIM_LOCAL pic%
pic% = 5000: WHILE OBJECT_EXISTS(pic%)=1: pic%=pic%+1: END_WHILE
PICTURE pic%: HIDE pic%: FILE_LOAD pic%, fi$: FILE_SAVE pic%, fo$: DELETE pic%
END_SUB
' ==============================================================================
SUB RedimImg(f$,w%,h%,fr$)
  ' Redimensionne l'image f$ (JPG,BMP) en w%xh%. Si h%=0: redimension proportionnelle
  ' résultat dans fr$ (BMP) ou clipboard si fr$ = ""
  ' L'image résultante doit pouvoir tenir en entier dans l'écran
  DIM_LOCAL n2d%,p%,w0%,h0%,r%,fm$,wi%,hi%: n2d% = NUMBER_2D_TARGET
  fm$ = "C:\Temp\Provy.bmp"
  p% = 900
  IF h% = 0
      PICTURE p%: HIDE p%: FILE_LOAD p%,f$: FILE_SAVE p%,fm$: DELETE p%
      FILEBIN_OPEN_READ 1,fm$: ' dimensions réelles de l'image f$
          FILEBIN_POSITION 1,18: wi% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
          FILEBIN_POSITION 1,22: hi% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
      FILEBIN_CLOSE 1: FILE_DELETE fm$
      h% = w%*hi%/wi%
  END_IF
  w0% = WIDTH(0): h0% = HEIGHT(0): r% = 0
  IF w0%<(w%+20) THEN WIDTH 0,w%+20: r% = 1
  IF h0%<(h%+40) THEN HEIGHT 0,h%+40: r% = 1
  PICTURE p%: WIDTH p%,w%: HEIGHT p%,h%: STRETCH_ON p%: FILE_LOAD p%,f$
  IMAGE p%+1
  2D_TARGET_IS 0: 2D_IMAGE_COPY p%+1,0,0,w%,h%: 2D_TARGET_IS n2d%: DELETE p%
  CLIPBOARD_COPY p%+1: IF fr$<>"" THEN FILE_SAVE p%+1,fr$
  DELETE p%+1
  IF r% = 1 THEN WIDTH 0,w0%: HEIGHT 0,h0%
END_SUB
' ==============================================================================