Encadrement

' Encadrement d'une partie d'image
LABEL Quit,Chimg,Savimg,Decoupe,Desfig,Desfig1,Ajuste,Appliq,Ombre,Extraire
LABEL Couleur,Aide
DIM f$,fig%,xd%,yd%,x%,y%,w%,h%,rx%,ry%,xc%,yc%,t,i%,j%,pas%,omb%
DIM ec%,r%,g%,b%,cb%,cr%,xr%,yr%,wi1%,hi1%,wi%,hi%,wo%,eb%
DIM bh%,bv%,a$,rc$,kgf$,rn%,gn%,bn%
DIM x1,y1,x2,y2,xd1,yd1,xd2,yd2
kgf$ = "C:\PANORAMIC\KGF\KGF.dll": ' <============= à ajuster

BORDER_SMALL 0: LEFT 0,160: WIDTH 0,700: HEIGHT 0,560: FONT_BOLD 0: COLOR 0,190,255,255
  ON_CLOSE 0,Quit
  bh% = WIDTH(0)-WIDTH_CLIENT(0): bv% = HEIGHT(0)-HEIGHT_CLIENT(0)
PICTURE 1: TOP 1,30: LEFT 1,0: WIDTH 1,640: HEIGHT 1,480
ALPHA 2: TOP 2,3: CAPTION 2,"Image:"
EDIT 3: LEFT 3,40: WIDTH 3,200: ON_CLICK 3,Chimg
OPEN_DIALOG 4
ALPHA 8: TOP 8,4: LEFT 8,LEFT(3)+WIDTH(3)+3
ALPHA 5: TOP 5,TOP(2): LEFT 5,LEFT(3)+WIDTH(3)+80: CAPTION 5,"Enreg.(BMP):": HIDE 5
EDIT 6: LEFT 6,LEFT(5)+80: WIDTH 6,WIDTH(3): ON_CLICK 6,Savimg: HIDE 6
SAVE_DIALOG 7: FILTER 7,"Fichier BMP|*.bmp"

IMAGE 10
IMAGE 11

FORM 12: TOP 12,0: LEFT 12,0: WIDTH 12,160: HEIGHT 12,560: BORDER_SMALL 12
  FONT_BOLD 12: COLOR 12,255,255,200
CONTAINER_OPTION 13: PARENT 13,12: TOP 13,25: WIDTH 13,140: HEIGHT 13,55
  CAPTION 13,"DÉCOUPE:": COLOR 13,255,200,200
OPTION 14: PARENT 14,13: TOP 14,15: LEFT 14,10: CAPTION 14,"Rectangle/Carré"
OPTION 15: PARENT 15,13: TOP 15,TOP(14)+16: LEFT 15,LEFT(14): CAPTION 15,"Ovale/Cercle"
  MARK_ON 14
BUTTON 16: PARENT 16,12: TOP 16,TOP(13)+HEIGHT(13): LEFT 16,25: CAPTION 16,"Tracer"
  ON_CLICK 16,Decoupe
ALPHA 20: PARENT 20,12: TOP 20,TOP(16)+35: CAPTION 20,"  ----- AJUSTAGE: -----"
BUTTON 21: PARENT 21,12: TOP 21,TOP(20)+20: WIDTH 21,25: LEFT 21,10
           CAPTION 21,CHR$(231)
BUTTON 22: PARENT 22,12: TOP 22,TOP(21): WIDTH 22,25: LEFT 22,40
           CAPTION 22,CHR$(232)
BUTTON 23: PARENT 23,12: TOP 23,TOP(22)+30: WIDTH 23,25: LEFT 23,LEFT(21)
           CAPTION 23,CHR$(233)
BUTTON 24: PARENT 24,12: TOP 24,TOP(23): WIDTH 24,25: LEFT 24,LEFT(22)
           CAPTION 24,CHR$(234)
BUTTON 25: PARENT 25,12: TOP 25,TOP(21): WIDTH 25,25: LEFT 25,LEFT(22)+30
           CAPTION 25,CHR$(246)
BUTTON 26: PARENT 26,12: TOP 26,TOP(25): WIDTH 26,25: LEFT 26,LEFT(25)+30
           CAPTION 26,CHR$(247)
           FOR i%=21 TO 26: FONT_NAME i%,"Wingdings": FONT_SIZE i%,12: ON_CLICK i%,Ajuste: NEXT i%
SPIN 27: PARENT 27,12: TOP 27,TOP(24)+3: LEFT 27,LEFT(25): WIDTH 27,38
           MIN 27,1: MAX 27,99: POSITION 27,5
ALPHA 28: PARENT 28,12: TOP 28,TOP(27)+3: LEFT 28,LEFT(27)+37: CAPTION 28,"pixels"

ALPHA 30: PARENT 30,12: TOP 30,TOP(27)+40: LEFT 30,20: CAPTION 30,"    - CADRE -"
ALPHA 31: PARENT 31,12: TOP 31,TOP(30)+20: CAPTION 31,"Épaisseur:              pixels"
SPIN 32: PARENT 32,12: TOP 32,TOP(31)-3: LEFT 32,60: WIDTH 32,40
         MIN 32,1: MAX 32,99: POSITION 32,20
         ON_CHANGE 32,Couleur
ALPHA 33: PARENT 33,12: TOP 33,TOP(32)+30: CAPTION 33,"Couleur du cadre:"

ALPHA 34: PARENT 34,12: TOP 34,TOP(33)+20: LEFT 34,15
          CAPTION 34,"R="+CHR$(10)+CHR$(10)+"G="+CHR$(10)+CHR$(10)+"B="
SPIN 35: PARENT 35,12: TOP 35,TOP(34)-3: LEFT 35,LEFT(34)+20: WIDTH 35,50
SPIN 36: PARENT 36,12: TOP 36,TOP(35)+26: LEFT 36,LEFT(35): WIDTH 36,WIDTH(35)
SPIN 37: PARENT 37,12: TOP 37,TOP(36)+26: LEFT 37,LEFT(35): WIDTH 37,WIDTH(35)
         FOR i% = 35 TO 37: MIN i%,0: MAX i%,255: NEXT i%
         POSITION 35,180: POSITION 36,80: POSITION 37,40
         FOR i% = 35 TO 37: ON_CHANGE i%,Couleur: NEXT i%
PICTURE 40: PARENT 40,12: TOP 40,TOP(35): LEFT 40,90: WIDTH 40,20: HEIGHT 40,70
            COLOR 40,POSITION(35),POSITION(36),POSITION(37)
BUTTON 41: PARENT 41,12: TOP 41,TOP(37)+30: LEFT 41,25: CAPTION 41,"Appliquer"
           ON_CLICK 41,Appliq
CONTAINER_OPTION 45: PARENT 45,12: TOP 45,TOP(41)+40: WIDTH 45,140: HEIGHT 45,35
           CAPTION 45,"Couleur de remplissage:": COLOR 45,200,255,200
OPTION 46: PARENT 46,45: TOP 46,15: LEFT 46,10: CAPTION 46,"Blanc"
OPTION 47: PARENT 47,45: TOP 47,TOP(46): LEFT 47,80: CAPTION 47,"Noir"
           MARK_ON 46
BUTTON 48: PARENT 48,12: TOP 48,TOP(45)+45: WIDTH 48,60: LEFT 48,10: CAPTION 48,"Ombrage"
           ON_CLICK 48,Ombre
SPIN 49: PARENT 49,12: TOP 49,TOP(48)+2: LEFT 49,LEFT(48)+63: WIDTH 49,35
         MIN 49,1: MAX 49,20: POSITION 49,3
ALPHA 50: PARENT 50,12: TOP 50,TOP(49)+3: LEFT 50,LEFT(49)+35: CAPTION 50,"pixels"
BUTTON 54: PARENT 54,12: TOP 54,HEIGHT(12)-80: LEFT 54,25: CAPTION 54,"Extraire"
           ON_CLICK 54,Extraire
ALPHA 55: PARENT 55,12: TOP 55,TOP(54)+30
BUTTON 60: PARENT 60,12: TOP 60,0: WIDTH 60,30: LEFT 60,WIDTH(12)-50: CAPTION 60,"?"
           FONT_SIZE 60,12: ON_CLICK 60,Aide
          
rn% = 100: gn% = 101: bn% = 102: ' couleur de bordure du cadre (noir)
GOSUB Couleur
END
' ==============================================================================
Quit:
TERMINATE
' ==============================================================================
Chimg:
  f$ = FILE_NAME$(4): ' image de fond
  TEXT 3,f$: DimJpgBmp(f$): wi1% = wi%: hi1% = hi%
  i% = wi%+bh%: j% = hi%+bv%+30
  IF i% > (SCREEN_X-WIDTH(12)) THEN i% = SCREEN_X-WIDTH(12)
  IF j% >(SCREEN_Y-30) THEN j% = SCREEN_Y-30
  WIDTH 0,i%: HEIGHT 0,j%
  WIDTH 1,wi%: HEIGHT 1,hi%
  FILE_LOAD 1,f$
  2D_TARGET_IS 1: 2D_IMAGE_COPY 10,0,0,wi%,hi%
  CAPTION 55,"": HIDE 5: HIDE 6
  CAPTION 8,STR$(wi1%)+"x"+STR$(hi1%)
  TO_FOREGROUND 12
  omb% = 0
RETURN
' ==============================================================================
Savimg:
  f$ = FILE_NAME$(7)
  IF UPPER$(FILE_EXTRACT_EXTENSION$(f$)) <> ".BMP"
      MESSAGE "Doit être au format BMP !": RETURN
  END_IF
  TEXT 6,f$
  FILE_SAVE 1,f$
RETURN
' ==============================================================================
Decoupe:
  CAPTION 0,"": 2D_IMAGE_PASTE 10,0,0
  WHILE MOUSE_LEFT_DOWN(1) = 0: PAUSE 100: END_WHILE
  xd% = MOUSE_X_LEFT_DOWN(1): yd% = MOUSE_Y_LEFT_DOWN(1): PAUSE 100
  2D_FILL_OFF
  CAPTION 0,"xd= "+STR$(xd%)+" yd= "+STR$(yd%)
  fig% = 1: IF CHECKED(15) = 1 THEN fig% = 2
  WHILE MOUSE_LEFT_UP(1) = 0
    x% = MOUSE_X_POSITION(1): y% = MOUSE_Y_POSITION(1)
    IF SCANCODE = 160: ' Maj gauche, carré ou cercle
        y% = yd%+(x%-xd%)
    END_IF
    SCANCODE = 0
    CAPTION 0,STR$(xd%)+" , "+STR$(yd%)+"  ->  "+STR$(x%)+" , "+STR$(y%)
    GOSUB Desfig
    PAUSE 100
  END_WHILE
  xd1 = xd%: yd1 = yd%: x1 = x%: y1 = y%: ' contour interne
RETURN
' ==============================================================================
Desfig:
    2D_IMAGE_PASTE 10,0,0
    2D_PEN_COLOR 255,0,255: 2D_PEN_WIDTH 2
Desfig1:
    SELECT fig%
      CASE 1: 2D_RECTANGLE xd%,yd%,x%,y%: ' carré, rectangle
      CASE 2: ' ellipse, cercle
              w% = x%-xd%: h% = y%-yd%: rx% = w%/2: ry% = h%/2
              xc% = xd%+rx%: yc% = yd%+ry%
              2D_POLY_FROM xc%+rx%,yc%
              FOR t = 0 TO 2*PI STEP PI/180
                  2D_POLY_TO xc%+rx%*COS(t),yc%+ry%*SIN(t)
              NEXT t
    END_SELECT
RETURN
' ==============================================================================
Ajuste:
  i% = NUMBER_CLICK: pas% = POSITION(27): ' pas du déplacement
  SELECT i%
      CASE 21: xd% = xd%-pas%: x% = x%-pas%
      CASE 22: xd% = xd%+pas%: x% = x%+pas%
      CASE 23: yd% = yd%-pas%: y% = y%-pas%
      CASE 24: yd% = yd%+pas%: y% = y%+pas%
      CASE 25: x% = x%+pas%: y% = y%+pas%
      CASE 26: x% = x%-pas%: y% = y%-pas%
  END_SELECT
  GOSUB Desfig
RETURN
' ==============================================================================
Couleur:
  r% = POSITION(35): g% = POSITION(36): b% = POSITION(37)
  COLOR 40,r%,g%,b%
  WIDTH 40,POSITION(32)
  2D_TARGET_IS 40: 2D_PEN_COLOR rn%,gn%,bn%: 2D_PEN_WIDTH 1
  2D_LINE 0,0,0,HEIGHT(40): 2D_LINE WIDTH(40)-1,0,WIDTH(40)-1,HEIGHT(40)
  2D_TARGET_IS 1
RETURN
' ==============================================================================
Appliq:
  WIDTH 10,wi1%: HEIGHT 10,hi1%
  ec% = POSITION(32): ' épaisseur du cadre
  r% = POSITION(35): g% = POSITION(36): b% = POSITION(37): ' couleur du cadre
  COLOR 40,r%,g%,b%
  2D_IMAGE_PASTE 10,0,0
  2D_PEN_COLOR rn%,gn%,bn%: 2D_PEN_WIDTH 1
  xd% = xd1: yd% = yd1: x% = x1: y% = y1
  GOSUB Desfig1: ' contour initial (image)
  xd2 = xd1-ec%: yd2 = yd1-ec%: x2 = x1+ec%: y2 = y1+ec%
  xd% = xd2: yd% = yd2: x% = x2: y% = y2
  GOSUB Desfig1: ' contour externe (cadre)
  cb% = bn%*65536+gn%*256+rn%: ' couleur bordure (BGR)
  cr% = b%*65536+g%*256+r%: ' couleur de remplissage
  xr% = xd1+(xd2-xd1)/2: yr% = yd2+(y2-yd2)/2
  Remplir(1,xr%,yr%,cb%,cr%)
RETURN
' ==============================================================================
Ombre:
  wo% = POSITION(49): 2D_PEN_WIDTH wo%
  eb% = wo%/2
  SELECT fig%
    CASE 1: 2D_LINE xd1,y1-eb%,xd1,yd1: 2D_POLY_TO x1-eb%,yd1
            2D_LINE xd2+eb%,y2,x2,y2: 2D_POLY_TO x2,yd2+eb%
    CASE 2
              w% = x2-xd2: h% = y2-yd2: rx% = w%/2: ry% = h%/2
              xc% = xd2+rx%: yc% = yd2+ry%
              2D_POLY_FROM xc%,yd2
              FOR t = 3*PI/2 TO 2*PI STEP PI/180
                  2D_POLY_TO xc%+rx%*COS(t),yc%+ry%*SIN(t)
              NEXT t
              FOR t = 0 TO PI/2 STEP PI/180
                  2D_POLY_TO xc%+rx%*COS(t),yc%+ry%*SIN(t)
              NEXT t
              w% = x1-xd1: h% = y1-yd1: rx% = w%/2: ry% = h%/2
              2D_POLY_FROM xc%,y1
              FOR t = PI/2 TO 3*PI/2 STEP PI/180
                  2D_POLY_TO xc%+rx%*COS(t),yc%+ry%*SIN(t)
              NEXT t
  END_SELECT
  omb% = 1
RETURN
' ==============================================================================
Extraire:
  GOSUB Appliq
  IF omb% = 1 THEN GOSUB Ombre
  wi% = x2-xd2+eb%+1: hi% = y2-yd2+1: ' dimensions de la découpe totale
  i% = yd1+(y1-yd1)/2
  FOR x% = x2+20 TO x2 STEP -1
      r%=COLOR_PIXEL_RED(1,x%,i%): g%=COLOR_PIXEL_GREEN(1,x%,i%): b%=COLOR_PIXEL_BLUE(1,x%,i%)
      IF r% = rn% AND g% = gn% AND b% = bn% THEN EXIT_FOR
  NEXT x%
  wi% = x%-xd2
  i% = xd2+(x2-xd2)/2
  FOR y% = y2+20 TO y2 STEP -1
      r%=COLOR_PIXEL_RED(1,i%,y%): g%=COLOR_PIXEL_GREEN(1,i%,y%): b%=COLOR_PIXEL_BLUE(1,i%,y%)
      IF r% = rn% AND g% = gn% AND b% = bn% THEN EXIT_FOR
  NEXT y%
  hi% = y%-yd2
  2D_IMAGE_COPY 11,xd2,yd2,xd2+wi%+1,yd2+hi%+1
  WIDTH 1,wi%: HEIGHT 1,hi%
  CLS: 2D_IMAGE_PASTE 11,0,0
  IF fig% = 2: ' ellipse
      cr% = 0: ' remplissage noir pur
      IF CHECKED(46) = 1 THEN cr%=65536*255+256*255+255: ' remplissage blanc
      Remplir(1,2,2,cb%,cr%)
      Remplir(1,wi%-2,2,cb%,cr%)
      Remplir(1,2,hi%-2,cb%,cr%)
      Remplir(1,wi%-2,hi%-2,cb%,cr%)
  END_IF
  CAPTION 55,"-> "+STR$(wi%)+ " x "+STR$(hi%)+" pixels"
  SHOW 5: SHOW 6
RETURN
' ==============================================================================
Aide:
rc$ = CHR$(13)+CHR$(10)
  a$ = "-   ENCADREMENT   D' UNE   PARTIE   D' IMAGE   -"+rc$
  a$=a$+"     =============================="+rc$+rc$
  a$=a$+"1) Choisir une image source"+rc$
  a$=a$+"2) Choisir le type de découpe, rectangle ou ovale."+rc$
  a$=a$+"3) Bouton 'Tracer' la découpe : cliquer le coin supérieur gauche,"+rc$
  a$=a$+"     déplacer sans relâcher vers le coin inférieur droit, relâcher."+rc$
  a$=a$+"     NB: en maintenant la touche 'Maj' gauche enfoncée pendant le"+rc$
  a$=a$+"           tracé, on obtient respectivement un carré ou un cercle."+rc$
  a$=a$+"4) Ajuster éventuellement la position (flèches) et les dimensions"+rc$
  a$=a$+"     (flèches de droite) de la découpe."+rc$
  a$=a$+"5) Fixer la couleur et l'épaisseur du cadre (aperçu en temps réel)."+rc$
  a$=a$+"6) Effectuer la découpe: bouton 'Appliquer': le cadre se dessine"+rc$
  a$=a$+"     autour de la découpe."+rc$
  a$=a$+"7) Pour le cas ellipse ou cercle, fixer la couleur de remplissage externe,"+rc$
  a$=a$+"     par exemple noir pur pour utilisation ultérieure comme Sprite dans"+rc$
  a$=a$+"     dans un SCENE2D (insertion du cadre dans une autre image)."+rc$
  a$=a$+"8) On peut ajouter un effet d'ombrage au cadre: surépaisseur des lignes"+rc$
  a$=a$+"     d'encadrement du côté droit, d'une valeur choisie."+rc$
  a$=a$+"9) Réaliser la découpe: bouton 'Extraire': la découpe encadrée est affichée"+rc$
  a$=a$+"     seule. Il est alors possible de la sauvegarder sous forme d'image au"+rc$
  a$=a$+"     format BMP."
  MESSAGE a$
RETURN
' ==============================================================================
SUB Remplir(p%,x%,y%,cb%,cr%)
  ' Dans le picture p%, à partir du point x%,y%, remplir de la couleur cr% la zone
  ' délimitée par la couleur de bordure cb% (Attention: format BGR)
  DIM_LOCAL res%
  DLL_ON kgf$
  CLIPBOARD_COPY p%
  res% = DLL_CALL0("LoadPicture"): ' image presse-papier -> image interne
  res% = DLL_CALL4("FloodfillPictureToBorderColor",x%,y%,cr%,cb%)
  res% = DLL_CALL0("SavePicture"): ' image interne -> presse-papier
  CLIPBOARD_PASTE p%
  DLL_OFF
END_SUB
' ==============================================================================
SUB DimJpgBmp(f$)
   ' Image JPG ou BMP exclusivement, dimensions dans wi% et hi%
   DIM_LOCAL fm$: fm$ = "C:\TEMP\Provy.bmp"
   PICTURE 1099: HIDE 1099: FILE_LOAD 1099,f$: FILE_SAVE 1099,fm$: DELETE 1099
   FILEBIN_OPEN_READ 1,fm$
      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
   FILE_DELETE fm$
END_SUB
' ==============================================================================