Un petit programme de dessin sans prétention

' Dessin.bas
LABEL time, Ligne, Rectplein, Rectvide, Cercplein, Cercvide, Texte, Coultrac, Coulfond
LABEL New, Opn, Enr, Ens, Imp, Quit, Anul, Hlp, Apr, Iminfo, Redim
LABEL chp, vlf, vfont

DIM w0, h0, wp, hp, mg, lb, hb, i%, j%, c, cr, cg, cb, tr, tg, tb, lc, hc
DIM x,y,x1,y1,x2,y2,x3,y3,xa,ya,truc,f$,fm$,fp$, fz$, fig,a,r,pi,pas, wp$, m$
DIM pic, o1, o2, oct, ocf, nti%, ra, wn, hn, pr%, pg%, pb%
DIM na, nva, fa$(10), iv$, a$, wi, hi, font$, fsz%, txt$, lc%, hc%
DATA 0,0,0,0,0,128,0,128,0,0,128,128,128,0,0,128,0,128,128,64,0,192,192,192
DATA 128,128,128,0,0,255,0,255,0,0,255,255,255,0,0,255,0,255,255,255,0,255,255,255
' ====================== CHEMINS A AJUSTER ===================================
fm$ = "D:\TEMP\Image": ' images résultat (de image1 à image5.bmp)
fp$ = "Z:\Imgprn.txt": ' fichier d'impression
fz$ = "Z:\Infoimg.tmp"
wp$ = "C:\UTIL\WinTextPrint.exe ": ' module d'impression de Klaus
iv$ = "C:\Progra~1\Irfanv~1\i_view32.exe ": ' IrfanView
' =============================================================================
pi = 4*ATN(1)
fig = 1: ' fig =1 trait, =2 rectangle vide, =3 rectangle plein, =4 cercle vide
'              =5 cercle plein, =6 texte
tr = 0: tg = 0: tb = 0
f$ = ""
nva = 5: ' profondeur d'annulations
FOR i% = 1 TO nva: fa$(i%) = fm$ + STR$(i%) + ".bmp": NEXT i%
na = 1
h0 = SCREEN_Y-30
hp = h0-70: wp = INT(210*hp/297): ' image d'une feuille A4
mg = 100
w0 = wp+mg+20
WIDTH 0, w0: HEIGHT 0, h0

pic = 140: PICTURE pic: TOP pic, 4: LEFT pic, mg: WIDTH pic, wp: HEIGHT pic, hp

MAIN_MENU 1
SUB_MENU 2: PARENT 2, 1: CAPTION 2, "Fichier"
  SUB_MENU 21: PARENT 21, 2: CAPTION 21, "Nouveau"
  SUB_MENU 22: PARENT 22, 2: CAPTION 22, "Ouvrir"
  SUB_MENU 23: PARENT 23, 2: CAPTION 23, "Enregistrer"
  SUB_MENU 24: PARENT 24, 2: CAPTION 24, "Enregistrer sous..."
  SUB_MENU 25: PARENT 25, 2: CAPTION 25, "Imprimer"
  SUB_MENU 26: PARENT 26, 2: CAPTION 26, "Quitter"
  ON_CLICK 21, New: ON_CLICK 22, Opn: ON_CLICK 23, Enr: ON_CLICK 24, Ens
  ON_CLICK 25, Imp: ON_CLICK 26, Quit
SUB_MENU 3: PARENT 3, 1: CAPTION 3, "Edition"
  SUB_MENU 31: PARENT 31, 3: CAPTION 31, "Annuler"
  ON_CLICK 31, Anul
SUB_MENU 4: PARENT 4, 1: CAPTION 4, "Aide"
  SUB_MENU 41: PARENT 41, 4: CAPTION 41, "Aide"
  SUB_MENU 42: PARENT 42, 4: CAPTION 42, "A propos"
  ON_CLICK 41, Hlp: ON_CLICK 42, Apr

o1 = 50: lb = mg-10: hb = 25
CONTAINER_OPTION o1: TOP o1, 25: LEFT o1, 5: HEIGHT o1, 145: WIDTH o1, mg-10: CAPTION o1, "Objet"
OPTION o1+1: PARENT o1+1, o1: TOP o1+1, 20: LEFT o1+1, 5: WIDTH o1+1, mg-20: CAPTION o1+1, "Ligne"
OPTION o1+2: PARENT o1+2, o1: TOP o1+2, 40: LEFT o1+2, 5: WIDTH o1+2, mg-20: CAPTION o1+2, "Rect. vide"
OPTION o1+3: PARENT o1+3, o1: TOP o1+3, 60: LEFT o1+3, 5: WIDTH o1+3, mg-20: CAPTION o1+3, "Rect. plein"
OPTION o1+4: PARENT o1+4, o1: TOP o1+4, 80: LEFT o1+4, 5: WIDTH o1+4, mg-20: CAPTION o1+4, "Cercle vide"
OPTION o1+5: PARENT o1+5, o1: TOP o1+5, 100: LEFT o1+5, 5: WIDTH o1+5, mg-20: CAPTION o1+5, "Cercle plein"
OPTION o1+6: PARENT o1+6, o1: TOP o1+6, 120: LEFT o1+6, 5: WIDTH o1+6, mg-20: CAPTION o1+6, "Texte"
ON_CLICK o1+6, chp
MARK_ON o1+1

o2 = 70
CONTAINER_OPTION o2: TOP o2, 190: LEFT o2, 5: HEIGHT o2, 125: WIDTH o2, mg-10: CAPTION o2, "Largeur du tracé"
OPTION o2+1: PARENT o2+1, o2: TOP o2+1, 20: LEFT o2+1, 5: WIDTH o2+1, mg-20: CAPTION o2+1, "1 pixel"
OPTION o2+2: PARENT o2+2, o2: TOP o2+2, 40: LEFT o2+2, 5: WIDTH o2+2, mg-20: CAPTION o2+2, "2 pixels"
OPTION o2+3: PARENT o2+3, o2: TOP o2+3, 60: LEFT o2+3, 5: WIDTH o2+3, mg-20: CAPTION o2+3, "3 pixels"
OPTION o2+4: PARENT o2+4, o2: TOP o2+4, 80: LEFT o2+4, 5: WIDTH o2+4, mg-20: CAPTION o2+4, "4 pixels"
OPTION o2+5: PARENT o2+5, o2: TOP o2+5, 100: LEFT o2+5, 5: WIDTH o2+5, mg-20: CAPTION o2+5, "5 pixels"
MARK_ON o2+1

oct = 81: x1 = 10: y1 = 380: lc = 40: hc = 20
ALPHA oct-1: TOP oct-1, y1-40: LEFT oct-1, 10: CAPTION oct-1, "Couleur"+CHR$(10)+" du"+CHR$(10)+"  tracé"
PICTURE oct: TOP oct, y1: LEFT oct, x1: WIDTH oct, lc*2: HEIGHT oct, hc*8
2D_TARGET_IS oct
FOR j% = 0 TO 7
    FOR i% = 0 TO 1
        READ cr: READ cg: READ cb: 2D_FILL_COLOR cr,cg,cb
        2D_RECTANGLE i%*lc,j%*hc,i%*lc+lc,j%*hc+hc
    NEXT i%
NEXT j%
ON_CLICK oct, Coultrac
PICTURE oct+1: TOP oct+1, y1-40: LEFT oct+1, x1+lc: WIDTH oct+1, lc: HEIGHT oct+1, lc-15
COLOR oct+1, 0,0,0

ocf = 85: x1 = 10: y1 = 590: lc = 40: hc = 20
ALPHA ocf-1: TOP ocf-1, y1-40: LEFT ocf-1, 10: CAPTION ocf-1, "Couleur"+CHR$(10)+" de"+CHR$(10)+"  remplissage"
PICTURE ocf: TOP ocf, y1: LEFT ocf, x1: WIDTH ocf, lc*2: HEIGHT ocf, hc*8
2D_TARGET_IS ocf
RESTORE
FOR j% = 0 TO 7
    FOR i% = 0 TO 1
        READ cr: READ cg: READ cb: 2D_FILL_COLOR cr,cg,cb
        2D_RECTANGLE i%*lc,j%*hc,i%*lc+lc,j%*hc+hc
    NEXT i%
NEXT j%
ON_CLICK ocf, Coulfond
PICTURE ocf+1: TOP ocf+1, y1-40: LEFT ocf+1, x1+lc: WIDTH ocf+1, lc: HEIGHT ocf+1, lc-15
2D_TARGET_IS ocf+1: 2D_PEN_COLOR 0,0,0: 2D_RECTANGLE 0,0,lc,lc-15

OPEN_DIALOG 90
FILTER 90,"Images *.bmp *.jpg|*.bmp|*.jpg"
SAVE_DIALOG 91
FILTER 91,"Image *.bmp|*.bmp"
FOR i% = 1 TO nva
    IF FILE_EXISTS(fa$(i%)) = 1 THEN FILE_DELETE fa$(i%)
NEXT i%

FORM 96: TOP 96, 60: LEFT 96, 50: HEIGHT 96, 245: WIDTH 96, 260: HIDE 96
CAPTION 96, "Police/Taille"
LIST 97: PARENT 97, 96: TOP 97, 5: HEIGHT 97, 90: WIDTH 97, 150
FONT_NAMES_LOAD 97: ON_CLICK 97, vfont
SPIN 98: PARENT 98, 96: TOP 98, 5: LEFT 98, 160: WIDTH 98, 60: MAX 98, 30
POSITION 98, 10: MIN 98, 6: MAX 98, 30: ON_CLICK 98, vfont
BUTTON 99: PARENT 99, 96: TOP 99, 74: LEFT 99, 160: WIDTH 99, 80
CAPTION 99, "OK": ON_CLICK 99, Texte
LIST 100: PARENT 100, 96: TOP 100, 100: WIDTH 100, 240: HEIGHT 100, 40
font$ = "Bitstream Vera Sans Mono": fsz% = 10
FONT_NAME 100, font$: FONT_SIZE 100, fsz%: COLOR 100, 255,128,128
ITEM_ADD 100, font$
ITEM_ADD 100, "Voyez le Brick Géant Que J'examine Près du Wharf"
ALPHA 101: PARENT 101, 96: TOP 101, 140: CAPTION 101, " Saisir le texte:"
EDIT 102: PARENT 102, 96: TOP 102, 156: WIDTH 102, 240
CHECK 103: PARENT 103, 96: TOP 103, 30: LEFT 103, 160: WIDTH 103, 80: CAPTION 103, "Gras"
CHECK 104: PARENT 104, 96: TOP 104, 45: LEFT 104, 160: WIDTH 104, 80: CAPTION 104, "Italique"
CHECK 105: PARENT 105, 96: TOP 105, 60: LEFT 105, 160: WIDTH 105, 80: CAPTION 105, "Souligné"
PICTURE 106: LEFT 106, -900: WIDTH 106, 890: HEIGHT 106, 100
ALPHA 107: PARENT 107, 96: TOP 107, 176: WIDTH 107, 240
CAPTION 107, " Après saisie, clic le bouton 'OK', puis clic" + CHR$(10)+" l'emplacement sur la feuille (patience, c'est long !)"

2D_TARGET_IS 0: 2D_RECTANGLE mg-1,3,mg+wp+1,5+hp
2D_TARGET_IS pic: CLS
nti% = 120: TIMER nti%
TIMER_INTERVAL nti%,40
ON_TIMER nti%, time
END
' ------------------------------------------------------------------------------
time:
CAPTION 0,f$ + "  X= "+STR$(MOUSE_X_POSITION(pic))+" Y= "+STR$(MOUSE_Y_POSITION(pic))
FOR i% = o1+1 TO o1+6
    IF CHECKED(i%) = 1 THEN EXIT_FOR
NEXT i%
fig = i%-o1
IF MOUSE_LEFT_DOWN(pic) = 1
    FILE_SAVE pic,fa$(na): 2D_PEN_DOT: 2D_PEN_COLOR tr,tg,tb: 2D_PEN_WIDTH 1
    x1=MOUSE_X_POSITION(pic): y1=MOUSE_Y_POSITION(pic)
    truc = 1
END_IF
IF MOUSE_LEFT_UP(pic) = 1
    FILE_LOAD pic,fa$(na): 2D_PEN_SOLID
    FOR i% = o2+1 TO o2+5
        IF CHECKED(i%)= 1 THEN EXIT_FOR
    NEXT i%
    2D_PEN_WIDTH i%-o2
    SELECT fig
        CASE 1: GOSUB Ligne
        CASE 2: GOSUB Rectvide
        CASE 3: GOSUB Rectplein
        CASE 4: GOSUB Cercvide
        CASE 5: GOSUB Cercplein
        CASE 6: GOSUB Texte
    END_SELECT
    na = na + 1: IF na > nva THEN na = 1
    FILE_SAVE pic,fa$(na)
    truc=0
END_IF
IF truc = 1
    x2=MOUSE_X_POSITION(pic): y2=MOUSE_Y_POSITION(pic)
    IF x2=x3 AND y2=y3 THEN RETURN
    FILE_LOAD pic,fa$(na)
    SELECT fig
        CASE 1: GOSUB Ligne
        CASE 2: GOSUB Rectvide
        CASE 3: GOSUB Rectplein
        CASE 4: GOSUB Cercvide
        CASE 5: GOSUB Cercplein
        CASE 6: GOSUB Texte
    END_SELECT
    x3=MOUSE_X_POSITION(pic)
    y3=MOUSE_Y_POSITION(pic)
END_IF
RETURN

Ligne:
2D_LINE x1,y1,x2,y2
RETURN

Rectplein:
2D_RECTANGLE x1,y1,x2,y2
RETURN

Rectvide:
2D_LINE x1,y1,x2,y1:2D_POLY_TO x2,y2:2D_POLY_TO x1,y2:2D_POLY_TO x1,y1
RETURN

Cercplein:
2D_CIRCLE x1,y1,SQR(POWER(x2-x1,2) + POWER(y2-y1,2))
RETURN

Cercvide:
r = SQR(POWER(x2-x1,2) + POWER(y2-y1,2)): IF r = 0 THEN RETURN
x = x1+r: y = y1
pas = 1: IF r>20 THEN pas = 10/r
FOR a = pas TO 2*pi+pas STEP pas
    xa = x1+r*COS(a): ya = y1+r*SIN(a): 2D_LINE x,y,xa,ya: x=xa: y=ya
NEXT a
RETURN

Texte:
HIDE 96
IF ITEM_INDEX(97) > 0 THEN font$ = ITEM_INDEX$(97)
fsz% = POSITION(98)
txt$ = TEXT$(102)
IF txt$ = "" THEN TIMER_ON nti%: RETURN
WHILE MOUSE_LEFT_DOWN(pic) = 0: WAIT 100: END_WHILE
WHILE MOUSE_LEFT_UP(pic) = 0
    x1 = MOUSE_X_POSITION(pic)
    y1 = MOUSE_Y_POSITION(pic)
    WAIT 100
END_WHILE
CURSOR_HOURGLASS pic
PRINT_TARGET_IS 106: COLOR 106, 254,254,254
FONT_NAME 106, font$: FONT_SIZE 106, fsz%: FONT_COLOR 106, tr,tg,tb
FONT_BOLD_OFF 106: FONT_ITALIC_OFF 106: FONT_UNDERLINE_OFF 106
IF CHECKED(103) = 1 THEN FONT_BOLD 106
IF CHECKED(104) = 1 THEN FONT_ITALIC 106
IF CHECKED(105) = 1 THEN FONT_UNDERLINE 106
PRINT_LOCATE 0,0: PRINT txt$
hc% = INT(fsz%*1.5): IF FRAC(fsz%*1.5) >= .5 THEN hc% = hc% + 1
IF fsz% < 9
    lc% = fsz%-1: IF fsz% = 7 THEN lc% = lc% - 1
ELSE
    lc% = INT(fsz%/1.25): IF FRAC(fsz%/1.25) >= .5 THEN lc% = lc% + 1
END_IF
lc% = lc% * LEN(txt$): ' longueur du texte, en pixels
FOR j% = 0 TO hc%-1
    FOR i% = 0 TO lc%-1
        pr% = COLOR_PIXEL_RED(106,i%,j%)
        pg% = COLOR_PIXEL_GREEN(106,i%,j%)
        pb% = COLOR_PIXEL_BLUE(106,i%,j%)
        ' IF pr%<>254 OR pg%<>254 OR pb%<>254
        IF pr% = tr and pg% = tg and pb% = tb
            2D_PEN_COLOR pr%,pg%,pb%: 2D_POINT x1+i%, y1+j%
        END_IF
    NEXT i%
NEXT j%
CURSOR_DEFAULT pic
na = na + 1: IF na > nva THEN na = 1
FILE_SAVE pic,fa$(na)
TIMER_ON nti%
RETURN

Coultrac:
xa = MOUSE_X_LEFT_DOWN(oct): ya = MOUSE_Y_LEFT_DOWN(oct)
j% = INT(ya/hc): i% = INT(xa/lc): c = 2*j% + i%: ' couleur 0 à 15
RESTORE
FOR i% = 0 TO c*3: READ tr: NEXT i%: READ tg: READ tb
2D_PEN_COLOR tr,tg,tb
COLOR oct+1, tr,tg,tb
RETURN

Coulfond:
xa = MOUSE_X_LEFT_DOWN(ocf): ya = MOUSE_Y_LEFT_DOWN(ocf)
j% = INT(ya/hc): i% = INT(xa/lc): c = 2*j% + i%: ' couleur 0 à 15
RESTORE
FOR i% = 0 TO c*3: READ cr: NEXT i%: READ cg: READ cb
2D_FILL_COLOR cr,cg,cb
COLOR ocf+1, cr,cg,cb
RETURN

New:
TIMER_OFF nti%
i% = MESSAGE_CONFIRMATION_YES_NO("Effacer le dessin en cours ?")
IF i% = 1 THEN CLS
TIMER_ON nti%
RETURN

Opn:
TIMER_OFF nti%
f$ = FILE_NAME$(90)
IF f$ = "_" OR f$ = "" THEN TIMER_ON nti%: RETURN
' Si les images chargées (bmp ou jpg) dépassent le cadre du picture, elles sont
' redimensionnées de façon proportionnelle (IrfanView).
GOSUB Iminfo: ' wi, hi largeur et hauteur d'origine de l'image
ra = wi/hi
IF wi > wp OR hi > hp
    ' réduction de l'image aux dimensions de la feuille
    wn = wp: hn = INT(wn/ra)
    IF hn > hp THEN hn = hp: wn = hn * ra
    m$ = " /resize=("+STR$(wn)+",0) /aspectratio /convert="+fa$(na)
    EXECUTE_WAIT iv$ + f$ + m$
    f$ = fa$(na)
END_IF
FILE_LOAD pic, f$
FILE_SAVE pic, fa$(na)
TIMER_ON nti%
RETURN

Enr:
IF f$ = "" OR f$ = "_" THEN RETURN
IF UPPER$(RIGHT$(f$, 4)) <> ".BMP" THEN GOTO Ens
TIMER_OFF nti%
FILE_SAVE pic, f$
TIMER_ON nti%
RETURN

Ens:
TIMER_OFF nti%
' enregistrement au format bmp exclusivement.
m$ = FILE_NAME$(91)
IF m$ = "_" OR m$= "" THEN TIMER_ON nti%: RETURN
f$ = m$: FILE_SAVE pic, f$
TIMER_ON nti%
RETURN

Imp:
TIMER_OFF nti%
i% = MESSAGE_CONFIRMATION_YES_NO("Prêt pour impression ?")
IF i% <> 1 THEN TIMER_ON nti%: RETURN
FILE_OPEN_WRITE 1, fp$
  FILE_WRITELN 1, "<#image="+fm$+",3,3,204,289#>"
FILE_CLOSE 1
EXECUTE_WAIT wp$ + "/file="+fp$+" /noshow"
TIMER_ON nti%
RETURN

Quit:
TERMINATE
RETURN

Anul:
' annulation en boucle sur nva (=5) éléments
na = na - 1: IF na < 1 THEN na = nva
FILE_LOAD pic, fa$(na)
RETURN

Iminfo:
EXECUTE_WAIT iv$ + f$ + " /info=" + fz$
FILE_OPEN_READ 1, fz$
WHILE FILE_EOF(1) = 0
    FILE_READLN 1, m$: IF LEFT$(m$, 6) = "Image " THEN EXIT_WHILE
END_WHILE
FILE_CLOSE 1: FILE_DELETE fz$
m$ = MID$(m$, 20, LEN(m$)): i% = INSTR(m$, " ")
wi = VAL(LEFT$(m$, i%-1)): m$ = MID$(m$, i%+3, LEN(m$)): i% = INSTR(m$, " ")
hi = VAL(LEFT$(m$, i%-1))
RETURN

Redim:

RETURN

chp:
TIMER_OFF nti%
SHOW 96
RETURN

vfont:
CLEAR 100
IF ITEM_INDEX(97) > 0 THEN font$ = ITEM_INDEX$(97)
fsz% = POSITION(98)
FONT_NAME 100, font$: FONT_SIZE 100, fsz%
ITEM_ADD 100, font$
ITEM_ADD 100, "Voyez le Brick Géant Que J'examine Près du Wharf"
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
vlf:
IF ITEM_INDEX(97) > 0 THEN font$ = ITEM_INDEX$(97)
fsz% = POSITION(98)
txt$ = TEXT$(102)
HIDE 96
GOSUB Texte
RETURN

Hlp:
TIMER_OFF nti%
m$ = CHR$(9) + CHR$(9) + "AIDE" + CHR$(10) + CHR$(9) + CHR$(9) + "===" + CHR$(10) + CHR$(10)
m$ = m$ + "Modification des paramètres:" + CHR$(10)
m$ = m$ + "~~~~~~~~~~~~~~~~~~~" + CHR$(10)
m$ = m$ + "- Largeur de trait: de 1 à 5 pixels" + CHR$(10)
m$ = m$ + "- Couleur du trait ou couleur du fond:" + CHR$(10)
m$ = m$ + "  Clic la couleur désirée parmi les 16 couleurs de base" + CHR$(10) + CHR$(10)
m$ = m$ + "Dessin des éléments:" + CHR$(10)
m$ = m$ + "~~~~~~~~~~~~~~" + CHR$(10)
m$ = m$ + "  Clic le départ, maintenir enfoncé, déplacer, relâcher à l'arrivée." + CHR$(10)
m$ = m$ + "1_ Ligne: Clic le départ, maintenir, relâcher à l'arrivée." + CHR$(10)
m$ = m$ + "2_ Rectangle: Clic un coin, maintenir, relâcher au coin opposé." + CHR$(10)
m$ = m$ + "3_ Cercle: Clic le centre, maintenir, relâcher sur un point du cercle." + CHR$(10)
m$ = m$ + CHR$(10)
m$ = m$ + "Menu:" + CHR$(10)
m$ = m$ + "~~~~" + CHR$(10)
m$ = m$ + "- Fichier: fonctions classiques." + CHR$(10)
m$ = m$ + "- Edition: Annulation de la dernière opération (profondeur = 5)" + CHR$(10)
m$ = m$ + "- Aide: affichage de ce texte." + CHR$(10) + CHR$(10)
m$ = m$ + "Remarques:" + CHR$(10)
m$ = m$ + "~~~~~~~~" + CHR$(10)
m$ = m$ + "- On peut charger une image BMP ou JPG." + CHR$(10)
m$ = m$ + "  L'image sera éventuellement redimensionnée de manière proportionnelle" + CHR$(10)
m$ = m$ + "  pour tenir dans le cadre." + CHR$(10)
m$ = m$ + "  On peut dessiner les figures géométriques de base sur l'image chargée" + CHR$(10)
m$ = m$ + "  (par exemple un cadre, etc.), puis sauvegarder le résultat," + CHR$(10)
m$ = m$ + "  exclusivement au format BMP." + CHR$(10)
MESSAGE m$
TIMER_ON nti%
RETURN

Apr:
TIMER_OFF nti%
MESSAGE "JL35 - Novembre 2010"
TIMER_ON nti%
RETURN

f$="Image.bmp"