Dessin sur A4

' Dessin.bas
LABEL time, Ligne, Rectplein, Rectvide, Cercplein, Cercvide, Libre, Remplir
LABEL Texte, Images, Coultrac, Coulfond, New, Opn, Enr, Ens, Impr, Impr1, Quit
LABEL Anul, Hlp, Dtxt, Dimg, chimg, vlf, vfont, Red1, Red2, Red3, Red4, Reda
LABEL Txtf, Imagfi, Imgf, Init, Chor, Razor, Timon, Timoff, Track, Trackp

DIM w0%, h0%, wp%, hp%, mg, lb, hb, i%, j%, c, cr, cg, cb, tr, tg, tb, lc, hc, fact
DIM x,y,x1,y1,x2,y2,x3,y3,xa,ya,truc,f$,fm$,fp$, fig, a, r, pi, pas, kg$, m$
DIM pic, o1, o2, oct, ocf, nti%, ra, wn, hn, pr%, pg%, pb%, yt%, wip%, hip%
DIM na, nva, img(10), a$, wi%, hi%, font$, fsz%, txt$, lc%, hc%, hnd%, cnv%
DIM orien%, igtr%, igrz%, w%, h%
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 ===================================
fp$ = "C:\Temp\Imgprn.bmp": ' fichier d'impression
kg$ = "C:\PANORAMIC\KLAUS\DLLs\KGF.dll": ' DLL Klaus
' =============================================================================
pi = 4*ATN(1)
orien% = 0: ' orientation 'portrait'

tr = 0: tg = 0: tb = 0: ' couleur initiale de tracé (noir)
cr = 0: cg = 0: cb = 0: ' couleur initiale de fond (blanc)
f$ = ""
na = 1: nva = 5: ' profondeur d'annulations
fact = 3.7: ' pixels par mm, à l'écran
mg = 100: ' marge gauche (zone des des commandes)
COLOR 0, 128,255,255
' ------------------------------------------------------------------------------
pic = 150: PICTURE pic: TOP pic, 5: LEFT pic, mg: ' image de la feuille A4
' ------------------------------------------------------------------------------
igtr% = 138: IMAGE igtr%: ' tampon pour transfert des images
igrz% = 139: IMAGE igrz%: ' page initiale, pour RAZ
GOSUB Init
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, Impr: ON_CLICK 26, Quit
SUB_MENU 3: PARENT 3, 1: CAPTION 3, "Edition"
  SUB_MENU 31: PARENT 31, 3: CAPTION 31, "Annuler dernier"
  SUB_MENU 32: PARENT 32, 3: CAPTION 32, "RAZ tout"
  ON_CLICK 31, Anul: ON_CLICK 32, Razor
SUB_MENU 4: PARENT 4, 1: CAPTION 4, "Aide": ON_CLICK 4, Hlp

PICTURE 9: TOP 9,4: LEFT 9,4: WIDTH 9,10: HEIGHT 9,20: ' témoin d'activité du Timer
' ------------------------------------------------------------------------------
CONTAINER_OPTION 10: TOP 10,30: LEFT 10,5: HEIGHT 10,50: WIDTH 10,mg-10
COLOR 10,255,255,180: CAPTION 10,"Orientation :"
  OPTION 11: PARENT 11,10: TOP 11,15: LEFT 11,10: CAPTION 11,"Portrait"
  OPTION 12: PARENT 12,10: TOP 12,30: LEFT 12,10: CAPTION 12,"Paysage"
  MARK_ON 11: ON_CLICK 11, Chor: ON_CLICK 12, Chor
' ------------------------------------------------------------------------------
ALPHA 49: LEFT 49,20: CAPTION 49,"Marges non"+chr$(10)+"    imprimables -->"
o1 = 50: lb = mg-10: hb = 25
CONTAINER_OPTION o1: TOP o1,90: LEFT o1,5: HEIGHT o1,210: WIDTH o1,mg-10: CAPTION o1,"Type d'objet"
COLOR o1,255,255,180
  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,"Remplir"
  OPTION o1+7: PARENT o1+7,o1: TOP o1+7,140: LEFT o1+7,5: WIDTH o1+7,mg-20: CAPTION o1+7,"Tracé libre"
  OPTION o1+8: PARENT o1+8,o1: TOP o1+8,160: LEFT o1+8,5: WIDTH o1+8,mg-20: CAPTION o1+8,"Texte"
  OPTION o1+9: PARENT o1+9,o1: TOP o1+9,180: LEFT o1+9,5: WIDTH o1+9,mg-20: CAPTION o1+9,"Image"
  ON_CLICK o1+8, Dtxt: ON_CLICK o1+9, Dimg
  MARK_ON o1+1: fig = 1: ' Ligne
' ------------------------------------------------------------------------------
o2 = 70
CONTAINER o2: TOP o2,315: LEFT o2,5: HEIGHT o2,50: WIDTH o2,mg-10: CAPTION o2,"Largeur du tracé"
COLOR o2,255,255,180
  SPIN o2+1: PARENT o2+1,o2: TOP o2+1,20: LEFT o2+1,5: WIDTH o2+1,45
  MIN o2+1,1: MAX o2+1,20: POSITION o2+1,1
  ALPHA o2+2: PARENT o2+2,o2: TOP o2+2,22: LEFT o2+2,55: CAPTION o2+2,"pixels"
' ------------------------------------------------------------------------------
oct = 81: x1 = 10: y1 = 410: lc = 40: hc = 20
ALPHA oct-1: TOP oct-1,y1-40: LEFT oct-1,10
COLOR oct-1, 255,255,180: 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 = 620: lc = 40: hc = 20
ALPHA ocf-1: TOP ocf-1, y1-40: LEFT ocf-1, 10
COLOR ocf-1,255,255,180: 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 5: IMAGE 140+i%: img(i%) = 140+i%: NEXT i% : ' Pour sauvegardes
' -------------- FORM TEXTES ---------------------------------------------------
FORM 96: TOP 96, 60: LEFT 96, 50: HEIGHT 96, 345: WIDTH 96, 360: HIDE 96
BORDER_SMALL 96: COLOR 96,255,180,180: CAPTION 96, "Police/Taille"
TO_FOREGROUND 96
  LIST 97: PARENT 97, 96: TOP 97, 5: HEIGHT 97, 90: WIDTH 97, 150
  FONT_NAMES_LOAD 97
  FOR i% = COUNT(97) TO 1 STEP -1
      IF LEFT$(ITEM_READ$(97, i%), 1) = "@" THEN ITEM_DELETE 97, i%
  NEXT i%
  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, 120: ON_CLICK 98, vfont
  BUTTON 99: PARENT 99, 96: TOP 99, 5: LEFT 99, 260: WIDTH 99, 80
  CAPTION 99, "OK": ON_CLICK 99, Texte: ON_CLOSE 96, Txtf
  LIST 100: PARENT 100, 96: TOP 100, 100: WIDTH 100, 340: 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 ou 'coller' le texte:"
  MEMO 102: PARENT 102,96: TOP 102,156: WIDTH 102,340: HEIGHT 102,120
  CHECK 103: PARENT 103,96: TOP 103,30: LEFT 103,160: WIDTH 103,80: CAPTION 103,"Gras"
  CHECK 104: PARENT 104,96: TOP 104,50: LEFT 104,160: WIDTH 104,80: CAPTION 104,"Italique"
  CHECK 105: PARENT 105,96: TOP 105,70: LEFT 105,160: WIDTH 105,80: CAPTION 105,"Souligné"
  PICTURE 106: TOP 106,-1000: WIDTH 106,w0%-20: HEIGHT 106,900
  CHECK 107: PARENT 107,96: TOP 107,70: LEFT 107,240: CAPTION 107,"Fond transparent"
  ALPHA 110: PARENT 110,96: TOP 110,280: WIDTH 110,240
  CAPTION 110," Après saisie, clic le bouton 'OK', puis clic"+CHR$(10)+" l'emplacement sur la feuille (patience, c'est long !)"
  BUTTON 111: PARENT 111,96: TOP 111,35: LEFT 111,260: WIDTH 111,80
  cAPTION 111,"Annuler": ON_CLICK 111, Txtf
' -------------- FORM IMAGES ---------------------------------------------------
FORM 115: TOP 115, 60: LEFT 115, 50: HEIGHT 115, 320: WIDTH 115, 360: HIDE 115
BORDER_SMALL 115: COLOR 115,255,180,180: CAPTION 115, "Image à insérer:"
FONT_BOLD 115
  EDIT 116: PARENT 116,115: TOP 116,5: WIDTH 116,WIDTH(115)-16
  TEXT 116," * clic pour choisir l'image *": ON_CLICK 116, chimg
  ALPHA 117: PARENT 117,115: TOP 117,35
  ALPHA 118: PARENT 118,115: TOP 118,62
  CAPTION 118, "Redimensionner: W=                H=                pixels"
  SPIN 119: PARENT 119,115: TOP 119,60: LEFT 119,120: WIDTH 119,55
  SPIN 120: PARENT 120,115: TOP 120,TOP(119): LEFT 120,200: WIDTH 120,55
  ALPHA 121: PARENT 121,115: TOP 121,87: LEFT 121,260: CAPTION 121,"mm"
  SPIN 122: PARENT 122,115: TOP 122,85: LEFT 122,120: WIDTH 122,55
  SPIN 123: PARENT 123,115: TOP 123,TOP(121): LEFT 123,200: WIDTH 123,55
  MIN 119,0: MAX 119,2000: MIN 120,0: MAX 120,2000
  MIN 122,0: MAX 122,210: MIN 123,0: MAX 123,300
  ON_CHANGE 119,Red1: ON_CHANGE 120,Red2: ON_CHANGE 122,Red3: ON_CHANGE 123,Red4

  ALPHA 125: PARENT 125,115: TOP 125,115: LEFT 125,5: CAPTION 125,"Correction gamma:"
  EDIT 126: PARENT 126,115: TOP 126,115: LEFT 126,120: WIDTH 126,40
  TRACK_BAR 127: PARENT 127,115: TOP 127,130: LEFT 127,5: WIDTH 127,WIDTH(115)-25
  HEIGHT 127,20: ON_CHANGE 127, Track
  MIN 127,-128: MAX 127,127: POSITION 127,0
  TEXT 126, STR$(POSITION(127))
  PICTURE 130: PARENT 130,115: TOP 130,160: LEFT 130,10: WIDTH 130,160: HEIGHT 130,120
  STRETCH_ON 130

  BUTTON 124: PARENT 124,115: TOP 124,200: LEFT 124,220: CAPTION 124,"OK"
  ON_CLICK 124, Images: ON_CLOSE 115, Imgf
  BUTTON 131: PARENT 131,115: TOP 131,230: LEFT 131,220: CAPTION 131,"Annuler"
  ON_CLICK 131, Imgf
' -------------- FORM IMPRESSION -----------------------------------------------
FORM 300: TOP 300,100: LEFT 300,200: HEIGHT 300,150: WIDTH 300,360: HIDE 300
COLOR 300,180,255,180: CAPTION 300, "  - IMPRESSION -": BORDER_SMALL 300
FONT_BOLD 300
  ALPHA 301: PARENT 301,300: TOP 301,20: LEFT 301,5
  CAPTION 301,"Correction gamma éventuelle :"
  EDIT 302: PARENT 302,300: TOP 302,20: LEFT 302,180: WIDTH 302,40
  TRACK_BAR 303: PARENT 303,300: TOP 303,40: LEFT 303,5: WIDTH 303,WIDTH(300)-25
  HEIGHT 303,20: ON_CHANGE 303, Trackp
  MIN 303,-128: MAX 303,127: POSITION 303,0
  TEXT 302, STR$(POSITION(303))
  BUTTON 310: PARENT 310,300: TOP 310,80: LEFT 310,100: CAPTION 310,"Imprimer"
  BUTTON 311: PARENT 311,300: TOP 311,TOP(310): LEFT 311,180: CAPTION 311,"Annuler"
  ON_CLICK 310, Impr1: ON_CLICK 311, Impr1
' ------------------------------------------------------------------------------
DLL_ON kg$: ' pour images et impression
nti% = 160: TIMER nti%: TIMER_INTERVAL nti%,40: ON_TIMER nti%, time: GOSUB Timon
GOSUB Init
' ==============================================================================
END: ' ========================= E N D =========================================
' ==============================================================================
Init:
IF orien% = 0
    wp% = 210*fact: hp% = 297*fact
ELSE
    wp% = 297*fact: hp% = 210*fact
END_IF
w0% = wp% + mg + 25: h0% = hp% + 65
WIDTH 0, w0%: HEIGHT 0, h0%: WIDTH pic, wp%: HEIGHT pic, hp%
2D_TARGET_IS 0: 2D_RECTANGLE mg-1,4,mg+wp%+1,5+hp%
2D_TARGET_IS pic: 2D_CLEAR
2D_FILL_COLOR 128,128,128
2D_FILL_DIAGONAL_CROSS: 2D_RECTANGLE 0,0,wp%,hp%
2D_FILL_SOLID: 2D_FILL_COLOR 255,255,255: 2D_PEN_COLOR 255,255,255
2D_RECTANGLE 13,13,wp%-12,hp%-12: ' avec les marges non imprimables
2D_IMAGE_COPY igrz%,0,0,wp%,hp%: ' page vierge initiale, pour raz totale
RETURN
' ==============================================================================
Chor:
' changement d'orientatgion portrait/paysage
IF CHECKED(11) = 1
    IF orien% = 0 THEN RETURN
    orien% = 0
ELSE
    IF orien% = 1 THEN RETURN
    orien% = 1
END_IF
GOSUB Timoff
2D_IMAGE_COPY img(na),0,0,wp%,hp%
GOSUB Init
GOSUB Timon
RETURN
' ==============================================================================
Razor:
GOSUB Timoff
i% = MESSAGE_CONFIRMATION_YES_NO("Effacer la page en cours ?")
IF i% = 1
    2D_IMAGE_COPY img(na),0,0,wp%,hp%: ' sauvegarde page actuelle
    2D_IMAGE_PASTE igrz%,0,0: ' restore la page vierge initiale
END_IF
HIDE 96: HIDE 115: HIDE 300
MARK_OFF o1+8: MARK_OFF o1+9: MARK_ON o1+1
GOSUB Timon
RETURN
' ==============================================================================
Timon:
HIDE 96: HIDE 115: HIDE 300
TIMER_ON nti%
COLOR 9,255,0,0
RETURN
' ==============================================================================
Timoff:
TIMER_OFF nti%
COLOR 9,164,164,164
RETURN
' ==============================================================================
time:
x = MOUSE_X_POSITION(pic): y = MOUSE_Y_POSITION(pic)
a$ =  "X= "+STR$(x)+" pixels  Y= "+STR$(y)+" pixels"
a$=a$+" (X= "+STR$(INT(10*x/fact)/10)+" mm  Y= "+STR$(INT(10*y/fact)/10)+" mm)"
CAPTION 0,f$ + "    " + a$
FOR i% = o1+1 TO o1+8
    IF CHECKED(i%) = 1 THEN EXIT_FOR
NEXT i%
fig = i%-o1: ' type d'objet choisi
IF MOUSE_LEFT_DOWN(pic) = 1
    2D_IMAGE_COPY img(na),0,0,wp%,hp%
    2D_PEN_DOT: 2D_PEN_COLOR tr,tg,tb: 2D_PEN_WIDTH 1
    x1 = x: y1 = y: ' origine
    truc = 1
END_IF
IF MOUSE_LEFT_UP(pic) = 1
    ' relâche, tracé final
    2D_IMAGE_PASTE img(na),0,0
    2D_PEN_SOLID: 2D_PEN_WIDTH POSITION(o2+1)
    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 Remplir
        CASE 7: GOSUB Libre
        CASE 8: GOSUB Texte
        CASE 9: GOSUB Images
    END_SELECT
    na = na + 1: IF na > nva THEN na = 1
    2D_IMAGE_COPY img(na),0,0,wp%,hp%
    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: ' inchangé
    2D_IMAGE_PASTE img(na),0,0
    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 Remplir
        CASE 7: GOSUB Libre
        CASE 8: ' GOSUB Texte: ' on ne vient jamais ici (?)
        CASE 9: ' GOSUB Images: ' idem
    END_SELECT
    x3 = x: y3 = y
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
' ==============================================================================
Libre:
GOSUB Timoff
2D_PEN_SOLID: 2D_PEN_WIDTH POSITION(o2+1)
x1 = MOUSE_X_LEFT_DOWN(pic): y1 = MOUSE_Y_LEFT_DOWN(pic)
2D_IMAGE_COPY img(na),0,0,wp%,hp%
WHILE MOUSE_LEFT_UP(pic)=0
    x2 = MOUSE_X_POSITION(pic): y2 = MOUSE_Y_POSITION(pic)
    IF x2<>x1 or y2<>y1
        2D_LINE x1,y1,x2,y2: x1 = x2: y1 = y2: wait 100
    END_IF
END_WHILE
na = na + 1: IF na > nva THEN na = 1
2D_IMAGE_COPY img(na),0,0,wp%,hp%
truc = 0
GOSUB Timon
RETURN
' ==============================================================================
Remplir:
na = na + 1: IF na > nva THEN na = 1
2D_IMAGE_COPY img(na),0,0,wp%,hp%: ' sauvegarde préalable
2D_FLOOD x1,y1,cr,cg,cb
truc = 0
RETURN
' ==============================================================================
Texte:
HIDE 96: GOSUB Timoff
IF ITEM_INDEX(97) > 0 THEN font$ = ITEM_INDEX$(97)
fsz% = POSITION(98)
IF COUNT(102) = 0 THEN GOSUB Timon: RETURN
WHILE MOUSE_LEFT_DOWN(pic) = 0: WAIT 100: END_WHILE
WHILE MOUSE_LEFT_UP(pic) = 0: WAIT 100: END_WHILE
x1 = MOUSE_X_POSITION(pic)
y1 = MOUSE_Y_POSITION(pic)
2D_IMAGE_COPY img(na),0,0,wp%,hp%
IF CHECKED(107) = 1
    ' Fond transparent
    PRINT_TARGET_IS 106
    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
    2D_TARGET_IS 106: 2D_FILL_COLOR 254,254,254: 2D_TARGET_IS pic
    FOR yt% = 1 TO COUNT(102)
        txt$ = ITEM_READ$(102, yt%)
        PRINT_LOCATE 0,0: PRINT txt$
        hc% = TEXT_HEIGHT(txt$,106): lc% = TEXT_WIDTH(txt$,106)
        FOR j% = 0 TO hc%-1
            FOR i% = 0 TO lc%-1 step 1
                IF COLOR_PIXEL_RED(106,i%,j%) <> 254
                    2D_PEN_COLOR tr,tg,tb: 2D_POINT x1+i%, y1+j%
                END_IF
            NEXT i%
            DISPLAY
        NEXT j%
        y1 = y1 + hc%: IF y1 > (hp%-15) THEN EXIT_FOR
    NEXT yt%
ELSE
    ' Fond opaque (couleur de remplissage)
    PRINT_TARGET_IS pic: 2D_TARGET_IS pic: 2D_FILL_COLOR cr,cg,cb
    FONT_NAME pic, font$: FONT_SIZE pic, fsz%: FONT_COLOR pic, tr,tg,tb
    FONT_BOLD_OFF pic: FONT_ITALIC_OFF pic: FONT_UNDERLINE_OFF pic
    IF CHECKED(103) = 1 THEN FONT_BOLD pic
    IF CHECKED(104) = 1 THEN FONT_ITALIC pic
    IF CHECKED(105) = 1 THEN FONT_UNDERLINE pic
    FOR yt% = 1 TO COUNT(102)
        txt$ = ITEM_READ$(102, yt%)
        PRINT_LOCATE x1,y1: PRINT txt$
        y1 = y1 + TEXT_HEIGHT(txt$,pic)
    NEXT yt%
END_IF
na = na + 1: IF na > nva THEN na = 1
2D_IMAGE_COPY img(na),0,0,wp%,hp%
GOSUB Timon
RETURN
' ==============================================================================
Txtf:
' Fermeture par la croix (abandon)
IF CLICKED(111) = 1 THEN MARK_ON o1+1: ' bouton Annuler
HIDE 96: GOSUB Timon
RETURN
' ==============================================================================
Track:
TEXT 126,STR$(POSITION(127))
RETURN
' ==============================================================================
Trackp:
TEXT 302,STR$(POSITION(303))
RETURN
' ==============================================================================
Dimg:
GOSUB Timoff
f$ = ""
SHOW 115
RETURN
' ==============================================================================
chimg:
f$ = FILE_NAME$(90): TEXT 116, f$
IF FILE_EXISTS(f$)=0 THEN f$="": CAPTION 117," -> Fichier non trouvé !": RETURN
ImgSize(f$): wi% = rs_w%: hi% = rs_h%: ' largeur et hauteur d'origine de l'image
ra = wi%/hi%
a$ =  STR$(wi%)+" x "+STR$(hi%)+" pixels"
a$ = a$+" (= "+STR$(INT(10*wi%/fact)/10)+" x "+STR$(INT(10*hi%/fact)/10)+" mm)"
CAPTION 117, a$
i% = wi%/fact: j% = hi%/fact: ' en mm, arrondi au plus proche
POSITION 119,wi%: POSITION 120,hi%: POSITION 122,i%: POSITION 123,j%
WIDTH 130, 120*ra: FILE_LOAD 130, f$
RETURN
' ==============================================================================
Red1:
IF f$ = "" THEN RETURN
OFF_CHANGE 119: OFF_CHANGE 120: OFF_CHANGE 122: OFF_CHANGE 123
i% = POSITION(119)/ra: POSITION 120, i%
i% = POSITION(119)/fact: j% = POSITION(120)/fact: POSITION 122,i%: POSITION 123,j%
GOTO Reda
Red2:
IF f$ = "" THEN RETURN
OFF_CHANGE 119: OFF_CHANGE 120: OFF_CHANGE 122: OFF_CHANGE 123
i% = ra*POSITION(120): POSITION 119, i%
i% = POSITION(119)/fact: j% = POSITION(120)/fact: POSITION 122,i%: POSITION 123,j%
GOTO reda
Red3:
IF f$ = "" THEN RETURN
OFF_CHANGE 119: OFF_CHANGE 120: OFF_CHANGE 122: OFF_CHANGE 123
i% = POSITION(122)/ra: POSITION 123, i%
i% = fact*POSITION(122): j% = fact*POSITION(123): POSITION 119,i%: POSITION 120,j%
GOTO Reda
Red4:
IF f$ = "" THEN RETURN
OFF_CHANGE 119: OFF_CHANGE 120: OFF_CHANGE 122: OFF_CHANGE 123
i% = ra*POSITION(123): POSITION 122, i%
i% = fact*POSITION(122): j% = fact*POSITION(123): POSITION 119,i%: POSITION 120,j%
GOTO Reda
Reda:
ON_CHANGE 119,Red1: ON_CHANGE 120,Red2: ON_CHANGE 122,Red3: ON_CHANGE 123,Red4
RETURN
' ==============================================================================
Images:
HIDE 115
a$ = TEXT$(116)
IF FILE_EXISTS(a$) = 0 THEN GOTO Imagfi
GOSUB Timoff
f$ = a$
WHILE MOUSE_LEFT_DOWN(pic) = 0: WAIT 100: END_WHILE
WHILE MOUSE_LEFT_UP(pic) = 0: WAIT 100: END_WHILE
x1 = MOUSE_X_POSITION(pic)
y1 = MOUSE_Y_POSITION(pic)
2D_IMAGE_COPY img(na),0,0,wp%,hp%: ' sauvegarde état précédent
i% = DLL_Call1("LoadAnyImageFile",ADR(f$)): ' fichier image -> clipboard
IF POSITION(127)<>0
    ' correction gamma
    j%=995: WHILE OBJECT_EXISTS(j%)=1: j%=j%+1: END_WHILE
    PICTURE j%: TOP j%,-1000: WIDTH j%,wi%: HEIGHT j%,hi%
    CLIPBOARD_PASTE j%: GAMMA j%, POSITION(127): CLIPBOARD_COPY j%
    DELETE j%
END_IF
w% = POSITION(119)
IF w% <> 0 AND w% <> wi%: ' redimensionnement demandé
    h% = w%*hi%/wi%: ' proportionnel
    i% = DLL_Call2("ResizePicture",h%,w%): ' se fait dans le clipboard
END_IF
CLIPBOARD_PASTE igtr%
2D_IMAGE_PASTE igtr%,x1,y1: ' clipboard -> picture
na = na + 1: IF na > nva THEN na = 1
2D_IMAGE_COPY img(na),0,0,wp%,hp%
Imagfi:
GOSUB Timon
RETURN
' ==============================================================================
Imgf:
IF CLICKED(131) = 1 THEN MARK_ON o1+1: ' bouton Annuler
' ou fermeture par la croix, abandon
HIDE 115: GOSUB Timon
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:
GOSUB Timoff
i% = MESSAGE_CONFIRMATION_YES_NO("Effacer le dessin en cours ?")
IF i% = 1 THEN CLS
MARK_ON o1+1
GOSUB Timon
RETURN
' ==============================================================================
Opn:
GOSUB Timoff
f$ = FILE_NAME$(90)
IF f$ = "_" OR f$ = "" THEN GOSUB Timon: RETURN
FILE_LOAD pic, f$
2D_IMAGE_COPY img(na),0,0,wp%,hp%
MARK_ON o1+1
GOSUB Timon
RETURN
' ==============================================================================
Enr:
IF f$ = "" OR f$ = "_" THEN RETURN
IF UPPER$(RIGHT$(f$, 4)) <> ".BMP" THEN GOTO Ens
GOSUB Timoff
FILE_SAVE pic, f$
GOSUB Timon
RETURN
' ==============================================================================
Ens:
GOSUB Timoff
' enregistrement au format bmp exclusivement.
m$ = FILE_NAME$(91)
IF m$ = "_" OR m$= "" THEN GOSUB Timon: RETURN
f$ = m$: FILE_SAVE pic, f$
GOSUB Timon
RETURN
' ==============================================================================
Impr:
GOSUB Timoff
SHOW 300
RETURN
' ==============================================================================
Impr1:
HIDE 300
IF CLICKED(311) = 1 THEN GOSUB Timon: RETURN: ' Annulé
2D_TARGET_IS pic
' Modifier le gamma général de la feuille ?
IF POSITION(303) <> 0
    2D_IMAGE_COPY img(na),0,0,wp%,hp%: ' sauvegarde avant gamma
    GAMMA pic, POSITION(303)
END_IF
2D_IMAGE_COPY igtr%,13,13,wp%-12,hp%-12: FILE_SAVE igtr%, fp$
IF POSITION(303) <> 0
    2D_IMAGE_PASTE img(na),0,0: ' restore l'avant gamma
    GAMMA pic, 0
END_IF
HIDE 300
IF wp% > hp%
    ' Orientation 'paysage'
    i% = DLL_Call4("PrinterManager",4,ADR(hnd%),ADR(cnv%),1)
END_IF
i% = DLL_Call4("PrinterManager",1,ADR(hnd%),ADR(cnv%),0): ' init
wip% = DLL_Call6("PrinterFunction",8,ADR(hnd%),ADR(cnv%),7,0,0): ' largeur utile (=4812)
hip% = DLL_Call6("PrinterFunction",8,ADR(hnd%),ADR(cnv%),8,0,0): ' hauteur utile (=6863)
i% = DLL_Call6("PrinterFunction",7,ADR(hnd%),ADR(cnv%),ADR(fp$),wip%,hip%)
i% = DLL_Call4("PrinterManager",3,ADR(hnd%),ADR(cnv%),0): ' lancement impression
i% = MESSAGE_CONFIRMATION_YES_NO("Suppression du fichier temporaire d'impression ?")
IF i% = 1 THEN FILE_DELETE fp$: ' suppression du fichier image
GOSUB Timon
RETURN
' ==============================================================================
Quit:
TERMINATE
RETURN
' ==============================================================================
Anul:
' annulation en boucle sur nva (=5) éléments
na = na - 1: IF na < 1 THEN na = nva
2D_IMAGE_PASTE img(na),0,0
RETURN
' ==============================================================================
Dtxt:
GOSUB Timoff
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:
GOSUB Timoff
a$ = CHR$(10)
m$ = CHR$(9)+CHR$(9)+CHR$(9)+"AIDE"+a$+CHR$(9)+CHR$(9)+CHR$(9)+"==="+a$+a$
m$ = m$ + "Modification des paramètres:" + a$
m$ = m$ + "~~~~~~~~~~~~~~~~~~~" + a$
m$ = m$ + "- Paramètre général: orientation 'Portrait' ou 'Paysage', puis pour chaque" + a$
m$ = m$ + "  élément:" + a$
m$ = m$ + "- Largeur de trait: de 1 à 20 pixels" + a$
m$ = m$ + "- Couleur du trait et des textes, ou couleur du fond:" + a$
m$ = m$ + "      clic la couleur désirée parmi les 16 couleurs de base." + a$+a$
m$ = m$ + "Dessin des éléments:" + a$
m$ = m$ + "~~~~~~~~~~~~~~" + a$
m$ = m$ + "  Clic le départ, maintenir enfoncé, déplacer, relâcher à l'arrivée." + a$
m$ = m$ + "1_ Ligne: Clic le départ, maintenir, relâcher à l'arrivée." + a$
m$ = m$ + "2_ Rectangle: Clic un coin, maintenir, relâcher au coin opposé." + a$
m$ = m$ + "3_ Cercle: Clic le centre, agrandir au diamètre désiré, relâcher." + a$
m$ = m$ + "4_ Remplir: Remplissage de figures fermées avec la couleur de fond choisie." + a$
m$ = m$ + "5_ Tracé libre: Cliquer le départ, dessiner, relâcher." + a$
m$ = m$ + "6_ Texte: Choisir les paramètres fonte et taille, enrichissements, fond"+a$
m$ = m$ + CHR$(9)+"transparent ou non, entrer ou 'coller' le texte, puis clic 'OK'." + a$
m$ = m$ + CHR$(9)+"Cliquer l'emplacement récepteur (coin supérieur gauche)." + a$
m$ = m$ + "7_ Image: Insertion d'une image quelconque, à redimensionner" + a$
m$ = m$ + CHR$(9)+"éventuellement, ou rectifier la luminosité (gamma)." + a$
m$ = m$ + CHR$(9)+"Clic 'OK', puis cliquer l'emplacement (coin supérieur gauche)."+a$
m$ = m$ + a$
m$ = m$ + "Menu:" + a$
m$ = m$ + "~~~~" + a$
m$ = m$ + "- Fichier: fonctions classiques." + a$
m$ = m$ + "- Edition: Annulation de la dernière opération (5 niveaux d'annulation)," + a$
m$ = m$ + CHR$(9)+"ou Effacement total de la page." + a$
m$ = m$ + "- Aide: affichage de ce texte." + a$ + a$
m$ = m$ + "Remarques:" + a$
m$ = m$ + "~~~~~~~~" + a$
m$ = m$ + "- La sauvegarde éventuelle de l'image de la page ('Fichier', 'Sauvegarder')" + a$
m$ = m$ + "  se fera au format BMP, pour reprise ultérieure éventuelle." + a$
m$ = m$ + "- L'impression ('Fichier', 'Imprimer') se fait de manière transparente, dès" + a$
m$ = m$ + "  le clic sur le bouton 'Imprimer'." + a$
m$ = m$ + "- Le petit rectangle en haut à gauche est rouge quand le timer est actif"+a$
m$ = m$ + "  (en attente de clic dans la page)." + a$
m$ = m$ + "- Ressources externes: KGF.dll pour les images et l'impression."+a$
MESSAGE m$
GOSUB Timon
RETURN
' ==============================================================================
SUB ImgSize(f$)
IF VARIABLE("rs_w%") = 0 THEN DIM rs_w%
IF VARIABLE("rs_h%") = 0 THEN DIM rs_h%
i% = DLL_Call3("AnalyzeImageFile",ADR(f$),adr(rs_w%),ADR(rs_h%)): ' -> w% x h%
END_SUB
' ==============================================================================

 pi = 4*ATN(1)

pi = acos(-1)