BAO de dessin de figures élémentaires

PICTURE 1: FULL_SPACE 1: 2D_TARGET_IS 1
Dessin_BAO()
END

SUB Dessin_BAO()
  ' BAO de dessin de figures élémentaires sur la cible 2D
  DIM_LOCAL p,fa,ff,we,im,pc,sp,co,r,g,b,x,y,x1,y1,x2,y2,mj,fig
  IF LABEL("Chcol") = 0 THEN LABEL Chcol
  IF LABEL("Anuder") = 0 THEN LABEL Anuder
  IF LABEL("Kit") = 0 THEN LABEL Kit
  p = NUMBER_2D_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,185
            COLOR fa,255,0,0: ON_CLOSE fa,Kit: CAPTION fa," -  OUTILS  DESSIN  -"
  im = fa+1: IMAGE im
  pc = im+1: PICTURE pc: PARENT pc,fa: TOP pc,3: LEFT pc,3: 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
  2D_FILL_COLOR 255,255,255: 2D_RECTANGLE we*2,0,we*3,we
  2D_FILL_COLOR 255,0,0: 2D_RECTANGLE we*3,0,we*4,we
  2D_FILL_COLOR 0,255,0: 2D_RECTANGLE we*4,0,we*5,we
  2D_FILL_COLOR 0,0,255: 2D_RECTANGLE we,we,we*2,we*2
  2D_FILL_COLOR 255,255,0: 2D_RECTANGLE we*2,we,we*3,we*2
  2D_FILL_COLOR 255,0,255: 2D_RECTANGLE we*3,we,we*4,we*2
  2D_FILL_COLOR 0,255,255: 2D_RECTANGLE we*4,we,we*5,we*2
  ON_CLICK pc,Chcol
  sp = pc+1: SPIN sp: PARENT sp,fa: TOP sp,8: LEFT sp,WIDTH(pc)+4: WIDTH sp,40
      MIN sp,1: MAX sp,20: POSITION sp,1
  co=sp+1: CONTAINER_OPTION co: PARENT co,fa: TOP co,HEIGHT(pc)+6: WIDTH co,WIDTH(fa)-26
      LEFT co,6: HEIGHT co,90: CAPTION co,"      FIGURE :"
      COLOR co,255,255,128
  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"
      FOR x1 = co+1 TO co+5: LEFT x1,5: NEXT x1
  x=co+10: BUTTON x: PARENT x,fa: TOP x,TOP(co)+HEIGHT(co)+1: WIDTH x,82
          LEFT x,WIDTH(fa)-100: HEIGHT x,17: CAPTION x,"Annul dernier"
          ON_CLICK x,Anuder
  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
      PAUSE 100
    END_WHILE
    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 x2<>x1 OR y2<>y1
              IF mj = 160 THEN y2 = y1+x2-x1
              IF fig > 0 THEN 2D_IMAGE_PASTE im,0,0
              SELECT fig
                  CASE 0: 2D_LINE x1,y1,x2,y2: x1=x2: y1=y2
                  CASE 1: 2D_LINE x1,y1,x2,y2: ' trait
                  CASE 2: 2D_RECTANGLE x1,y1,x2,y2
                  CASE 3: 2D_ELLIPSE x1,y1,x2,y2
                  ' CASE 4: 2D_FLOOD x2,y2,r,g,b
              END_SELECT
          END_IF
      END_IF
      TO_FOREGROUND fa: PAUSE 100
    END_WHILE
    PAUSE 100
  END_WHILE
  DELETE pc: DELETE im: DELETE fa: EXIT_SUB
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
Kit:
  DELETE pc: DELETE im: DELETE fa: ff=1
RETURN
END_SUB