Une petite règle

WIDTH 0,800: HEIGHT 0,1140: BORDER_SMALL 0
PICTURE 1: WIDTH 1,778: HEIGHT 1,1100: 2D_TARGET_IS 1
Regle_A4()
END
' =============================================================================
SUB Regle_A4()
  ' Affichage d'une règle graduée en mm, déplaçable à la souris sur tout l'écran,
  '   orientable horizontale ou verticale en bascule (petit bouton à gauche).
  ' Quitter: double_clic sur la règle.
  IF LABEL("Attn") = 0 THEN LABEL Attn
  IF LABEL("Rota") = 0 THEN LABEL Rota
  IF LABEL("Freg") = 0 THEN LABEL Freg  
  DIM_LOCAL n2,np,ppm,rg,hr,h1,a$,i,ff,x0,y0,x,y,x1,y1,tr,lr,ori,pv,pq,ih,iv,im(2)
  DIM_LOCAL wp,hp,wa4,ha4
  wa4 = 210: ha4 = 297: ' dimensions page A4, ou tout l'écran, en millimètres
  wp = 778: hp = 1100: ' page A4 à l'écran, ou tout l'écran, en pixels
  ppm = hp/ha4: ' pixels/mm, à ajuster (ici, 297 mm = 1100 pixels)
                  ' soit image d'une page A4 grandeur nature = 778 x 1100 pixels
  n2 = NUMBER_2D_TARGET: np = NUMBER_PRINT_TARGET
  hr = 30: ' épaisseur règle
  rg = 840
  FORM rg: BORDER_HIDE rg: x0 = 0: y0 = 0: ' position initiale
        TOP rg,y0: LEFT rg,x0: WIDTH rg,778: HEIGHT rg,hr: COLOR rg,255,255,128
        ON_DOUBLE_CLICK rg,Freg
  pv=rg+1: BUTTON pv: PARENT pv,rg: TOP pv,7: LEFT pv,12: WIDTH pv,14: HEIGHT pv,12
          FONT_SIZE pv,8: CAPTION pv,">": FONT_BOLD pv: ON_CLICK pv,Rota
  iv = pv+1: IMAGE iv: im(1) = iv        
  ih = iv+1: IMAGE ih: im(0) = ih
  
  2D_TARGET_IS rg: PRINT_TARGET_IS rg  
  WIDTH rg,hr: HEIGHT rg,hp: ' créer image règle verticale
  FOR y = 0 TO ha4: ' hauteur A4, 297 mm (hauteur de la règle verticale)
      y1 = y*ppm: h1 = 5: a$ = ""
      IF y/5 = INT(y/5)
          h1 = h1+3
          IF y/10 = INT(y/10) THEN h1 = h1+3: a$ = str$(y/10): i=TEXT_HEIGHT(a$,rg)
      END_IF
      2D_LINE 0,y1,h1,y1: 2D_LINE hr,y1,hr-h1-2,y1
      IF a$<>"" THEN PRINT_LOCATE h1-3,y1-i/2: PRINT a$
  NEXT y
  TOP pv,8: LEFT pv,8: 2D_IMAGE_COPY iv,0,0,WIDTH(rg),HEIGHT(rg)
  CLS
  WIDTH rg,wp: HEIGHT rg,hr: ' créer image règle horizontale
  FOR x = 0 TO wa4: ' largeur A4, 210 mm (longueur de la règle horizontale)
      x1 = x*ppm: h1 = 5: a$ = ""
      IF x/5 = INT(x/5)
          h1 = h1+3
          IF x/10 = INT(x/10) THEN h1 = h1+3: a$ = str$(x/10): i=TEXT_WIDTH(a$,rg)
      END_IF
      2D_LINE x1,0,x1,h1: 2D_LINE x1,hr,x1,hr-h1-2
      IF a$<>"" THEN PRINT_LOCATE x1-i/2,h1-3: PRINT a$
  NEXT x
  TOP pv,8: LEFT pv,12: 2D_IMAGE_COPY ih,0,0,WIDTH(rg),HEIGHT(rg): ori = 0
Attn:
  WHILE MOUSE_LEFT_DOWN(rg) = 0: TO_FOREGROUND rg: PAUSE 200: END_WHILE
  x1 = MOUSE_X_POSITION(rg): y1 = MOUSE_Y_POSITION(rg)
  WHILE MOUSE_LEFT_UP(rg) = 0
       tr = TOP(rg): lr = LEFT(rg)  
       x = MOUSE_X_POSITION(rg): y = MOUSE_Y_POSITION(rg)
       IF x<>x1 OR y<>y1
           tr = tr+y-y1: lr = lr+x-x1: TOP rg,tr: LEFT rg,lr
           2D_IMAGE_PASTE im(ori),0,0
       END_IF
       PAUSE 100
  END_WHILE
  GOTO Attn
Rota:
  TOP rg,y0: LEFT rg,x0: 2D_TARGET_IS rg
  IF ori = 0: ' horizontale -> verticale
      WIDTH rg,hr: HEIGHT rg,hp: 2D_IMAGE_PASTE iv,0,0: LEFT pv,8: ori = 1
  ELSE: ' verticale -> horizontale
      WIDTH rg,wp: HEIGHT rg,hr: 2D_IMAGE_PASTE ih,0,0: LEFT pv,5: ori = 0
  END_IF
RETURN
Freg:
  2D_TARGET_IS n2: PRINT_TARGET_IS np: DELETE rg: DELETE iv: DELETE ih
END_SUB

label Fin
on_close 0,Fin
Reglette()
END
Fin:
TERMINATE
end

SUB Reglette()
  ' Affichage d'un objet réglette graduée en millimètres ou en pixels
  ' Orientation horizontale ou verticale, bouton haut/gauche ('V' ou 'H')
  ' Graduation pixels ou mm: bouton suivant ('P' ou 'M')
  ' Déplaçable sur tout l'écran à la souris (cliquer, déplacer, relâcher)
  ' Le double-clic sur la règle la supprime.
  ' ATTENTION: Renseigner la variable we = largeur de l'écran en millimètres.
  IF LABEL("Ma") = 0 THEN LABEL Ma
  IF LABEL("Mr") = 0 THEN LABEL Mr
  IF LABEL("Mg") = 0 THEN LABEL Mg
  IF LABEL("Ms") = 0 THEN LABEL Ms
  DIM_LOCAL fr,dt,pt,ff,ppm,wt,ht,hr,h,i,j,xt,yt,st,n$,x,y,x1,y1,we,ws,hs
  DIM_LOCAL im(3),ty,br,be
  ' ****************
  we = 518: ' largeur de l'écran, en millimètres, *** À AJUSTER ***
  ' ****************
  ws = SCREEN_X: hs = SCREEN_Y: ' dimensions de l'écran en pixels
  dt = NUMBER_2D_TARGET: pt = NUMBER_PRINT_TARGET
  hr = 30: ' épaisseur de la règle
  ppm = ws/we: ' écran acer 24"
  fr = 850: ' n° d'objet règle (arbitraire)
  FORM fr: BORDER_HIDE fr: TOP fr,0: LEFT fr,0: WIDTH fr,ws: HEIGHT fr,hs
          COLOR fr,255,255,190: 2D_TARGET_IS fr: PRINT_TARGET_IS fr
          ON_DOUBLE_CLICK fr,Ms
  i=fr+1: BUTTON i: PARENT i,fr: TOP i,9: LEFT i,7: WIDTH i,17: HEIGHT i,13
          CAPTION i,"V": ON_CLICK i,Mr: br = i
  i=i+1: BUTTON i: PARENT i,fr: TOP i,9: LEFT i,30: WIDTH i,17: HEIGHT i,13
        CAPTION i,"P": ON_CLICK i,Mg: be = i
  i=i+1: IMAGE i: im(0) = i: ' image règle horizontale millimètres
  i=i+1: IMAGE i: im(1) = i: ' image règle horizontale pixels
  i=i+1: IMAGE i: im(2) = i: ' image règle verticale millimètres
  i=i+1: IMAGE i: im(3) = i: ' image règle verticale pixels
  WIDTH fr,hr: HEIGHT fr,hs
  ' Création des 4 images de règle
  wt = 30: ht = hs: ' ***** règle verticale, millimètres *****
  2D_LINE 0,0,0,hs: 2D_LINE hr-1,0,hr-1,hs
  FOR i = 0 TO hs
      n$ = LTRIM$(RIGHT$("  "+STR$(i),4)): j = TEXT_WIDTH(n$,fr)
      yt = i*ppm: h = 5: IF i/5=INT(i/5) THEN h=8
      IF i/10 = INT(i/10) THEN h = 9
      2D_LINE 1,yt,h+1,yt: 2D_LINE hr-1,yt,hr-h-1,yt
      IF h = 9 THEN PRINT_LOCATE 9,yt-j/2: PRINT n$
  NEXT i
  2D_IMAGE_COPY im(2),0,0,ws,hs: CLS
  2D_LINE 0,0,0,hs: 2D_LINE hr-1,0,hr-1,hs
  st = 10: ' ***** verticale, pas de 10 pixels *****
  FOR i = 0 TO hs STEP st
      n$ = LTRIM$(RIGHT$("  "+STR$(i),4)): j = TEXT_WIDTH(n$,fr)
      yt = i: h = 5: IF i/50 = INT(i/50) THEN h = 8
      IF i/100 = INT(i/100) THEN h = 9
      2D_LINE 1,yt,h+1,yt: 2D_LINE hr-1,yt,hr-h-1,yt
      IF h = 9 THEN PRINT_LOCATE 9,yt-j/2: PRINT n$
  NEXT i
  2D_IMAGE_COPY im(3),0,0,ws,hs: CLS 
  ' ***** règle horizontale, millimètres *****
  WIDTH fr,ws: HEIGHT fr,hr
  2D_LINE 0,0,ws,0: 2D_LINE 0,hr-1,ws,hr-1
  FOR i = 0 TO ws
      n$ = LTRIM$(RIGHT$("  "+STR$(i),4)): j = TEXT_WIDTH(n$,fr)
      xt = i*ppm: h = 5: IF i/5=INT(i/5) THEN h=8
      IF i/10 = INT(i/10) THEN h = 9
      2D_LINE xt,1,xt,h+1: 2D_LINE xt,hr-1,xt,hr-h-1
      IF h = 9 THEN PRINT_LOCATE xt-j/2,9: PRINT n$
  NEXT i
  2D_IMAGE_COPY im(0),0,0,ws,hs: CLS
  2D_LINE 0,0,ws,0: 2D_LINE 0,hr-1,ws,hr-1
  st = 10: ' ***** horizontale, pas de 10 pixels *****
  FOR i = 0 TO ws STEP st: ' pixels
      n$ = LTRIM$(RIGHT$("  "+STR$(i),4)): j = TEXT_WIDTH(n$,fr)
      xt = i: h = 5: IF i/50 = INT(i/50) THEN h = 8
      IF i/100 = INT(i/100) THEN h = 9
      2D_LINE xt,1,xt,h+1: 2D_LINE xt,hr-1,xt,hr-h-1
      IF h = 9 THEN PRINT_LOCATE xt-j/2,9: PRINT n$
  NEXT i
  2D_IMAGE_COPY im(1),0,0,ws,hs
  ty = 0: 2D_IMAGE_PASTE im(ty),0,0
Ma:
  ' Attente clic sur la règle pour déplacement
  WHILE MOUSE_LEFT_DOWN(fr) = 0: PAUSE 100: IF ff = 1 THEN EXIT_WHILE
  END_WHILE
  IF ff = 0
      x1 = MOUSE_X_POSITION(fr): y1 = MOUSE_Y_POSITION(fr)
      WHILE MOUSE_LEFT_UP(fr) = 0
          x = MOUSE_X_POSITION(fr): y = MOUSE_Y_POSITION(fr)
          IF x<>x1 OR y<>y1
              TOP fr,TOP(fr)+y-y1: LEFT fr,LEFT(fr)+x-x1
              2D_IMAGE_PASTE im(ty),0,0
          END_IF
          PAUSE 100
      END_WHILE
      GOTO Ma
  END_IF
  2D_TARGET_IS dt: PRINT_TARGET_IS pt: DELETE fr: EXIT_SUB
Mr:
  TOP fr,0: LEFT fr,0: ' changement d'orientation
  IF ty = 0 OR ty = 1: ' horizontale
      ty = ty+2: WIDTH fr,hr: HEIGHT fr,hs: ' -> verticale
      TOP be,45: LEFT be,7: CAPTION br,"H"
  ELSE
      ty = ty-2: WIDTH fr,ws: HEIGHT fr,hr: ' -> horizontale
      TOP be,9: LEFT be,30: CAPTION br,"V"
  END_IF
  2D_IMAGE_PASTE im(ty),0,0     
RETURN
Mg:
  SELECT ty: ' changement pixels <-> mm
      CASE 0: ty = 1: CAPTION be,"M": ' horizontale mm -> pixels
      CASE 1: ty = 0: CAPTION be,"P": ' horizontale pixels -> mm
      CASE 2: ty = 3: CAPTION be,"M": ' verticale mm -> pixels
      CASE 3: ty = 2: CAPTION be,"P": ' verticale pixels -> mm
  END_SELECT
  2D_IMAGE_PASTE im(ty),0,0
RETURN
Ms:
  ff = 1: ' double-clic, arrêt demandé
RETURN
END_SUB