PureBasic

Forums PureBasic
Nous sommes le Mar 18/Juin/2013 7:40

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 10 messages ] 
Auteur Message
 Sujet du message: Font system nom et taille
MessagePosté: Jeu 09/Fév/2012 18:55 
Hors ligne

Inscription: Mer 14/Sep/2011 16:59
Messages: 344
Plusieurs posts pour récupérer la police système et sa taille.

Code:
Procedure.l Ansi2Uni(ansi.s)
  size.l=MultiByteToWideChar_(#CP_ACP,0,ansi,-1,0,0)
  Dim unicode.w(size)
  MultiByteToWideChar_(#CP_ACP, 0, ansi, Len(ansi), unicode(), size)
  ProcedureReturn @unicode()
EndProcedure

TMT_CAPTIONFONT = 801
TMT_SMALLCAPTIONFONT = 802
TMT_MENUFONT = 803
TMT_STATUSFONT = 804
TMT_MSGBOXFONT = 805
TMT_ICONTITLEFONT = 806

WindowID_Fenetre_Principale = OpenWindow(0, 0, 0, 560 , 355, "GetThemeSysFont", #PB_Window_MinimizeGadget | #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

htheme =OpenThemeData_(WindowID_Fenetre_Principale, Ansi2Uni("Window"))
Debug "htheme = "+Str(htheme)
ok=GetThemeSysFont_(htheme,TMT_MSGBOXFONT,ft.LOGFONT)

If ok=#S_OK
  Debug PeekS(@ft\lfFaceName, 32, #PB_Unicode);
  ;CompilerIf #PB_Compiler_Debugger
  DC = GetDC_(0)
  Debug Round(Abs(ft\lfheight) * 72 / GetDeviceCaps_(DC, #LOGPIXELSY), #PB_Round_Nearest)
  ReleaseDC_(0, DC)
  ; CompilerEndIf
EndIf
Repeat
 
Until WaitWindowEvent() = #PB_Event_CloseWindow   

End


Haut
 Profil  
 
 Sujet du message: Re: Font system nom et taille
MessagePosté: Jeu 09/Fév/2012 18:55 
Hors ligne

Inscription: Mer 14/Sep/2011 16:59
Messages: 344
Code:
Procedure.l LoadWindowFont(Bold = -1, Italic = -1, UnderLine = -1, Size.f = -1)
   Protected ncm.NONCLIENTMETRICS
   ncm\cbSize = SizeOf(NONCLIENTMETRICS)
   SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @ncm, 0)
   If Bold = 0
      ncm\lfMessageFont\lfWeight = 0
   ElseIf Bold = 1
      ncm\lfMessageFont\lfWeight = 700
   EndIf
   If Italic = 0
      ncm\lfMessageFont\lfItalic = 0
   ElseIf Italic = 1
      ncm\lfMessageFont\lfItalic = 1
   EndIf
   If UnderLine = 0
      ncm\lfMessageFont\lfUnderline = 0
   ElseIf UnderLine = 1
      ncm\lfMessageFont\lfUnderline = 1
   EndIf
   If Size > 0
      ncm\lfMessageFont\lfheight * Size
   EndIf
   
   Debug PeekS(@ncm\lfMessageFont\lfFaceName, 32)
   CompilerIf #PB_Compiler_Debugger
   DC = GetDC_(0)
   Debug Round(Abs(ncm\lfMessageFont\lfheight) * 72 / GetDeviceCaps_(DC, #LOGPIXELSY), #PB_Round_Nearest)
   ReleaseDC_(0, DC)
   CompilerEndIf
;   
   ProcedureReturn CreateFontIndirect_(@ncm\lfMessageFont)
EndProcedure
FontID = LoadWindowFont()


Haut
 Profil  
 
 Sujet du message: Re: Font system nom et taille
MessagePosté: Jeu 09/Fév/2012 18:56 
Hors ligne

Inscription: Mer 14/Sep/2011 16:59
Messages: 344
Code:
; Reference Code
; PureBasic :: View topic - Windows defautl font
; http://www.purebasic.fr/english/viewtopic.php?t=2913

[color=#FF0000];SANS THEME[/color]

Procedure.s GetDefaultFontName()
  fnt.l=GetStockObject_(#DEFAULT_GUI_FONT)
  If fnt
    finfo.LOGFONT
    GetObject_(fnt,SizeOf(LOGFONT),@finfo)
    systemfontname.s=PeekS(@finfo\lfFaceName[0])
    ProcedureReturn PeekS(@finfo\lfFaceName[0])
  EndIf
  ProcedureReturn "System"
EndProcedure

Procedure.l GetDefaultFontSize()
  fnt.l=GetStockObject_(#DEFAULT_GUI_FONT)
  If fnt
    finfo.LOGFONT
    GetObject_(fnt,SizeOf(LOGFONT),@finfo)
    systemfontsize=finfo\lfHeight
    DC = GetDC_(0)
    ok=Round(Abs(finfo\lfheight) * 72 / GetDeviceCaps_(DC, #LOGPIXELSY), #PB_Round_Nearest)
    ReleaseDC_(0, DC)
    ProcedureReturn ok;finfo\lfHeight
  EndIf
  ProcedureReturn 12
EndProcedure

Debug GetDefaultFontName()
Debug GetDefaultFontSize()


Haut
 Profil  
 
 Sujet du message: Re: Font system nom et taille
MessagePosté: Jeu 09/Fév/2012 18:57 
Hors ligne

Inscription: Mer 14/Sep/2011 16:59
Messages: 344
Code:
; A debugger

Procedure DebugFontParameters(DeviceContext.l)
      Color = GetTextColor_(DeviceContext)
      Debug "Color is " + Str(Red(Color)) + " " + Str(Green(Color)) + " " + Str(Blue(Color))
      FaceName.s = Space(255)
      Debug GetTextFace_(DeviceContext, 255, @FaceName)
      Debug FaceName
      Debug GetLastError_()
      GetTextMetrics_(DeviceContext, @TxtMetrics.TEXTMETRIC)

      Debug "Height = " + Str(TxtMetrics\tmHeight) ; Specifies the height (ascent + descent) of characters.
      Debug "Ascent = " + Str(TxtMetrics\tmAscent) ; Specifies the ascent (units above the base line) of characters.
      Debug "Descent = " + Str(TxtMetrics\tmDescent) ; Specifies the descent (units below the base line) of characters.
      Debug "Leading = " + Str(TxtMetrics\tmInternalLeading) ; Specifies the amount of leading (space) inside the bounds set by the tmHeight member. Accent marks And other diacritical characters may occur in this area. The designer may set this member To zero.
      Debug "ExternalLeadin = " + Str(TxtMetrics\tmExternalLeading) ; Specifies the amount of extra leading (space) that the application adds between rows. Since this area is outside the font, it contains no marks And is not altered by text output calls in either OPAQUE Or TRANSPARENT mode. The designer may set this member To zero.
      Debug "AveCharWidth = " + Str(TxtMetrics\tmAveCharWidth) ; Specifies the average width of characters in the font (generally defined as the width of the letter x). This value does not include the overhang required For bold Or italic characters.
      Debug "MaxCharWidth = " + Str(TxtMetrics\tmMaxCharWidth) ; Specifies the width of the widest character in the font.
      Debug "Weight = " + Str(TxtMetrics\tmWeight) ; Specifies the weight of the font.
      Debug "Overhang = " + Str(TxtMetrics\tmOverhang) ; Specifies the extra width per string that may be added To some synthesized fonts. When synthesizing some attributes, such as bold Or italic, graphics device Interface (GDI) Or a device may have To add width To a string on both a per-character And per-string basis. For example, GDI makes a string bold by expanding the spacing of each character And overstriking by an offset value; it italicizes a font by shearing the string. In either case, there is an overhang past the basic string. For bold strings, the overhang is the distance by which the overstrike is offset. For italic strings, the overhang is the amount the top of the font is sheared past the bottom of the font.
                       ; The tmOverhang member enables the application To determine how much of the character width returned by a GetTextExtentPoint32 function call on a single character is the actual character width And how much is the per-string extra width. The actual width is the extent minus the overhang.
      Debug "DigitizedAspectX = " + Str(TxtMetrics\tmDigitizedAspectX) ; Specifies the horizontal aspect of the device For which the font was designed.
      Debug "DigitizedAspectY = " + Str(TxtMetrics\tmDigitizedAspectY) ; Specifies the vertical aspect of the device For which the font was designed. The ratio of the tmDigitizedAspectX And tmDigitizedAspectY members is the aspect ratio of the device For which the font was designed.
      Debug "FirstChar = " + Str(TxtMetrics\tmFirstChar) ; Specifies the value of the first character defined in the font.
      Debug "LastChar = " + Str(TxtMetrics\tmLastChar) ; Specifies the value of the last character defined in the font.
      Debug "DefaultChar = " + Str(TxtMetrics\tmDefaultChar) ; Specifies the value of the character To be substituted For characters not in the font.
      Debug "BreakChar = " + Str(TxtMetrics\tmBreakChar) ; Specifies the value of the character that will be used To define word breaks For text justification.
      Debug "Italic = " + Str(TxtMetrics\tmItalic) ; Specifies an italic font If it is nonzero.
      Debug "Underlined = " + Str(TxtMetrics\tmUnderlined) ; Specifies an underlined font If it is nonzero.
      Debug "StruckOut = " + Str(TxtMetrics\tmStruckOut) ; Specifies a strikeout font If it is nonzero.
      Debug "PitchAndFamily = " + Str(TxtMetrics\tmPitchAndFamily) ; Specifies information about the pitch, the technology, And the family of a physical font.
                               ; The four low-order bits of this member specify information about the pitch And the technology of the font. A constant is defined For each of the four bits:

    ; Constant Meaning
    ; TMPF_FIXED_PITCH If this bit is set the font is a variable pitch font. If this bit is clear the font is a fixed pitch font. Note very carefully that those meanings are the opposite of what the constant name implies.
    ; TMPF_VECTOR If this bit is set the font is a vector font.
    ; TMPF_TRUETYPE If this bit is set the font is a TrueType font.
    ; TMPF_DEVICE If this bit is set the font is a device font.
    ; An application should carefully test For qualities encoded in these low-order bits, making no arbitrary assumptions. For example, besides having their own bits set, TrueType And PostScript fonts set the TMPF_VECTOR bit. A monospace bitmap font has all of these low-order bits clear; a proportional bitmap font sets the TMPF_FIXED_PITCH bit. A Postscript printer device font sets the TMPF_DEVICE, TMPF_VECTOR, and TMPF_FIXED_PITCH bits.
    ; The four high-order bits of tmPitchAndFamily designate the font's font family. An application can use the value 0xF0 and the bitwise AND operator to mask out the four low-order bits of tmPitchAndFamily, thus obtaining a value that can be directly compared with font family names to find an identical match. For information about font families, see the description of the LOGFONT structure.
      Debug "CharSet = " + Str(TxtMetrics\tmCharSet) ; Specifies the character set of the font.
      Debug "====================="
    EndProcedure
   
    ok=OpenWindow(0,0,0,200,200,"ok")
    ok2=EditorGadget(0,10,10,120,30)
    hdc = GetDC_(ok)
    DebugFontParameters(ok)
    ReleaseDC_(ok, hdc)
    Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow


Haut
 Profil  
 
 Sujet du message: Re: Font system nom et taille
MessagePosté: Jeu 09/Fév/2012 19:17 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 5324
Pas eu le temps d'essayé (je rentre du taf) mais merci d'avance, nul doute que ça va servir.

_________________
.: Ar-S :. - Windows 8 x64 - Radeon HD 7870 - PB 5.11
LDV MULTIMEDIA : Assistance informatique Isère (38) Oyeu
PURE BASIC forum non officiel : Forum PB


Haut
 Profil  
 
 Sujet du message: Re: Font system nom et taille
MessagePosté: Ven 10/Fév/2012 11:26 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 28/Jan/2004 20:58
Messages: 4311
Localisation: Clermont ferrand OU Olsztyn
Le deuxième code vient de la :mrgreen:
viewtopic.php?f=3&t=8550&hilit=LoadWindowFont

_________________
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]


Haut
 Profil  
 
 Sujet du message: Re: Font system nom et taille
MessagePosté: Sam 11/Fév/2012 0:01 
Hors ligne
Avatar de l’utilisateur

Inscription: Lun 26/Avr/2004 0:40
Messages: 13075
Le Soldat Inconnu a écrit:
Le deuxième code vient de la :mrgreen:
viewtopic.php?f=3&t=8550&hilit=LoadWindowFont


oui, et le dernier code est de Fweil
il viens de là :
http://forums.purebasic.com/english/vie ... e4b767fe7a

@Mesa , c'est toujours cool de citer l'auteur du code ;)
voir de donner le lien
car là (brune nie) , on pourrai croire que c'est toi l'auteur , vu que tu ne cite personne
de plus , nous savons aussi nous servir du bouton de recherche ;)
enfin, je pense que c'est un oubli de ta part :)

_________________
Image


Dernière édition par Dobro le Sam 11/Fév/2012 0:09, édité 1 fois.

Haut
 Profil  
 
 Sujet du message: Re: Font system nom et taille
MessagePosté: Sam 11/Fév/2012 0:04 
Hors ligne

Inscription: Mer 11/Nov/2009 18:17
Messages: 1251
Localisation: Poitiers (Vienne)
Oui mesa, pas bien sa :(

_________________
La vie, C'est comme, Une boitte, De startis, On en voie, De toutes, Les couleurs !

Mon forum http://purebasic.forumphp3.com/index.php


Haut
 Profil  
 
 Sujet du message: Re: Font system nom et taille
MessagePosté: Sam 11/Fév/2012 10:34 
Hors ligne

Inscription: Mer 14/Sep/2011 16:59
Messages: 344
Oui c'est un oubli, pas eu le temps... :|


Haut
 Profil  
 
 Sujet du message: Re: Font system nom et taille
MessagePosté: Sam 11/Fév/2012 13:07 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 5324
Oui c'est toujours sympa de retrouver l'origine d'un code. Mais en tout cas, ça va bien servir. :mrgreen:

_________________
.: Ar-S :. - Windows 8 x64 - Radeon HD 7870 - PB 5.11
LDV MULTIMEDIA : Assistance informatique Isère (38) Oyeu
PURE BASIC forum non officiel : Forum PB


Haut
 Profil  
 
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 10 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 0 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye