Flouter une image

' Floutage.bas: floutage d'une partie rectangulaire d'image
' (intérieure ou extérieure)
LABEL Chf,Svf,Desrec,Flou,Annul
DIM f$,fs$,p%,wi%,hi%,x1,y1,x,y,i%,j%,ph%,pv%,r,g,b
WIDTH 0,200: HEIGHT 0,240: BORDER_SMALL 0: CAPTION 0,""
FONT_SIZE 0,10: FONT_BOLD 0: COLOR 0,200,255,255
ALPHA 1: CAPTION 1,"Image source (clic):"
EDIT 2: TOP 2,TOP(1)+15: WIDTH 2,WIDTH_CLIENT(0): ON_CLICK 2,Chf
OPEN_DIALOG 3: FILTER 3,"Image JPG,BMP|*.jpg;*.bmp"
ALPHA 5: TOP 5,TOP(2)+25: CAPTION 5,"Cadrer la zone"+CHR$(10)+"     à flouter"
BUTTON 6: TOP 6,TOP(5)+5: LEFT 6,120: WIDTH 6,60: CAPTION 6,"Cadrer": ON_CLICK 6,Desrec
CONTAINER_OPTION 7: TOP 7,TOP(5)+35: HEIGHT 7,25
OPTION 8: PARENT 8,7: CAPTION 8,"Intérieur": MARK_ON 8
OPTION 9: PARENT 9,7: TOP 9,TOP(8): LEFT 9,LEFT(8)+80: CAPTION 9,"Extérieur"
ALPHA 10: TOP 10,TOP(7)+30: CAPTION 10,"Niveau de flou"+CHR$(10)+"  (1 à 10):"
SPIN 11: TOP 11,TOP(10)+15: LEFT 11,LEFT(10)+70: WIDTH 11,40
    MIN 11,1: MAX 11,10: POSITION 11,1
BUTTON 12: TOP 12,TOP(10)-3: LEFT 12,LEFT(11)+50: WIDTH 12,60: CAPTION 12,"Flouter"
    HEIGHT 12,20: ON_CLICK 12,Flou
BUTTON 13: TOP 13,TOP(12)+24: LEFT 13,LEFT(12): WIDTH 13,WIDTH(12): CAPTION 13,"Annuler"
    HEIGHT 13,20: ON_CLICK 13,Annul
ALPHA 15: TOP 15,TOP(13)+25: CAPTION 15,"Enregistrer sous (bmp):"
EDIT 16: TOP 16,TOP(15)+15: WIDTH 16,WIDTH(2): ON_CLICK 16,Svf
SAVE_DIALOG 17: FILTER 17,"Image bmp|*.bmp"
 
FORM 20: TOP 20,0: LEFT 20,LEFT(0)+WIDTH(0): BORDER_SMALL 20
p% = 21: PICTURE p%: PARENT p%,20

END
' ==============================================================================
Chf:
  f$ = FILE_NAME$(3): IF FILE_EXISTS(f$) = 0 THEN RETURN
  TEXT 2,f$
  DimJpgBmp(f$)
  WIDTH 20,wi%+20: HEIGHT 20,hi%+40
  CAPTION 20,f$+" ("+STR$(wi%)+" x "+STR$(hi%)+" pixels)"
  WIDTH p%,wi%: HEIGHT p%,hi%: FILE_LOAD p%,f$
RETURN
' ==============================================================================
Svf:
  fs$ = FILE_NAME$(17)
  TEXT 16,fs$
  FILE_SAVE p%,fs$
RETURN
' ==============================================================================
Desrec:
  ' Dessin d'un rectangle
  ' Paramètres courants (trait, couleur, remplissage etc.)
  x = MOUSE_LEFT_DOWN(p%): x = MOUSE_LEFT_UP(p%): ' Réinit  
  WHILE MOUSE_LEFT_DOWN(p%) = 0: PAUSE 100: END_WHILE: ' attente clic de départ
  CLIPBOARD_COPY p%: 2D_TARGET_IS p%: 2D_PEN_COLOR 0,0,0: 2D_FILL_OFF
  x1 = MOUSE_X_POSITION(p%): y1 = MOUSE_Y_POSITION(p%)
  WHILE MOUSE_LEFT_UP(p%) = 0
      x = MOUSE_X_POSITION(p%): y = MOUSE_Y_POSITION(p%)
      IF x<>x1 OR y<>y1
          CLIPBOARD_PASTE p%
          2D_RECTANGLE x1,y1,x,y: ' rectangle
      END_IF
      PAUSE 50
  END_WHILE
  ' Rectangle de sélection délimité: x1,y1 -> x,y
RETURN
' ==============================================================================
Flou:
  i% = POSITION(11)
  ph% = i%+2
  r = 164: g = 164: b = 164
  2D_PEN_COLOR r,g,b: 2D_FILL_COLOR r,g,b: 2D_FILL_ON
  CLIPBOARD_PASTE p%
  IF CHECKED(8) = 1: ' floutage intérieur
      FOR j% = y1 TO y STEP ph%
          FOR i% = x1 TO x STEP ph%: 2D_RECTANGLE i%,j%,i%+ph%-1,j%+ph%-1: NEXT i%
          display
      NEXT j%
  ELSE: ' floutage extérieur
     FOR j% = 0 TO y1 STEP ph%
         FOR i% = 0 TO wi% STEP ph%: 2D_RECTANGLE i%,j%,i%+ph%-1,j%+ph%-1: NEXT i%
         display
     NEXT j%
     FOR j% = y1 TO y STEP ph%
         FOR i% = 0 TO x1 STEP ph%: 2D_RECTANGLE i%,j%,i%+ph%-1,j%+ph%-1: NEXT i%
         FOR i% = x TO wi% STEP ph%: 2D_RECTANGLE i%,j%,i%+ph%-1,j%+ph%-1: NEXT i%
         display
     NEXT j%
     FOR j% = y TO hi% STEP ph%
         FOR i% = 0 TO wi% STEP ph%: 2D_RECTANGLE i%,j%,i%+ph%-1,j%+ph%-1: NEXT i%
         display
     NEXT j%    
  END_IF
RETURN
' ==============================================================================
Annul:
  CLIPBOARD_PASTE p%
RETURN
' ==============================================================================
SUB DimJpgBmp(f$)
   ' Image JPG ou BMP exclusivement, dimensions dans wi% et hi%
   DIM_LOCAL fm$: fm$ = "Z:\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
' ==============================================================================