Visualisation des polices de caractères installées

' Aperçu des polices installées
' **** Polices fixes (pour info): ****
' Andale Mono IPA, Courier, Courier New, DejaVu Sans Mono, DFKai-SB, DotumChe
' FangSong, GulimChe, GungsuhCh, KaiTi, Lucida Console, LingLiU, MingLiU_HKSCS
' MingLiU_HKSCS-ExtB, MingLiU-ExtB, Miriam Fixed, MS Gothic, MS Mincho, NSimSun
' OCR A Extended, SimHei, Simplified Arab Fixed, SimSun, SimSun-ExtB, Terminal
DIM fonte$(500), nf, i, tx$, sz%, ec%, x, y, hh, ww, nl, np, p%, pl%, po%
DIM lf%, tp%, cah%, cav%, ofx%, ofy%, h$, tb%
LABEL Afpage, Clic, Carpol, Clicbut, Afjeu

' au choix...
tx$ = "The quick brown fox jumps over the lazy dog 0123456789"
tx$ = "Voyez le brick géant que j'examine près du wharf 0123456789"
tx$ = "Portez ce vieux whisky au juge blond qui fume 0123456789"
sz% = 11: ' taille des polices affichées
ec% = 18: ' interligne
h$ = "0123456789ABCDEF"
hh = SCREEN_Y-36: ww = 1000
nl = INT((hh-32)/ec%)
cah% = 38: cav% = 40: ofx% = 40: ofy% = 60
HEIGHT 0, hh: WIDTH 0, ww
LIST 1: FONT_NAMES_LOAD 1: nf = COUNT(1)
FOR i = 1 TO nf: fonte$(i) = ITEM_READ$(1, i): NEXT i
DELETE 1
CAPTION 0, " "+STR$(nf) + " FONTES."
np = INT(nf/nl): IF nf/nl > np THEN np = np + 1
BUTTON 5: TOP 5, 5: LEFT 5, ww-140: WIDTH 5, 100: CAPTION 5, "Page Préc."
BUTTON 6: TOP 6, 35: LEFT 6, ww-140: WIDTH 6, 100: CAPTION 6, "Page Suiv."
BUTTON 7: TOP 7, 65: LEFT 7, ww-140: WIDTH 7, 100: CAPTION 7, "Exit"
FOR i = 5 TO 7
    FONT_SIZE i, 12: FONT_BOLD i: ON_CLICK i, Clic
NEXT i
PICTURE 1: WIDTH 1, 970: HEIGHT 1, ec%*nl
lf% = 250: tp% = 150
PICTURE 10: TOP 10, tp%: LEFT 10, lf%: WIDTH 10, 18*cah%: HEIGHT 10, 19*cav%
HIDE 10
tb% = tp% + ofy%+16*cav%+20
CHECK 11: TOP 11, tb%: LEFT 11, lf%+40: CAPTION 11, "Gras"
CHECK 12: TOP 12, tb%: LEFT 12, lf%+140: CAPTION 12, "Italique"
CHECK 13: TOP 13, tb%: LEFT 13, lf%+240: CAPTION 13, "Souligné"
CHECK 14: TOP 14, tb%: LEFT 14, lf%+340: CAPTION 14, "Barré"
BUTTON 15: TOP 15, tb%-5: LEFT 15, lf%+18*cah%-110: CAPTION 15, "Retour"
FOR i = 11 TO 15: ON_CLICK i, Clicbut: FONT_SIZE i,11: FONT_BOLD i: HIDE i: NEXT i
FONT_SIZE 1, sz%
ON_CLICK 1, Carpol
p% = 1
GOSUB Afpage
END
' =============================================================================
Afpage:
HIDE 1: COLOR 1, 255, 255, 255: ' Nettoyage
pl% = (p%-1)*nl + 1: ' 1ère police de la page affichée
PRINT_TARGET_IS 1: y = 0
FOR i = pl% TO pl%+nl-1
    IF i>nf THEN EXIT_FOR
    FONT_NAME 1, "Arial": PRINT_LOCATE 0, y: PRINT fonte$(i)
    FONT_NAME 1, fonte$(i): PRINT_LOCATE 180, y: PRINT tx$
    y = y + ec%
NEXT i
SHOW 1
IF p% = 1
    HIDE 5
ELSE
    SHOW 5
END_IF
IF p% = np
    HIDE 6
ELSE
    SHOW 6: ' de Strasbourg
END_IF
RETURN
' =============================================================================
Clic:
' Clic sur un bouton
IF CLICKED(7) = 1 THEN TERMINATE
IF CLICKED(5) = 1
    IF p% < 2 THEN RETURN
    p% = p% - 1
ELSE
    IF p% >= np THEN RETURN
    p% = p% + 1
END_IF
GOSUB Afpage
RETURN
' =============================================================================
Carpol:
' Clic sur une police
FOR i = 11 TO 14: MARK_OFF i: NEXT i
IF MOUSE_X_LEFT_DOWN(1) > (ww-140) THEN RETURN
FOR i = 11 TO 15: SHOW i: NEXT i
y = MOUSE_Y_LEFT_DOWN(1)
po% = pl% + INT(y/ec%): IF po% > nf THEN RETURN
2D_TARGET_IS 10: 2D_FILL_COLOR 255,255,160: 2D_RECTANGLE 0,0,18*cah%-1, 19*cav%-1
PRINT_TARGET_IS 10
FONT_BOLD_OFF 10: FONT_ITALIC_OFF 10: FONT_UNDERLINE_OFF 10: FONT_STRIKE_OFF 10
FONT_COLOR 10,0,0,255: FONT_BOLD 10
FONT_NAME 10, "Arial": FONT_SIZE 10, 14: PRINT_LOCATE 20, 5: PRINT fonte$(po%)
FOR x = 0 TO 15
    PRINT_LOCATE ofx%+x*cah%+cah%/2-5, ofy%-24: PRINT MID$(h$, x+1, 1)
NEXT x
FOR y = 0 TO 15
    PRINT_LOCATE 24, ofy%+y*cav%+cav%/2-14: PRINT MID$(h$, y+1, 1)
NEXT y
GOSUB Afjeu
RETURN
' =============================================================================
Clicbut:
FOR i = 11 TO 15
    IF CLICKED(i) = 1 THEN EXIT_FOR
NEXT i
SELECT i
    CASE 11: GOSUB Afjeu
    CASE 12: GOSUB Afjeu
    CASE 13: GOSUB Afjeu
    CASE 14: GOSUB Afjeu
    CASE 15: 2D_TARGET_IS 0: PRINT_TARGET_IS 1
        FOR i = 10 TO 15: HIDE i: NEXT i
END_SELECT
RETURN
' =============================================================================
Afjeu:
FONT_NAME 10, "Terminal": FONT_SIZE 10, 8
FONT_BOLD_OFF 10: FONT_ITALIC_OFF 10: FONT_UNDERLINE_OFF 10: FONT_STRIKE_OFF 10
FONT_COLOR 10,0,0,180
HIDE 10
2D_FILL_COLOR 255,255,220
FOR y = 0 TO 15
    FOR x = 0 TO 15
        2D_RECTANGLE ofx%+x*cah%, ofy%+y*cav%, ofx%+(x+1)*cah%, ofy%+(y+1)*cav%
        PRINT_LOCATE ofx%+x*cah%+cah%/2-15, ofy%+(y+1)*cav%-10
        PRINT CHR$(16*y+x)+" "+RIGHT$("00"+STR$(16*y+x), 3)
    NEXT x
NEXT y
IF CHECKED(11) = 1
    FONT_BOLD 10
ELSE
    FONT_BOLD_OFF 10
END_IF
IF CHECKED(12) = 1
    FONT_ITALIC 10
ELSE
    FONT_ITALIC_OFF 10
END_IF
IF CHECKED(13) = 1
    FONT_UNDERLINE 10
ELSE
    FONT_UNDERLINE_OFF 10
END_IF
IF CHECKED(14) = 1
    FONT_STRIKE 10
ELSE
    FONT_STRIKE_OFF 10
END_IF
FONT_NAME 10, fonte$(po%): FONT_SIZE 10, 14: FONT_COLOR 10,0,0,0
FOR y = 0 TO 15
    FOR x = 0 TO 15
        PRINT_LOCATE ofx%+x*cah%+6, ofy%+y*cav%+3: PRINT CHR$(y*16+x)
    NEXT x
NEXT y
SHOW 10
RETURN