Petit outils pour icones

LABEL Afpol,Clikico
DIM pic%,pol$(10),fn$,p%,a$,i%,k%,x%,y%,wc%,hc%,nbc%,pr%,dr%
DIM op%,lf%,c%,r%,tpc%,car%
' Liste des polices 'symboles'
DATA "Bookdings","Webdings","Wingdings","Wingdings 2","Wingdings 3"
DATA "F"

WIDTH 0,880: HEIGHT 0,740: COLOR 0,180,255,255: BORDER_SMALL 0
    CAPTION 0,"   -   POLICES   SYMBOLES   -
CONTAINER 1: TOP 1,-8: LEFT 1,0: WIDTH 1,WIDTH(0)-20: HEIGHT 1,38
FONT_SIZE 1,10: FONT_BOLD 1
READ a$: i% = 0: op% = 1 : lf% = 20
WHILE a$<>"F"
    i%=i%+1: pol$(i%) = a$
    op%=op%+1: OPTION op%: PARENT op%,1: TOP op%,15: LEFT op%,lf%: lf% = lf%+110
    CAPTION op%,a$: READ a$
END_WHILE
FOR k% = 2 TO op%: ON_CLICK k%,Afpol: NEXT k%
MARK_ON 2
pic% = 10: PICTURE pic%: TOP pic%,30: WIDTH pic%,WIDTH(0)-20: HEIGHT pic%,HEIGHT(0)-130
           ON_CLICK pic%,Clikico
ALPHA 20: TOP 20,TOP(pic%)+HEIGHT(pic%)+20: LEFT 20,20: FONT_NAME 20,"Arial": FONT_SIZE 20,12
pr% = 33: dr% = 255: ' 1er et dernier caractères à afficher
GOSUB Afpol
END
' ==============================================================================
Afpol:
  FOR i% = 2 TO 6: IF CHECKED(i%) = 1 THEN EXIT_FOR
  NEXT i%
  p% = i%-1
  fn$ = pol$(p%)
  a$ = " Police: "+fn$+" ": FONT_NAME pic%,"Arial": FONT_SIZE pic%,16
  PRINT_TARGET_IS pic%
  2D_TARGET_IS pic%: CLS: 2D_FILL_COLOR 255,255,0
  i% = TEXT_WIDTH(a$,pic%): PRINT_LOCATE (WIDTH(pic%)-i%)/2,0: PRINT a$
  FONT_NAME pic%,fn$: FONT_SIZE pic%,28: 2D_FILL_COLOR 255,255,255
  wc% = 0: hc% = 0
  FOR i% = pr% TO dr%
      k% = TEXT_WIDTH(CHR$(i%),pic%): IF k%>wc% THEN wc% = k%
      k% = TEXT_HEIGHT(CHR$(i%),pic%): IF k%>hc% THEN hc% = k%
  NEXT i%
  tpc% = 25
  x% = 0: y% = tpc%
  nbc% = 16: ' nb de colonnes d'affichage
  FOR i% = pr% TO dr% STEP nbc%
      FOR k% = i% TO i%+nbc%-1
          IF k% > dr% THEN EXIT_FOR
          PRINT_LOCATE x%,y%: PRINT CHR$(k%)
          x% = x%+wc%
      NEXT k%
      y% = y%+hc%: x% = 0
  NEXT i%
RETURN
' ==============================================================================
Clikico:
  x% = MOUSE_X_LEFT_DOWN(pic%): y% = MOUSE_Y_LEFT_DOWN(pic%)
  IF y%<tpc% THEN RETURN
  c% = INT(x%/wc%): r% = INT((y%-tpc%)/hc%)
  car% = pr%+r%*nbc%+c%
  CAPTION 20, "Caractère "+STR$(car%): ' n° du caractère cliqué
  x% = 140: y%=TOP(pic%)+HEIGHT(pic%)+2
  IF OBJECT_EXISTS(30) = 1 THEN DELETE 30
  Icone(30,fn$,car%,x%,y%,60,16711680,1): ' affichage de l'icône, en rouge par exemple
RETURN
' ==============================================================================
SUB Icone(obj%,p$,n%,x%,y%,w%,rgb%,cad%)
  ' Icône cliquable obj%, police p$, caractère n%, en x%,y%, dimensions w% x w%
  ' de couleur rgb% (R*65536 + G*256 + B)
  ' si cad% = 1: encadrement de l'icône
  DIM_LOCAL npt%,n2d%,r%,g%,b%,wc%,hc%,mg%,mh%,i%
  n2d% = NUMBER_2D_TARGET: npt% = NUMBER_PRINT_TARGET
  r% = INT(rgb%/65536): g% = BIN_AND(rgb%,65280)/256: b% = BIN_AND(rgb%,255)
  PICTURE obj%: WIDTH obj%,w%: HEIGHT obj%,w%: TOP obj%,y%: LEFT obj%,x%
  FONT_NAME obj%,p$: FONT_COLOR obj%,r%,g%,b%: i% = w%
  FONT_SIZE obj%,i%: wc% = TEXT_WIDTH(CHR$(n%),obj%): hc% = TEXT_HEIGHT(CHR$(n%),obj%)
  WHILE wc%>w% OR hc%>w%
      i% = i%-1: FONT_SIZE obj%,i%
      wc% = TEXT_WIDTH(CHR$(n%),obj%): hc% = TEXT_HEIGHT(CHR$(n%),obj%)
  END_WHILE
  PRINT_TARGET_IS obj%: PRINT CHR$(n%)
  IF cad% = 1
      2D_TARGET_IS obj%: 2D_FILL_OFF: 2D_RECTANGLE 0,0,w%,w%
  END_IF
  2D_TARGET_IS n2d%: PRINT_TARGET_IS npt%
END_SUB
' ==============================================================================