Ce code permet de mettre les x premiers caractères du texte de la statusBar avec les styles gras, italique, souligné, barré ou une des compositions de ces styles, en utilisant les variables de PB (#PB_Font_Bold etc.). Il y a une procedure que j'ai écrite qui permet à partir de la font passée en paramètre (hFont = FontID(#Font)), de lui mettre les styles (paramètre Type).
On peut utiliser la font système en utilisant la procedure Init_Default_Font(), si on veut utiliser une autre font, on utilisera à la place la procedure SetDefaultFont().
Code : Tout sélectionner
;/ Structure permettant l'affichage du texte dans la status Bar
;/ contenant les diverses informations que nous allons gérer.
EnableExplicit
Structure Status_Draw
Texte.s
couleur.l
Font.l
Style.l ;- on utilise la font, #PB_Bold
; #PB_Font_Bold ; La police de caractère sera en gras
; #PB_Font_Italic ; La police de caractère sera en italique
; #PB_Font_Underline ; La police de caractère sera soulignée
; #PB_Font_StrikeOut ; La police de caractère sera barrée
Longueur_Car_Style.l ; nombre de caractère utilisant le style
Emplacement.l
EndStructure
Enumeration
#Window_0
EndEnumeration
Enumeration
#StatusBar
EndEnumeration
#MC_NoFontStyle = 1024
Global Hstatus
Global L_OriginProc_StatusBar, Hstatus
Global Champ_0.Status_Draw
Global *pointeur_champ0.Status_Draw
Global Hicon, Event, Quit
;// charge la fonte par défaut
Global Defaut_Font
Procedure.l CreateFont(hFont.l, Type.l)
;// crée une nouvelle font bassée sur la font passée en paramètre --> hFont.l
;// Type --> #PB_Font_Bold : La police de caractère sera en gras
;// #PB_Font_Italic : La police de caractère sera en italique
;// #PB_Font_Underline : La police de caractère sera soulignée
;// #PB_Font_StrikeOut : La police de caractère sera barrée
;// #PB_Font_Bold = 256
;// #PB_Font_Italic = 512
;// #PB_Font_Underline = 4
;// #PB_Font_StrikeOut = 8
;// retourne 0 si erreur sinon la font
;// la font retournée doit être détruite avec DeleteObject_(Font)
Protected lpvObject.LOGFONT
If GetObject_(hFont, SizeOf(LOGFONT), lpvObject.LOGFONT) ;// = 0
If Type & #MC_NoFontStyle
lpvObject\lfWeight = #FW_NORMAL
lpvObject\lfItalic = #False
lpvObject\lfUnderline = #False
lpvObject\lfStrikeOut = #False
Else
If Type & #PB_Font_Bold
lpvObject\lfWeight = #FW_BOLD
ElseIf Type & #PB_Font_NoBold
lpvObject\lfWeight = #FW_NORMAL
EndIf
If Type & #PB_Font_Italic
lpvObject\lfItalic = #True
ElseIf Type & #PB_Font_NoItalic
lpvObject\lfItalic = #False
EndIf
If Type & #PB_Font_Underline
lpvObject\lfUnderline = #True
ElseIf Type & #PB_Font_NoUnderline
lpvObject\lfUnderline = #False
EndIf
If Type & #PB_Font_StrikeOut
lpvObject\lfStrikeOut = #True
ElseIf Type & #PB_Font_NoStrikeOut
lpvObject\lfStrikeOut = #False
EndIf
EndIf
ProcedureReturn CreateFontIndirect_(lpvObject)
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure StatusBarCallBack(WindowID, Message, wParam, lParam)
Protected L_OriginProc = GetProp_(WindowID, "Pure"+Hex(WindowID))
Protected *pointeur.Status_Draw, lpSize.size
Protected hFontOld, Local_Font
Protected *texte$
Protected *DrawItem.DRAWITEMSTRUCT
Select Message
Case #WM_NCDESTROY
;Remettre la procédure d'origine
SetWindowLongPtr_(WindowID, #GWL_WNDPROC, L_OriginProc)
;Supprimer la donnée associée à la fenêtre.
RemoveProp_(WindowID,"Pure"+Hex(WindowID))
Case #WM_DRAWITEM
If wParam = GetDlgCtrlID_(Hstatus)
*DrawItem = lParam
*pointeur.Status_Draw=*DrawItem\itemdata
SetBkMode_(*DrawItem\hDC, #TRANSPARENT)
SetTextColor_(*DrawItem\hDC, *pointeur\couleur )
With *pointeur
Select \Style
Case - 1 ;// on utilise la font chargée par \Font
hFontOld = SelectObject_(*DrawItem\hDC,*pointeur\Font)
DrawText_(*DrawItem\hDC, *pointeur\Texte, -1, *DrawItem\rcItem , *pointeur\Emplacement)
SelectObject_(*DrawItem\hDC, hFontOld)
Default
Local_Font = CreateFont(Defaut_Font, \Style)
If Local_Font = 0
;// la création de la font a échouée, on dessine normalement
DrawText_(*DrawItem\hDC, *pointeur\Texte, -1, *DrawItem\rcItem , *pointeur\Emplacement)
Else
;// pas de test sur la valeur Longueur_Car_Style
hFontOld = SelectObject_(*DrawItem\hDC, Local_Font)
*texte$ = PeekS(@*pointeur\Texte, \Longueur_Car_Style)
;// on dessine le texte en gras correspondant à la longueur voulue
DrawText_(*DrawItem\hDC, *texte$, -1, *DrawItem\rcItem , *pointeur\Emplacement)
;// on retrouve la position de la chaine avec la police dce caractère associée au hdc
If GetTextExtentPoint32_(*DrawItem\hDC, *texte$, \Longueur_Car_Style, @lpSize) = 0
ProcedureReturn #True
EndIf
;// on modifie la position en x pour afficher le reste de la chaine manquante
;// après la partie ayant le style
*DrawItem\rcItem\left = lpSize\cx
;// on retrouve le texte manquant
*texte$ = Mid(*pointeur\Texte, \Longueur_Car_Style + 1)
;// on remet la font initiale pour ensuite écrire normalement
SelectObject_(*DrawItem\hDC, hFontOld)
DrawText_(*DrawItem\hDC, *texte$, -1, *DrawItem\rcItem , *pointeur\Emplacement)
;// on détruit la font
If Local_Font
DeleteObject_(Local_Font)
EndIf
EndIf
EndSelect
ProcedureReturn #True
EndWith
EndIf
EndSelect
ProcedureReturn CallWindowProc_(L_OriginProc, WindowID, Message, wParam, lParam)
EndProcedure
Procedure Init_Default_Font()
;// essaye de charge la font utilisée pour l'affichage des gadget etc.
;// si échec, on utilise la font système
;// mémorise les données de la font
Protected lpvObject.LOGFONT
Defaut_Font = GetStockObject_(#DEFAULT_GUI_FONT)
If Defaut_Font
Defaut_Font = GetObject_(Defaut_Font, SizeOf(LOGFONT), @lpvObject)
If Defaut_Font
Defaut_Font = CreateFontIndirect_(lpvObject)
Else
;// échec, on essaye avec #SYSTEM_FONT
Defaut_Font = GetStockObject_(#SYSTEM_FONT)
If Defaut_Font
Defaut_Font = GetObject_(Defaut_Font, SizeOf(LOGFONT), @lpvObject)
If Defaut_Font
Defaut_Font = CreateFontIndirect_(lpvObject)
Else
;// on stoppe, ne evrait pas arriver
End
EndIf
EndIf
EndIf
EndIf
EndProcedure
Procedure SetDefaultFont(FontID)
;// on va forcer une nouvelle font dans la variable globale Defaut_Font
If FontID
If Defaut_Font
DeleteObject_(Defaut_Font)
Defaut_Font = 0
EndIf
Defaut_Font = FontID
EndIf
EndProcedure
If OpenWindow(0, 100, 150, 500, 100, "Des styles dans la Status Bar", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
If LoadFont(0, "ARIAL", 12) = 0
End
EndIf
;// charge la font utilisée pour l'affichage des gadget par défault etc.
;Init_Default_Font()
SetDefaultFont(FontID(0))
Hstatus= CreateStatusBar(#StatusBar, WindowID(0))
;/ Ajuster la hauteur de la Status Bar
; SendMessage_(Hstatus, #SB_SETMINHEIGHT, 40, 0)
;/ Nécessaire pour le rafraichissement immédiat de la nouvelle taille
SendMessage_(Hstatus, #WM_SIZE, 0,0)
;/ Création de trois Champs, 0, 1, et 2
If Hstatus
AddStatusBarField(WindowWidth(0))
L_OriginProc_StatusBar = SetWindowLongPtr_(WindowID(0), #GWL_WNDPROC, @StatusBarCallBack())
SetProp_(WindowID(0), "Pure"+Hex(WindowID(0)), L_OriginProc_StatusBar)
EndIf
;/ On remplit la structure pour le champ N°0 de la Status Bar
With Champ_0.Status_Draw
\Texte = " Fichier : C:\essai.pb"
\couleur = #Blue
\Font = FontID(0)
\Emplacement=#DT_VCENTER| #DT_LEFT| #DT_SINGLELINE
\Style = #PB_Font_Bold ; = -1 on utilise la font \Font
\Style = #PB_Font_Bold| #PB_Font_Italic ; = -1 on utilise la font \Font
;\Style = #PB_Font_Italic ; = -1 on utilise la font \Font
;\Style = -1
\Longueur_Car_Style = 12 ; nombre de caractère utilisant le style
EndWith
;/ Pointeur vers la Structure à afficher
*pointeur_champ0.Status_Draw=@Champ_0
;/ On envoie les différents pointeurs à la Status Bar
SendMessage_(Hstatus, #SB_SETTEXT, 0 | #SBT_OWNERDRAW ,*pointeur_champ0)
Repeat
Event = WaitWindowEvent()
Select Event
Case #WM_CLOSE
FreeFont(0)
If Defaut_Font
DeleteObject_(Defaut_Font)
EndIf
Quit + 1
EndSelect
Until Quit=1
EndIf
End
)