Zoom d'une partie d'image

' Zoom d'une sélection rectangulaire d'image
LABEL Des,Zm
DIM f$,fm$,wi%,hi%,a$,et%,x1,y1,x2,y2,w%,h%,z,w1%,h1%,s2,bw,bh,v,vv
fm$ = "Z:\Toto.bmp": ' (Z:\ = répertoire de manoeuvre, à ajuster)
BORDER_SMALL 0
bw = WIDTH(0)-WIDTH_CLIENT(0): bh = HEIGHT(0)-HEIGHT_CLIENT(0): ' bordures
CAPTION 0,"IMAGE  SOURCE  :": FONT_SIZE 0,12: FONT_BOLD 0
PRINT "Choisir l'image de fond..."
Chimg(): ' choix de l'image source (JPG, BMP) -> f$, wi%, hi%
IF f$ = "" THEN MESSAGE "Pas d'image source, abandon !": TERMINATE
CAPTION 0,f$+" ("+STR$(wi%)+" x "+STR$(hi%)+" pixels)."
WIDTH 0,wi%+bw: HEIGHT 0,hi%+bh+26: FONT_SIZE 0,12: COLOR 0,240,255,255
  IF WIDTH(0)<360 THEN WIDTH 0,360
  FONT_NAME 0,"Consolas": FONT_BOLD 0
PICTURE 1: TOP 1,26: WIDTH 1,wi%: HEIGHT 1,hi%
IMAGE 2
ALPHA 3: TOP 3,2: COLOR 3,255,255,0
  CAPTION 3,"1)            2) x    ,"
BUTTON 4: LEFT 4,LEFT(3)+20: WIDTH 4,90: CAPTION 4,"Délimiter": ON_CLICK 4,Des
SPIN 6: TOP 6,-2: LEFT 6,LEFT(3)+175: WIDTH 6,42: POSITION 6,3
SPIN 7: TOP 7,TOP(6): LEFT 7,LEFT(6)+WIDTH(6)+10: WIDTH 7,40: POSITION 7,0
BUTTON 8: LEFT 8,LEFT(7)+WIDTH(7): CAPTION 8,"Zoomer": ON_CLICK 8,Zm
s2 = 15: SCENE2D s2: HIDE s2: STRETCH_ON s2: ' pour zoom
FORM 20: BORDER_SMALL 20: HIDE 20
PICTURE 21: PARENT 21,20: FULL_SPACE 21
TOP 20,TOP(0)+TOP(1)+bh-bw/2: LEFT 20,LEFT(0)+bw/2
FILE_LOAD 1,f$
2D_TARGET_IS 1: 2D_FILL_OFF
END
' ==============================================================================
Des:
  ' Délimitation rectangulaire de la zone à la souris
  vv = 0
  HIDE 20: CAPTION 0,f$
  FILE_LOAD 1,f$: 2D_TARGET_IS 1: CLIPBOARD_COPY 1
  WHILE MOUSE_LEFT_DOWN(1) = 1: END_WHILE: ' réinit, à tout hasard
  2D_PEN_COLOR 255,0,255: et% = 1: 2D_PEN_WIDTH et%: ' couleur/épaisseur tracé
  CURSOR_CROSS 1
  WHILE MOUSE_LEFT_DOWN(1) = 0: END_WHILE: ' attente clic souris
  WHILE MOUSE_LEFT_UP(1) = 1: END_WHILE: ' réinit
  x1 = MOUSE_X_POSITION(1): y1 = MOUSE_Y_POSITION(1)
  WHILE MOUSE_LEFT_UP(1) = 0
      x2 = MOUSE_X_POSITION(1): y2 = MOUSE_Y_POSITION(1)
      CLIPBOARD_PASTE 1: 2D_RECTANGLE x1,y1,x2,y2
  END_WHILE
  CURSOR_ARROW 1
  IF x1>x2 THEN v = x1: x1 = x2: x2 = v
  IF y1>y2 THEN v = y1: y1 = y2: y2 = v
  x1 = x1+et%: y1 = y1+et%: x2 = x2-et%: y2 = y2-et%
  caption 0,"x1="+STR$(x1)+" y1="+ str$(y1)+"  x2="+str$(x2)+" y2="+str$(y2)
  IF x2<=x1 OR y2<=y1 THEN CLIPBOARD_PASTE 1: RETURN
  2D_IMAGE_COPY 2,x1,y1,x2,y2: vv = 1
RETURN
' ==============================================================================
Zm:
  ' Zoom de la zone sélectionnée:
  ' Valeur entière + décimale éventuelle (1 seule)
  IF vv = 0 THEN RETURN: ' pas de zone délimitée
  IF LEN(STR$(POSITION(7)))>1 THEN MESSAGE "Zoom: une seule décimale !": RETURN
  z = POSITION(6)+POSITION(7)/10
  IF z = 0 THEN MESSAGE "Zoom: valeur positive obligatoire !": RETURN
  w% = x2-x1: h% = y2-y1
  2D_IMAGE_COPY 2,x1,y1,x1+w%,y1+h%: FILE_SAVE 2,fm$
  w1% = INT(w%*z): h1% = INT(h%*z)
  WIDTH s2,w1%: HEIGHT s2,h1%
  FILE_LOAD s2,fm$: SNAPSHOT s2,fm$
  FILE_LOAD 2,fm$: CLIPBOARD_COPY 2: FILE_DELETE fm$
  WIDTH 20,w1%+bw: HEIGHT 20,h1%+bh: FULL_SPACE 21
  CLIPBOARD_PASTE 21: SHOW 20: TO_FOREGROUND 20
  a$ = STR$(w%)+" x "+STR$(h%)+"  X"+STR$(z)+" = "+STR$(w1%)+" x "+STR$(h1%)
  a$ = a$+"  pixels -> clipboard"
  CAPTION 20,a$
RETURN
' ==============================================================================
SUB Chimg()
  ' Choix d'une image Bmp ou Jpg -> path f$, dimensions wi% x hi%
  DIM_LOCAL ob,fm$: fm$ = "Z:\Provy.bmp": ' Z:\ = répertoire de manoeuvre
  ob = 1099: OPEN_DIALOG ob: FILTER ob,"Image Bmp,Jpg|*.bmp;*.jpg"
  f$ = FILE_NAME$(ob): DELETE ob
  IF LEN(f$)<4 THEN f$ = "": EXIT_SUB: ' pas d'image, abandon
  PICTURE ob: HIDE ob: FILE_LOAD ob,f$: FILE_SAVE ob,fm$: DELETE ob
  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
' ==============================================================================

 if x1 > x2
     x1 = bin_xor(x1,x2)
     x2 = bin_xor(x1,x2)
     x1 = bin_xor(x1,x2)
  end_if
  
  if y1 > y2
     y1 = bin_xor(y1,y2)
     y2 = bin_xor(y1,y2)
     y1 = bin_xor(y1,y2)
  end_if

dim x1,y1,x2,y2
image 2
' erreur si x2<x1 et y1<>y2
x1= 55
x2= 54
y1= 33
y2= 32
2D_IMAGE_COPY 2,x1,y1,x2,y2