Tester rapidement les polices de caractères

' Choix de la police de caracères
' Marc - Juin 2024
' Ecrit en langage PANORAMIC 9.9.29i9

dim titre$, texte$, start%, police$, i%

label afficherListePolices, choisirPolice, effacerMEMO, actualiserTexte
label gras, italique, souligne, barre

inactive 0

interfaceUtilisateur()

active 0

end
' ------------------------------------------------------------------------------
sub interfaceUtilisateur()
    
    ' dimension de la fenêtre pricipale FORM 0
    width 0,width(0) - width_client(0) + 800
    height 0,height(0) - height_client(0) + 700
    
    ' couleur de fond de la fenêtre principale FORM 0
    color 0,255,255,255
    
    ' Titre du bandeau de la fenêtre principale FORM 0
    caption 0,"Panoramic"

    ' définir le message par défaut
    texte$ ="PANORAMIC est un langage" + chr$(13) + "simple et façile" + chr$(13)

    ' center la fenêtre principale FORM 0
    top 0,(screen_y - height(0)) / 2
    left 0,(screen_x - width(0)) / 2
    
    ' Titre
    titre$ = "Les polices de caractères en Panoramic"
    alpha 10
    font_name 10,"Segoe UI"
    font_size 10,20
    caption 10,titre$
    top 10,20

    ' centrage automatique du titre
    left 10,(width_client(0)- text_width(titre$,10)) / 2
    
    ' MEMO pour un texte personnalisé    
    memo_rich 30
    top 30,230
    left 30,70
    font_color 30,127,127,127
    font_size 30,10
    text 30,texte$
    on_click 30,effacerMEMO
    
    alpha 31
    top 31,215
    left 31,75
    caption 31,"Tapez votre texte :"
    
    check 32
    top 32,350
    left 32,90
    caption 32,"Gras"
    on_click 32,gras
    
    check 33
    top 33,400
    left 33,90
    caption 33,"Italique"
    on_click 33,italique
    
    check 34
    top 34,350
    left 34,170
    caption 34,"Souligné"
    on_click 34,souligne
    
    check 35
    top 35,400
    left 35,170
    caption 35,"Barré"
    on_click 35, barre
    
    
    ' créer combo contenant les noms des polices de caractères disponibles
    comboFont(70,140,250,12)

    ' créer les zones de rendu texte
    alpha 11
    left 11,400
    font_size 11,6
    
    alpha 12
    left 12,400
    font_size 12,7
    
    alpha 13
    left 13,400
    font_size 13,8
    
    alpha 14
    left 14,400
    font_size 14,9
    
    alpha 15
    left 15,400
    font_size 15,10
    
    alpha 16
    left 16,400
    font_size 16,11
    
    alpha 17
    left 17,400
    font_size 17,12
    
    alpha 18
    left 18,400
    font_size 18,13
    
    alpha 19
    left 19,400
    font_size 19,14
    
    alpha 20
    left 20,400
    font_size 20,15
    
    alpha 21
    left 21,400
    font_size 21,16
    
    ' Dessin
    picture 22
    width 22,167
    height 22,137
    top 22,500
    left 22,115
    color 22,255,255,255
    2d_target_is 22
    2d_pen_color 220,200,200
    2d_fill_off
    2d_rectangle 0,0,167,108
    2d_rectangle 9,9,158,99
    2d_flood 3,3,220,200,200
    2d_fill_color 220,200,200
    2d_rectangle 71,108,96,127
    2d_rectangle 47,127,120,137
    ' signe "inférieur"
    2d_line 33,50,69,34
    2d_line 68,35,68,45
    2d_line 68,44,42,54
    2d_line 42,54,69,66
    2d_line 68,65,68,74
    2d_line 33,58,69,74
    2d_line 33,50,33,59
    2d_flood 37,53,220,200,200
    ' slash
    2d_line 86,27,93,27
    2d_line 86,27,72,82
    2d_line 73,81,80,81
    2d_line 92,27,79,82
    2d_flood 88,30,220,200,200
    ' signe "supérieur"
    2d_line 98,35,134,50
    2d_line 133,50,133,59
    2d_line 98,73,134,58
    2d_line 98,65,98,74
    2d_line 98,65,124,54
    2d_line 98,43,124,54
    2d_line 98,35,98,44
    2d_flood 101,40,220,200,200

    afficherLesRendus()
  
end_sub
' ------------------------------------------------------------------------------
effacerMEMO:
    off_click 30

    if start% = 0
        clear 30 :' effacer MEMO
        font_color 30,0,0,0
        start% = 1
        on_change 30,actualiserTexte
    end_if
return
' ------------------------------------------------------------------------------
actualiserTexte:
    off_change 30
    texte$ = text$(30) + chr$(13)
    afficherLesRendus()
    on_change 30,actualiserTexte
return
' ------------------------------------------------------------------------------
sub afficherLesRendus()
    dim_local y_position%, hauteur%
    
    y_position% = 100
    top 11,y_position%
    font_name 11,police$
    caption 11,"Taille 6 : " + texte$
    
    hauteur% = height(11)
    y_position% = y_position% + hauteur%
    top 12,y_position%
    font_name 12,police$
    caption 12,"Taille 7 : " + texte$

    hauteur% = height(12)
    y_position% = y_position% + hauteur%
    top 13,y_position%
    font_name 13,police$
    caption 13,"Taille 8 : " + texte$

    ' calcul position suivante
    hauteur% = height(13)
    y_position% = y_position% + hauteur%
    top 14,y_position%
    font_name 14,police$
    caption 14,"Taille 9 : " + texte$

    ' calcul position suivante
    hauteur% = height(14)
    y_position% = y_position% + hauteur%
    top 15,y_position%
    font_name 15,police$
    caption 15,"Taille 10 : " + texte$
  
    ' calcul position suivante
    hauteur% = height(15)
    y_position% = y_position% + hauteur%
    top 16,y_position%
    font_name 16,police$
    caption 16,"Taille 11 : " + texte$

    ' calcul position suivante
    hauteur% = height(16)
    y_position% = y_position% + hauteur%
    top 17,y_position%
    font_name 17,police$
    caption 17,"Taille 12 : " + texte$

    ' calcul position suivante
    hauteur% = height(17)
    y_position% = y_position% + hauteur%
    top 18,y_position%
    font_name 18,police$
    caption 18,"Taille 13 : " + texte$

    ' calcul position suivante
    hauteur% = height(18)
    y_position% = y_position% + hauteur%
    top 19,y_position%
    font_name 19,police$
    caption 19,"Taille 14 : " + texte$

    ' calcul position suivante
    hauteur% = height(19)
    y_position% = y_position% + hauteur%
    top 20,y_position%
    font_name 20,police$
    caption 20,"Taille 15 : " + texte$

    ' calcul position suivante
    hauteur% = height(20)
    y_position% = y_position% + hauteur%
    top 21,y_position%
    font_name 21,police$
    caption 21,"Taille 16 : " + texte$

end_sub
' ------------------------------------------------------------------------------
sub comboFont(x%,y%,l%,h%)
    ' comboFont(position en x, position en y, largeur combo, hauteur combo)

    dim_local i%, a$, trameRTF$

    edit 1
    left 1,x%
    top 1,y%
    width 1,l%
    font_size 1,h%
    cursor_point 1
    on_click 1,afficherListePolices

    memo_rich 2
    left 2,x%
    top 2,y%+height(1)
    width 2,l%
    height 2,250
    font_size 2,h%
    bar_vertical 2
    on_click 2,choisirPolice
    cursor_point 2
    hide 2
    
    dlist 3
    font_names_load 3

    panel 4
    top 4,y%+2
    left 4,x%+width(1)-19
    height 4,height(1)-4
    width 4,17
    
    picture 5
    parent 5,4
    top 5,0
    left 5,0
    width 5,width(4)
    height 5,height(4)
    cursor_point 5
    color 5,240,240,240
    2d_target_is 5
    2d_pen_color 227,227,227
    2d_line 0,0,0,height(5)
    2d_line 0,0,16,0
    2d_pen_color 105,105,105
    2d_line 16,0,16,height(4)
    2d_line 0,height(4)-1,width(4),height(4)-1
    2d_pen_color 255,255,255
    2d_line 1,1,1,height(4)-2
    2d_line 1,1,15,1
    2d_pen_color 160,160,160
    2d_line 15,1,15,height(4)-2
    2d_line 1,height(4)-2,16,height(4)-2
    2d_pen_color 0,0,0
    2d_line 5,int(height(4)/2)-1,12,int(height(4)/2)-1
    2d_line 6,int(height(4)/2),11,int(height(4)/2)
    2d_line 7,int(height(4)/2)+1,10,int(height(4)/2)+1
    2d_point 8,int(height(4)/2)+2
    on_click 5,afficherListePolices
    
    ' suppression des noms de polices indésirables
    dlist 6
    for i% = 1 to count(3)
        a$=item_read$(3,i%)
        if left$(a$,1) <> "@"
            item_add 6,a$
        end_if
    next i%
  
    ' remplir Memo_rich
    trameRTF$ = "{\rtf1\ansi\deff0{\fonttbl"
  
    for i% = 1 to count(6)
        a$ = item_read$(6,i%)
        trameRTF$ = trameRTF$ + "{\f" + str$(i%)+" "+ a$ + ";}"
    next i%

    trameRTF$ = trameRTF$ + "}"

    for i% = 1 to count(6)
       trameRTF$ = trameRTF$ + "\f" + str$(i%) + " " + item_read$(6,i%) + "\par"
    next i%

    trameRTF$ = trameRTF$ + "}"
    text 2,trameRTF$
    
    ' initaliser la police par défaut
    police$ = "Default"
    text 1,police$

    ' Caption du combo
    alpha 7
    left 7,x% + 5
    top 7,y% - 15
    caption 7,"Choix de la Police :"
    
end_sub
' ------------------------------------------------------------------------------
afficherListePolices:
    if hide(2) = 1
        show 2
        set_focus 2
    else
        hide 2
    end_if
return
' ------------------------------------------------------------------------------
choisirPolice:
    font_name 1,item_read$(2,caret_y_position(2))
    text 1,item_read$(2,caret_y_position(2))
    ajusterHauteur()
    hide 2
    police$ = text$(1)
    afficherLesRendus()  
return
' ------------------------------------------------------------------------------
sub ajusterHauteur()
    height 4,height(1)-4
    width 4,17
    
    width 5,width(4)
    height 5,height(4)
    color 5,240,240,240
    2d_target_is 5
    2d_pen_color 227,227,227
    2d_line 0,0,0,height(5)
    2d_line 0,0,16,0
    2d_pen_color 105,105,105
    2d_line 16,0,16,height(4)
    2d_line 0,height(4)-1,width(4),height(4)-1
    2d_pen_color 255,255,255
    2d_line 1,1,1,height(4)-2
    2d_line 1,1,15,1
    2d_pen_color 160,160,160
    2d_line 15,1,15,height(4)-2
    2d_line 1,height(4)-2,16,height(4)-2
    2d_pen_color 0,0,0
    2d_line 5,int(height(4)/2)-1,12,int(height(4)/2)-1
    2d_line 6,int(height(4)/2),11,int(height(4)/2)
    2d_line 7,int(height(4)/2)+1,10,int(height(4)/2)+1
    2d_point 8,int(height(4)/2)+2
end_sub
' ------------------------------------------------------------------------------
gras:
    if checked(32) = 1
        for i% = 11 to 21
            font_bold i%    
        next i%
    else
        for i% = 11 to 21
            font_bold_off i%    
        next i%
    end_if
return
' ------------------------------------------------------------------------------
italique:
    if checked(33) = 1
        for i% = 11 to 21
            font_italic i%    
        next i%
    else
        for i% = 11 to 21
            font_italic_off i%    
        next i%
    end_if
return
' ------------------------------------------------------------------------------
souligne:
    if checked(34) = 1
        for i% = 11 to 21
            font_underline i%    
        next i%
    else
        for i% = 11 to 21
            font_underline_off i%    
        next i%
    end_if
return
' ------------------------------------------------------------------------------
barre:
    if checked(35) = 1
        for i% = 11 to 21
            font_strike i%    
        next i%
    else
        for i% = 11 to 21
            font_strike_off i%    
        next i%
    end_if
return