Boîte à outils de dessin dans un picture

'' A4_Pano.bas source création d'un Form et Picture A4 (778x1100)
LABEL Qt,Impr
DIM fa$,a$,b$,k$,ori,wp,hp
DIM xg,yh,xd,yb
fa$ = "Z:\SavA4.bmp": ' Sauvegarde provisoire, à adapter
ori = 0: wp = 778: hp = 1100: ' orientation portrait
' ori = 1: wp = 1100: hp = 778: ' orientation paysage
BORDER_SMALL 0: WIDTH 0,wp+16: HEIGHT 0,hp+34: CAPTION 0,"A4 (778x1100)"
PICTURE 1: WIDTH 1,wp: HEIGHT 1,hp: 2D_TARGET_IS 1: PRINT_TARGET_IS 1
  ' affichage des limites périphériques non imprimables (non imprimées)
  2D_PEN_COLOR 164,0,0: xg = 10: yh = 10: ' pixels mini (imprimables)
  IF ori = 0 THEN xd = 764: yb = 1081: ELSE: xd = 1081: yb = 764
  2D_LINE xg,yh,xd,yh: 2D_POLY_TO xd,yb: 2D_POLY_TO xg,yb: 2D_POLY_TO xg,yh
  2D_PEN_COLOR 0,0,0
  
Dessin_BAO()

FILE_SAVE 1,fa$: ' sauvegarde du résultat
FORM 20: BORDER_SMALL 20: TOP 20,60: LEFT 20,50: WIDTH 20,140: HEIGHT 20,100
         COLOR 20,255,255,128: FONT_SIZE 20,11: CAPTION 20," - Image page A4 -"
ALPHA 21: PARENT 21,20: CAPTION 21," Enregistrée sous:"+CHR$(10)+"   "+fa$
BUTTON 22: PARENT 22,20: TOP 22,TOP(21)+40: CAPTION 22,"Imprimer": ON_CLICK 22,Impr    
BUTTON 23: PARENT 23,20: TOP 23,TOP(22): LEFT 23,LEFT(22)+WIDTH(22): WIDTH 23,50
           CAPTION 23,"Quitter": ON_CLICK 23,Qt
END
' =============================================================================
Qt:
  TERMINATE
' =============================================================================
Impr:
  Print_A4(fa$,ori)
RETURN
' =============================================================================
SUB Dessin_BAO()
  ' Boîte à outils de dessin de figures élémentaires sur la cible 2D
  DIM_LOCAL p,pr,pz,fa,fi,ft,ff,we,im,im1,pc,sp,co,ck,r,g,b,x,y,x1,y1,x2,y2,mj,fig
  DIM_LOCAL a$,ia$,fm$,rc$,mt,hl,i,j,ba,d,wi%,hi%,w%,h%,rr
  fm$ = "Z:\AAA.bmp": ' <- fichier de manoeuvre temporaire, À AJUSTER !
  rc$ = CHR$(13)+CHR$(10)
  IF LABEL("Depl") = 0 THEN LABEL Depl
  IF LABEL("Chcol") = 0 THEN LABEL Chcol
  IF LABEL("Anuder") = 0 THEN LABEL Anuder
  IF LABEL("Resz") = 0 THEN LABEL Resz
  IF LABEL("Kit") = 0 THEN LABEL Kit
  IF LABEL("Chim") = 0 THEN LABEL Chim
  IF LABEL("Chim1") = 0 THEN LABEL Chim1
  IF LABEL("Redim") = 0 THEN LABEL Redim
  IF LABEL("Chtx") = 0 THEN LABEL Chtx
  IF LABEL("Partx") = 0 THEN LABEL Partx
  p = NUMBER_2D_TARGET: pr = NUMBER_PRINT_TARGET
  we = 18
  fa = 600: FORM fa: BORDER_SMALL fa: FONT_SIZE fa,10
            LEFT fa,30: TOP fa,40: WIDTH fa,5*we+60: HEIGHT fa,250
            COLOR fa,255,164,164: ON_CLOSE fa,Kit: CAPTION fa," -  OUTILS  DESSIN  -"
  im = fa+1: IMAGE im
  im1 = im+1: IMAGE im1
  pc = im1+1: PICTURE pc: PARENT pc,fa: TOP pc,3: LEFT pc,1: WIDTH pc,we*5: HEIGHT pc,we*2
  2D_TARGET_IS pc: 2D_FILL_COLOR 0,0,0: 2D_RECTANGLE 0,0,we-2,we*2
  2D_FILL_COLOR 0,0,0: 2D_RECTANGLE we,0,we*2,we: ' noir
  2D_FILL_COLOR 255,255,255: 2D_RECTANGLE we*2,0,we*3,we: ' blanc
  2D_FILL_COLOR 255,0,0: 2D_RECTANGLE we*3,0,we*4,we: ' rouge
  2D_FILL_COLOR 0,255,0: 2D_RECTANGLE we*4,0,we*5,we: ' vert
  2D_FILL_COLOR 0,0,255: 2D_RECTANGLE we,we,we*2,we*2: ' bleu
  2D_FILL_COLOR 255,255,0: 2D_RECTANGLE we*2,we,we*3,we*2: ' jaune
  2D_FILL_COLOR 255,0,255: 2D_RECTANGLE we*3,we,we*4,we*2: ' magenta
  2D_FILL_COLOR 0,255,255: 2D_RECTANGLE we*4,we,we*5,we*2: ' cyan
  ON_CLICK pc,Chcol
  sp = pc+1: SPIN sp: PARENT sp,fa: TOP sp,13: LEFT sp,WIDTH(pc)+4: WIDTH sp,43
       MIN sp,1: MAX sp,20: POSITION sp,1
  x=sp+1: ALPHA x: PARENT x,fa: TOP x,-1: LEFT x,LEFT(sp): CAPTION x,"ép.trait"
          FONT_SIZE x,8: FONT_BOLD x: COLOR x,255,255,128
  co=sp+2: CONTAINER_OPTION co: PARENT co,fa: TOP co,HEIGHT(pc)+4
           WIDTH co,WIDTH(fa)-18: LEFT co,1: HEIGHT co,120
           COLOR co,255,255,164: CAPTION co,"      FIGURE :"
  OPTION co+1: PARENT co+1,co: TOP co+1,15: CAPTION co+1,"Tracé libre": MARK_ON co+1
  OPTION co+2: PARENT co+2,co: TOP co+2,TOP(co+1)+14: CAPTION co+2,"Trait"
  OPTION co+3: PARENT co+3,co: TOP co+3,TOP(co+2)+14: CAPTION co+3,"Rectangle"
  OPTION co+4: PARENT co+4,co: TOP co+4,TOP(co+3)+14: CAPTION co+4,"Ellipse"
  OPTION co+5: PARENT co+5,co: TOP co+5,TOP(co+4)+14: CAPTION co+5,"Remplir"
  OPTION co+6: PARENT co+6,co: TOP co+6,TOP(co+5)+14: CAPTION co+6,"Image"
  OPTION co+7: PARENT co+7,co: TOP co+7,TOP(co+6)+14: CAPTION co+7,"Texte"  
               FOR x = co+1 TO co+7: LEFT x,5: NEXT x
               ON_CLICK co+6,Chim: ON_CLICK co+7,Chtx
  x=co+9: CHECK x: PARENT x,fa: TOP x,TOP(co)+TOP(co+3)+9: LEFT x,82: CAPTION x,"pleins"
                   COLOR x,255,255,164: ck = x
  x=co+10: ALPHA x: PARENT x,fa: TOP x,TOP(co)+HEIGHT(co)
                    CAPTION x,"ajuster (pix.->)": FONT_ITALIC x
  ba=co+12: j = 16
  x=ba: BUTTON x: PARENT x,fa: TOP x,TOP(co)+HEIGHT(co)+16: WIDTH x,j: CAPTION x,CHR$(223)
  x=x+1: BUTTON x: PARENT x,fa: TOP x,TOP(x-1): LEFT x,LEFT(x-1)+j-1: WIDTH x,j: CAPTION x,CHR$(224)
  x=x+1: BUTTON x: PARENT x,fa: TOP x,TOP(x-1): LEFT x,LEFT(x-1)+j-1: WIDTH x,j: CAPTION x,CHR$(225)
  x=x+1: BUTTON x: PARENT x,fa: TOP x,TOP(x-1): LEFT x,LEFT(x-1)+j-1: WIDTH x,j: CAPTION x,CHR$(226)
  x=x+1: BUTTON x: PARENT x,fa: TOP x,TOP(x-1): LEFT x,LEFT(x-1)+j-1: WIDTH x,j: CAPTION x,CHR$(228)
  x=x+1: BUTTON x: PARENT x,fa: TOP x,TOP(x-1): LEFT x,LEFT(x-1)+j-1: WIDTH x,j: CAPTION x,CHR$(229)
  x=x+1: SPIN x: PARENT x,fa: TOP x,TOP(x-1)-10: LEFT x,LEFT(x-1)+j: WIDTH x,46: MIN x,1: MAX x,999
         POSITION x,1
         FOR i=ba TO ba+5: HEIGHT i,20: FONT_NAME i,"Wingdings": ON_CLICK i,Depl: NEXT i    
                  
  x=ba+10: BUTTON x: PARENT x,fa: TOP x,HEIGHT(fa)-52: WIDTH x,82
           LEFT x,WIDTH(fa)-100: HEIGHT x,17: CAPTION x,"Annul dernier"
           ON_CLICK x,Anuder

' * --- IMAGE ---
  fi = 570: FORM fi: BORDER_SMALL fi: FONT_SIZE fi,10: COLOR fi,220,220,255: HIDE fi
            TOP fi,TOP(fa): LEFT fi,LEFT(fa): WIDTH fi,200: HEIGHT fi,120
  ALPHA fi+1: PARENT fi+1,fi
  CAPTION fi+1,"Image (jpg, bmp) clic :"+rc$+rc$+rc$+rc$+"puis clic le point d'insertion"
  EDIT fi+2: PARENT fi+2,fi: TOP fi+2,20: WIDTH fi+2,WIDTH_CLIENT(fi)
             ON_CLICK fi+2,Chim1
  ALPHA fi+3: PARENT fi+3,fi: TOP fi+3,TOP(fi+2)+25: LEFT fi+3,20: FONT_ITALIC fi+3
  OPEN_DIALOG fi+4: FILTER fi+4,"Image BMP/JPG|*.bmp;*.jpg"

' * --- TEXTE ---
  ft = 580: FORM ft: BORDER_SMALL ft: FONT_SIZE ft,10: COLOR ft,255,255,200: HIDE ft
            TOP ft,TOP(fa): LEFT ft,LEFT(fa)+150: WIDTH ft,330: HEIGHT ft,200
            CAPTION ft," Paramètres de l'ensemble du texte ('OK' = valider) :"
            ON_RESIZE ft,Resz
  ALPHA ft+1: PARENT ft+1,ft: TOP ft+1,3: CAPTION ft+1,"Fnt="
  EDIT ft+2: PARENT ft+2,ft: LEFT ft+2,30: WIDTH ft+2,120: TEXT ft+2,"Arial"
  SPIN ft+3: PARENT ft+3,ft: TOP ft+3,TOP(ft+2): LEFT ft+3,WIDTH(ft+2)+33
             WIDTH ft+3,43: POSITION ft+3,16
  CHECK ft+4: PARENT ft+4,ft: TOP ft+4,TOP(ft+3)+3: LEFT ft+4,LEFT(ft+3)+45
              CAPTION ft+4,"G": FONT_BOLD ft+4
  CHECK ft+5: PARENT ft+5,ft: TOP ft+5,TOP(ft+4): LEFT ft+5,LEFT(ft+4)+31
              CAPTION ft+5,"I": ' FONT_ITALIC ft+5
  CHECK ft+6: PARENT ft+6,ft: TOP ft+6,TOP(ft+4): LEFT ft+6,LEFT(ft+5)+31
              CAPTION ft+6,"S": FONT_UNDERLINE ft+6
  BUTTON ft+7: PARENT ft+7,ft: TOP ft+7,TOP(ft+3): LEFT ft+7,WIDTH(ft)-42
               WIDTH ft+7,27: CAPTION ft+7,"OK": ON_CLICK ft+7,Partx
  mt = ft+8: MEMO mt: PARENT mt,ft: TOP mt,25: WIDTH mt,WIDTH_CLIENT(ft)
             HEIGHT mt,HEIGHT(ft)-60
  2D_TARGET_IS p: 2D_FILL_OFF
'
  WHILE ff = 0
      WHILE MOUSE_LEFT_DOWN(p) = 0
          IF ff = 1 THEN EXIT_SUB
          fig = 0: IF CHECKED(co+2) = 1 THEN fig = 1
          IF CHECKED(co+3) = 1 THEN fig = 2
          IF CHECKED(co+4) = 1 THEN fig = 3
          IF CHECKED(co+5) = 1 THEN fig = 4
          IF CHECKED(co+6) = 1 THEN fig = 5
          IF CHECKED(co+7) = 1 THEN fig = 6            
          PAUSE 100
      END_WHILE
      2D_FILL_OFF: IF fig=2 OR fig=3 AND CHECKED(ck)=1 THEN 2D_FILL_COLOR r,g,b: 2D_FILL_ON      
      x1 = MOUSE_X_POSITION(p): y1 = MOUSE_Y_POSITION(p)
      2D_IMAGE_COPY im,0,0,WIDTH(p),HEIGHT(p): ' sauvegarde préalable
      2D_PEN_COLOR r,g,b: 2D_PEN_WIDTH POSITION(sp)
      WHILE MOUSE_LEFT_UP(p) = 0
          mj = SCANCODE: SCANCODE = 0
          x2 = MOUSE_X_POSITION(p): y2 = MOUSE_Y_POSITION(p)
          IF fig = 4
              2D_FLOOD x2,y2,r,g,b: 2D_FILL_OFF
          ELSE
              IF fig = 5 OR fig = 6
                  IF fig = 5
                      2D_IMAGE_PASTE im1,x1,y1: HIDE fi: ' image
                  ELSE
                      y = y1
                      FOR i = 1 TO COUNT(mt)
                          ia$ = ITEM_READ$(mt,i)
                          PRINT_LOCATE x1,y: PRINT ia$: y = y+hl
                      NEXT i
                      HIDE ft
                  END_IF
              ELSE    
                IF x2<>x1 OR y2<>y1
                  IF mj = 160 THEN y2 = y1+x2-x1: ' touche Maj, carré/cercle
                  IF fig > 0 THEN 2D_IMAGE_PASTE im,0,0
                  SELECT fig
                      CASE 0: 2D_LINE x1,y1,x2,y2: x1=x2: y1=y2: ' tracé libre
                      CASE 1: 2D_LINE x1,y1,x2,y2: ' droite
                      CASE 2: 2D_RECTANGLE x1,y1,x2,y2: ' rectangle (/carré)
                              IF x2<>x1 AND y2<>y1 THEN rr = (x2-x1)/(y2-y1): ' pour ajustage éventuel
                      CASE 3: 2D_ELLIPSE x1,y1,x2,y2: ' ellipse (/cercle)
                  END_SELECT
                END_IF
              END_IF
          END_IF
          TO_FOREGROUND fa: PAUSE 20
      END_WHILE
      PAUSE 100
  END_WHILE
  DELETE pc: DELETE im: DELETE fa: EXIT_SUB
Depl:
  IF fig <1 OR fig >6 OR fig = 4 THEN RETURN
  d = POSITION(ba+6): GOSUB Anuder
  i = NUMBER_CLICK-ba
  SELECT i
      CASE 0: x1 = x1-d: x2 = x2-d: ' gauche
      CASE 1: x1 = x1+d: x2 = x2+d: ' droite
      CASE 2: y1 = y1-d: y2 = y2-d: ' haut
      CASE 3: y1 = y1+d: y2 = y2+d: ' bas
      CASE 4: x2 = x2+d: ' y2 = y2+d: ' agrandir
              y2 = y1+(x2-x1)/rr: ' (proportionnel)
      CASE 5: x2 = x2-d: y2 = y2-d: ' réduire
  END_SELECT
  SELECT fig
      CASE 1: 2D_LINE x1,y1,x2,y2: ' droite
      CASE 2: 2D_RECTANGLE x1,y1,x2,y2: ' rectangle (/carré)
      CASE 3: 2D_ELLIPSE x1,y1,x2,y2: ' ellipse (/cercle)
      CASE 5: IF i=4 OR i=5 THEN GOSUB Redim
              2D_IMAGE_PASTE im1,x1,y1: ' image
      CASE 6: y = y1: ' texte
              IF i = 4 OR i = 5
                  j = POSITION(ft+3): IF i=4 THEN j = j+d: ELSE: j = j-d
                  POSITION ft+3,j: FONT_SIZE pr,j
              END_IF
              FOR i = 1 TO COUNT(mt)
                  ia$ = ITEM_READ$(mt,i)
                  PRINT_LOCATE x1,y: PRINT ia$: y = y+hl
              NEXT i
  END_SELECT
RETURN
Chcol:
  x = MOUSE_X_LEFT_DOWN(pc): y = MOUSE_Y_LEFT_DOWN(pc)
  r=COLOR_PIXEL_RED(pc,x,y): g=COLOR_PIXEL_GREEN(pc,x,y): b=COLOR_PIXEL_BLUE(pc,x,y)
  2D_TARGET_IS pc: 2D_FILL_COLOR r,g,b: 2D_RECTANGLE 0,0,we-2,we*2: 2D_TARGET_IS p
RETURN
Anuder:
  2D_IMAGE_PASTE im,0,0: ' annul dernier
RETURN
Chim:
  TEXT fi+2,"": CAPTION fi+3,""
  SHOW fi: TO_FOREGROUND fi
RETURN
Chim1:
  ia$ = FILE_NAME$(fi+4): TEXT fi+2,ia$
  IF UPPER$(FILE_EXTRACT_EXTENSION$(ia$)) <> ".BMP"
      PICTURE 390: HIDE 390: FILE_LOAD 390,ia$: FILE_SAVE 390,fm$: ia$ = fm$
      DELETE 390
  END_IF
  FILEBIN_OPEN_READ 1,ia$
      FILEBIN_POSITION 1,18: wi% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
      FILEBIN_POSITION 1,22: hi% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
  FILEBIN_CLOSE 1
  CAPTION fi+3,STR$(wi%)+" x "+STR$(hi%)+" pixels"
  rr = wi%/hi%
  FILE_LOAD im1,ia$
RETURN
Redim:
  ' agrandir ou réduire l'image de d pixels (ou -d pixels)
  IF i = 5 THEN d = -1*d: ' réduire
  w% = wi%+d: h% = w%*hi%/wi%: pz = 550
  FORM pz: BORDER_HIDE pz: WIDTH pz,w%: HEIGHT pz,h%: 2D_TARGET_IS pz
  PICTURE pz+1: PARENT pz+1,pz: FULL_SPACE pz+1: STRETCH_ON pz+1: FILE_LOAD pz+1,ia$
  IMAGE pz+2: PARENT pz+2,pz: 2D_IMAGE_COPY pz+2,0,0,w%,h%: CLIPBOARD_COPY pz+2
  2D_TARGET_IS p: DELETE pz+1: DELETE pz+2: DELETE pz: CLIPBOARD_PASTE im1
RETURN
Chtx:
  GOSUB Partx: SHOW ft
RETURN
Partx:
  IF WIDTH(ft) < 330 THEN WIDTH ft,330
  WIDTH mt,WIDTH_CLIENT(ft): HEIGHT mt,HEIGHT(ft)-60
  FONT_NAME mt,TEXT$(ft+2): FONT_COLOR mt,r,g,b: FONT_SIZE mt,POSITION(ft+3): ' Memo saisie
  IF CHECKED(ft+4) = 1 THEN FONT_BOLD mt: ELSE: FONT_BOLD_OFF mt
  IF CHECKED(ft+5) = 1 THEN FONT_ITALIC mt: ELSE: FONT_ITALIC_OFF mt
  IF CHECKED(ft+6) = 1 THEN FONT_UNDERLINE mt: ELSE: FONT_UNDERLINE_OFF mt
  FONT_NAME pr,TEXT$(ft+2): FONT_COLOR pr,r,g,b: FONT_SIZE pr,POSITION(ft+3): ' Cible
  IF CHECKED(ft+4) = 1 THEN FONT_BOLD pr: ELSE: FONT_BOLD_OFF pr
  IF CHECKED(ft+5) = 1 THEN FONT_ITALIC pr: ELSE: FONT_ITALIC_OFF pr
  IF CHECKED(ft+6) = 1 THEN FONT_UNDERLINE pr: ELSE: FONT_UNDERLINE_OFF pr  
  hl = TEXT_HEIGHT("Abg",pr): ' hauteur 1 ligne
RETURN
Resz:
  ' redimensionnement manuel de la fenêtre de saisie texte (Form + Memo)
  WIDTH mt,WIDTH_CLIENT(ft): HEIGHT mt,HEIGHT(ft)-60
RETURN
Kit:
  DELETE pc: DELETE im: DELETE fa
  DELETE fi: DELETE im1
  ff = 1
RETURN
END_SUB
' =============================================================================
SUB Print_A4(f$,or%)
  ' Impression d'une image de page A4, orientation or%=0 Portrait, =1 Paysage
  ' Dimensions conservées, seules manquent les marges non imprimables.
  ' Page de 778x1100 pixels, pixels imprimables (imprimante Canon):
  ' PORTRAIT: xg mini = 11, xd maxi = 763, yh mini = 11, yb maxi = 1080
  '           -> w = 753 pixels, h = 1070 pixels
  ' PAYSAGE:  xg mini = 11, xd maxi = 1080, yh mini = 11, yb maxi = 763
  '           -> w = 1070 pixels, h = 753 pixels
  ' Surface imprimable: ~ 203,3 x 288 mm
  ' portrait: mg = 2,97 mm, md = 3,78 mm, mh = 2,97 mm, mb = 6 mm
  ' Arrondi: Marges non imprimées Gauche,Droite,Haut = 3 mm, Bas = 6 mm
  DIM_LOCAL wtp$,ft$,w$,h$,a$
  wtp$ = "C:\UTIL\WinTextPrint.exe": ' module 'Klaus'
  ft$ = "Z:\Balises.txt": ' fichier temporaire de manoeuvre  
  IF or% = 0
      w$ = "210": h$ = "297": a$ = "<#orientation=Portrait#>"
  ELSE
      w$ = "297": h$ = "210": a$ = "<#orientation=Paysage#>"
  END_IF
  FILE_OPEN_WRITE 1,ft$
    FILE_WRITELN 1,a$+" <#image="+f$+","+STR$(-3)+","+STR$(-3)+","+w$+","+h$+"#>"
  FILE_CLOSE 1
  EXECUTE_WAIT wtp$+"|/file="+ft$  
  FILE_DELETE ft$
END_SUB
' =============================================================================