Editeur d'icônes

' Iconedit.bas éditeur d'icônes
DIM w0, h0, wi, hi, we, he, hfe, xi, yi, ic, x%, y%, xc%, yc%, xca%, yca%
DIM i%, j%, k%, c%, x1%, y1%, at2, an, pi, pr, pg, pb, xce, yce, wim, him, d%(8)
DIM a$, b$, co, rpr$, ftmp$, fpr$, fred$, f$, xou, you, hou, out, cr, cg, cb, iv$, on
DIM l$, v%, vh$, lh%, obj%, sob%, et$, ccr%, ccg%, ccb%, lcou%, hcou%, yac%, grid%
DIM pix(64,64), r(16), g(16), b(16)
DIM xcr%, ycr%, ysy%, prc, pgc, pbc, cst%, wd%, hd%, xt%, yt%
LABEL Desima, Desoutil, Desfl, Clic, Couleur, Outil, Ico2Des, Des2Ico, Lirbmp, Savbmp
LABEL Undo, Format, Pic2Dat, Dat2Pic, DecHex, Cvx, Rdat, rs, Rota90, Aide, Stxt
LABEL Dessy, Decal, Sym, Teinte

LABEL Lbmp

DATA "Fill", "2020": ' l, h
DATA "000080000001C0000003600000063000000C180000180C000030060000600300"
DATA "00C0018001FFFFC001FFFFE0019FFFF0018FFFF00187FFE00183FFC00181FF80"
DATA "0180FF0001807E0001803C00018018000FF000003FFE00007FFF80007FFF8000"
DATA "7FFF00000FF80000000000000000000000000000000000000000000000000000"
DATA "Rot90", "2020"
DATA "00000000000000000000000000000000007FFE0000FFFE0001FFFE0003E00000"
DATA "07C00000078000000703C3C60707E7EF070C6669070C6669070C6669070C6669"
DATA "070C6669070C666F070C66660707E660FFF3E6607FF066603FE066601FC06660"
DATA "0F806660070466600207E7E00003C3C000000000000000000000000000000000"
DATA "Pipette", "2020"
DATA "00000000000000000000000000000000000001E0000003F0000007F8000007F8"
DATA "0000F7F800007FF800003FF000007FE00000EF000001C78000038F8000071D80"
DATA "000E3880001C70000038E0000071C00000E3800001C70000018E000001DC0000"
DATA "07F8000007F00000038000000180000000000000000000000000000000000000"
DATA "Transp", "2020"
DATA "00000000000000000FFFFFF00800001010000010100000081000000815DF7F68"
DATA "10000008180000182055550828AAAA143055550C20AAAA043055550C20AAAA04"
DATA "5055550C40AAAA825155550A40AAAA867FFFFFFE21FFFF8421FFFF8421FFFF84"
DATA "21FFFF84400000024000000240000002400000027FFFFFFE0000000000000000"
DATA "Grille","2020"
DATA "00000000000000003FFFFFFC2081020420810204208102042081020420810204"
DATA "3FFFFFFC2081020420810204208102042081020420810204208102043FFFFFFC"
DATA "2081020420810204208102042081020420810204208102043FFFFFFC20810204"
DATA "20810204208102042081020420810204208102043FFFFFFC0000000000000000"
DATA "Texte","2020"
DATA "000000000000000000000000000000000000000007FFFFE007FFFFE007FFFFE0"
DATA "07FFFFE00603C0600403C0200003C0000003C0000003C0000003C0000003C000"
DATA "0003C0000003C0000003C0000003C0000003C0000003C0000003C0000003C000"
DATA "0003C0000007E000000FF0000000000000000000000000000000000000000000"
DATA "Flh","1010"
DATA "00000000018003C003C007E00FF01DB801800180018001800180018000000000"
DATA "Flg","1010"
DATA "0000000000000100030007001E003FFC3FFC1E00070003000100000000000000"
DATA "Flb","1010"
DATA "000000000180018001800180018001801DB80FF007E003C003C0018000000000"
DATA "Fld","1010"
DATA "000000000000008000C000E000783FFC3FFC007800E000C00080000000000000"
DATA "Syv","1830"
DATA "FFFFFF800001800001800001801801803C01807E0180FF0181FF8183FFC187FF"
DATA "E1803C01803C01803C01803C01803C01803C01803C01803C01803C0180000180"
DATA "0001800001FFFFFF800001800001800001803C01803C01803C01803C01803C01"
DATA "803C01803C01803C01803C01803C0187FFE183FFC181FF8180FF01807E01803C"
DATA "01801801800001800001800001FFFFFF"
DATA "Syh","3018"
DATA "FFFFFFFFFFFF8000010000018000010000018000010000018000010000018020"
DATA "0100040180600100060180E00100070181E00100078183E0010007C187FFF11F"
DATA "FFE18FFFF11FFFF18FFFF11FFFF187FFF11FFFE183E0010007C181E001000781"
DATA "80E0010007018060010006018020010004018000010000018000010000018000"
DATA "01000001800001000001FFFFFFFFFFFF"
DATA "logo", "1010"
DATA "00001EC002800280428042823CFE00007EFC448008801C7C020242823C7C0000"

rpr$ = "Z:": ' ******** Répertoire des fichiers de manoeuvre, à ajuster *******
ftmp$ = rpr$ + "Ftmp.bmp"
fred$ = rpr$ + "Fred.bmp"
fpr$ = rpr$ + "Preced.bmp"
iv$ = "C:\Progra~1\Irfanv~1\i_view32.exe ": ' **** à ajuster éventuellement ****

' --------- partie déclaration à inclure dans le programme
label form_color_picker, corriger_couleur_RGB, color_picker
label change_2802, change_2806, click_2810, click_2811
dim color_r%, color_g%, color_b%, color_s$, color_res%, color_test$, color_test%
gosub form_color_picker

' couleurs (les 16 couleurs du basic + transparence)
r(0)=0: g(0)=0: b(0)=0: ' noir
r(1)=0: g(1)=0: b(1)=128: ' bleu
r(2)=0: g(2)=128: b(2)=0: ' vert
r(3)=0: g(3)=128: b(3)=128: ' cyan
r(4)=128: g(4)=0: b(4)=0: ' rouge
r(5)=128: g(5)=0: b(5)=128: ' magenta
r(6)=128: g(6)=64: b(6)=0: ' brun
r(7)=192: g(7)=192: b(7)=192: ' blanc
r(8)=128: g(8)=128: b(8)=128: ' gris
r(9)=0: g(9)=0: b(9)=255: ' bleu clair
r(10)=0: g(10)=255: b(10)=0: ' vert clair
r(11)=0: g(11)=255: b(11)=255: ' cyan clair
r(12)=255: g(12)=0: b(12)=0: ' rouge clair
r(13)=255: g(13)=0: b(13)=255: ' magenta clair
r(14)=255: g(14)=255: b(14)=0: ' jaune
r(15)=255: g(15)=255: b(15)=255: ' blanc intense
r(16)=255: g(16)=255: b(16)=254: ' couleur 'transparente'

w0 = 900: h0 = 800
WIDTH 0, w0: HEIGHT 0, h0: CAPTION 0, "ICONE/EDIT": ' Form 0

hfe = 640: ' fenêtre de dessin
xi = 220: yi = 80: ' coordonnées de la fenêtre
pi = 4*ATN(1)
co = 0: ' indice couleur courante initiale (noir)
ccr% = r(co): ccg% = g(co): ccb% = b(co): ' couleur courante
out = 0: ' outil courant initial (point)
at2 = 0
ic = 32: ' icône 32x32
grid% = 0
cst% = 0
xt% = 0: yt% = 0

' image principale
PICTURE 1: ON_CLICK 1, Clic

' icône grandeur nature
PICTURE 4: PICTURE 5
GOSUB Desima

' tableau des couleurs
lcou% = 80: hcou% = 30: ' dimension des cases
PICTURE 2: TOP 2, yi+hfe-8*hcou%: LEFT 2, 20: WIDTH 2, 2*lcou%: HEIGHT 2, 9*hcou%
ON_CLICK 2, Couleur
2D_TARGET_IS 2
FOR j% = 0 TO 7
    FOR i% = 0 TO 1
        c% = j% + 8*i%: 2D_FILL_COLOR r(c%), g(c%), b(c%)
        x% = i%*lcou%: y% = j%*hcou%
        2D_RECTANGLE x%, y%, x%+lcou%, y%+hcou%
    NEXT i%
NEXT j%
x% = 80: y% = 8*hcou%: 2D_RECTANGLE x%, y%, x%+lcou%, y%+hcou%
2D_PEN_COLOR 128,128,128
2D_LINE x%, y%, x%+lcou%, y%+hcou%: 2D_LINE x%, y%+hcou%, x%+lcou%, y%
PRINT_TARGET_IS 2: PRINT_LOCATE x%+8, y%+8: PRINT "Transparente"
' couleur active
yac% = yi + hfe - 8*hcou%-50
PICTURE 3: TOP 3, yac%: LEFT 3, 80: WIDTH 3, 50: HEIGHT 3, 40
2D_TARGET_IS 3: 2D_FILL_COLOR ccr%, ccg%, ccb%
2D_RECTANGLE 0, 0, 80, 40
BUTTON 6: TOP 6, yac%: LEFT 6, 135: WIDTH 6, 45: HEIGHT 6, 20
CAPTION 6, "+ clair": ON_CLICK 6, Teinte
HINT 6, "Éclaircir la teinte de la couleur (non réversible)"
BUTTON 7: TOP 7, yac%+20: LEFT 7, 135: WIDTH 7, 45: HEIGHT 7, 20
HINT 7, "Assombrir la teinte de la couleur( non réversible)"
CAPTION 7, "+ foncé": ON_CLICK 7, Teinte

' tableau des outils
xou = 50: you = yi+50: hou = 40
PICTURE 10: LEFT 10, xou: TOP 10, you: WIDTH 10, hou: HEIGHT 10, hou
HINT 10,"Clic un pixel:"+chr$(10)+"il prend la couleur courante"
PICTURE 11: LEFT 11, xou+hou: TOP 11, you: WIDTH 11, hou: HEIGHT 11, hou
HINT 11, "Clic successivement les points"+chr$(10)+"de départ et d'arrivée de la ligne"
PICTURE 12: LEFT 12, xou: TOP 12, you+hou: WIDTH 12, hou: HEIGHT 12, hou
HINT 12, "Clic deux coins opposés du rectangle plein"
PICTURE 13: LEFT 13, xou+hou: TOP 13, you+hou: WIDTH 13, hou: HEIGHT 13, hou
HINT 13, "Clic deux coins opposés du rectangle vide"
PICTURE 14: LEFT 14, xou: TOP 14, you+2*hou: WIDTH 14, hou: HEIGHT 14, hou
HINT 14, "Clic successivement le centre"+chr$(10)+"et un point de la circonférence"
PICTURE 15: LEFT 15, xou+hou: TOP 15, you+2*hou: WIDTH 15, hou: HEIGHT 15, hou
HINT 15, "Clic successivement le centre"+chr$(10)+"et un point de la circonférence"
PICTURE 16: LEFT 16, xou: TOP 16, you+3*hou: WIDTH 16, hou: HEIGHT 16, hou
HINT 16, "Clic un point de la zone à remplir de la couleur courante"
PICTURE 17: LEFT 17, xou+hou: TOP 17, you+3*hou: WIDTH 17, hou: HEIGHT 17, hou
HINT 17, "La couleur du point cliqué"+chr$(10)+"devient la couleur courante"
PICTURE 18: LEFT 18, xou: TOP 18, you+4*hou: WIDTH 18, hou: HEIGHT 18, hou
HINT 18, "Rotation de l'image de 90° à gauche"
PICTURE 19: LEFT 19, xou+hou: TOP 19, you+4*hou: WIDTH 19, hou: HEIGHT 19, hou
HINT 19, "Effacement total du dessin"+chr$(10)+"après confirmation"
PICTURE 20: LEFT 20, xou: TOP 20, you+5*hou: WIDTH 20, hou: HEIGHT 20, hou
HINT 20, "Choix de la couleur de transparence"
PICTURE 21: LEFT 21, xou+hou: TOP 21, you+5*hou: WIDTH 21, hou: HEIGHT 21, hou
HINT 21, "Superposition d'une grille repère de 8x8 pixels"
PICTURE 22: LEFT 22, xou: TOP 22, you+6*hou: WIDTH 22, hou: HEIGHT 22, hou
HINT 22, "Insertion de caractères alphanumériques"
PICTURE 23: LEFT 23, xou+hou: TOP 23, you+6*hou: WIDTH 23, hou: HEIGHT 23, hou
on = 0
FOR obj% = 10 TO 23
    out = obj%-10: GOSUB Desoutil
    ON_CLICK obj%, Outil
NEXT obj%
out = 0: on = 1: GOSUB Desoutil: ' outil initial

' flèches de décalage de l'image d'un pixel
xcr% = xi-80: ycr% = yi+80
x% = 0: y% = 0
PICTURE 24: TOP 24, ycr%: LEFT 24, xcr%+24: WIDTH 24, 24: HEIGHT 24, 24
obj% = 24: et$ = "Flh": GOSUB Desfl: ON_CLICK 24, Decal
HINT 24, "Décalage de l'image"+chr$(10)+"d'un pixel vers le haut"
PICTURE 25: TOP 25, ycr%+24: LEFT 25, xcr%: WIDTH 25, 24: HEIGHT 25, 24
obj% = 25: et$ = "Flg": GOSUB Desfl: ON_CLICK 25, Decal
HINT 25, "Décalage de l'image"+chr$(10)+"d'un pixel vers la gauche"
PICTURE 26: TOP 26, ycr%+24: LEFT 26, xcr%+48: WIDTH 26, 24: HEIGHT 26, 24
obj% = 26: et$ = "Fld": GOSUB Desfl: ON_CLICK 26, Decal
HINT 26, "Décalage de l'image"+chr$(10)+"d'un pixel vers la droite"
PICTURE 27: TOP 27, ycr%+48: LEFT 27, xcr%+24: WIDTH 27, 24: HEIGHT 27, 24
obj% = 27: et$ = "Flb": GOSUB Desfl: ON_CLICK 27, Decal
HINT 27, "Décalage de l'image"+chr$(10)+"d'un pixel vers le bas"
ALPHA 45: TOP 45, ycr%+80: LEFT 45, xcr%+10: CAPTION 45, "Décalages"
' symétries
ysy% = ycr% + 120
PICTURE 28: TOP 28, ysy%: LEFT 28, xcr%: WIDTH 28, 28: HEIGHT 28, 48
obj% = 28: et$ = "Syv":GOSUB Dessy: ON_CLICK 28, Sym
HINT 28, "Symétrie verticale"+chr$(10)+"de l'ensemble de l'image"
PICTURE 29: TOP 29, ysy%+12: LEFT 29, xcr%+26: WIDTH 29, 50: HEIGHT 29, 24
obj% = 29: et$ = "Syh": GOSUB Dessy: ON_CLICK 29, Sym
HINT 29, "Symétrie horizontale"+chr$(10)+"de l'ensemble de l'image"
ALPHA 46: TOP 46, ysy%+55: LEFT 46, xcr%+10: CAPTION 46, "Symétries"


x%=xi+ic*we-18:y%=10
2D_TARGET_IS 0: 2D_FILL_COLOR 192,255,255: 2D_RECTANGLE x%,y%-2,x%+23,y%+18
obj%=0:et$="logo":GOSUB Dat2Pic

' boutons
BUTTON 30: TOP 30, 5: LEFT 30, 10: WIDTH 30, 120: HEIGHT 30, 25
CAPTION 30, "Lire BMP/ICO"
HINT 30, "Ouvrir un fichier image BMP ou ICO"+chr$(10)+"au choix, dans la zone dessin"
ON_CLICK 30, Lirbmp
BUTTON 31: TOP 31, 35: LEFT 31, 10: WIDTH 31, 120: HEIGHT 31, 25
CAPTION 31, "Sauve BMP/ICO"
HINT 31, "Enregistrer l'image actuelle"+chr$(10)+"au format BMP ou ICO, au choix"
ON_CLICK 31, Savbmp
BUTTON 32: TOP 32, 65: LEFT 32, 10: WIDTH 32, 120: HEIGHT 32, 25
CAPTION 32, "Sauve Datas (progr.)"
HINT 32, "Enregistrer l'image actuelle sous forme de datas dans le clipboard"
ON_CLICK 32, Pic2Dat
BUTTON 33: TOP 33, 95: LEFT 33, 10: WIDTH 33, 120: HEIGHT 33, 25
CAPTION 33, "Undo"
HINT 33, "Annulation de la dernière action"+chr$(10)+"(un seul retour)"
ON_CLICK 33, Undo
BUTTON 34: TOP 34, 34: LEFT 34, w0-80: WIDTH 34, 60: HEIGHT 34, 30
CAPTION 34, "Aide": ON_CLICK 34, Aide

' Texte
EDIT 60: TOP 60, yi+ic*he+10: LEFT 60, xi+50
LIST 63: TOP 63, yi+ic*he+10: LEFT 63, xi+185: WIDTH 63, 135: HEIGHT 63, 25
FONT_NAMES_LOAD 63
ALPHA 61: TOP 61, yi+ic*he+12: LEFT 61, xi+325
FONT_BOLD 61
CAPTION 61, "Taille:"
SPIN 62: TOP 62, yi+ic*he+10: LEFT 62, xi+360: WIDTH 62, 40: HEIGHT 62, 25
MAX 62, 30: MIN 62, 4: POSITION 62, 8
BUTTON 35: TOP 35, yi+ic*he+12: LEFT 35, xi + 405: CAPTION 35, "OK"
BUTTON 36: TOP 36, yi+ic*he+12: LEFT 36, xi + 485: CAPTION 36, "Annul"
ON_CLICK 35, Stxt: ON_CLICK 36, Stxt
HIDE 60: HIDE 61: HIDE 62: HIDE 63: HIDE 35: HIDE 36

' directives
ALPHA 40: TOP 40, yi+ic*he+10: LEFT 40, xi
FONT_SIZE 40, 12: FONT_BOLD 40: CAPTION 40, "Outil Point: Clic le point à colorer"
ALPHA 41: TOP 41, yac%: LEFT 41, 20
FONT_SIZE 41, 12: FONT_BOLD 41: CAPTION 41, "Couleur"+chr$(10)+" active:"
ALPHA 42: TOP 42, you+35: LEFT 42, 20: WIDTH 42, 20
FONT_SIZE 42, 12
CAPTION 42,"O"+CHR$(10)+"U"+CHR$(10)+"T"+CHR$(10)+"I"+CHR$(10)+"L"+CHR$(10)+"S"
ALPHA 43: TOP 43, 5: LEFT 43, xi
FONT_NAME 43, "Verdana": FONT_SIZE 43, 11: FONT_COLOR 43, 0, 0, 255

ALPHA 48: TOP 48, yi+ic*he: LEFT 48, xi+ic*he-70
FONT_BOLD 48

' options (format)
CONTAINER_OPTION 50: TOP 50, 25: LEFT 50, xi: WIDTH 50, hfe-50: HEIGHT 50, 50
FONT_SIZE 50, 12: FONT_BOLD 50
CAPTION 50, " Format: "
OPTION 51: PARENT 51, 50: TOP 51, 24: LEFT 51, 90: CAPTION 51, "16 x 16"
OPTION 52: PARENT 52, 50: TOP 52, 24: LEFT 52, 190: CAPTION 52, "24 x 24"
OPTION 53: PARENT 53, 50: TOP 53, 24: LEFT 53, 290: CAPTION 53, "32 x 32"
OPTION 54: PARENT 54, 50: TOP 54, 24: LEFT 54, 390: CAPTION 54, "48 x 48"
OPTION 55: PARENT 55, 50: TOP 55, 24: LEFT 55, 490: CAPTION 55, "64 x 64"
FOR i% = 51 TO 55: ON_CLICK i%, Format: NEXT i%
MARK_ON 53

END
' ============================================================================
Desima:
' icône grandeur nature
TOP 4, yi: LEFT 4, xi-ic-10: WIDTH 4, ic+4: HEIGHT 4, ic+4
COLOR 4, 0,255,0
TOP 5, yi+2: LEFT 5, xi-ic-8: WIDTH 5, ic: HEIGHT 5, ic
2D_TARGET_IS 5
2D_FILL_COLOR r(16),g(16),b(16): 2D_PEN_COLOR r(16),g(16),b(16): 2D_RECTANGLE 0, 0, ic, ic
' zone de dessin
we = hfe/ic: he = we
TOP 1, yi: LEFT 1, xi: WIDTH 1, ic*we: HEIGHT 1, ic*he
2D_TARGET_IS 1
2D_FILL_COLOR r(16),g(16),b(16): 2D_PEN_COLOR r(16),g(16),b(16): 2D_RECTANGLE 1, 1, hfe, hfe
GOSUB Ico2Des
RETURN
' *****************************************************************************
Desoutil:
sob% = obj%: obj% = out+10
2D_TARGET_IS obj%
IF on = 1
    2D_FILL_COLOR 255,255,0
ELSE
    2D_FILL_COLOR 230,230,230
END_IF
2D_PEN_COLOR 0,0,0: 2D_RECTANGLE 0,0,hou,hou
SELECT out
    CASE 0: 2D_FILL_COLOR 0,0,0: 2D_RECTANGLE hou/2-3,hou/2-3, hou/2+3, hou/2+3: ' point
    CASE 1: 2D_PEN_WIDTH 3: 2D_LINE 10, hou-10, hou-10, 10: ' ligne
    CASE 2: 2D_PEN_WIDTH 3: 2D_RECTANGLE 6, 10, hou-6, hou-10: ' rectangle vide
    CASE 3: 2D_FILL_COLOR 0,0,0: 2D_RECTANGLE 5, 9, hou-5, hou-9: ' rectangle plein
    CASE 4: 2D_PEN_WIDTH 3: 2D_CIRCLE hou/2,hou/2,hou/2-6 : ' cercle vide
    CASE 5: 2D_FILL_COLOR 0,0,0: 2D_CIRCLE hou/2,hou/2,hou/2-5: ' cercle plein
    CASE 6: x% = 2: y% = 6: et$ = "Fill": GOSUB Dat2Pic
    CASE 7: x% = 0: y% = 2: et$ = "Pipette": GOSUB Dat2Pic
    CASE 8: x% = 0: y% = 2: obj% = 18: et$ = "Rot90": GOSUB Dat2Pic
    CASE 9: PRINT_TARGET_IS 19: FONT_SIZE 19,12: FONT_BOLD 19: PRINT: PRINT "RAZ"
    CASE 10: x% = 0: y% = 4: obj% = 20: et$ = "Transp": GOSUB Dat2Pic
    CASE 11: x% = 0: y% = 4: obj% = 21: et$ = "Grille": GOSUB Dat2Pic
    CASE 12: x% = 0: y% = 4: obj% = 22: et$ = "Texte": GOSUB Dat2Pic
    CASE 13: ' libre
END_SELECT
obj% = sob%
RETURN
' *****************************************************************************
Desfl:
2D_TARGET_IS obj%
2D_FILL_COLOR 230,230,230: 2D_PEN_COLOR 0,0,0: 2D_RECTANGLE 0,0,24,24
x% = 0: y% = 4: GOSUB Dat2pic
RETURN
' *****************************************************************************
Dessy:
2D_TARGET_IS obj%
COLOR obj%,230,230,230
x% = -4: y% = 0: GOSUB Dat2pic
RETURN
' *****************************************************************************
Clic:
' Clic dans la zone de dessin
x% = MOUSE_X_LEFT_DOWN(1): xca% = INT(x%/we)
y% = MOUSE_Y_LEFT_DOWN(1): yca% = INT(y%/he)
CAPTION 48, "X=" + STR$(xca%)+"  Y=" + STR$(yca%)
pr = COLOR_PIXEL_RED(5, xca%, yca%): ' couleur du clic
pg = COLOR_PIXEL_GREEN (5, xca%, yca%)
pb = COLOR_PIXEL_BLUE (5, xca%, yca%)
IF out = 12
    2D_TARGET_IS 1
    IF cst% = 1
        2D_PEN_COLOR prc,pgc,pbc: 2D_FILL_COLOR prc,pgc,pbc: 2D_RECTANGLE xce,yce,xce+we-1,yce+he-1
        2D_PEN_COLOR prc, pgc, pbc: 2D_POINT xce, yce
    END_IF
    prc = pr: pgc = pg: pbc = pb: ' couleur initiale du centre, pour restore
    xt% = xca%: yt% = yca%
    x% = xca%*we+1: y% = yca%*he+1: xce = x%: yce = y%: ' case cliquée
    2D_FILL_COLOR 255,255,0: 2D_PEN_COLOR 0,0,0: 2D_RECTANGLE x%,y%,x%+we-1,y%+he-1
    2D_PEN_WIDTH 2
    2D_LINE x%+we/4, y%+he/4, x%+3*we/4, y%+he/4
    2D_LINE x%+we/2, y%+he/4, x%+we/2, y%+3*he/4: 2D_PEN_WIDTH 1
    cst% = 1
    RETURN
END_IF
IF out = 7: ' pipette
    ccr% = pr: ccg% = pg: ccb% = pb: ' nouvelle couleur active
    2D_TARGET_IS 3: 2D_FILL_COLOR ccr%, ccg%, ccb%
    2D_RECTANGLE 0, 0, 160, 40
END_IF
FILE_SAVE 5, fpr$
IF out = 4 AND at2 = 0
    prc = pr: pgc = pg: pbc = pb: ' couleur initiale du centre, pour restore
    xce = xca%: yce = yca%: ' centre cliqué
END_IF
2D_TARGET_IS 5: 2D_PEN_COLOR ccr%, ccg%, ccb%
IF out < 6 THEN 2D_POINT xca%, yca%
xc% = xca%*we: yc% = yca%*he
2D_TARGET_IS 1
IF co=16
    2D_FILL_COLOR 255,255,254
    2D_RECTANGLE xc%, yc%, xc%+we+1, yc%+he+1
    2d_line xc%,yc%+he+1,xc%+we+1,yc%
    2d_line xc%,yc%,xc%+we+1,yc%+he+1
ELSE
    2D_FILL_COLOR ccr%, ccg%, ccb%
    2D_RECTANGLE xc%, yc%, xc%+we+1, yc%+he+1
END_IF
IF at2 <> 0
    2D_TARGET_IS 5
    SELECT at2
        CASE 1: 2D_LINE x1%, y1%, xca%, yca%
                CAPTION 40, "Outil Ligne: Clic le point de départ de la ligne"
        CASE 2: 2D_LINE x1%, y1%, xca%, y1%: 2D_POLY_TO xca%,yca%
                2D_POLY_TO x1%, yca%: 2D_POLY_TO x1%, y1%
                CAPTION 40, "Outil Rectangle vide: Clic le 1er coin du rectangle"
        CASE 3: 2D_FILL_COLOR ccr%, ccg%, ccb%: 2D_RECTANGLE x1%,y1%,xca%+1,yca%+1
                CAPTION 40, "Outil Rectangle plein: Clic le 1er coin du rectangle"
        CASE 4: j% = INT(SQR((xca%-x1%)*(xca%-x1%)+(yca%-y1%)*(yca%-y1%))): ' rayon
                IF j%<2 THEN RETURN
                FOR an = 0 to 2*pi STEP 1/j%
                    x% = x1%+j%*COS(an): y% = y1%+j%*SIN(an)
                    2D_POINT x%, y%
                NEXT an
                2D_PEN_COLOR prc, pgc, pbc: 2D_POINT xce, yce
                CAPTION 40, "Outil Cercle vide: Clic le centre du cercle"
        CASE 5: j% = INT(SQR((xca%-x1%)*(xca%-x1%)+(yca%-y1%)*(yca%-y1%)))
                IF j%<2 THEN RETURN
                2D_FILL_COLOR ccr%, ccg%, ccb%: 2D_CIRCLE x1%, y1%, j%
                CAPTION 40, "Outil Cercle plein: Clic le centre du cercle"
    END_SELECT
    GOSUB Ico2Des
    at2 = 0
ELSE
x1% = xca%: y1% = yca%
SELECT out
    CASE 1: CAPTION 40, "Outil Ligne: Clic le point d'arrivée de la ligne"
            at2 = 1
    CASE 2: CAPTION 40, "Outil Rectangle vide: Clic le coin opposé du rectangle"
            at2 = 2
    CASE 3: CAPTION 40, "Outil Rectangle plein: Clic le coin opposé du rectangle"
            at2 = 3
    CASE 4: CAPTION 40, "Outil Cercle vide: Clic un point de la circonférence"
            at2 = 4
    CASE 5: CAPTION 40, "Outil Cercle plein: Clic un point du cercle de la circonférence"
            at2 = 5
    CASE 6: 2D_TARGET_IS 5: 2D_FLOOD xca%, yca%, ccr%, ccg%, ccb%
            GOSUB Ico2Des
END_SELECT
END_IF
RETURN
' *****************************************************************************
Couleur:
x% = MOUSE_X_LEFT_DOWN(2): xc% = INT(x%/lcou%)
y% = MOUSE_Y_LEFT_DOWN(2): yc% = INT(y%/hcou%)
co = yc% + 8*xc%
ccr% = r(co): ccg% = g(co): ccb% = b(co): ' nouvelle couleur courante
2D_TARGET_IS 3: 2D_FILL_COLOR ccr%, ccg%, ccb%
2D_RECTANGLE 2, 1, 50, 40
IF co = 16 THEN 2D_LINE 1, 1, 50, 40: 2D_LINE 1, 40, 50, 0
RETURN
' *****************************************************************************
Outil:
FOR obj% = 10 TO 23
  IF CLICKED(obj%) = 1 THEN EXIT_FOR
NEXT obj%
IF obj% > 22 THEN RETURN: ' les outils suivants ne sont pas définis
at2 = 0: ' on abandonne l'action éventuellement en cours
IF cst% = 1
    2D_TARGET_IS 1
    2D_PEN_COLOR prc,pgc,pbc: 2D_FILL_COLOR prc,pgc,pbc: 2D_RECTANGLE xce,yce,xce+we-1,yce+he-1
    2D_PEN_COLOR prc, pgc, pbc: 2D_POINT xce, yce
END_IF
IF obj% = 22
    ' texte
    CAPTION 40, "Texte: ": SHOW 60: SHOW 61: SHOW 62: SHOW 63: SHOW 35: SHOW 36
END_IF
IF obj% = 21
    ' grille
    grid% = 1 - grid%: GOSUB Ico2Des
    RETURN
END_IF
IF obj% = 20
    GOSUB color_picker: ' choix de la couleur de transparence
    RETURN
END_IF
IF obj% = 19
    ' RAZ
    i% = MESSAGE_CONFIRMATION_YES_NO("Effacer entièrement le dessin")
    IF i% = 1 THEN GOSUB Desima: CAPTION 43, "": ' retour à l'état d'origine
    RETURN
END_IF
IF obj% = 18
    ' Rotation 90°
    GOSUB Rota90
    RETURN
END_IF
on = 0: GOSUB Desoutil
IF out=12
    HIDE 60: HIDE 61: HIDE 62: HIDE 63: HIDE 35: HIDE 36
END_IF
out = obj% - 10
on = 1: GOSUB Desoutil
SELECT out
    CASE 0: CAPTION 40, "Outil Point: Clic le point à colorer"
    CASE 1: CAPTION 40, "Outil Ligne: Clic le point de départ de la ligne"
    CASE 2: CAPTION 40, "Outil Rectangle vide: Clic le 1er coin du rectangle"
    CASE 3: CAPTION 40, "Outil Rectangle plein: Clic le 1er coin du rectangle"
    CASE 4: CAPTION 40, "Outil Cercle vide: Clic le centre du cercle"
    CASE 5: CAPTION 40, "Outil Cercle plein: Clic le centre du cercle"
    CASE 6: CAPTION 40, "Outil Flood: clic un point de la surface à remplir"
    CASE 7: CAPTION 40, "Outil Pipette: Clic une case de la zone dessin"
END_SELECT
RETURN
' *****************************************************************************
Ico2Des:
' recopie de l'icône grandeur nature dans l'espace de dessin
2D_TARGET_IS 1
FOR j% = 0 TO ic-1
    FOR i% = 0 TO ic-1
        cr = COLOR_PIXEL_RED(5, i%, j%)
        cg = COLOR_PIXEL_GREEN (5, i%, j%)
        cb = COLOR_PIXEL_BLUE (5, i%, j%)
        xc% = i%*we: yc% = j%*he
        IF cr=r(16) AND cg=g(16) AND cb=b(16)
            ' couleur 'transparente'
            2D_PEN_COLOR 200,200,200
            2D_FILL_COLOR 255,255,254
            2D_RECTANGLE xc%, yc%, xc%+we+1, yc%+he+1
            2D_LINE xc%,yc%,xc%+we,yc%+he: 2D_LINE xc%, yc%+he, xc%+we, yc%
        ELSE
            2D_FILL_COLOR cr, cg, cb
            2D_RECTANGLE xc%, yc%, xc%+we+1, yc%+he+1
        END_IF
    NEXT i%
NEXT j%
2D_PEN_COLOR 96,96,96
2D_LINE 0, 0, hfe-1, 0: 2D_POLY_TO hfe-1, hfe-1: 2D_POLY_TO 0, hfe-1: 2D_POLY_TO 0, 0
IF grid% = 1
    FOR i% = 0 TO hfe STEP 8*hfe/ic
        2D_LINE 0, i%, hfe, i%: 2D_LINE i%, 0, i%, hfe
    NEXT i%
END_IF
RETURN
' *****************************************************************************
Des2Ico:
' recopie de l'espace de dessin dans l'icône grandeur nature
2D_TARGET_IS 5
FOR j% = 0 TO ic-1
    FOR i% = 0 TO ic-1
        xc% = i%*we+we/2: yc% = j%*he+he/2
        cr = COLOR_PIXEL_RED(1, xc%, yc%)
        cg = COLOR_PIXEL_GREEN (1, xc%, yc%)
        cb = COLOR_PIXEL_BLUE (1, xc%, yc%)
        2D_PEN_COLOR cr,cg,cb: 2D_POINT i%, y%
    NEXT i%
NEXT j%
RETURN
' *****************************************************************************
Lirbmp:
' Charger une image bmp ou une icône dans la zone dessin
OPEN_DIALOG 80
FILTER 80, "Fichiers BMP/ICO|*.bmp;*.ico"
f$ = FILE_NAME$(80): DELETE 80: IF f$ = "_" THEN RETURN
CAPTION 43, "Fichier: " + f$
a$ = UPPER$(RIGHT$(f$, 4))
IF a$ = ".ICO"
    EXECUTE_WAIT iv$ + f$ + " /convert=" + ftmp$: f$ = ftmp$
ELSE
    IF a$ <> ".BMP" THEN RETURN
END_IF
' dimensions wi x hi du fichier bmp f$
FILEBIN_OPEN_READ 1, f$
FILEBIN_POSITION 1, 18
FOR i% = 1 TO 8: FILEBIN_READ 1, d%(i%): NEXT i%
wim = d%(1) + 256*d%(2) + 256*256*d%(3) + 256*256*256*d%(4)
him = d%(5) + 256*d%(6) + 256*256*d%(7) + 256*256*256*d%(8)
FILEBIN_CLOSE 1
cAPTION 43, "Fichier: " + f$ + " (" + STR$(wim) + "x" + STR$(him) + ")"
IF wim<>ic
    ' redimensionner l'image (le stretch_on ne convient pas, il ne redimensionne
    ' l'image que visuellement, pas en mémoire)
    a$ = " /resize=(" + STR$(ic) + "," + STR$(ic) + ")"
    EXECUTE_WAIT iv$ + f$ + a$ + " /convert=" + fred$
    FILE_LOAD 5, fred$
ELSE
    FILE_LOAD 5, f$
END_IF
GOSUB Ico2Des
RETURN
' *****************************************************************************
Savbmp:
' sauvegarde de l'icône actuelle en fichier BMP ou ICO
SAVE_DIALOG 80: FILTER 80, "Fichier BMP/ICO|*.bmp;*.ico"
f$ = FILE_NAME$(80): DELETE 80: IF f$ = "_" THEN RETURN
CAPTION 43, "Fichier: " + f$ + " (" + STR$(ic) + "x" + STR$(ic) + ")"
a$ = UPPER$(RIGHT$(f$, 4))
IF a$ = ".ICO"
    FILE_SAVE 5, ftmp$
    EXECUTE_WAIT iv$ + ftmp$ + " /convert=" + f$: ' conversion bmp -> ico
ELSE
    FILE_SAVE 5, f$
END_IF
RETURN
' *****************************************************************************
Undo:
FILE_LOAD 5, fpr$
GOSUB Ico2Des
at2 = 0
RETURN
' *****************************************************************************
Format:
FOR i% = 51 TO 55
    IF CLICKED(i%) = 1 THEN EXIT_FOR
NEXT i%
SELECT i%
    CASE 51: ic = 16
    CASE 52: ic = 24
    CASE 53: ic = 32
    CASE 54: ic = 48
    CASE 55: ic = 64
END_SELECT
GOSUB Desima
RETURN
' *****************************************************************************
Dimfic:
' dimensions wi x hi du fichier bmp f$
FILEBIN_OPEN_READ 1, f$
FILEBIN_POSITION 1, 18
FOR i% = 1 TO 8: FILEBIN_READ 1, d%(i%): NEXT i%
wi = d%(1) + 256*d%(2) + 256*256*d%(3) + 256*256*256*d%(4)
hi = d%(5) + 256*d%(6) + 256*256*d%(7) + 256*256*256*d%(8)
FILEBIN_CLOSE 1
RETURN
' *****************************************************************************
Pic2Dat:
' Copie dans le clipboard de l'image (N/B) sous forme de lignes de datas
HIDE 33
PICTURE 80: TOP 80,95:LEFT 80,10:WIDTH 80,200:HEIGHT 80,32
2D_TARGET_IS 80:2D_FILL_COLOR 255,192,192:2D_PEN_COLOR 255,0,0
2D_PEN_WIDTH 3: 2D_RECTANGLE 0,0,199,31
2D_TARGET_IS 0
SPIN 81: TOP 81,98: LEFT 81,12:WIDTH 81,50:HEIGHT 81,27
SPIN 82: TOP 82,98: LEFT 82,78:WIDTH 82,50:HEIGHT 82,27
POSITION 81, ic: POSITION 82, ic
PRINT_TARGET_IS 80:FONT_BOLD 80: PRINT_LOCATE 56,5: PRINT "X": PRINT_TARGET_IS 0
BUTTON 83: TOP 83,98: LEFT 83,137:WIDTH 83,70:HEIGHT 83,27:CAPTION 83,"OK"
REPEAT
UNTIL MOUSE_LEFT_DOWN(83) = 1
wd% = POSITION(81): hd% = POSITION(82): ' hauteur et largeur à sauvegarder

l$ = "": lh% = 2
FOR y% = 0 TO hd%-1
    FOR x% = 0 TO wd%-1 STEP 8
        v% = 0
        FOR i% = 0 to 7
            cr = COLOR_PIXEL_RED(5,x%+i%,y%)
            cg = COLOR_PIXEL_GREEN(5,x%+i%,y%)
            cb = COLOR_PIXEL_BLUE(5,x%+i%,y%)
            IF (cr+cg+cb) < 750 : ' non blanc ou transparent
                v% = v% + POWER(2, 7-i%)
            END_IF
        NEXT i%
        GOSUB DecHex
        l$ = l$ + vh$
    NEXT x%
NEXT y%
' sauvegarde de l$ sous forme de lignes de datas dans le clipboard
v% = wd%: GOSUB DecHex: b$ = vh$: v% = hd%: GOSUB DecHex
a$ = "DATA " + CHR$(34) + "?????" + CHR$(34) + ",": ' futur nom d'icône
a$ = a$ + CHR$(34)+b$+vh$+CHR$(34)+CHR$(13)+CHR$(10): ' largeur, hauteur
rs:
IF LEN(l$) > 64
    a$ = a$ + "DATA " + CHR$(34) + LEFT$(l$, 64) + CHR$(34) + CHR$(13) + CHR$(10)
    l$ = MID$(l$, 65, LEN(l$) - 64): GOTO rs
END_IF
a$ = a$ + "DATA " + CHR$(34) + l$ + CHR$(34)
CLIPBOARD_STRING_COPY a$
a$ = "Le dessin a été sauvegardé dans le clipboard" + CHR$(10)
a$ = a$ + "sous forme de lignes de datas en hexadécimal"
MESSAGE a$
DELETE 80: DELETE 81: DELETE 82: DELETE 83: SHOW 33
RETURN
' *****************************************************************************
Dat2Pic:
' Positionnement de lecture des datas après le label et$
RESTORE: REPEAT: READ a$: UNTIL a$ = et$
' dessin des datas en x%, y% dans l'objet système obj%
READ l$: vh$ = LEFT$(l$, 2): GOSUB Cvx: wim = v%
vh$ = RIGHT$(l$, 2): GOSUB Cvx: him = v%
a$ = ""
WHILE LEN(a$) < wim*him/4: READ l$: a$ = a$ + l$: END_WHILE
2D_TARGET_IS obj%: 2D_PEN_COLOR 0,0,0
FOR j% = 0 TO him - 1
    l$ = MID$(a$, 1+j%*wim/4, wim/4)
    FOR i% = 1 TO LEN(l$)
        v% = INSTR("0123456789ABCDEF", MID$(l$, i%, 1))-1
        FOR k% = 0 TO 4
            IF BIN_AND(v%, POWER(2, 3-k%)) > 0
                2D_POINT x%+i%*4+k%, y%+j%
            END_IF
        NEXT k%
    NEXT i%
NEXT j%
GOTO Rdat
Cvx:
' conversion hexadécimal/décimal de vh$, résultat dans v%
v% = 0
FOR k% = 1 TO LEN(vh$)
    v% = v%*16 + INSTR("0123456789ABCDEF", MID$(vh$, k%, 1))-1
NEXT k%
RETURN
Rdat:
RETURN
' *****************************************************************************
DecHex:
' conversion décimal/hexa de v%, résultat vh$ (complété si utile à lh% caractères)
vh$="": IF lh% < 1 THEN lh% = 1
REPEAT
    vh$ = MID$("0123456789ABCDEF", 16*(v%/16-INT(v%/16))+1, 1) + vh$: v% = INT(v%/16)
UNTIL v% <= 0
IF LEN(vh$) < lh% THEN vh$ = STRING$(lh% - LEN(vh$), "0") + vh$
RETURN
' *****************************************************************************
Rota90:
FILE_SAVE 5, fpr$
' rotation de l'icône de 90° à gauche
FOR y% = 0 TO ic-1
    i% = y%
    FOR x% = 0 TO ic-1
        j% = ic-1-x%
        pr = COLOR_PIXEL_RED(5, x%, y%)
        pg = COLOR_PIXEL_GREEN(5, x%, y%)
        pb = COLOR_PIXEL_BLUE(5, x%, y%)
        pix(j%,i%) = 65536*pr + 256*pg + pb
    NEXT x%
NEXT y%
2D_TARGET_IS 5
FOR y% = 0 TO ic-1
    FOR x% = 0 TO ic-1
        pr = INT(pix(y%,x%)/65536)
        pg = BIN_AND(INT(pix(y%,x%)/256), 255)
        pb = BIN_AND(pix(y%,x%), 255)
        2D_PEN_COLOR pr, pg, pb: 2D_POINT x%, y%
    NEXT x%
NEXT y%
GOSUB Ico2Des
RETURN
' *****************************************************************************
Decal:
' décalage de l'image d'un pixel
FOR i% = 24 TO 27
    IF CLICKED(i%) = 1 THEN EXIT_FOR
NEXT i%
k% = i% - 24: ' sens de décalage, 0 haut, 1 gauche, 2 droite, 3 bas
FILE_SAVE 5, fpr$
2D_TARGET_IS 5
SELECT k%
    CASE 0: ' décalage vers le haut
        FOR y% = 0 TO ic-2
            FOR x% = 0 TO ic-1
                pr = COLOR_PIXEL_RED(5, x%, y%+1)
                pg = COLOR_PIXEL_GREEN(5, x%, y%+1)
                pb = COLOR_PIXEL_BLUE(5, x%, y%+1)
                2D_PEN_COLOR pr, pg, pb: 2D_POINT x%, y%
            NEXT x%
        NEXT y%
        2D_PEN_COLOR r(16),g(16),b(16)
        FOR x% = 0 TO ic-1: 2D_POINT x%, ic-1: NEXT x%
    CASE 1: ' décalage vers la droite
        FOR x% = 0 TO ic-2
            FOR y% = 0 TO ic-1
                pr = COLOR_PIXEL_RED(5, x%+1, y%)
                pg = COLOR_PIXEL_GREEN(5, x%+1, y%)
                pb = COLOR_PIXEL_BLUE(5, x%+1, y%)
                2D_PEN_COLOR pr, pg, pb: 2D_POINT x%, y%
            NEXT y%
        NEXT x%
        2D_PEN_COLOR r(16),g(16),b(16)
        FOR y% = 0 TO ic-1: 2D_POINT ic-1, y%: NEXT y%
    CASE 2: ' décalage vers la gauche
        FOR x% = ic-1 TO 1 STEP -1
            FOR y% = 0 TO ic-1
                pr = COLOR_PIXEL_RED(5, x%-1, y%)
                pg = COLOR_PIXEL_GREEN(5, x%-1, y%)
                pb = COLOR_PIXEL_BLUE(5, x%-1, y%)
                2D_PEN_COLOR pr, pg, pb: 2D_POINT x%, y%
            NEXT y%
        NEXT x%
        2D_PEN_COLOR r(16),g(16),b(16)
        FOR y% = 0 TO ic-1: 2D_POINT 0, y%: NEXT y%
    CASE 3: ' décalage vers le bas
        FOR y% = ic-1 TO 1 STEP -1
            FOR x% = 0 TO ic-1
                pr = COLOR_PIXEL_RED(5, x%, y%-1)
                pg = COLOR_PIXEL_GREEN(5, x%, y%-1)
                pb = COLOR_PIXEL_BLUE(5, x%, y%-1)
                2D_PEN_COLOR pr, pg, pb: 2D_POINT x%, y%
            NEXT x%
        NEXT y%
        2D_PEN_COLOR r(16),g(16),b(16)
        FOR x% = 0 TO ic-1: 2D_POINT x%, 0: NEXT x%
END_SELECT
GOSUB Ico2Des
RETURN

Sym:
FILE_SAVE 5, fpr$
FOR y% = 0 TO ic-1
    FOR x% = 0 TO ic-1
        pr = COLOR_PIXEL_RED(5, x%, y%)
        pg = COLOR_PIXEL_GREEN(5, x%, y%)
        pb = COLOR_PIXEL_BLUE(5, x%, y%)
        pix(y%,x%) = 65536*pr + 256*pg + pb
    NEXT x%
NEXT y%
2D_TARGET_IS 5
IF CLICKED(28) = 1
    ' symétrie verticale
    FOR y% = 0 TO ic-1
        FOR x% = 0 TO ic-1
            pr = INT(pix(y%,x%)/65536)
            pg = BIN_AND(INT(pix(y%,x%)/256), 255)
            pb = BIN_AND(pix(y%,x%), 255)
            2D_PEN_COLOR pr, pg, pb: 2D_POINT x%, ic-1-y%
        NEXT x%
    NEXT y%
ELSE
    ' symétrie horizontale
    FOR y% = 0 TO ic-1
        FOR x% = 0 TO ic-1
            pr = INT(pix(y%,x%)/65536)
            pg = BIN_AND(INT(pix(y%,x%)/256), 255)
            pb = BIN_AND(pix(y%,x%), 255)
            2D_PEN_COLOR pr, pg, pb: 2D_POINT ic-1-x%, y%
        NEXT x%
    NEXT y%
END_IF
GOSUB Ico2Des
RETURN
' *****************************************************************************
Stxt:
IF CLICKED(35) = 1
    ' OK
    FILE_SAVE 5, fpr$
    a$ = TEXT$(60): ' texte saisi
    PICTURE 100: TOP 100, yi: LEFT 100, xi: WIDTH 100, ic: HEIGHT 100, ic: HIDE 100
    b$ = "Lucida Console": x% = ITEM_INDEX(63): IF x% <> 0 THEN b$ = ITEM_INDEX$(63)
    PRINT_TARGET_IS 100: FONT_NAME 100, b$: FONT_SIZE 100, POSITION(62)
    FONT_COLOR 100,0,0,0
    PRINT_LOCATE xt%, yt%: PRINT a$
    FOR y% = 0 TO ic-1
        FOR x% = 0 TO ic-1
            pr = COLOR_PIXEL_RED(100, x%, y%)
            pg = COLOR_PIXEL_GREEN(100, x%, y%)
            pb = COLOR_PIXEL_BLUE(100, x%, y%)
            pix(y%,x%) = 65536*pr + 256*pg + pb
        NEXT x%
    NEXT y%
    PRINT_TARGET_IS 0: DELETE 100
    2D_TARGET_IS 5
    FOR y% = 0 TO ic-1
        FOR x% = 0 TO ic-1
            IF pix(y%,x%) < 16777215
                pr = INT(pix(y%,x%)/65536)
                pg = BIN_AND(INT(pix(y%,x%)/256), 255)
                pb = BIN_AND(pix(y%,x%), 255)
                2D_PEN_COLOR pr, pg, pb: 2D_POINT x%, y%
            END_IF
        NEXT x%
    NEXT y%
    GOSUB Ico2Des
ELSE
    ' Annul, ignorer
END_IF
HIDE 60: HIDE 61: HIDE 62: HIDE 63: HIDE 35: HIDE 36
cst% = 0
on = 0: GOSUB Desoutil
out = 0
on = 1: GOSUB Desoutil
CAPTION 40, "Outil Point: Clic le point à colorer"
RETURN
' *****************************************************************************
Teinte:
IF co = 16 THEN RETURN
k% = 32: ' pas d'incrémentation de luminosité
IF CLICKED(6) = 1
    ccr% = ccr% + k%: IF ccr% > 255 THEN ccr% = 255
    ccg% = ccg% + k%: IF ccg% > 255 THEN ccg% = 255
    ccb% = ccb% + k%: IF ccb% > 255 THEN ccb% = 255
ELSE
    ccr% = ccr% - k%: IF ccr% < 0 THEN ccr% = 0
    ccg% = ccg% - k%: IF ccg% < 0 THEN ccg% = 0
    ccb% = ccb% - k%: IF ccb% < 0 THEN ccb% = 0
END_IF
2D_TARGET_IS 3: 2D_FILL_COLOR ccr%, ccg%, ccb%
2D_RECTANGLE 2, 1, 50, 40
RETURN
' *****************************************************************************
Lbmp:
DATA Lb_ctr, Lb_wi%, Lb_hi%, Lb_bpp%, Lb_dt%(5000)
' Affichage de l'image bmp (type 16M de couleurs) f$ en x%,y% de l'objet obj%
Lb_ctr = 0: ' couleur transparente
FILEBIN_OPEN_READ 1, f$: FILEBIN_BLOCK_READ 1, 32, Lb_dt%(0)
Lb_wi% = Lb_dt%(18)+256*Lb_dt%(19): Lb_hi% = Lb_dt%(22)+256*Lb_dt%(23): ' largeur et hauteur
Lb_bpp% = Lb_dt%(28)/8: ' octets par pixel
FILEBIN_POSITION 1, Lb_dt%(10)+256*Lb_dt%(11): ' début datas image
2D_TARGET_IS obj%
FOR Lb_j% = 1 TO Lb_hi%
    FILEBIN_BLOCK_READ 1, Lb_wi%*Lb_bpp%, Lb_dt%(0)
    FOR Lb_i% = 0 TO Lb_wi%-1
        Lb_ccb% = Lb_dt%(Lb_i%*Lb_bpp%): Lb_ccg% = Lb_dt%(Lb_i%*Lb_bpp%+1): Lb_ccr% = Lb_dt%(Lb_i%*Lb_bpp%+2)
        IF (256*256*Lb_ccr% + 256*Lb_ccg% + Lb_ccb%) <> Lb_ctr
            2D_PEN_COLOR Lb_ccr%, Lb_ccg%, Lb_ccb%: 2D_POINT x%+Lb_i%, y%+Lb_hi%-Lb_j%
        END_IF
    NEXT Lb_i%
NEXT Lb_j%
FILEBIN_CLOSE 1
RETURN
' *****************************************************************************
Aide:
a$ = chr$(9) + chr$(9) + chr$(9) + chr$(9) + "- EDITEUR D'ICONES -" + chr$(10)
a$ = a$ + chr$(10)
a$ = a$ + "Pour création et/ou modification d'icônes simples." + chr$(10)
a$ = a$ + "- Le programme ne propose que 16 couleurs élémentaires." + chr$(10)
a$ = a$ + "- Le programme gère la transparence." + chr$(10)
a$ = a$ + chr$(10)
a$ = a$ + "Deux zones d'images: la zone de dessin agrandie à droite, l'icône grandeur nature"+chr$(10)
a$ = a$ + "en haut à gauche." + chr$(10)
a$ = a$ + "Chaque case à droite représente un pixel de l'icône." + chr$(10)
a$ = a$ + chr$(10)
a$ = a$ + "1) Création d'une icône pour usage général (Windows)" + chr$(10)
a$ = a$ + "- Choisir l'option format: 16x16, 24x24, 32x32, 48x48 ou 64x64" + chr$(10)
a$ = a$ + "- Dessiner l'icône à l'aide des outils fournis en cliquant sur l'outil désiré:"+chr$(10)
a$ = a$ + "  Point, Ligne, Rectangle vide ou plein, Cercle vide ou plein, Remplissage,"+chr$(10)
a$ = a$ + "  Rotation 90° à gauche, Effacement complet du dessin, choix de la couleur 'transparente',"+chr$(10)
a$ = a$ + "  superposition d'une grille repère 8x8 pixels pour aide au dessin."+chr$(10)
a$ = a$ + "  L'outil Texte (T) permet d'insérer quelques caractères dans l'icône, en haut à gauche."+chr$(10)
a$ = a$ + "  On peut choisir la police, sa taille de la police, et l'emplacement en x et y du texte dans l'icône."+chr$(10)
a$ = a$ + "  Pour positionner le texte avec précision, cliquer sur l'emplacement désiré dans la zone de dessin,"+chr$(10)
a$ = a$ + "  entrer le texte, puis cliquer 'OK'."+chr$(10)
a$ = a$ + "  Les outils flèches dans les 4 directions permettent de décaler l'icône d'une ligne ou d'une rangée"+chr$(10)
a$ = a$ + "  dans la direction désirée. Les pixels libérés ainsi deviennent transparents."+chr$(10)+chr$(10)

a$ = a$ + "  Il y a possibilité d'un seul retour en arrière (touche 'Undo') en cas d'erreur."+chr$(10)
a$ = a$ + "  Cliquer sur la couleur de tracé désirée (16 couleurs disponibles), ou à l'aide de l'outil"+chr$(10)
a$ = a$ + "  'pipette' sur une des couleurs du dessin."+chr$(10)
a$ = a$ + "  La couleur ainsi choisie devient la couleur active."+chr$(10)
a$ = a$ + "  La couleur active est affichée au-dessus du tableau des couleurs."+chr$(10)
a$ = a$ + "  On peut moduler la couleur choisie en plus clair ou en plus sombre."+chr$(10)
a$ = a$ + "  L'outil actif est surligné en jaune."+chr$(10)
a$ = a$ + "        Pour effacer un point ou une figure: dessiner avec la couleur de fond (transparente),"+chr$(10)
a$ = a$ + "        ou avec une autre couleur (blanc par exemple, ou autre)."+chr$(10)
a$ = a$ + "  La couleur transparente peut se choisir en cliquant sur l'outil correspondant (contribution de Klaus)."+chr$(10)
a$ = a$ + "  Elle est implicitement le noir pur (0,0,0) conformément à la norme des 'sprites' Panoramic."+chr$(10)
a$ = a$ + "- Sauvegarder l'icône dans un fichier (BMP ou ICO, au choix): clic 'Sauve BMP/ICO'."+chr$(10)
a$ = a$ + chr$(10)
a$ = a$ + "2) Création d'une icône pour usage sous Panoramic, pour agrémenter un programme."+chr$(10)
a$ = a$ + "    (fonction à l'usage des programmeurs: bouton 'Sauve Datas')."+chr$(10)
a$ = a$ + "- Le dessin créé en noir et blanc sera sauvegardé dans le Clipboard sous forme de lignes"+chr$(10)
a$ = a$ + "  de DATAs en hexadécimal pour utilisation ultérieure dans un programme Panoramic."+chr$(10)
a$ = a$ + "  Il suffit de 'Coller' ces lignes de datas dans le nouveau programme, de remplacer"+chr$(10)
a$ = a$ + "  les points d'interrogation en tête par un nom convenu, et d'appeler le sous-programme Dat2Pic"+chr$(10)
a$ = a$ + "  avec en paramètres le numéro d'objet destinataire (Picture par exemple), le nom attribué à cette icône"+chr$(10)
a$ = a$ + "  et les coordonnées x et y de l'emplacement désiré dans l'objet."+chr$(10)
a$ = a$ + "  On se contentera du noir et blanc (1 bit par pixel), sinon les datas seraient trop volumineux."+chr$(10)
a$ = a$ + "  Les icônes 'remplissage' et 'pipette' entre autres de ce programme ont été créées ainsi (voir les datas"+chr$(10)
a$ = a$ + "  en tête du programme)."+chr$(10)
a$ = a$ + chr$(10)
a$ = a$ + "Les directives affichée sous la zone de dessin sont fonction de l'outil choisi."+chr$(10)
a$ = a$ + chr$(10)
a$ = a$ + "3) Lecture d'une icône (.ICO, ou petite image carrée au format .BMP)"+chr$(10)
a$ = a$ + "- Touche 'Lire BMP/ICO', ouverture d'une boîte de dialogue pour choisir le fichier."+chr$(10)
a$ = a$ + "  On peut modifier l'icône chargée et la sauvegarder modifiée, au format choisi."+chr$(10)
a$ = a$ + chr$(10)
a$ = a$ + "Les conversions format bmp <-> format ico (Panoramic ne gère pas le format ico) sont"+chr$(10)
a$ = a$ + "sous-traitées au programme IrfanView, qui doit donc être présent sur le pc."
MESSAGE a$
RETURN
' *****************************************************************************
'                                    - Contribution Klaus-
' ****** Création form sélecteur de couleur - sous-programmes à inclure en fin de programme ******
form_color_picker:
form 2800 : hide 2800 : command_target_is 2800 : border_hide 2800 : color 2800,220,220,220
  top 2800,320 : left 2800,320 : width 2800,500 : height 2800,300
picture 2801 : top 2801,20 : left 2801,20 : width 2801,100 : height 2801,100
scroll_bar 2802 : top 2802,150 : left 2802,20 : width 2802,400 : horizontal 2802
  min 2802,0 : max 2802,255 : on_change 2802,change_2802
scroll_bar 2803 : top 2803,170 : left 2803,20 : width 2803,400 : horizontal 2803
  min 2803,0 : max 2803,255 : on_change 2803,change_2802
scroll_bar 2804 : top 2804,190 : left 2804,20 : width 2804,400 : horizontal 2804
  min 2804,0 : max 2804,255 : on_change 2804,change_2802
picture 2805 : top 2805,23 : left 2805,23 : width 2805,94 : height 2805,96 : color 2805,0,0,0
edit 2806 : top 2806,150 : left 2806,440 : width 2806,30 : text 2806,"0" : on_change 2806,change_2806
edit 2807 : top 2807,170 : left 2807,440 : width 2807,30 : text 2807,"0" : on_change 2807,change_2806
edit 2808 : top 2808,190 : left 2808,440 : width 2808,30 : text 2808,"0" : on_change 2808,change_2806
button 2810 : top 2810,220 : left 2810,20 : caption 2810,"Annuler" : on_click 2810,click_2810
button 2811 : top 2811,220 : left 2811,110 : caption 2811,"Valider" : on_click 2811,click_2811
alpha 2812 : top 2812,20 : left 2812,150 : font_size 2812,12 : font_bold 2812 : caption 2812,"Couleur <transparent>"
color_r% = 0 : color_g% = 0 : color_b% = 0
command_target_is 0 : return
' *****************************************************************************
' afficher le color picker
color_picker:
text 2806,str$(r(16)) : text 2807,str$(g(16)) : text 2808,str$(b(16))
show 2800
return
' *****************************************************************************
' changer couleur R, G ou B
change_2802:
    color 2805,position(2802),position(2803),position(2804)
    text 2806,position(2802) : text 2807,position(2803) : text 2808,position(2804)
    return
' *****************************************************************************
' changer couleur R G ou B par saisie directe
change_2806:
color_test$ = text$(2806) : gosub corriger_couleur_RGB : text 2806,color_test% : color_r% = color_test%
color_test$ = text$(2807) : gosub corriger_couleur_RGB : text 2807,color_test% : color_g% = color_test%
color_test$ = text$(2808) : gosub corriger_couleur_RGB : text 2808,color_test% : color_b% = color_test%
color 2805,color_r%,color_g%,color_b%
position 2802,color_r% : position 2803,color_g% : position 2804,color_b%
return
' *****************************************************************************
    ' abandon changer couleur
click_2810:
    color_s$ = ""
    hide 2800
    return
' *****************************************************************************
' valider changer couleur
'    la couleur est retournée en color_s$
'    et dans les variables color_r%, color_g%, color_g%
click_2811:
    color_s$ = str$(color_pixel_red(2805,1,1))+","+str$(color_pixel_green(2805,1,1))+","+str$(color_pixel_blue(2805,1,1))
    r(16)=position(2802) : g(16)=position(2803) : b(16)=position(2804) : ' couleur 'transparente'
    hide 2800
    return
' *****************************************************************************
' corriger une valeur RGB contenue dans color_test%
corriger_couleur_RGB:
    if numeric(color_test$)=1
        color_test% = val(color_test$)
    else
        color_test% = 0
    end_if
    if color_test%>255 then color_test% = 255
    if color_test%<0 then coolor_test% = 0
    return
' *****************************************************************************