Sources PureBasic
Sources PureBasicConsultez toutes les sources
Nombre d'auteurs : 41, nombre de sources : 88, dernière mise à jour : 13 août 2011
Sommaire→StatusBar
Voici un petit code qui est une ébauche et que j'ai fait pour mon besoin propre,
en détournant partiellement un code de Nico sur les couleurs dans la statusBar.
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 procédure 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 procédure Init_Default_Font(), si on veut utiliser une autre font,
on utilisera à la place la procédure SetDefaultFont().
Sélectionnez
;/ 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
Else
lpvObject\lfWeight = #FW_NORMAL
EndIf
If Type & #PB_Font_Italic
lpvObject\lfItalic = #True
Else
lpvObject\lfItalic = #False
EndIf
If Type & #PB_Font_Underline
lpvObject\lfUnderline = #True
Else
lpvObject\lfUnderline = #False
EndIf
If Type & #PB_Font_StrikeOut
lpvObject\lfStrikeOut = #True
Else
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
EndCréé le 14 novembre 2009 par Denis