Curvimètre

Sujet: Curvimètre Sam 24 Sep 2022 - 21:04

Une petite sub pour mesurer en pixels la distance parcourue avec la souris entre clic et relâchement
sur une cible 2D.
Par exemple sur un plan de ville tracer un parcours par des rues successives et récupérer la distance totale.
(après, en fonction de l'échelle, traduire les pixels en mètres).

Code:: LABEL Qt,Curv
DIM d
BORDER_SMALL 0: ON_CLOSE 0,Qt: CAPTION 0,"Clic 'Curvimètre'"
PICTURE 1: FULL_SPACE 1: 2D_TARGET_IS 1
PRINT_TARGET_IS 1: FONT_SIZE 1,12
BUTTON 2: WIDTH 2,100: CAPTION 2,"Curvimètre": ON_CLICK 2,Curv
2D_CIRCLE 290,220,200: 2D_LINE 0,220,600,220: 2D_LINE 290,0,290,450
END
' =============================================================================
Qt:
TERMINATE
' =============================================================================
Curv:
  CAPTION 0,"Cliquer le point de départ, parcourir, relâcher"
  WHILE MOUSE_LEFT_DOWN(1) = 0: PAUSE 100: END_WHILE: ' attente clic départ
  Curvimetre(1)
  PRINT_LOCATE 5,25: PRINT STR$(d)+" pixels "
  CAPTION 0,"Clic 'Curvimètre'"
RETURN
' =============================================================================
SUB Curvimetre(p)
' -> d = distance en pixels parcourue par le pointeur souris sur l'objet p
' du clic départ jusqu'au relâchement (variable d définie dans l'appelant).
' NB: la sub est lancée par le clic du point de départ
DIM_LOCAL x,y,x1,y1,a,b,d1
CLIPBOARD_COPY p
2D_PEN_COLOR 255,80,255: 2D_PEN_WIDTH 2
x1 = MOUSE_X_POSITION(p): y1 = MOUSE_Y_POSITION(p)
2D_LINE x1-10,y1,x1+10,y1: 2D_LINE x1,y1-10,x1,y1+10
d = 0
WHILE MOUSE_LEFT_UP(p) = 0
x = MOUSE_X_POSITION(p): y = MOUSE_Y_POSITION(p)
IF x <> x1 OR y <> y1
a = x-x1: b = y-y1: d1 = SQR(a*a+b*b)
IF d1 > 0
d = d+d1: 2D_LINE x1,y1,x,y: x1 = x: y1 = y
PRINT_LOCATE 5,25: PRINT STR$(INT(d))+" pixels "
END_IF
END_IF
PAUSE 50
END_WHILE
d = INT(d): ' distance totale parcourue
2D_PEN_WIDTH 1: 2D_PEN_COLOR 0,0,0
CLIPBOARD_PASTE p: ' restore image initiale
END_SUB
' =============================================================================

PS:
J'avais d'abord mis l'attente du clic de départ dans la sub, mais ça coince parfois au bout de quelques mesures,
je ne sais pas trop pourquoi, alors je l'ai mise avant l'appel de la sub.