L'examen des polices améliore aussi le crossplatform

Vous avez une idée pour améliorer ou modifier PureBasic ? N'hésitez pas à la proposer.
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

L'examen des polices améliore aussi le crossplatform

Message par Ollivier »

Bonjour,

Si ma mémoire est bonne, verdana doit s'écrire au chargement (avec LoadFont):
"VERDANA" sur Linux
"Verdana" sur Mac
"vErdANa" sur Windows (y s'en moque de la casse)
Après, je peux me planter (comme d'hab): ça a pu changer, au point que cette subtilité, selon les OS, n'a plus d'importance.

Si elle en a encore, une requête de liste des polices ne serait pas mal.

Code : Tout sélectionner

ExamineFonts()
While NextFont()
A$ = GetFontName()
Etc...
Wend
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Re: L'examen des polices améliore aussi le crossplatform

Message par PAPIPP »

Bonjour Ollivier.
Comme cela avec FontRequester(...)

Code : Tout sélectionner

Police$="Arial"   ; Police initiale (peut aussi être nulle)
TaillePolice=14  ; Taille initiale (peut aussi être nulle)
Resultat=FontRequester(Police$,TaillePolice,#PB_FontRequester_Effects)
If Resultat
  Message$="Vous avez sélectionné la police suivante :"+#LF$
  Message$+"Nom :  "+SelectedFontName()+#LF$
  Message$+"Taille :  "+Str(SelectedFontSize())+#LF$
  Message$+"Couleur : "+Str(SelectedFontColor())+#LF$
  If SelectedFontStyle() & #PB_Font_Bold
    Message$+"Gras"+#LF$
  EndIf
  If SelectedFontStyle() & #PB_Font_StrikeOut
    Message$+"Barré"+#LF$
  EndIf
  If SelectedFontStyle() & #PB_Font_Underline
    Message$+"Souligné"+#LF$
  EndIf
Else
  Message$="La sélection a été annulée."
EndIf

MessageRequester("FontRequester",Message$,#PB_MessageRequester_Ok)

A+
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: L'examen des polices améliore aussi le crossplatform

Message par Ollivier »

Bonjour PAPIPP,

je comprends ton code. Je te remercie pour ça, mais parfois, on a besoin de l'essentiel (la recherche cross platform de police de caractère uniquement).

Dans ton exemple, qui est une solution concrète à l'évidence, le choix de la police est conditionné dans une requête. Or, ça ne répond pas toujours à ce que l'on peut avoir besoin.

Faire l'inventaire des polices sans nécessiter un affichage immédiat, c'est ça la demande du sujet.

Cette précision ne remet en cause ni l'utilité de FontRequester() ni la pertinence de ta réponse.
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Re: L'examen des polices améliore aussi le crossplatform

Message par PAPIPP »

Bonjour à tous

Voici pour Window la possibilité d’obtenir les caractéristiques des polices installées.

Ce prg utilise une API et un callback je ne sais s’il peut être adapté à Linux et à MacOS X.

Aux spécialistes de ces deux OS de me répondre merci d’avance.

Code : Tout sélectionner

Enumeration
  #Window_Main
EndEnumeration
; 
Procedure EnumFontFamProc(lpelf.l, lpntm.l, FontType.l, lParam.l)
Static FontCounter.l
  *lpelf.ENUMLOGFONT = lpelf
  sFontType.s = ""
  TrueType = #False
  If FontType & #DEVICE_FONTTYPE
      sFontType.s + "Device "
  EndIf
  If FontType & #RASTER_FONTTYPE
      sFontType.s + "Raster "
  EndIf
  If FontType & #TRUETYPE_FONTTYPE 
      sFontType.s + "TrueType "
      TrueType = #True
    EndIf
  FontHeight = *lpelf\elfLogFont\lfHeight
  FontWidth = *lpelf\elfLogFont\lfWidth
  FontEscapement = *lpelf\elfLogFont\lfEscapement
  FontOrientation = *lpelf\elfLogFont\lfOrientation
  FontWeight = *lpelf\elfLogFont\lfWeight
  FontItalic = *lpelf\elfLogFont\lfItalic
  FontUnderline = *lpelf\elfLogFont\lfUnderline
  FontStrikeOut = *lpelf\elfLogFont\lfStrikeOut
  FontCharSet = *lpelf\elfLogFont\lfCharSet
  FontOutPrecision = *lpelf\elfLogFont\lfOutPrecision
  FontClipPrecision = *lpelf\elfLogFont\lfClipPrecision
  FontQuality = *lpelf\elfLogFont\lfQuality
  FontPitchAndFamily = *lpelf\elfLogFont\lfPitchAndFamily
  FontName.s=PeekS(@*lpelf\elfFullName[0])
  FontStyle.s=PeekS(@*lpelf\elfStyle[0])
  If TrueType
      *lpntm1.NEWTEXTMETRIC = lpntm
      MetricHeight = *lpntm1\tmHeight
      MetricAscent = *lpntm1\tmAscent
      MetricDescent = *lpntm1\tmDescent
      MetricInternalLeading = *lpntm1\tmInternalLeading
      MetricExternalLeading = *lpntm1\tmExternalLeading
      MetricAveCharWidth = *lpntm1\tmAveCharWidth
      MetricMaxCharWidth = *lpntm1\tmMaxCharWidth
      MetricWeight = *lpntm1\tmWeight
      MetricOverhang = *lpntm1\tmOverhang
      MetricDigitizedAspectX = *lpntm1\tmDigitizedAspectX
      MetricDigitizedAspectY = *lpntm1\tmDigitizedAspectY
      MetricFirstChar = *lpntm1\tmFirstChar
      MetricLastChar = *lpntm1\tmLastChar
      MetricDefaultChar = *lpntm1\tmDefaultChar
      MetricBreakChar = *lpntm1\tmBreakChar
      MetricItalic = *lpntm1\tmItalic
      MetricUnderlined = *lpntm1\tmUnderlined
      MetricStruckOut = *lpntm1\tmStruckOut
      MetricPitchAndFamily = *lpntm1\tmPitchAndFamily
      MetricCharSet = *lpntm1\tmCharSet
      MetricFlags = *lpntm1\ntmFlags
      MetricSizeEM = *lpntm1\ntmSizeEM
      MetricCellHeight = *lpntm1\ntmCellHeight
      MetricAveWidth = *lpntm1\ntmAvgWidth
    Else
      *lpntm2.TEXTMETRIC = lpntm
      MetricHeight = *lpntm2\tmHeight
      MetricAscent = *lpntm2\tmAscent
      MetricDescent = *lpntm2\tmDescent
      MetricInternalLeading = *lpntm2\tmInternalLeading
      MetricExternalLeading = *lpntm2\tmExternalLeading
      MetricAveCharWidth = *lpntm2\tmAveCharWidth
      MetricMaxCharWidth = *lpntm2\tmMaxCharWidth
      MetricWeight = *lpntm2\tmWeight
      MetricOverhang = *lpntm2\tmOverhang
      MetricDigitizedAspectX = *lpntm2\tmDigitizedAspectX
      MetricDigitizedAspectY = *lpntm2\tmDigitizedAspectY
      MetricFirstChar = *lpntm2\tmFirstChar
      MetricLastChar = *lpntm2\tmLastChar
      MetricDefaultChar = *lpntm2\tmDefaultChar
      MetricBreakChar = *lpntm2\tmBreakChar
      MetricItalic = *lpntm2\tmItalic
      MetricUnderlined = *lpntm2\tmUnderlined
      MetricStruckOut = *lpntm2\tmStruckOut
      MetricPitchAndFamily = *lpntm2\tmPitchAndFamily
      MetricCharSet = *lpntm2\tmCharSet
  EndIf
  sFontAttributes.s = ""
  If FontItalic
      sFontAttributes + "I"
  EndIf
  If FontUnderline
      sFontAttributes + "U"
  EndIf
  If FontStrikeOut
      sFontAttributes + "S"
  EndIf
  If sFontAttributes <> ""
      sFontAttributes = "(" + sFontAttributes + ")"
  EndIf
  If lParam
    If FindString(LCase(FontName), LCase(PeekS(lParam)), 1)
      Debug Str(FontCounter)+" "+FontName + Chr(10) + Str(FontWidth) + Chr(9) + Str(FontHeight) + Chr(9) + Str(FontWeight) + Chr(9) + FontStyle + " " + sFontAttributes + Chr(9) + sFontType
      EndIf
    Else
      Debug Str(FontCounter)+" "+FontName + Chr(9) + Str(FontWidth) + Chr(9) + Str(FontHeight) + Chr(9) + Str(FontWeight) + Chr(9) + FontStyle + " " + sFontAttributes + Chr(9) + sFontType
  EndIf
  While WindowEvent()
  Wend
  FontCounter + 1
  ProcedureReturn 1
EndProcedure

If OpenWindow(#Window_Main, 0, 0, 0, 0,"", #PB_Window_Invisible)
;       Debug _nl+_n(SizeOf(ENUMLOGFONT))+_n(SizeOf(NEWTEXTMETRIC))+_n(SizeOf(TEXTMETRIC))
      EnumFontFamilies_(GetDC_(WindowID(#Window_Main)), #Null, @EnumFontFamProc(), 0)
  EndIf
End
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: L'examen des polices améliore aussi le crossplatform

Message par Ollivier »

Bonjour PAPIPP,

tu as dû en consacrer du temps pour ça. Je pense qu'un sujet doit être dédié à cette fonction. Ou bien il me faudra changer le titre de ce sujet dans les jours à venir, parce que là, c'est un "hors sujet" dans le sens honorable du terme.

Je doute que les linuxiens puissent consacrer autant de temps dans l'immédiat.

En tout cas, je tâcherai de regarder avec soin les perspectives que cela permet.

Sacrément bien!
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Re: L'examen des polices améliore aussi le crossplatform

Message par PAPIPP »

Je ne sais si ce programme doit être posté ici, sinon déplacer le à votre gré.

Voici le même prg avec une meilleure présentation.

1) une animation de window ( on peut s’amuser).

2) l’aperçu d’une police sélectionnée.

Code : Tout sélectionner

Enumeration
  #Window_Main
  #Gadget_Button
  #Gadget_String
  #Gadget_ListIcon
  #Gadget_Image
  #Image
EndEnumeration

#AW_HOR_POSITIVE = $1 ; Anime  window de la gauche vers la droite. ces indicateurs peuvent être utilisés en rouleau ou  en animation de diapositives
#AW_HOR_NEGATIVE = $2 ; Anime window de la droite vers la gauche.
#AW_VER_POSITIVE = $4 ; Anime window du haut vers le bas.
#AW_VER_NEGATIVE = $8 ; Anime window du bas vers le haut.
#AW_CENTER = $10      ; anime window en partant du centre
#AW_HIDE = $10000     ; Cache window.//par défaut window est activé
#AW_ACTIVATE = $20000 ; Active window.
#AW_SLIDE = $40000    ; Utilise l'animation de la diapositive. Par défaut, l'animation en rouleau est utilisé.
#AW_BLEND = $80000    ; Utilise un effet de fondu. Cet indicateur peut être utilisé que si hwnd est une fenêtre de niveau supérieur.
Procedure EnumFontFamProc(lpelf.l, lpntm.l, FontType.l, lParam.l)
  Static FontCounter.l
  *lpelf.ENUMLOGFONT = lpelf
  sFontType.s = ""
  TrueType = #False
  If FontType & #DEVICE_FONTTYPE
    sFontType.s + "Device "
  EndIf
  If FontType & #RASTER_FONTTYPE
    sFontType.s + "Raster "
  EndIf
  If FontType & #TRUETYPE_FONTTYPE 
    sFontType.s + "TrueType "
    TrueType = #True
  EndIf
  FontHeight = *lpelf\elfLogFont\lfHeight
  FontWidth = *lpelf\elfLogFont\lfWidth
  FontEscapement = *lpelf\elfLogFont\lfEscapement
  FontOrientation = *lpelf\elfLogFont\lfOrientation
  FontWeight = *lpelf\elfLogFont\lfWeight
  FontItalic = *lpelf\elfLogFont\lfItalic
  FontUnderline = *lpelf\elfLogFont\lfUnderline
  FontStrikeOut = *lpelf\elfLogFont\lfStrikeOut
  FontCharSet = *lpelf\elfLogFont\lfCharSet
  FontOutPrecision = *lpelf\elfLogFont\lfOutPrecision
  FontClipPrecision = *lpelf\elfLogFont\lfClipPrecision
  FontQuality = *lpelf\elfLogFont\lfQuality
  FontPitchAndFamily = *lpelf\elfLogFont\lfPitchAndFamily
  FontName.s=PeekS(@*lpelf\elfFullName[0])
  FontStyle.s=PeekS(@*lpelf\elfStyle[0])
  If TrueType
    *lpntm1.NEWTEXTMETRIC = lpntm
    MetricHeight = *lpntm1\tmHeight
    MetricAscent = *lpntm1\tmAscent
    MetricDescent = *lpntm1\tmDescent
    MetricInternalLeading = *lpntm1\tmInternalLeading
    MetricExternalLeading = *lpntm1\tmExternalLeading
    MetricAveCharWidth = *lpntm1\tmAveCharWidth
    MetricMaxCharWidth = *lpntm1\tmMaxCharWidth
    MetricWeight = *lpntm1\tmWeight
    MetricOverhang = *lpntm1\tmOverhang
    MetricDigitizedAspectX = *lpntm1\tmDigitizedAspectX
    MetricDigitizedAspectY = *lpntm1\tmDigitizedAspectY
    MetricFirstChar = *lpntm1\tmFirstChar
    MetricLastChar = *lpntm1\tmLastChar
    MetricDefaultChar = *lpntm1\tmDefaultChar
    MetricBreakChar = *lpntm1\tmBreakChar
    MetricItalic = *lpntm1\tmItalic
    MetricUnderlined = *lpntm1\tmUnderlined
    MetricStruckOut = *lpntm1\tmStruckOut
    MetricPitchAndFamily = *lpntm1\tmPitchAndFamily
    MetricCharSet = *lpntm1\tmCharSet
    MetricFlags = *lpntm1\ntmFlags
    MetricSizeEM = *lpntm1\ntmSizeEM
    MetricCellHeight = *lpntm1\ntmCellHeight
    MetricAveWidth = *lpntm1\ntmAvgWidth
  Else
    *lpntm2.TEXTMETRIC = lpntm
    MetricHeight = *lpntm2\tmHeight
    MetricAscent = *lpntm2\tmAscent
    MetricDescent = *lpntm2\tmDescent
    MetricInternalLeading = *lpntm2\tmInternalLeading
    MetricExternalLeading = *lpntm2\tmExternalLeading
    MetricAveCharWidth = *lpntm2\tmAveCharWidth
    MetricMaxCharWidth = *lpntm2\tmMaxCharWidth
    MetricWeight = *lpntm2\tmWeight
    MetricOverhang = *lpntm2\tmOverhang
    MetricDigitizedAspectX = *lpntm2\tmDigitizedAspectX
    MetricDigitizedAspectY = *lpntm2\tmDigitizedAspectY
    MetricFirstChar = *lpntm2\tmFirstChar
    MetricLastChar = *lpntm2\tmLastChar
    MetricDefaultChar = *lpntm2\tmDefaultChar
    MetricBreakChar = *lpntm2\tmBreakChar
    MetricItalic = *lpntm2\tmItalic
    MetricUnderlined = *lpntm2\tmUnderlined
    MetricStruckOut = *lpntm2\tmStruckOut
    MetricPitchAndFamily = *lpntm2\tmPitchAndFamily
    MetricCharSet = *lpntm2\tmCharSet
  EndIf
  sFontAttributes.s = ""
  If FontItalic
    sFontAttributes + "I"
  EndIf
  If FontUnderline
    sFontAttributes + "U"
  EndIf
  If FontStrikeOut
    sFontAttributes + "S"
  EndIf
  If sFontAttributes <> ""
    sFontAttributes = "(" + sFontAttributes + ")"
  EndIf
  If lParam
    If FindString(LCase(FontName), LCase(PeekS(lParam)), 1)
      AddGadgetItem(#Gadget_ListIcon, -1, FontName + Chr(10) + Str(FontWidth) + Chr(10) + Str(FontHeight) + Chr(10) + Str(FontWeight) + Chr(10) + FontStyle + " " + sFontAttributes + Chr(10) + sFontType)
    EndIf
  Else
    AddGadgetItem(#Gadget_ListIcon, -1, FontName + Chr(10) + Str(FontWidth) + Chr(10) + Str(FontHeight) + Chr(10) + Str(FontWeight) + Chr(10) + FontStyle + " " + sFontAttributes + Chr(10) + sFontType)
  EndIf
  While WindowEvent()
  Wend
  FontCounter + 1
  ProcedureReturn 1
EndProcedure
WindowWidth = 640
WindowHeight = 480
WindowTitle.s = "Polices installées sur Window. Cliquez sur une police pour la voir"
ImageWidth = WindowWidth - 20
ImageHeight = 120
If OpenWindow(#Window_Main, 0, 0, WindowWidth, WindowHeight, WindowTitle, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_Invisible)
;   AnimateWindow_(WindowID(#Window_Main), 1500, #AW_BLEND | #AW_ACTIVATE)
;   AnimateWindow_(WindowID(#Window_Main), 1500, #AW_CENTER | #AW_ACTIVATE)
  AnimateWindow_(WindowID(#Window_Main), 1500, #AW_VER_POSITIVE|#AW_HOR_POSITIVE | #AW_ACTIVATE)
  AddKeyboardShortcut(#Window_Main, #PB_Shortcut_Escape, #PB_Shortcut_Escape)
  AddKeyboardShortcut(#Window_Main, #PB_Shortcut_Return, #Gadget_Button)
  ListIconGadget(#Gadget_ListIcon, 10, 40, WindowWidth - 20, WindowHeight - 180, "Name", 240)
  AddGadgetColumn(#Gadget_ListIcon, 1, "Largeur", 50)
  AddGadgetColumn(#Gadget_ListIcon, 2, "Hauteur", 50)
  AddGadgetColumn(#Gadget_ListIcon, 3, "Poids", 50)
  AddGadgetColumn(#Gadget_ListIcon, 4, "Style & Attr.", 80)
  AddGadgetColumn(#Gadget_ListIcon, 5, "Type", 70)
  EnumFontFamilies_(GetDC_(WindowID(#Window_Main)), #Null, @EnumFontFamProc(), 0)
  Quit = #False
  Repeat
    WindowEvent = WindowEvent()
    EventType = EventType()
    Select WindowEvent
      Case #PB_Event_CloseWindow
        Quit = #True
      Case #PB_Event_Menu
        Select EventMenu()
          Case #PB_Shortcut_Escape
            Quit = #True
        EndSelect
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #Gadget_ListIcon
            FontName.s = GetGadgetItemText(#Gadget_ListIcon, GetGadgetState(#Gadget_ListIcon), 0)
            FontSize.l = Val(GetGadgetItemText(#Gadget_ListIcon, GetGadgetState(#Gadget_ListIcon), 1))
            ;                 FontHeight.l = Val(GetGadgetItemText(#Gadget_ListIcon, GetGadgetState(#Gadget_ListIcon), 2))
            FontID1 =LoadFont(#PB_Any, FontName, 20, #PB_Font_HighQuality)
            SetGadgetFont(#PB_Default, FontID( FontID1)) 
            TextGadget(#Window_Main, 20, WindowHeight - 130, WindowWidth-20, 45, FONTName) 
            TextGadget(#Window_Main+1, 20, WindowHeight - 130+50, WindowWidth-20, 45,"1233 abcd ABCD àçéèêù") 
            
        EndSelect
      Case #PB_Event_SizeWindow
;         Debug _nl+_n(#PB_Event_SizeWindow)
    EndSelect
  Until Quit
  AnimateWindow_(WindowID(#Window_Main), 1000, #AW_BLEND | #AW_HIDE)
EndIf
End
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: L'examen des polices améliore aussi le crossplatform

Message par Micoute »

Bonjour PAPIPP, merci pour ce partage, c'est vraiment de la belle ouvrage !
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: L'examen des polices améliore aussi le crossplatform

Message par Kwai chang caine »

C'est beau 8O , merci pour le partage PAPPIP 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
SPH
Messages : 4722
Inscription : mer. 09/nov./2005 9:53

Re: L'examen des polices améliore aussi le crossplatform

Message par SPH »

Te fait pas avoir, c'est un bot qui a repondu !
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: L'examen des polices améliore aussi le crossplatform

Message par Kwai chang caine »

J'ai vu mon canard..tu me prends pour un lapin de trois semaines :wink:

Moi je parlais du code de PAPIPP.... qui me "Botte" :mrgreen:

D'un autre coté les BOT ont au moins cet avantage de faire ressortir certains vieux codes qu'on avait zapper, et du coups pouvoir remercier les copains 8) à titre "posthume" :lol:
Comme quoi on peut même trouver du bonheur dans la merde....tout est une question de phylosophie ...suffit de chercher :mrgreen:
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Ollivier
Messages : 4190
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: L'examen des polices améliore aussi le crossplatform

Message par Ollivier »

@PAPIPP

Je me suis permis d'établir un lien depuis une question du forum US. https://www.purebasic.fr/english/viewto ... 13&t=71630 vers cette page pour que tes codes source puissent être partagés.

Olliv
Shadow
Messages : 1373
Inscription : mer. 04/nov./2015 17:39

Re: L'examen des polices améliore aussi le crossplatform

Message par Shadow »

Super code merci :D
Processeur: Intel Core I7-4790 - 4 Cœurs - 8 Thread: 3.60 Ghz.
Ram: 32 GB.
Disque: C: SDD 250 GB, D: 3 TB.
Vidéo: NVIDIA GeForce GTX 960: 2 GB DDR5.
Écran: Asus VX248 24 Pouces: 1920 x 1080.
Système: Windows 7 64 Bits.

PureBasic: 5.60 x64 Bits.
Répondre