Dessin

' Module de dessin
LABEL Quit,Charger,Sauver,Timeur,Desfig,Timon,Timoff,Trait,Rectangle,Cercle,Libre
LABEL Couleur,Annul
DIM p%,tp%,lp%,wp%,hp%,ns%,fs$(10),fig%,tr%,tg%,tb%,truc%,ray%
DIM f$,a$,i%,j%,x%,y%,x1%,y1%,x2%,y2%,x3%,y3%,sx1%,sx2%,sy1%,sy2%
DIM plein%,term%,an,w%,h%
DIM c%,t%,tc%,lc%,hc%,wc%,nf
DIM irfan$
irfan$ = "C:\Progra~2\Irfanv~1\i_view32.exe "

FOR i% = 1 TO 10: fs$(i%)="Z:\Save"+STR$(i%)+".bmp": NEXT i%

wp% = 640: hp% = 480: ' dimensions du picture de dessin
WIDTH 0,wp%+26: HEIGHT 0,hp%+180
FONT_NAME 0,"Arial": FONT_BOLD 0: CAPTION 0,""
COLOR 0,180,255,255
tr% = 255: tg% = 0: tb% = 255
tp% = 5: lp% = 5

p% = 1
PICTURE p%: TOP p%,tp%: LEFT p%,lp%: WIDTH p%,wp%: HEIGHT p%,hp%
CLIPBOARD_COPY p%: ' init vide

tc% = TOP(p%)+HEIGHT(p%)+5: lc% = LEFT(p%)
hc% = 120: wc% = WIDTH(p%)
c% = 20
CONTAINER c%: TOP c%,tc%: LEFT c%,lc%: WIDTH c%,wc%: HEIGHT c%,hc%
CAPTION c%," = TRACÉ = ": COLOR c%,255,255,180
CONTAINER_OPTION 21: PARENT 21,20: TOP 21,15: LEFT 21,5
WIDTH 21,90: HEIGHT 21,100: CAPTION 21,"Type": COLOR 21,200,255,200
OPTION 22: PARENT 22,21: TOP 22,15: LEFT 22,5: CAPTION 22,"Trait"
OPTION 23: PARENT 23,21: TOP 23,TOP(22)+20: LEFT 23,LEFT(22): CAPTION 23,"Rectangle"
OPTION 24: PARENT 24,21: TOP 24,TOP(23)+20: LEFT 24,LEFT(23): CAPTION 24,"Cercle"
OPTION 25: PARENT 25,21: TOP 25,TOP(24)+20: LEFT 25,LEFT(24): CAPTION 25,"Tracé libre"
MARK_ON 22

CONTAINER 30: PARENT 30,20: TOP 30,15: LEFT 30,LEFT(21)+WIDTH(21)+5: WIDTH 30,120
HEIGHT 30,75: CAPTION 30,"Taille/Couleur": COLOR 30,200,255,200
ALPHA 31: PARENT 31,30: TOP 31,20: LEFT 31,5: CAPTION 31,"Épaisseur"
SPIN 32: PARENT 32,30: TOP 32,TOP(31)-3: LEFT 32,60: WIDTH 32,40
MIN 32,1: MAX 32,20: POSITION 32,1
ALPHA 33: PARENT 33,30: TOP 33,45: LEFT 33,LEFT(31): CAPTION 33,"Couleur"
PICTURE 34: PARENT 34,30:TOP 34,TOP(33)-5: LEFT 34,LEFT(32)-2: WIDTH 34,44
HEIGHT 34,29: COLOR 34,0,0,0
PICTURE 35: PARENT 35,30: TOP 35,TOP(34)+2: LEFT 35,LEFT(34)+2: WIDTH 35,WIDTH(34)-4
HEIGHT 35,HEIGHT(34)-4: COLOR 35,tr%,tg%,tb%: ON_CLICK 35,Couleur
BUTTON 40: PARENT 40,c%: TOP 40,TOP(30)+HEIGHT(30)+2: LEFT 40,LEFT(30)
WIDTH 40,WIDTH(30): CAPTION 40,"Annuler dernier": ON_CLICK 40,Annul

ALPHA 50: PARENT 50,c%: TOP 50,6: LEFT 50,LEFT(30)+WIDTH(30)+5
CAPTION 50,"Charger une image:"
EDIT 51: PARENT 51,c%: TOP 51,TOP(50)+14: LEFT 51,LEFT(50): WIDTH 51,wp%-230
TEXT 51,"(clic)": ON_CLICK 51,Charger
ALPHA 52: PARENT 52,c%: TOP 52,TOP(51)+20: LEFT 52,LEFT(51)+50
FONT_BOLD_OFF 52
ALPHA 55: PARENT 55,c%: TOP 55,TOP(51)+35: LEFT 55,LEFT(50)
CAPTION 55,"Sauvegarder sous:"
EDIT 56: PARENT 56,c%: TOP 56,TOP(55)+14: LEFT 56,LEFT(55): WIDTH 56,WIDTH(51)
TEXT 56,"(clic)": ON_CLICK 56,Sauver
BUTTON 60: PARENT 60,c%: TOP 60,HEIGHT(c%)-28: LEFT 60,WIDTH(c%)-90
CAPTION 60,"Quitter": ON_CLICK 60,Quit

OPEN_DIALOG 68
SAVE_DIALOG 69

t% = 499
TIMER t%: TIMER_INTERVAL t%,40: ON_TIMER t%,Timeur: ' GOSUB Timoff

fig% = 1: ' trait
plein% = 0: ' figures géométriques vides
truc% = 0: term% = 0
2D_TARGET_IS p%
END
' ==============================================================================
Quit:
TERMINATE
' ==============================================================================
Charger:
GOSUB Timoff
f$ = FILE_NAME$(68): IF LEN(f$)<4 THEN GOSUB Timon: RETURN
ImgDim(f$)
a$ = CLIPBOARD_STRING_PASTE$
w% = VAL(LEFT$(a$,INSTR(a$,"x")-1)): h% = VAL(MID$(a$,INSTR(a$,"x")+1,10))
WIDTH p%,wp%: HEIGHT p%,wp%*h%/w%
IF HEIGHT(p%)>hp%
    HEIGHT p%,hp%: WIDTH p%,hp%*w%/h%
END_IF
' L'image est redimensionnée sans déformation pour tenir dans p%
i% = WIDTH(p%): j% = HEIGHT(p%)
a$ = " /resize=("+STR$(i%)+","+STR$(j%)+") /clipcopy /killmesoftly"
EXECUTE_WAIT irfan$+f$+a$
CLIPBOARD_PASTE p%
ns%=ns%+1: IF ns%>10 THEN ns%=1
FILE_SAVE p%,fs$(ns%)
TEXT 51,f$
CAPTION 52,"Image "+STR$(w%)+" x "+STR$(h%)+" redimensionnée en "+STR$(i%)+" x "+STR$(j%)
GOSUB Timon
RETURN
' ==============================================================================
Sauver:
GOSUB Timoff
f$ = FILE_NAME$(69): IF LEN(a$)<4 THEN GOSUB Timon: RETURN
a$ = UPPER$(RIGHT$(f$,4))
IF a$<>".BMP"
    CLIPBOARD_COPY p%
    EXECUTE_WAIT irfan$ + "/clippaste /convert="+f$
ELSE
    FILE_SAVE p%,f$
END_IF
TEXT 56,f$
GOSUB Timon
RETURN
' ==============================================================================
Timeur:
x% = MOUSE_X_POSITION(p%): y% = MOUSE_Y_POSITION(p%): ' position actuelle souris
a$ =  "X= "+STR$(x%)+" pixels  Y= "+STR$(y%)+" pixels"
caption 0,a$

2D_PEN_COLOR tr%,tg%,tb%: 2D_PEN_WIDTH POSITION(32)
IF MOUSE_LEFT_DOWN(p%) = 1: ' bouton gauche enfoncé
    x1% = x%: y1% = y%: ' origine
    truc% = 1
END_IF
fig% = 1
IF CHECKED(23) = 1
    fig% = 2
ELSE
    IF CHECKED(24) = 1
        fig% = 3
    ELSE
        IF CHECKED(25) = 1
            fig% = 4
        END_IF
    END_IF
END_IF
IF MOUSE_LEFT_UP(p%) = 1: ' relâche, tracé final
    GOSUB Timoff
Desfig:
    sx1% = x1%: sx2% = x2%: sy1% = y1%: sy2% = y2%
    ' Tracé en continu
    ' Sauvegarde état précédent (10 sauvegardes possibles, en boucle)
    ns%=ns%+1: IF ns%>10 THEN ns%=1
    FILE_SAVE p%,fs$(ns%)
    term% = 1
    SELECT fig%
        CASE 1: GOSUB Trait
        CASE 2: GOSUB Rectangle
        CASE 3: GOSUB Cercle
        CASE 4: GOSUB Libre
    END_SELECT
    x1% = sx1%: x2% = sx2%: y1% = sy1%: y2% = sy2%
    truc% = 0
END_IF
IF truc% = 1
    ' tracé provisoire, en continu
    x2% = x%: y2% = y%: ' position actuelle
    IF x2%=x3% AND y2%=y3% THEN RETURN: ' position inchangée
    SELECT fig%
        CASE 1: GOSUB Trait
        CASE 2: GOSUB Rectangle
        CASE 3: GOSUB Cercle
        CASE 4: GOSUB Libre
    END_SELECT
    x3% = x%: y3% = y%
END_IF
GOSUB Timon
RETURN
' ==============================================================================
Timon:
TIMER_ON t%
RETURN
' ==============================================================================
Timoff:
TIMER_OFF t%
RETURN
' ==============================================================================
Trait:
CLIPBOARD_PASTE p%
2D_LINE x1%,y1%,x2%,y2%
IF term% = 1
    CLIPBOARD_COPY p%
    term% = 0
END_IF
RETURN
' ==============================================================================
Rectangle:
CLIPBOARD_PASTE p%
2D_LINE x1%,y1%,x2%,y1%:2D_POLY_TO x2%,y2%:2D_POLY_TO x1%,y2%:2D_POLY_TO x1%,y1%
IF term% = 1
    CLIPBOARD_COPY p%
    term% = 0
END_IF
RETURN
' ==============================================================================
Cercle:
CLIPBOARD_PASTE p%
ray% = SQR((y2%-y1%)*(y2%-y1%) + (x2%-x1%)*(x2%-x1%))
2D_POLY_FROM x1%+ray%,y1%
FOR an = 0 TO 8*ATN(1)+.1 STEP .1
    2D_POLY_TO x1%+ray%*COS(an), y1%+ray%*SIN(an)
NEXT an
IF term% = 1
    CLIPBOARD_COPY p%
    term% = 0
END_IF
RETURN
' ==============================================================================
Libre:
2D_LINE x1%,y1%,x2%,y2%: x1%=x2%: y1%=y2%
IF term% = 1 THEN CLIPBOARD_COPY p%
term% = 0
RETURN
' ==============================================================================
Couleur:
GOSUB Timoff
Palette16(LEFT(50),TOP(20))
a$ = CLIPBOARD_STRING_PASTE$
i% = INSTR(a$,","): tr%=VAL(LEFT$(a$,i%-1)): a$ = MID$(a$,i%+1,10)
i% = INSTR(a$,","): tg%=VAL(LEFT$(a$,i%-1)): tb% = VAL(MID$(a$,i%+1,10))
COLOR 35,tr%,tg%,tb%
CLIPBOARD_COPY p%: ' rafraîchissement du clipboard
GOSUB Timon
RETURN
' ==============================================================================
Annul:
ns% = ns%-1: IF ns%<1 THEN ns% = 10
FILE_LOAD p%,fs$(ns%)
CLIPBOARD_COPY p%
RETURN
' ==============================================================================
SUB ImgDim(f$)
' Dimensions de l'image f$ -> clipboard sous la forme wwwxhhh
' Lecture du résultat:
'     a$ = CLIPBOARD_STRING_PASTE$
'     w% = VAL(LEFT$(a$,INSTR(a$,"x")-1)): h% = VAL(MID$(a$,INSTR(a$,"x")+1,10))
DIM_LOCAL r$, n$, q$, fv$
q$ = CHR$(34): fv$ = "C:\TEMP\Script.vbs"
r$ = FILE_EXTRACT_PATH$(f$): n$ = FILE_EXTRACT_NAME$(f$)
FILE_OPEN_WRITE 9,fv$
    FILE_WRITELN 9,"Const DIMENSIONS = 31"
    FILE_WRITELN 9,"Set oShell  = CreateObject ("+q$+"Shell.Application"+q$+")"
    FILE_WRITELN 9,"Set oFolder = oShell.Namespace ("+q$+r$+q$+")"
    FILE_WRITELN 9,"Set oFile   = oFolder.ParseName("+q$+n$+q$+")"
    FILE_WRITELN 9,"strDimensions = oFolder.GetDetailsOf(oFile, DIMENSIONS)"
    FILE_WRITELN 9,"WScript.Echo strDimensions"
FILE_CLOSE 9
EXECUTE_WAIT "Cmd.exe /c Cscript.exe "+fv$+" | clip"
FILE_DELETE fv$
r$ = TRIM$(CLIPBOARD_STRING_PASTE$): r$ = MID$(r$,2,LEN(r$)-2)
r$ = LEFT$(r$,INSTR(r$," x ")-1)+"x"+MID$(r$,INSTR(r$," x ")+3,10)
CLIPBOARD_STRING_COPY r$
END_SUB
' ==============================================================================
SUB Palette16(x,y)
' Choix d'une couleur dans une palette de 16 (couleurs html de base) affichée en x,y
' Résultat dans le clipboard sous forme d'une chaîne r,g,b (ex. "192,24,33")
IF LABEL("Aff_pal16") = 0 THEN LABEL Aff_pal16
IF LABEL("Qui_pal16") = 0 THEN LABEL Qui_pal16
DIM_LOCAL ch$(16),nc$(16)
DIM_LOCAL a$, nf, np, nq, nt, nb, wc, hc, r, g, b, i, j, k, n2t
n2t = NUMBER_2D_TARGET
DATA "Pal16"
DATA "000000","000080","0000FF","008000","008080","00FF00","00FFFF","800000"
DATA "800080","808000","808080","C0C0C0","FF0000","FF00FF","FFFF00","FFFFFF"
DATA " black"," navy","  blue"," green"," teal","  lime"," cyan","maroon"," purple"
DATA " olive"," gray"," silver","  red","magenta","  yellow","  white": ' noms standards
RESTORE: READ a$: WHILE a$<>"Pal16": READ a$: END_WHILE
FOR i=1 TO 16: READ ch$(i): NEXT i: FOR i=1 TO 16: READ nc$(i): NEXT i
wc = 40: hc = 20
nf=3000: WHILE OBJECT_EXISTS(nf)=1: nf=nf+1: END_WHILE
FORM nf: TOP nf,y: LEFT nf,x: WIDTH nf,4*(wc+1)+16: HEIGHT nf,4*(hc+14)+66
BORDER_SMALL nf
CAPTION nf," -   16  COULEURS  HTML   -": ON_CLOSE nf,Qui_pal16
np=nf+1: WHILE OBJECT_EXISTS(np)=1: np=np+1: END_WHILE
PICTURE np: PARENT np,nf: FULL_SPACE np: 2D_TARGET_IS np: PRINT_TARGET_IS np
ON_CLICK np,Aff_pal16
nq=np+1: WHILE OBJECT_EXISTS(nq)=1: nq=nq+1: END_WHILE
PICTURE nq: PARENT nq,nf: TOP nq,4*(hc+14)+5: LEFT nq,0: WIDTH nq,wc
HEIGHT nq,25
nt=nq+1: WHILE OBJECT_EXISTS(nt)=1: nt=nt+1: END_WHILE
ALPHA nt: PARENT nt,nf: TOP nt,TOP(nq): LEFT nt,LEFT(nq)+WIDTH(nq)+5
FONT_NAME nt,"Lucida Console"
nb=nt+1: WHILE OBJECT_EXISTS(nb)=1: nb=nb+1: END_WHILE
BUTTON nb: PARENT nb,nf:TOP nb,TOP(nq): WIDTH nb,40: LEFT nb,WIDTH(nf)-56
CAPTION nb,"OK"
ON_CLICK nb,Qui_pal16
k = 1
FOR j=0 TO 3
    y = j*(hc+14)
    FOR i = 0 TO 3
        a$ = ch$(k): r=HEX(LEFT$(a$,2)): g=HEX(MID$(a$,3,2)): b=HEX(RIGHT$(a$,2))
        x = i*(wc+1): 2D_PEN_COLOR r,g,b: 2D_FILL_COLOR r,g,b
        2D_RECTANGLE x,y,x+wc,y+hc
        2D_FILL_COLOR 255,255,255: PRINT_LOCATE x,y+hc: PRINT nc$(k)
        k = k+1
    NEXT i
NEXT j
r=0: g=0: b=0: COLOR nq,r,g,b
CAPTION nt,"#00 00 00"+CHR$(10)+STR$(r)+","+STR$(g)+","+STR$(b)
2D_TARGET_IS nq: 2D_PEN_COLOR 164,164,164
WHILE 1>0: WAIT 100: TO_FOREGROUND nf: END_WHILE
Aff_pal16:
x=MOUSE_X_LEFT_DOWN(np): y=MOUSE_Y_LEFT_DOWN(np)
r=COLOR_PIXEL_RED(np,x,y): g=COLOR_PIXEL_GREEN(np,x,y): b=COLOR_PIXEL_BLUE(np,x,y)
2D_FILL_COLOR r,g,b: 2D_RECTANGLE 0,0,WIDTH(nq),HEIGHT(nq)
a$ = "#"+RIGHT$("0"+HEX$(r),2)+" "+RIGHT$("0"+HEX$(g),2)+" "+RIGHT$("0"+HEX$(b),2)
a$ = a$ + CHR$(10)+STR$(r)+","+STR$(g)+","+STR$(b)
CAPTION nt,a$
RETURN
Qui_pal16:
2D_TARGET_IS n2t: DELETE nf
CLIPBOARD_STRING_COPY STR$(r)+","+STR$(g)+","+STR$(b)
END_SUB
' ==============================================================================

' teste affichage sur une image:
full_space 0
dim obj% : obj% = 100

scene2d 10: width 10,500 : height 10,500 : color 10,200,200,240

picture 20:width  20,500 : height 20,500: color 20,0,0,0:left 20,510

texte()
end
' ===============================
sub texte()
   dim_local a%
   color 20,0,0,0
   2d_target_is 20
   font_size 20,15
   font_color 20,100,0,1: ' 1 pour différentié du noir
   2d_fill_color 0,0,0
   print_target_is 20

   print_locate 0,0
   print "ceci est un essai pour voir le résultat"
   ' on copie le texte:
   image 30
   2d_image_copy 30,0,0,500,30
   sprite obj%
   sprite_image_load obj%,30
   pause 1000
   for a% = 1 to 100
         sprite_position obj%,20,a%   : pause 10
   next a%
   obj% = obj% + 1
end_sub

' Module de dessin
LABEL Quit,Errare, Charger,Sauver,Timeur,Timon,Timoff,Svg,Rst,Trait,Rectangle
LABEL Cercle,Libre,Remdec,Remplir,Decoupe,Couleur,Majcoul,Annul,Instxt,Insimg
LABEL Chi,Rdim,Coultex,Valtex, Valim,Aninser,Police,Police1,Ashow,Ahide,Grille
LABEL Virfan,Coller,Ttpic,Raztou,Aide

DIM p%,tp%,lp%,wp%,hp%,ns%,fs$(10),fig%,tr%,tg%,tb%,truc%,ray%,ttr%,ttg%,ttb%
DIM f$,a$,b$,c$,i%,j%,k%,x%,y%,x1%,y1%,x2%,y2%,x3%,y3%,sx1%,sx2%,sy1%,sy2%,ctt%
DIM xr%,yr%,plein%,term%,an,w%,h%,clr$(16),gril%,tof%,ct%,cbo%,act%
DIM c%,t%,tc%,lc%,hc%,wc%,nf,ax%,ay%,bx%,by%,r%,g%,b%,rt%,gt%,bt%,wis%,his%
DIM irfan$,savzon$

irfan$ = "C:\Progra~2\Irfanv~1\i_view32.exe "
savzon$ = "C:\TEMP\Extrima.bmp": ' fichier de sauvegarde des extraits d'images

FOR i% = 1 TO 10: fs$(i%)="Z:\Save"+STR$(i%)+".bmp": NEXT i%
DATA "Pal16"
DATA "000000","000080","0000FF","008000","008080","00FF00","00FFFF","800000"
DATA "800080","808000","808080","C0C0C0","FF0000","FF00FF","FFFF00","FFFFFF"
RESTORE: READ a$: WHILE a$<>"Pal16": READ a$: END_WHILE
FOR i% = 1 TO 16: READ clr$(i%): NEXT i%

wp% = 800
hp% = 3*wp%/4: ' dimensions du picture de dessin (rapport 4/3)
WIDTH 0,wp%+26: HEIGHT 0,hp%+220: BORDER_SMALL 0
FONT_NAME 0,"Arial": FONT_BOLD 0: CAPTION 0,""
COLOR 0,180,255,255: ON_CLOSE 0,Quit
tr% = 255: tg% = 0: tb% = 255
tp% = 8: lp% = 5

p% = 1
PICTURE p%: TOP p%,tp%: LEFT p%,lp%: WIDTH p%,wp%: HEIGHT p%,hp%
CLIPBOARD_COPY p%: ' init vide
on_click p%,Ttpic

' témoin d'activité du timer
PICTURE 8: TOP 8,0: LEFT 8,5: WIDTH 8,20: HEIGHT 8,8
PICTURE 9: TOP 9,TOP(8): LEFT 9,LEFT(8)+WIDTH(8): WIDTH 9,WIDTH(8): HEIGHT 9,HEIGHT(8)
PICTURE 10: TOP 10,0: LEFT 10,60: HEIGHT 10,8: WIDTH 10,40

tc% = TOP(p%)+HEIGHT(p%)+5: lc% = LEFT(p%)
hc% = 170: wc% = WIDTH(p%)
c% = 20
CONTAINER c%: TOP c%,tc%: LEFT c%,lc%: WIDTH c%,wc%: HEIGHT c%,hc%
CAPTION c%," = TRACÉ = ": COLOR c%,255,255,180
CONTAINER_OPTION 21: PARENT 21,20: TOP 21,15: LEFT 21,5
WIDTH 21,100: HEIGHT 21,130: CAPTION 21,"Type": COLOR 21,200,255,200
OPTION 22: PARENT 22,21: TOP 22,15: LEFT 22,5: CAPTION 22,"Trait"
OPTION 23: PARENT 23,21: TOP 23,TOP(22)+18: LEFT 23,LEFT(22): CAPTION 23,"Rectangle"
OPTION 24: PARENT 24,21: TOP 24,TOP(23)+18: LEFT 24,LEFT(23): CAPTION 24,"Cercle"
OPTION 25: PARENT 25,21: TOP 25,TOP(24)+18: LEFT 25,LEFT(24): CAPTION 25,"Tracé libre"
OPTION 26: PARENT 26,21: TOP 26,TOP(25)+18: LEFT 26,LEFT(25): CAPTION 26,"Remplir"
OPTION 27: PARENT 27,21: TOP 27,TOP(26)+18: LEFT 27,LEFT(26): CAPTION 27,"Découper"
MARK_ON 22
CHECK 29: PARENT 29,c%: TOP 29,TOP(21)+HEIGHT(21)+3: LEFT 29,5
CAPTION 29,"Grille": WIDTH 29,150: ON_CLICK 29,Grille

CONTAINER 30: PARENT 30,20: TOP 30,15: LEFT 30,LEFT(21)+WIDTH(21)+5: WIDTH 30,120
HEIGHT 30,150: CAPTION 30,"Taille/Couleur": COLOR 30,200,255,200
ALPHA 31: PARENT 31,30: TOP 31,20: LEFT 31,5: CAPTION 31,"Épaisseur"
SPIN 32: PARENT 32,30: TOP 32,TOP(31)-3: LEFT 32,60: WIDTH 32,40
MIN 32,1: MAX 32,20: POSITION 32,1
ALPHA 33: PARENT 33,30: TOP 33,40: LEFT 33,LEFT(31): CAPTION 33,"Couleur"
PICTURE 34: PARENT 34,30:TOP 34,TOP(33): LEFT 34,LEFT(32)-2: WIDTH 34,44
HEIGHT 34,18: COLOR 34,0,0,0: ' encadrement
PICTURE 35: PARENT 35,30: TOP 35,TOP(34)+2: LEFT 35,LEFT(34)+2: WIDTH 35,WIDTH(34)-4
HEIGHT 35,HEIGHT(34)-4: COLOR 35,tr%,tg%,tb%: ' couleur de tracé
BUTTON 40: PARENT 40,c%: TOP 40,HEIGHT(c%)-60: LEFT 40,LEFT(30)+WIDTH(30)
WIDTH 40,120: CAPTION 40,"Annuler dernier": ON_CLICK 40,Annul
PICTURE 41: PARENT 41,30: TOP 41,58: LEFT 41,2: WIDTH 41,WIDTH(30)-4: HEIGHT 41,70
ON_CLICK 41,Couleur
k% = 0: y% = 3: x% = 2: 2D_TARGET_IS 41
FOR j% = 1 TO 4
    FOR i% = 1 TO 4
        k% = k%+1: a$ = clr$(k%)
        tr%=HEX(LEFT$(a$,2)): tg%=HEX(MID$(a$,3,2)): tb%=HEX(RIGHT$(a$,2))
        2D_FILL_COLOR tr%,tg%,tb%
        2D_RECTANGLE x%,y%,x%+27,y%+15: x%=x%+28
    NEXT i%
    y%=y%+16: x% = 2
NEXT j%
ALPHA 42: PARENT 42,30: TOP 42,TOP(41)+71: LEFT 42,3: CAPTION 42,"R=        G=        B="
EDIT 43: PARENT 43,30: TOP 43,TOP(42)-3: LEFT 43,15: WIDTH 43,25
EDIT 44: PARENT 44,30: TOP 44,TOP(43): LEFT 44,53: WIDTH 44,25
EDIT 45: PARENT 45,30: TOP 45,TOP(43): LEFT 45,90: WIDTH 45,25
tr% = 255: tg% = 0: tb% = 255
TEXT 43,STR$(tr%): TEXT 44,STR$(tg%): TEXT 45,STR$(tb%)
FOR i% = 43 TO 45: ON_CHANGE i%,Majcoul: NEXT i%

BUTTON 47: PARENT 47,c%: TOP 47,HEIGHT(c%)-34: LEFT 47,LEFT(30)+WIDTH(30): WIDTH 47,120
CAPTION 47,"Insertion texte": ON_CLICK 47,Instxt
BUTTON 48: PARENT 48,c%: TOP 48,TOP(47): LEFT 48,LEFT(47)+WIDTH(47)+5: WIDTH 48,WIDTH(47)
CAPTION 48,"Insertion image": ON_CLICK 48,Insimg
BUTTON 49: PARENT 49,c%: TOP 49,TOP(40): LEFT 49,LEFT(48): WIDTH 49,120
CAPTION 49,"RAZ Tout": ON_CLICK 49,Raztou

ALPHA 50: PARENT 50,c%: TOP 50,6: LEFT 50,LEFT(30)+WIDTH(30)+5
CAPTION 50,"Charger une image:"
EDIT 51: PARENT 51,c%: TOP 51,TOP(50)+14: LEFT 51,LEFT(50): WIDTH 51,wp%-230
TEXT 51,"(clic ...)": ON_CLICK 51,Charger
ALPHA 52: PARENT 52,c%: TOP 52,TOP(51)+20: LEFT 52,LEFT(51)+180
FONT_BOLD_OFF 52
ALPHA 55: PARENT 55,c%: TOP 55,TOP(51)+25: LEFT 55,LEFT(50)
CAPTION 55,"Sauvegarder le dessin sous:"
EDIT 56: PARENT 56,c%: TOP 56,TOP(55)+14: LEFT 56,LEFT(55): WIDTH 56,WIDTH(51)
TEXT 56,"(clic ...)": ON_CLICK 56,Sauver
ALPHA 57: PARENT 57,c%: TOP 57,TOP(56)+30: LEFT 57,LEFT(50): COLOR 57,255,255,0

BUTTON 58: PARENT 58,c%: TOP 58,TOP(56)+23: LEFT 58,WIDTH(c%)-180: WIDTH 58,85
HEIGHT 58,20: CAPTION 58,"Voir dans IV": ON_CLICK 58,Virfan
BUTTON 59: PARENT 59,c%: TOP 59,TOP(58): LEFT 59,LEFT(58)+WIDTH(58): WIDTH 59,85
HEIGHT 59,20: CAPTION 59,"Coller de IV": ON_CLICK 59,Coller
ALPHA 60: PARENT 60,c%: TOP 60,TOP(58)+20: LEFT 60,LEFT(58)+55
font_italic 60: CAPTION 60,"(IrfanView)"

BUTTON 70: PARENT 70,c%: TOP 70,TOP(48): LEFT 70,WIDTH(c%)-90
CAPTION 70,"Quitter": ON_CLICK 70,Quit
BUTTON 71: PARENT 71,c%: TOP 71,TOP(70): LEFT 71,LEFT(70)-35: WIDTH 71,30
CAPTION 71,"?": ON_CLICK 71,Aide

OPEN_DIALOG 88
SAVE_DIALOG 89

DIM ft%,fp%,fi%,fr%,fd%
DIM hnd%,pos%,fnt$,sz%,attr%,coul%
' ++++++++++++++++++++++++ FORM DE SAISIE DE TEXTE POUR INSERTION ++++++++++++++
ft%=100:  FORM ft%: TOP ft%,hp%-20: LEFT ft%,LEFT(50)+20: WIDTH ft%,400: HEIGHT ft%,220
          COLOR ft%,190,255,190: BORDER_SMALL ft%: FONT_NAME ft%,"Arial": FONT_BOLD ft%
          CAPTION ft%," -  INSERTION  DE  TEXTE  -": HIDE ft%
          ON_CLOSE ft%,Aninser
i%=ft%+1: ALPHA i%: PARENT i%,ft%: TOP i%,5: LEFT i%,40: FONT_BOLD i%
          a$ = "Police              Taille    Couleur  G    I    S"
          a$=a$+"      Posit.X      Posit.Y": CAPTION i%,a$
i%=ft%+2: EDIT i%: PARENT i%,ft%: TOP i%,20: LEFT i%,5: WIDTH i%,100
          TEXT i%,"Arial": ON_CLICK i%,Police
i%=ft%+3: SPIN i%: PARENT i%,ft%: TOP i%,20: LEFT i%,LEFT(ft%+2)+WIDTH(ft%+2)+5
          WIDTH i%,45: MIN i%,5: MAX i%,255: POSITION i%,10
i%=ft%+4: PICTURE i%: PARENT i%,ft%: TOP i%,20: LEFT i%,LEFT(ft%+3)+WIDTH(ft%+3)+5
          WIDTH i%,40: HEIGHT i%,20: COLOR i%,0,0,0: ON_CLICK i%,Coultex
i%=ft%+5: CHECK i%: PARENT i%,ft%: TOP i%,20: LEFT i%,LEFT(ft%+4)+WIDTH(ft%+4)+10
i%=ft%+6: CHECK i%: PARENT i%,ft%: TOP i%,20: LEFT i%,LEFT(ft%+5)+20
i%=ft%+7: CHECK i%: PARENT i%,ft%: TOP i%,20: LEFT i%,LEFT(ft%+6)+20
' coordonnées d'implantation
i%=ft%+8: EDIT i%: PARENT i%,ft%: TOP i%,20: LEFT i%,LEFT(ft%+7)+20: WIDTH i%,50
i%=ft%+9: EDIT i%: PARENT i%,ft%: TOP i%,20: LEFT i%,LEFT(ft%+8)+60: WIDTH i%,50
' choix couleur
i%=ft%+15: PICTURE i%: PARENT i%,ft%: TOP i%,45: LEFT i%,8: WIDTH i%,WIDTH(ft%)-31
          HEIGHT i%,16: ON_CLICK i%,Coultex
          y% = 0: x% = 0: 2D_TARGET_IS i%
          FOR j% = 1 TO 16
              a$ = clr$(j%)
              tr%=HEX(LEFT$(a$,2)): tg%=HEX(MID$(a$,3,2)): tb%=HEX(RIGHT$(a$,2))
              2D_FILL_COLOR tr%,tg%,tb%
              2D_RECTANGLE x%,y%,x%+24,y%+16: x%=x%+23
          NEXT j%
i%=ft%+10: MEMO i%: PARENT i%,ft%: TOP i%,TOP(ft%+15)+23: LEFT i%,5: WIDTH i%,WIDTH(ft%)-25
          HEIGHT i%,90
i%=ft%+11: BUTTON i%: PARENT i%,ft%: TOP i%,HEIGHT(ft%)-59
          LEFT i%,WIDTH(ft%)/2-40: CAPTION i%,"Insérer": ON_CLICK i%,Valtex
i%=ft%+12: BUTTON i%: PARENT i%,ft%: TOP i%,TOP(i%-1): LEFT i%,WIDTH(ft%)-100
          CAPTION i%,"Annuler": ON_CLICK i%,Aninser
' choix police
fp%=ft%+20: FORM fp%: TOP fp%,TOP(ft%)+40: LEFT fp%,LEFT(ft%)+10: BORDER_HIDE fp%
            HIDE fp%
i%=fp%+1: LIST i%: PARENT i%,fp%: FULL_SPACE i%: FONT_NAMES_LOAD i%
          FOR j% = COUNT(i%) TO 1 STEP -1
              IF LEFT$(ITEM_READ$(i%,j%),1)="@" THEN ITEM_DELETE i%,j%
          NEXT j%
          ON_CLICK i%,Police1
' +++++++++++++++++++++++++ FORM POUR INSERTION D'IMAGE ++++++++++++++++++++++++
fi%=200:  FORM fi%: TOP fi%,TOP(ft%)+40: LEFT fi%,LEFT(ft%): WIDTH fi%,400: HEIGHT fi%,175
          COLOR fi%,190,190,255: BORDER_SMALL fi%: FONT_NAME fi%,"Arial": FONT_BOLD fi%
          CAPTION fi%," -  INCRUSTATION  D' IMAGE  -": HIDE fi%
          ON_CLOSE fi%,Aninser
i%=fi%+1: ALPHA i%: PARENT i%,fi%: TOP i%,5: LEFT i%,5: CAPTION i%,"Image:"
          FONT_BOLD i%
i%=fi%+2: EDIT i%: PARENT i%,fi%: TOP i%,2: LEFT i%,45: WIDTH i%,WIDTH(fi%)-65
          TEXT i%," (clic)": ON_CLICK i%,Chi
i%=fi%+3: ALPHA i%: PARENT i%,fi%: TOP i%,30: LEFT i%,100
          CAPTION i%,"Dimensions (W x H):                      X": FONT_BOLD i%
i%=fi%+4: EDIT i%: PARENT i%,fi%: TOP i%,TOP(i%-1)-3: LEFT i%,LEFT(i%-1)+120
          WIDTH i%,50
i%=fi%+5: EDIT i%: PARENT i%,fi%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+70
          WIDTH i%,50
i%=fi%+6: ALPHA i%: PARENT i%,fi%: TOP i%,TOP(fi%+3)+30: LEFT i%,LEFT(fi%+3)
          WIDTH i%,200: CAPTION i%,"Redimensionner en:                      X"
          FONT_BOLD i%
i%=fi%+7: EDIT i%: PARENT i%,fi%: TOP i%,TOP(i%-1)-3: LEFT i%,LEFT(fi%+4): WIDTH i%,50
i%=fi%+8: EDIT i%: PARENT i%,fi%: TOP i%,TOP(i%-1): LEFT i%,LEFT(fi%+5): WIDTH i%,50
i%=fi%+9: BUTTON i%: PARENT i%,fi%: TOP i%,TOP(i%-1)-1: LEFT i%,LEFT(i%-1)+52
          WIDTH i%,40: CAPTION i%,"OK": ON_CLICK i%,Rdim
i%=fi%+10: ALPHA i%: PARENT i%,fi%: TOP i%,TOP(fi%+6)+30: LEFT i%,LEFT(fi%+6)+40
          CAPTION i%,"Insérer en  X=                    Y="
i%=fi%+11: EDIT i%: PARENT i%,fi%: TOP i%,TOP(i%-1)-3: LEFT i%,LEFT(fi%+7): WIDTH i%,50
i%=fi%+12: EDIT i%: PARENT i%,fi%: TOP i%,TOP(i%-1): LEFT i%,LEFT(fi%+8): WIDTH i%,50
i%=fi%+13: BUTTON i%: PARENT i%,fi%: TOP i%,TOP(fi%+11)+HEIGHT(fi%+11)+5
          LEFT i%,WIDTH(fi%)/2: CAPTION i%,"Insérer": ON_CLICK i%,Valim
i%=fi%+14: BUTTON i%: PARENT i%,fi%: TOP i%,TOP(i%-1): LEFT i%,WIDTH(fi%)-100
          CAPTION i%,"Quitter": ON_CLICK i%,Aninser
i%=fi%+15: IMAGE i%

i%=fi%+16: CHECK i%: PARENT i%,fi%: TOP i%,90: LEFT i%,5: CAPTION i%,"Transparence:"
i%=fi%+17: ALPHA i%: PARENT i%,fi%: TOP i%,115: LEFT i%,5: CAPTION i%,"R=          G=            B="
i%=fi%+18: EDIT i%: PARENT i%,fi%: TOP i%,112: LEFT i%,20: WIDTH i%,30: TEXT i%,"0"
i%=fi%+19: EDIT i%: PARENT i%,fi%: TOP i%,112: LEFT i%,67: WIDTH i%,30: TEXT i%,"0"
i%=fi%+20: EDIT i%: PARENT i%,fi%: TOP i%,112: LEFT i%,117: WIDTH i%,30: TEXT i%,"0"

' +++++++++++++++++++++++ FORM DE REMPLISSAGE ++++++++++++++++++++++++++++++++++
fr%=300: FORM fr%: TOP fr%,TOP(ft%)+70: LEFT fr%,LEFT(ft%): WIDTH fr%,400: HEIGHT fr%,150
        COLOR fr%,255,190,190: BORDER_SMALL fr%: FONT_NAME fr%,"Arial": FONT_BOLD fr%
        CAPTION fr%," - REMPLISSAGE  D'UNE  ZONE  DÉJÀ  DÉLIMITÉE-": HIDE fr%
        ON_CLOSE fr%,Aninser
i%=fr%+1: ALPHA i%: PARENT i%,fr%: TOP i%,5: LEFT i%,5: COLOR i%,255,255,0
i%=fr%+2: BUTTON i%: PARENT i%,fr%: TOP i%,45: LEFT i%,2: WIDTH i%,120
          CAPTION i%,"Remplir la zone": ON_CLICK i%,Remplir
i%=fr%+3: ALPHA i%: PARENT i%,fr%: TOP i%,TOP(fr%+2)+25: LEFT i%,5
          CAPTION i%,"( <- couleur actuelle)"
i%=fr%+4: CONTAINER_OPTION i%: PARENT i%,fr%: TOP i%,0: LEFT i%,130: WIDTH i%,250
          HEIGHT i%,30: COLOR i%,255,210,210
i%=fr%+5: OPTION i%: PARENT i%,fr%+4: TOP i%,8: LEFT i%,5: CAPTION i%,"Fond uniforme"
          MARK_ON i%
i%=fr%+6: OPTION i%: PARENT i%,fr%+4: TOP i%,8: LEFT i%,120: CAPTION i%,"Fond composite"
i%=fr%+7: ALPHA i%: PARENT i%,fr%: TOP i%,TOP(fr%+4)+HEIGHT(fr%+4): LEFT i%,LEFT(fr%+4)+15
          a$="- Fond uniforme:"+CHR$(10)
          a$=a$+"  la zone à remplir est de couleur uniforme"+CHR$(10)
          a$=a$+"- Fond composite:"+CHR$(10)
          a$=a$+"  la zone est un fond d'image quelconque, la"+CHR$(10)
          a$=a$+"  couleur de bordure doit être différente des"+CHR$(10)
          a$=a$+"  couleurs incluses."
          FONT_BOLD_OFF i%: CAPTION i%,a$
i%=fr%+8: ALPHA i%: PARENT i%,fr%: TOP i%,25: LEFT i%,1: CAPTION i%,"Couleur bordure:"
i%=fr%+9: PICTURE i%: PARENT i%,fr%: TOP i%,22: LEFT i%,100: WIDTH i%,25: HEIGHT i%,20
i%=fr%+10: BUTTON i%: PARENT i%,fr%: TOP i%,HEIGHT(fr%)-60: LEFT i%,10: WIDTH i%,110
          CAPTION i%,"Annuler/Quitter": ON_CLICK i%,Aninser
' +++++++++++++++++++ FORM POUR DÉCOUPAGE / EXTRACTION +++++++++++++++++++++++++
fd%=400: FORM fd%: TOP fd%,TOP(ft%)+70: LEFT fd%,LEFT(ft%): WIDTH fd%,400: HEIGHT fd%,150
        COLOR fd%,255,190,190: BORDER_SMALL fd%: FONT_NAME fd%,"Arial": FONT_BOLD fd%
        CAPTION fd%," - DÉCOUPAGE  D'UNE  ZONE  DÉJÀ  DÉLIMITÉE-": HIDE fd%
        ON_CLOSE fd%,Aninser
i%=fd%+1: ALPHA i%: PARENT i%,fd%: TOP i%,5: LEFT i%,5
          COLOR i%,255,255,0
i%=fd%+2: BUTTON i%: PARENT i%,fd%: TOP i%,TOP(i%-1)+20: LEFT i%,50: WIDTH i%,275
          CAPTION i%,"Extraire le rectangle": ON_CLICK i%,Decoupe
i%=fd%+3: ALPHA i%: PARENT i%,fd%: TOP i%,TOP(i%-1)+25: LEFT i%,10
          CAPTION i%,"Sera enregistré sous (BMP):"
i%=fd%+4: EDIT i%: PARENT i%,fd%: TOP i%,TOP(i%-1)+14: LEFT i%,5
          WIDTH i%,WIDTH(fd%)-26: TEXT i%,savzon$
i%=fd%+9: BUTTON i%: PARENT i%,fd%: TOP i%,HEIGHT(fd%)-60: LEFT i%,10: WIDTH i%,110
          CAPTION i%,"Annuler/Quitter": ON_CLICK i%,Aninser
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

t% = 499
TIMER t%: TIMER_INTERVAL t%,50: ON_TIMER t%,Timeur
color 10,0,255,0

fig% = 1: ' trait
plein% = 0: ' figures géométriques vides
truc% = 0: term% = 0
tr% = 255: tg% = 0: tb% = 255
act% = 0
ax% = -1
2D_TARGET_IS p%
ON_ERROR_GOTO Errare
END
' ==============================================================================
Quit:
GOSUB Timoff
IF act% = 1
    i% = MESSAGE_CONFIRMATION_YES_NO("Quitter sans sauvegarder ?")
    IF i% = 1 THEN TERMINATE
    GOSUB Sauver
END_IF
TERMINATE
' ==============================================================================
Errare:
TIMER_OFF t%
' terminate
RETURN
' ==============================================================================
Charger:
GOSUB Timoff
a$ = "Le chargement d'une image va surcharger le dessin"+CHR$(10)
a$ = a$ + "le dessin éventuellement existant."+CHR$(10)
a$ = a$ + "      Confirmer svp."
i% = MESSAGE_CONFIRMATION_YES_NO(a$)
IF i% <> 1 THEN GOSUB Timon: RETURN
f$ = FILE_NAME$(88)
IF LEN(f$)> 3
    IF FILE_EXISTS(f$) = 0
        MESSAGE "Fichier "+f$+" non trouvé !"
        GOSUB Timon: RETURN
    END_IF
    ImgDim(f$)
    a$ = CLIPBOARD_STRING_PASTE$
    w% = VAL(LEFT$(a$,INSTR(a$,"x")-1)): h% = VAL(MID$(a$,INSTR(a$,"x")+1,10))
    WIDTH p%,wp%: HEIGHT p%,wp%*h%/w% : ' redimensionnement du picture de travail
    IF HEIGHT(p%)>hp%
        HEIGHT p%,hp%: WIDTH p%,hp%*w%/h%
    END_IF
    ' L'image est redimensionnée sans déformation pour tenir dans p%
    i% = WIDTH(p%): j% = HEIGHT(p%)
    a$ = " /resize=("+STR$(i%)+","+STR$(j%)+") /clipcopy /killmesoftly"
    EXECUTE_WAIT irfan$+f$+a$
    CLIPBOARD_PASTE p%
    GOSUB Svg: ' sauvegarde préalable du picture
    TEXT 51,f$
    CAPTION 52,STR$(w%)+" x "+STR$(h%)+" redimensionnée en "+STR$(i%)+" x "+STR$(j%)
END_IF
GOSUB Timon
RETURN
' ==============================================================================
Sauver:
GOSUB Timoff
f$ = FILE_NAME$(89)
IF LEN(a$) > 3
    a$ = UPPER$(RIGHT$(f$,4))
    IF a$<>".BMP"
        CLIPBOARD_COPY p%
        EXECUTE_WAIT irfan$ + "/clippaste /convert="+f$
    ELSE
        FILE_SAVE p%,f$
    END_IF
    TEXT 56,f$
END_IF
GOSUB Timon
RETURN
' ==============================================================================
Timeur:
IF tof% = 1 THEN RETURN
' témoin d'activité du timer t%:
    ctt% = ctt%+1
    IF ctt% = 5 THEN COLOR 8,255,0,0: COLOR 9,255,255,0
    IF ctt% = 10 THEN COLOR 8,255,255,0: COLOR 9,255,0,0: ctt% = 0
x% = MOUSE_X_POSITION(p%): y% = MOUSE_Y_POSITION(p%): ' position actuelle souris
a$ =  "X= "+STR$(x%)+" pixels  Y= "+STR$(y%)+" pixels"
CAPTION 0,a$
2D_PEN_COLOR tr%,tg%,tb%: 2D_PEN_WIDTH POSITION(32)
IF MOUSE_LEFT_DOWN(p%) = 1: ' bouton gauche enfoncé
    x1% = x%: y1% = y%: ' origine
    truc% = 1
END_IF
fig% = 1
IF CHECKED(23) = 1
    fig% = 2
ELSE
    IF CHECKED(24) = 1
        fig% = 3
    ELSE
        IF CHECKED(25) = 1
            fig% = 4
        ELSE
            IF CHECKED(26) = 1
                fig% = 5
            ELSE
                IF CHECKED(27) = 1
                    fig% = 6
                END_IF
            END_IF
        END_IF
    END_IF
END_IF
IF MOUSE_LEFT_UP(p%) = 1: ' relâche, tracé final
    GOSUB Timoff
    sx1% = x1%: sx2% = x2%: sy1% = y1%: sy2% = y2%
    ct% = 65536*tr%+256*tg%+tb%: ' couleur actuelle des tracés
    ' Tracé en continu
    ' Sauvegarde état précédent (10 sauvegardes possibles, en boucle)
    IF gril% = 1 THEN MARK_OFF 29: ' suppression de la grille
    GOSUB Svg
    term% = 1
    SELECT fig%
        CASE 1: GOSUB Trait
        CASE 2: GOSUB Rectangle
        CASE 3: GOSUB Cercle
        CASE 4: GOSUB Libre
        CASE 5: GOSUB Remdec: ' remplir
        CASE 6: GOSUB Remdec: ' découper
    END_SELECT
    x1% = sx1%: x2% = sx2%: y1% = sy1%: y2% = sy2%
    truc% = 0
    act% = 1: ' au moins un dessin effectué
    gosub Timon
END_IF
IF truc% = 1
    ' tracé provisoire, en continu
    x2% = x%: y2% = y%: ' position actuelle
    IF x2%=x3% AND y2%=y3% THEN RETURN: ' position inchangée
    SELECT fig%
        CASE 1: GOSUB Trait
        CASE 2: GOSUB Rectangle
        CASE 3: GOSUB Cercle
        CASE 4: GOSUB Libre
        ' CASE 5: GOSUB Remdec
    END_SELECT
    x3% = x%: y3% = y%
END_IF
' GOSUB Timon
RETURN
' ==============================================================================
Timon:
' Relance du timer
TIMER_ON t%
color 10,0,255,0: display
tof% = 0: ' timer actif
RETURN
' ==============================================================================
Timoff:
' Arrêt du timer
TIMER_OFF t%
color 10,255,0,0: display
tof% = 1: ' timer inactif
RETURN
' ==============================================================================
Ashow:
' Montrer le Form i%
GOSUB Timoff
SHOW i%: COMMAND_TARGET_IS i%
RETURN
' ==============================================================================
Ahide:
' Cacher le Form i%
HIDE i%: COMMAND_TARGET_IS 0
GOSUB Timon
RETURN
' ==============================================================================
Svg:
' sauvegarde de l'état du picture avant opération
ns%=ns%+1: IF ns%>10 THEN ns%=1
FILE_SAVE p%,fs$(ns%)
RETURN
' ==============================================================================
Rst:
' restore de la dernière sauvegarde
FILE_LOAD p%,fs$(ns%): CLIPBOARD_COPY p%
RETURN
' ==============================================================================
Ttpic:
IF SHOW(fd%) = 1 THEN TO_FOREGROUND fd%
IF SHOW(fr%) = 1 THEN TO_FOREGROUND fr%
IF SHOW(ft%) = 1 THEN TO_FOREGROUND ft%
IF SHOW(fi%) = 1 THEN TO_FOREGROUND fi%
RETURN
' ==============================================================================
Trait:
CLIPBOARD_PASTE p%
2D_LINE x1%,y1%,x2%,y2%
IF term% = 1
    CLIPBOARD_COPY p%
    term% = 0
    CAPTION 57,"Ligne  x1="+STR$(x1%)+"  y1="+STR$(y1%)+"  x2="+STR$(x2%)+"  y2="+STR$(y2%)
    cbo% = ct%
END_IF
ax% = -1
RETURN
' ==============================================================================
Rectangle:
CLIPBOARD_PASTE p%
2D_LINE x1%,y1%,x2%,y1%:2D_POLY_TO x2%,y2%:2D_POLY_TO x1%,y2%:2D_POLY_TO x1%,y1%
IF term% = 1
    CLIPBOARD_COPY p%
    term% = 0
    ax%=x1%: ay%=y1%: bx%=x2%: by%=y2%
    CAPTION 57,"Rect.  x1="+STR$(x1%)+"  y1="+STR$(y1%)+"  x2="+STR$(x2%)+"  y2="+STR$(y2%)
    cbo% = ct%: ' couleur du tracé
END_IF
RETURN
' ==============================================================================
Cercle:
CLIPBOARD_PASTE p%
ray% = SQR((y2%-y1%)*(y2%-y1%) + (x2%-x1%)*(x2%-x1%))
2D_POLY_FROM x1%+ray%,y1%
FOR an = 0 TO 8*ATN(1)+.1 STEP .1
    2D_POLY_TO x1%+ray%*COS(an), y1%+ray%*SIN(an)
NEXT an
IF term% = 1
    CLIPBOARD_COPY p%
    term% = 0
    CAPTION 57,"Cercle  xc="+STR$(x1%)+"  yc="+STR$(y1%)+"  R="+STR$(ray%)
    cbo% = ct%
END_IF
ax% = -1
RETURN
' ==============================================================================
Libre:
2D_LINE x1%,y1%,x2%,y2%: x1%=x2%: y1%=y2%
IF term% = 1
    CLIPBOARD_COPY p%
    CAPTION 57,"Tracé  x1="+STR$(x1%)+"  y1="+STR$(y1%)+"  x2="+STR$(x2%)+"  y2="+STR$(y2%)
    cbo% = ct%
END_IF
term% = 0: ax% = -1
RETURN
' ==============================================================================
Remdec:
' remplissage ou découpe
xr% = x%: yr% = y%: a$ = "Clic:  x="+STR$(xr%)+"  y="+STR$(yr%): ' clic sur p%
IF fig% = 5: ' Remplir
    CAPTION fr%+1,a$
    a$ = "x1="+STR$(ax%)+"  y1="+STR$(ay%)+"  x2="+STR$(bx%)+"  y2="+STR$(by%)
    i%=BIN_AND(cbo%,16711680)/65536: j%=BIN_AND(cbo%,65280)/256: k%=BIN_AND(cbo%,255)
    COLOR fr%+9,i%,j%,k%: ' couleur bordure
    i% = fr%
ELSE
    ' découper
    IF ax% = -1
        a$ = "IL N'Y A PAS DE RECTANGLE DE SÉLECTION POUR LA DÉCOUPE !"+CHR$(10)+CHR$(10)
        a$=a$+"- Passer en mode 'Rectangle', dessiner le rectangle encadrant"+CHR$(10)
        a$=a$+"- Passer en mode 'Découper', cliquer à l'intérieur de ce rectangle"
        MESSAGE a$
        RETURN
    ELSE
        a$=a$+"        Sélection:  x1="+STR$(ax%)+"  y1="+STR$(ay%)+"  x2="+STR$(bx%)+"  y2="+STR$(by%)
    END_IF
    CAPTION fd%+1,a$
    i% = fd%
END_IF
GOSUB Ashow
RETURN
' ==============================================================================
Remplir:
' remplir une figure fermée
IF gril% = 1 THEN MARK_OFF 29
IF CHECKED(fr%+5) = 1
    ' fond uniforme
    2D_FLOOD xr%,yr%,tr%,tg%,tb%: ' fond uniforme
ELSE
    ' fond composite
    ' cbo% = couleur du dernier tracé (contour)
    ' ct% = couleur actuelle (de remplissage)
    ' message str$(p%)+","+str$(xr%)+","+str$(yr%)+","+str$(cbo%)+","+str$(cr%)
    gosub Timoff
    Remplissage(p%,xr%,yr%,cbo%,ct%)
END_IF
CLIPBOARD_COPY p%
i% = fr%: GOSUB Ahide
ax% = -1
RETURN
' ==============================================================================
Decoupe:
' effacer le rectangle de sélection ???
IF ax%<0 THEN GOSUB Aninser: RETURN
IF gril% = 1 THEN MARK_OFF 29
2D_IMAGE_COPY fi%+15,ax%+1,ay%+1,bx%,by%
FILE_SAVE fi%+15,TEXT$(fd%+4): ' enregistrer la découpe
i% = fd%: GOSUB Ahide
ax% = -1
RETURN
' ==============================================================================
Couleur:
x% = MOUSE_X_LEFT_DOWN(41): y% = MOUSE_Y_LEFT_DOWN(41)
tr%=COLOR_PIXEL_RED(41,x%,y%): tg%=COLOR_PIXEL_GREEN(41,x%,y%): tb%=COLOR_PIXEL_BLUE(41,x%,y%)
ct% = 65536*tr%+256*tg%+tb%: ' couleur compacte
COLOR 35,tr%,tg%,tb%
FOR i% = 43 TO 45: OFF_CHANGE i%: NEXT i%
TEXT 43,STR$(tr%): TEXT 44,STR$(tg%): TEXT 45,STR$(tb%)
FOR i% = 43 TO 45: ON_CHANGE i%,Majcoul: NEXT i%
IF SHOW(fd%) = 1 THEN TO_FOREGROUND fd%
IF SHOW(fr%) = 1 THEN TO_FOREGROUND fr%
IF SHOW(ft%) = 1 THEN TO_FOREGROUND ft%
IF SHOW(fi%) = 1 THEN TO_FOREGROUND fi%
RETURN
' ==============================================================================
Majcoul:
' modif couleur en manuel: entrer les valeurs directement
a$ = TEXT$(43): b$ = TEXT$(44): c$ = TEXT$(45)
IF NUMERIC(a$)=0 OR NUMERIC(b$)=0 OR NUMERIC(c$)=0 THEN RETURN
tr%=VAL(a$): tg%=VAL(b$): tb%=VAL(c$)
COLOR 35,tr%,tg%,tb%
RETURN
' ==============================================================================
Annul:
ns% = ns%-1: IF ns%<1 THEN ns% = 10
FILE_LOAD p%,fs$(ns%)
CLIPBOARD_COPY p%
RETURN
' ==============================================================================
Instxt:
i% = ft%: GOSUB Ashow: TO_FOREGROUND ft%
RETURN
' ==============================================================================
Insimg:
i% = fi%: GOSUB Ashow: TO_FOREGROUND fi%
RETURN
' ==============================================================================
Chi:
' Choix d'une image à insérer
a$ = FILE_NAME$(89)
IF LEN(a$)<4 THEN RETURN
IF FILE_EXISTS(a$) = 0
    MESSAGE "Fichier "+a$+" non trouvé !": RETURN
END_IF
TEXT fi%+2,a$
ImgDim(a$): ' dimensions de l'image
b$ = CLIPBOARD_STRING_PASTE$
wis% = VAL(LEFT$(b$,INSTR(b$,"x")-1)): his% = VAL(MID$(b$,INSTR(b$,"x")+1,10))
TEXT fi%+4,STR$(wis%): TEXT fi%+5,STR$(his%): ' dimensions de l'image choisie
EXECUTE_WAIT irfan$+TEXT$(fi%+2)+" /clipcopy /killmesoftly": ' -> clipboard
RETURN
' ==============================================================================
Rdim:
' redimensionnement de l'image à incruster -> clipboard
i% = VAL(TEXT$(fi%+7)): IF i% = 0 THEN RETURN
j%=i%*VAL(TEXT$(fi%+5))/VAL(TEXT$(fi%+4))
TEXT fi%+8,STR$(j%)
a$ = " /resize=("+STR$(i%)+","+STR$(j%)+") /clipcopy /killmesoftly"
EXECUTE_WAIT irfan$+TEXT$(fi%+2)+a$: ' -> clipboard
wis% = i%: his% = j%: ' nouvelles dimensions de l'image à insérer
RETURN
' ==============================================================================
Coultex:
' couleur du texte
i% = ft%+15
x% = MOUSE_X_LEFT_DOWN(i%): y% = MOUSE_Y_LEFT_DOWN(i%)
ttr%=COLOR_PIXEL_RED(i%,x%,y%): ttg%=COLOR_PIXEL_GREEN(i%,x%,y%)
ttb%=COLOR_PIXEL_BLUE(i%,x%,y%)
COLOR ft%+4,ttr%,ttg%,ttb%
RETURN
' ==============================================================================
Valtex:
i% = ft%: GOSUB Ahide
IF COUNT(ft%+10) > 0
    GOSUB Timoff
    IF gril% = 1 THEN MARK_OFF 29
    GOSUB Svg: ' sauvegarde préalable
    x% = VAL(TEXT$(ft%+8)): y% = VAL(TEXT$(ft%+9))
    fnt$ = TEXT$(ft%+2): sz% = POSITION(ft%+3)
    attr% = 0
    IF CHECKED(ft%+5) = 1 THEN attr% = attr%+1
    IF CHECKED(ft%+6) = 1 THEN attr% = attr%+2
    IF CHECKED(ft%+7) = 1 THEN attr% = attr%+4
    ttr% = COLOR_PIXEL_RED(ft%+4,2,2): ttg% = COLOR_PIXEL_GREEN(ft%+4,2,2)
    ttb% = COLOR_PIXEL_BLUE(ft%+4,2,2)
    coul% = (ttr%*256+ttg%)*256+ttb%
    a$ = ""
    FOR i% = 1 TO COUNT(ft%+10)
        a$ = a$+ITEM_READ$(ft%+10,i%)+CHR$(13)+CHR$(10)
    NEXT i%
    a$ = LEFT$(a$,LEN(a$)-2)
    Tx2Pic(p%,x%,y%,a$,fnt$,sz%,attr%,coul%)
    clipboard_copy p%
    GOSUB Svg
    GOSUB Timon
END_IF
RETURN
' ==============================================================================
Police:
SHOW fp%
RETURN
Police1:
TEXT ft%+2,ITEM_INDEX$(fp%+1)
HIDE fp%
RETURN
' ==============================================================================
Valim:
' incrustation de l'image
IF TEXT$(fi%+2) = "" THEN GOTO Aninser
IF gril% = 1 THEN MARK_OFF 29
i% = fi%: GOSUB Ahide
GOSUB Timoff
GOSUB Svg
CLIPBOARD_PASTE fi%+15: ' récupération du clipboard dans l'IMAGE (fi%+15)
x% = VAL(TEXT$(fi%+11)): y% = VAL(TEXT$(fi%+12)): ' coordonnées de l'insertion
IF CHECKED(fi%+16) = 0
    ' insertion simple
    2D_IMAGE_PASTE fi%+15,x%,y%: ' incrustation de l'IMAGE dans le picture
ELSE
    ' incrustation avec transparence
    ' couleur de transparence:
    rt%=VAL(TEXT$(fi%+18)): gt%=VAL(TEXT$(fi%+19)): bt%=VAL(TEXT$(fi%+20))
    k%=999: PICTURE k%: TOP k%,-1000: WIDTH k%,wis%: HEIGHT k%,his%
    2D_TARGET_IS k%: 2D_IMAGE_PASTE fi%+15,0,0: 2D_TARGET_IS p%
    FOR j% = 0 TO his%-1
        FOR i% = 0 TO wis%-1
            r% = COLOR_PIXEL_RED(k%,i%,j%)
            g% = COLOR_PIXEL_GREEN(k%,i%,j%)
            b% = COLOR_PIXEL_BLUE(k%,i%,j%)
            IF r%<>tr% OR g%<>tg% OR b%<>tb%
                2D_PEN_COLOR r%,g%,b%: 2D_POINT x%+i%,y%+j%
            END_IF
        NEXT i%
        DISPLAY
    NEXT j%
    DELETE k%: ' suppression du picture de travail
END_IF
TEXT fi%+4,"": TEXT fi%+5,"": TEXT fi%+7,"": TEXT fi%+8,"": TEXT fi%+11,""
TEXT fi%+12,"": TEXT fi%+2,"": MARK_OFF fi%+16
CLIPBOARD_COPY p%: ' mise à jour du clipboard
GOSUB Timon
RETURN
' ==============================================================================
Aninser:
HIDE ft%: HIDE fi%: HIDE fr%: HIDE fd%: COMMAND_TARGET_IS 0
GOSUB Timon
RETURN
' ==============================================================================
Grille:
IF CHECKED(29) = 1
    Grille_Pict(p%,100): gril% = 1: ' affichage
    CAPTION 29,"Grille (pas=100)"
ELSE
    Grille_Pict(p%,-1): gril% = 0: ' suppression
    2D_PEN_SOLID: 2D_PEN_COLOR tr%,tg%,tb%: 2D_PEN_WIDTH POSITION(32)
END_IF
RETURN
' ==============================================================================
Virfan:
GOSUB Timoff
CLIPBOARD_COPY p%
EXECUTE_WAIT irfan$ + " /clippaste"
GOSUB Timon
RETURN
' ==============================================================================
Coller:
' le picture prendra les dimensions du contenu du presse-papier (venant de IrfanView) !
CLIPBOARD_PASTE p%
RETURN
' ==============================================================================
Raztou:
GOSUB Timoff
a$ = "Voulez-vous effacer entièrement le dessin ?"
i% = MESSAGE_CONFIRMATION_YES_NO(a$)
IF i% = 1 THEN CLS: CLIPBOARD_COPY p%
GOSUB Timon
RETURN
' ==============================================================================
Aide:
GOSUB Timoff
b$ = CHR$(13)+CHR$(10)
a$ = "- DESSIN :  AIDE SUCCINCTE -"+b$+b$
a$=a$+"Dessin de lignes, figures ou textes sur fond uni ou sur une image chargée"+b$
a$=a$+"au préalable ('Charger une image...). Dans ce cas, l'image choisie sera"+b$
a$=a$+"redimensionnée, sans déformation, pour tenir dans la surface de dessin."+b$+b$
a$=a$+"Tracé d'une figure géométrique, ou tracé libre:"+b$
a$=a$+"- Choisir la couleur et l'épaisseur du trait"+b$
a$=a$+"- Cliquer le point de départ (rectangle: coin, cercle: centre), déplacer"+b$
a$=a$+"  la souris, relâcher."+b$+b$
a$=a$+"Remplissage d'une figure fermée délimitée préalablement:"+b$
a$=a$+"- Option 'Remplir', cliquer un point intérieur à la figure, choisir"+b$
a$=a$+"  fond uniforme ou composite (comportant une image ou des objets), modifier"+b$
a$=a$+"  éventuellement la couleur de remplissage, puis cliquer 'Remplir la zone'."+b$
a$=a$+"  Dans le cas du remplissage 'composite', le remplissage peut être incomplet"+b$
a$=a$+"  et il faut dans ce cas le compléter en cliquant un autre point. Ou le faire"+b$
a$=a$+"  manuellement, au pinceau."+b$+b$
a$=a$+"Extraction d'une zone rectangulaire du dessin (ou de l'image de fond):"+b$
a$=a$+"- Option 'Rectangle', tracer un rectangle de délimitation de la zone, puis"+b$
a$=a$+"- Option 'Découper', puis cliquer à l'intérieur du rectangle tracé."+b$
a$=a$+"  Cliquer 'Extraire le rectangle', la zone sera enregistrée sous la forme"+b$
a$=a$+"  d'une image bmp (du chemin/nom indiqué au-dessous)."+b$
a$=a$+"  (on peut ensuite effacer le rectangle de sélection par des 'Annuler dernier'"+b$
a$=a$+"  successifs)."+b$+b$
a$=a$+"Insertion de texte: cliquer le bouton correspondant, saisir le texte,"+b$
a$=a$+"  (plusieurs lignes possibles), fixer les paramètres et l'emplacement x,y,"+b$
a$=a$+"  puis 'Insérer'"+b$+b$
a$=a$+"Incrustation d'image: découper la partie rectangulaire enveloppe concernée"+b$
a$=a$+"  dans l'image d'origine, la sauvegarder. L'insertion se fera avec ou sans"+b$
a$=a$+"  transparence. NB: on peut redimensionner l'imagette avant son insertion"+b$
a$=a$+"  (préciser la largeur, puis bouton 'OK')."+b$
a$=a$+"  Sans transparence: c'est le rectangle tel quel qui sera intégré à la"+b$
a$=a$+"  nouvelle image."+b$
a$=a$+"  Avec transparence: il s'agit d'une image 'détourée' aux contours variés."+b$
a$=a$+"  Rappeler l'image découpée comme image principale, la détourer de la couleur"+b$
a$=a$+"  de transparence choisie à l'aide des outils Trait ou Tracé libre, remplir"+b$
a$=a$+"  entièrement l'extérieur de la zone choisie (voir outil 'Remplir'), puis la"+b$
a$=a$+"  sauvegarder au format bmp impérativement (pour le respect des couleurs)."+b$
a$=a$+"  Charger l'image principale (réceptrice), 'Insertion image', redimensionner"+b$
a$=a$+"  éventuellement l'imagette à incruster (bouton 'OK'), cocher l'option"+b$
a$=a$+"  'Transparence' et préciser au-dessous la couleur de transparence définie"+b$
a$=a$+"  pour le détourage. Préciser les coordonnées de l'insertion, puis 'Insérer'"+b$+b$
a$=a$+"NB: on peut annuler les dernières opérations (10 sauvegardes, en boucle)"+b$
a$=a$+"    par clics sur 'Annuler dernier'."+b$+b$
a$=a$+"Sauvegarde du résultat: cliquer la zone 'Sauvegarder le dessin sous:',"+b$
a$=a$+"choisir le chemin et le nom, sauvegarder sous un nom d'image quelconque."+b$+b$
a$=a$+"On peut amener l'ensemble du dessin dans IrfanView: 'Voir dans IrfanView',"+b$
a$=a$+"l'y imprimer et/ou modifier, copier dans le presse-papier, et récupérer le"+b$
a$=a$+"résultat dans le programme avec le bouton 'Coller'."+b$+b$
a$=a$+"Remarque: choix de la couleur de tracé ou remplissage: on peut choisir une"+b$
a$=a$+"des 16 couleurs standard par clic, mais on peut également imposer une couleur"+b$
a$=a$+"quelconque en saisissant les valeurs R, G et B désirées."
MESSAGE a$
GOSUB Timon
RETURN
' ==============================================================================
'                                SUBs
' ==============================================================================
SUB ImgDim(f$)
' Dimensions de l'image f$ -> clipboard sous la forme wwwxhhh
' Lecture du résultat:
'    a$ = CLIPBOARD_STRING_PASTE$
'    w% = VAL(LEFT$(a$,INSTR(a$,"x")-1)): h% = VAL(MID$(a$,INSTR(a$,"x")+1,10))
DIM_LOCAL r$, n$, q$, fv$
q$ = CHR$(34): fv$ = "C:\TEMP\Script.vbs"
r$ = FILE_EXTRACT_PATH$(f$): n$ = FILE_EXTRACT_NAME$(f$)
FILE_OPEN_WRITE 9,fv$
    FILE_WRITELN 9,"Const DIMENSIONS = 31"
    FILE_WRITELN 9,"Set oShell  = CreateObject ("+q$+"Shell.Application"+q$+")"
    FILE_WRITELN 9,"Set oFolder = oShell.Namespace ("+q$+r$+q$+")"
    FILE_WRITELN 9,"Set oFile  = oFolder.ParseName("+q$+n$+q$+")"
    FILE_WRITELN 9,"strDimensions = oFolder.GetDetailsOf(oFile, DIMENSIONS)"
    FILE_WRITELN 9,"WScript.Echo strDimensions"
FILE_CLOSE 9
EXECUTE_WAIT "Cmd.exe /c Cscript.exe "+fv$+" | clip"
FILE_DELETE fv$
r$ = TRIM$(CLIPBOARD_STRING_PASTE$): r$ = MID$(r$,2,LEN(r$)-2)
r$ = LEFT$(r$,INSTR(r$," x ")-1)+"x"+MID$(r$,INSTR(r$," x ")+3,10)
CLIPBOARD_STRING_COPY r$
END_SUB
' ==============================================================================
SUB Tx2Pic(p%,xi%,yi%,txt$,fnt$,sz%,attr%,cl%)
' Affichage d'une ou plusieurs lignes de texte txt$ sur l'objet p%, en position x%,y%,
' police fnt$, taille sz% (->255), attributs attr% (= B=1, I=2, U=4)
' couleur coul% format RGB (=65536*R + 256*G + B)
' Si plusieurs lignes: séparées par des '0D0A'
DIM_LOCAL rst$,pk%,wt%,ht%,ri%,gi%,bi%,i%,j%,k%,t2d%,tpt%
pk% = 950: WHILE OBJECT_EXISTS(pk%)=1: pk%=pk%+1: END_WHILE
tpt% = NUMBER_PRINT_TARGET: t2d% = NUMBER_2D_TARGET
PICTURE pk%: TOP pk%,-1000
PRINT_TARGET_IS pk%: FONT_NAME pk%,fnt$: FONT_SIZE pk%,sz%
IF BIN_AND(attr%,1) = 1 THEN FONT_BOLD pk%
IF BIN_AND(attr%,2) = 2 THEN FONT_ITALIC pk%
IF BIN_AND(attr%,4) = 4 THEN FONT_UNDERLINE pk%
ri%=BIN_AND(cl%,16711680)/65536: gi%=BIN_AND(cl%,65280)/256: bi%=BIN_AND(cl%,255)
COLOR pk%,254,254,254: 2D_TARGET_IS pk%: 2D_FILL_COLOR 254,254,254: ' transparence
2D_PEN_COLOR ri%,gi%,bi%
2D_TARGET_IS p%: 2D_PEN_COLOR ri%,gi%,bi%
REPEAT
    rst$ = "": k% = INSTR(txt$,CHR$(13))
    IF k%>0 THEN rst$ = MID$(txt$,k%+2,LEN(txt$)-k%-1): txt$ = LEFT$(txt$,k%-1)
    wt%=TEXT_WIDTH(txt$,pk%): ht%=TEXT_HEIGHT(txt$,pk%)
    WIDTH pk%,wt%: HEIGHT pk%,ht%
    2D_TARGET_IS pk%: CLS: PRINT txt$
    2D_TARGET_IS p%
    FOR j% = 0 TO ht%-1
        FOR i% = 0 TO wt%-1
            IF COLOR_PIXEL_RED(pk%,i%,j%) <> 254
                2d_target_is p%: 2D_PEN_COLOR ri%,gi%,bi%: 2D_POINT xi%+i%,yi%+j%
            END_IF
        NEXT i%
        DISPLAY
    NEXT j%
    txt$ = rst$
    y% = y%+ht%
UNTIL txt$ = ""
PRINT_TARGET_IS tpt%: 2D_TARGET_IS t2d%
DELETE pk%
END_SUB
' ==============================================================================
SUB Grille_Pict(obj%,wg%)
' Dessin d'une grille sur un picture obj%, de pas wg% pixels
' Si wg% = -1: Restore du picture sans la grille
DIM_LOCAL i%,n2t,fm$
fm$ = "C:\TEMP\Savgrid.bmp"
IF wg% = -1
    IF FILE_EXISTS(fm$) = 0 THEN EXIT_SUB
    FILE_LOAD obj%,fm$: FILE_DELETE fm$: ' pour éviter les restore intempestifs
ELSE
    n2t = NUMBER_2D_TARGET
    FILE_SAVE obj%,fm$: ' sauvegarde avant grille
    2D_TARGET_IS obj%: 2D_PEN_COLOR 255,0,255: 2D_PEN_WIDTH 1: 2D_PEN_DOT
    FOR i% = wg% TO WIDTH(obj%)*4 STEP wg%
        2D_LINE i%,0,i%,HEIGHT(obj%)*4
    NEXT i%
    FOR i% = wg% TO HEIGHT(obj%)*4 STEP wg%
        2D_LINE 0,i%,WIDTH(obj%)*4,i%
    NEXT i%
    2D_TARGET_IS n2t
END_IF
END_SUB
' ==============================================================================
SUB Remplissage(p%,x%,y%,cb%,cr%)
' Remplir une zone de p% délimitée par la couleur cb% de la couleur cr%,
' à partir du point x%,y%
DIM_LOCAL rb%,gb%,bb%,rr%,gr%,br%,rc%,gc%,bc%,x1%,x2%,y1%
' couleur de bord
rb%=BIN_AND(cb%,16711680)/65536: gb%=BIN_AND(cb%,65280)/256: bb%=BIN_AND(cb%,255)
' couleur de remplissage
rr%=BIN_AND(cr%,16711680)/65536: gr%=BIN_AND(cr%,65280)/256: br%=BIN_AND(cr%,255)
2D_TARGET_IS p%: 2D_PEN_COLOR rr%,gr%,br%: 2D_PEN_WIDTH 1
FOR y1% = y% TO 0 STEP -1: ' partie haute
    rc%=COLOR_PIXEL_RED(p%,x%,y1%): gc%=COLOR_PIXEL_GREEN(p%,x%,y1%): bc%=COLOR_PIXEL_BLUE(p%,x%,y1%)
    IF (rc%=rb% AND gc%=gb% AND bc%=bb%) THEN EXIT_FOR: ' bordure supérieure atteinte
    FOR x1% = x% TO 0 STEP -1: ' partie gauche
        rc%=COLOR_PIXEL_RED(p%,x1%,y1%): gc%=COLOR_PIXEL_GREEN(p%,x1%,y1%)
            bc%=COLOR_PIXEL_BLUE(p%,x1%,y1%): ' couleur du point
        IF (rc%=rb% AND gc%=gb% AND bc%=bb%) THEN EXIT_FOR: ' bordure atteinte
    NEXT x1%
    FOR x2% = x% TO WIDTH(p%): ' partie droite
        rc%=COLOR_PIXEL_RED(p%,x2%,y1%): gc%=COLOR_PIXEL_GREEN(p%,x2%,y1%)
            bc%=COLOR_PIXEL_BLUE(p%,x2%,y1%)
        IF (rc%=rb% AND gc%=gb% AND bc%=bb%) THEN EXIT_FOR: ' bordure atteinte
    NEXT x2%
    2D_LINE x1%+1,y1%,x2%,y1%
    display
NEXT y1%
FOR y1% = y%+1 TO HEIGHT(p%): ' partie basse
    rc%=COLOR_PIXEL_RED(p%,x%,y1%): gc%=COLOR_PIXEL_GREEN(p%,x%,y1%): bc%=COLOR_PIXEL_BLUE(p%,x%,y1%)
    IF (rc%=rb% AND gc%=gb% AND bc%=bb%) THEN EXIT_FOR: ' bordure inférieure atteinte
    FOR x1% = x% TO 0 STEP -1: ' partie gauche
        rc%=COLOR_PIXEL_RED(p%,x1%,y1%): gc%=COLOR_PIXEL_GREEN(p%,x1%,y1%)
            bc%=COLOR_PIXEL_BLUE(p%,x1%,y1%)
        IF (rc%=rb% AND gc%=gb% AND bc%=bb%) THEN EXIT_FOR: ' bordure atteinte
    NEXT x1%
    FOR x2% = x% TO WIDTH(p%): ' partie droite
        rc%=COLOR_PIXEL_RED(p%,x2%,y1%): gc%=COLOR_PIXEL_GREEN(p%,x2%,y1%)
            bc%=COLOR_PIXEL_BLUE(p%,x2%,y1%)
        IF (rc%=rb% AND gc%=gb% AND bc%=bb%) THEN EXIT_FOR: ' bordure atteinte
    NEXT x2%
    2D_LINE x1%+1,y1%,x2%,y1%
    display
NEXT y1%
END_SUB
' ==============================================================================