Ayant galéré depuis plusieurs jours en essayant de changer la couleur du caret sous W10 je suis tombé sur des articles plus ou moins complets et surtout plus ou moins justes. Alors je vous partage mon modeste programme de test, qui j'espère contribuera à vous aider dans cette démarche. J'ai volontairement rajouté de nombreux commentaires dans le code.
N'hésitez pas à me remonter vos remarques.
Bonne lecture.
F.R.
Code : Tout sélectionner
; Programme de test pour la couleur du caret d'une zone de saisie
; F.RAPIN le 15/04/2026
; ********************
; *** Déclarations ***
; ********************
Enumeration FONT_WEIGHT ; Valeurs de poids standard de la police (Déjà déclaré dans PureBasic, juste a titre d'information)
#FW_DONTCARE = 0
#FW_THIN = 100
#FW_EXTRALIGHT = 200
#FW_ULTRALIGHT = 200
#FW_LIGHT = 300
#FW_NORMAL = 400
#FW_REGULAR = 400
#FW_MEDIUM = 500
#FW_SEMIBOLD = 600
#FW_DEMIBOLD = 600
#FW_BOLD = 700
#FW_EXTRABOLD = 800
#FW_ULTRABOLD = 800
#FW_HEAVY = 900
#FW_BLACK = 900
EndEnumeration
Structure Text_Font ; Structure décrivant la police à utiliser
pszFaceName.s ; Nom de la police à utiliser
cHeight.l ; Hauteur de la cellule d'un caractère
cWidth.l ; Largeur moyenne d'un caractère. 0 : le système choisira une valeur la plus proche
cWeight.l ; Poids de la police. Valeur entre 0 et 1000 (voir l'énumération FONT_WEIGHT)
bItalic.i ; #True si le texte doit être en italique
bUnderline.i ; #True si le texte doit être soulignée
bStrikeOut.i ; #True si le texte doit être barré
TextColor.d ; Couleur de la police
BackColor.d ; Couleur de l'arrière plan
EndStructure
Structure ColorMemory ; Structure permettant de stocker les couleurs personnalisées avec l'api ChooseColor
RGB.l[16]
EndStructure
Global hWnd_StringGadget ; Handle de la zone de saisie
Global Color_WindowBackground.q = $00FF00 ; Couleur initiale du fond de la fenêtre
Global Color_InputBackground.q = $00FF00 ; Couleur initiale du fond de la zone de saisie
Global Color_InputText.q = $0000FF ; Couleur initiale du texte de la zone de saisie
Global Color_InputCaret.q = $00D7FF ; Couleur initiale du caret de la zone de saisie
Global Bt_CaretSize.l = #False ; Spécifie la taille initiale du caret : #False = Full, #True = Half
Procedure.l InputBoxCallback(hWnd, uMsg, wParam, lParam)
; Procèdure de CallBack pour la fenêtre principale
; hWnd : handle de la fenêtre
; uMsg : message envoyé à la fenêtre
; wParam, lParam : données supplémentaires envoyées relatives au message => Dépend du message)
; lResult est le code de retour du callback.
lResult = #PB_ProcessPureBasicEvents ; Informe PureBasic que l'événement n'a pas été traité afin qu'il le prenne en charge.
Select uMsg
Case #WM_COMMAND
hwndFrom = GetProp_(lParam, "PB_ID")
Select hwndFrom
Case hWnd_StringGadget ; handle de la zone de saisie
Select wParam >> 16 ; décalage de 16 bits pour obtenir le mot de poids fort qui défini le code de notification envoyé au contrôle
; Contrairement à la documentation Microsoft (https://learn.microsoft.com/fr-fr/windows/win32/menurc/using-carets)
; le système n'envoie pas le message WM_SETFOCUS à la fenêtre qui reçoit le focus clavier mais WM_COMMAND, puis EN_SETFOCUS
Case #EN_SETFOCUS
; La couleur du caret est obtenue avec un XOR (ou exclusif) entre la couleur du caret et la couleur du fond de la zone de saisie
; La couleur du fond est également donnée par la commande : GetGadgetColor(hWnd_StringGadget, #PB_Gadget_BackColor)
; Pour une raison inconnue, GetBkColor_(GadgetID(hWnd_StringGadget)) avec ou sans ! $FF000000 pour supprimer la composante alpha, donnera toujours $FFFFFF Mystère...
; La meilleure explication que j'ai trouvée concernant la couleur du caret se trouve sur la page : https://helparchive.huntertur.net/document/108331
; Juste une remarque qui m'a pris du temps concernant l'algèbre de boole A XOR B = C <=> B XOR A = C <=> A XOR C = B, c'était pourtant très simple.
ColorToUse.q = (Color_InputCaret ! Color_InputBackground) ; Il est préférable de définir la couleur sur 32 bits pour éviter tout problème
If Bt_CaretSize ; Défini la dimention du caret
With rcCaret.RECT ; -> Half
\left = 0
\top = 10
\right = 10
\bottom = 20
EndWith
Else
With rcCaret.RECT ; -> Full
\left = 0
\top = 0
\right = 10
\bottom = 20
EndWith
EndIf
hdc = GetDC_(GadgetID(hWnd_StringGadget)) ; Récupère un handle dans le contexte de l'appareil (DC)
hdcMem = CreateCompatibleDC_(hdc) ; Crée un contexte de périphérique compatible
hBitmap = CreateCompatibleBitmap_(hdc, 10, 20) ; Crée une bitmap compatible avec l'appareil associé au contexte d'appareil spécifié
hBitmapOld = SelectObject_( hdcMem, hBitmap) ; Sélectionne la bitmap
CaretBrush = CreateSolidBrush_(ColorToUse) ; Crée un pinceau uni
FillRect_(hdcMem, rcCaret, CaretBrush) ; Colorise la bitmap
CreateCaret_(GadgetID(hWnd_StringGadget),hBitmap,0,0) ; Crée le caret
ShowCaret_(GadgetID(hWnd_StringGadget)) ; Puis l'affiche
DeleteObject_(CaretBrush) ; Fait le ménage...
DeleteObject_(hdcMem)
SelectObject_(hdcMem, hBitmapOld)
ReleaseDC_(GadgetID(hWnd_StringGadget), hdc)
; Contrairement à la documentation Microsoft (https://learn.microsoft.com/fr-fr/windows/win32/menurc/using-carets)
; le système n'envoie pas le message WM_KILLFOCUS à la fenêtre qui reçoit le focus clavier mais WM_COMMAND, puis EN_KILLFOCUS
Case #EN_KILLFOCUS
DestroyCaret_() ; Supprime le caret
EndSelect
EndSelect
Case #WM_CTLCOLOREDIT
hwndFrom = GetProp_(lParam, "PB_ID")
Select hwndFrom
Case hWnd_StringGadget ; handle de la zone de saisie
SetTextColor_(wParam, Color_InputText) ; Défini la couleur du texte de la zone de saisie (pas possible un PB de base)
EndSelect
EndSelect
ProcedureReturn lResult
EndProcedure
; ***************************
; *** PROGRAMME PRINCIPAL ***
; ***************************
; Crée la fenêtre principale
hWnd_Windows = OpenWindow(#PB_Any, 0, 0, 410, 215, "What does it mean that the caret is square? Is it square, or just tidy?", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
If hWnd_Windows
; Met en place la procèdure de CallBack afin de modifier la couleur du caret et du texte de la zone de saisie
SetWindowCallback(@InputBoxCallback())
; Crée la zone de saisie
y = 25 ; Position verticale des gadgets
hWnd_StringGadget = StringGadget(#PB_Any, 50, y, 310, 25,"")
; Défini la police de la zone de saisie
With Text_Font.Text_Font
\pszFaceName = "Comic Sans MS"
\cHeight = 20
\cWidth = 0
\cWeight = #FW_BOLD
\bItalic = #False
\bUnderline = #False
\bStrikeOut = #False
\TextColor = Color_InputText
\BackColor = Color_InputBackground
EndWith
HFont = CreateFont_(Text_Font\cHeight,Text_Font\cWidth,0,0,Text_Font\cWeight,Text_Font\bItalic,Text_Font\bUnderline,Text_Font\bStrikeOut,#DEFAULT_CHARSET,#OUT_TT_PRECIS,#CLIP_DEFAULT_PRECIS,#NONANTIALIASED_QUALITY,#DEFAULT_PITCH | #FF_DONTCARE,Text_Font\pszFaceName)
SendMessage_(GadgetID(hWnd_StringGadget), #WM_SETFONT, HFont, #True)
; Réglage de la couleur du fond de la fenêtre
y + 50
hWnd_lblFaderWindowBackground = TextGadget (#PB_Any, 50, y, 200, 20, "Window background color :", #PB_Text_Right)
SetGadgetColor(hWnd_lblFaderWindowBackground, #PB_Gadget_BackColor, Color_WindowBackground)
hWnd_ValFaderWindowBackground = SpinGadget (#PB_Any, 260, y, 100, 20, 0, $FFFFFF,#PB_Spin_Numeric)
SetGadgetState(hWnd_ValFaderWindowBackground, Color_WindowBackground)
SetWindowTheme_(GadgetID(hWnd_ValFaderWindowBackground), "", "")
hWnd_BtWindowBackground = ButtonGadget (#PB_Any, 370, y, 20, 20, "...")
SetWindowTheme_(GadgetID(hWnd_BtWindowBackground), "", "")
; Réglage de la couleur du fond de la zone de saisie
y + 25
hWnd_lblFaderInputBackground = TextGadget (#PB_Any, 50, y, 200, 20, "Input background color :", #PB_Text_Right)
SetGadgetColor(hWnd_lblFaderInputBackground, #PB_Gadget_BackColor, Color_WindowBackground)
hWnd_ValFaderInputBackground = SpinGadget (#PB_Any, 260, y, 100, 20, 0, $FFFFFF,#PB_Spin_Numeric)
SetGadgetState(hWnd_ValFaderInputBackground, Color_InputBackground)
SetWindowTheme_(GadgetID(hWnd_ValFaderInputBackground), "", "")
hWnd_BtInputBackground = ButtonGadget (#PB_Any, 370, y, 20, 20, "...")
SetWindowTheme_(GadgetID(hWnd_BtInputBackground), "", "")
; Réglage de la couleur du texte de la zone de saisie
y + 25
hWnd_lblFaderInputText = TextGadget (#PB_Any, 50, y, 200, 20, "Input texte color :", #PB_Text_Right)
SetGadgetColor(hWnd_lblFaderInputText, #PB_Gadget_BackColor, Color_WindowBackground)
hWnd_ValFaderInputText = SpinGadget (#PB_Any, 260, y, 100, 20, 0, $FFFFFF,#PB_Spin_Numeric)
SetGadgetState(hWnd_ValFaderInputText, Color_InputText)
SetWindowTheme_(GadgetID(hWnd_ValFaderInputText), "", "")
hWnd_BtInputText = ButtonGadget (#PB_Any, 370, y, 20, 20, "...")
SetWindowTheme_(GadgetID(hWnd_BtInputText), "", "")
; Réglage de la couleur du caret de la zone de saisie
y + 25
hWnd_lblFaderInputCaret = TextGadget (#PB_Any, 50, y, 200, 20, "Input caret color :", #PB_Text_Right)
SetGadgetColor(hWnd_lblFaderInputCaret, #PB_Gadget_BackColor, Color_WindowBackground)
hWnd_ValFaderInputCaret = SpinGadget (#PB_Any, 260, y, 100, 20, 0, $FFFFFF,#PB_Spin_Numeric)
SetGadgetState(hWnd_ValFaderInputCaret, Color_InputCaret)
SetWindowTheme_(GadgetID(hWnd_ValFaderInputCaret), "", "")
hWnd_BtInputCaret = ButtonGadget (#PB_Any, 370, y, 20, 20, "...")
SetWindowTheme_(GadgetID(hWnd_BtInputCaret), "", "")
; Bouton spécifiant la taille du caret
y + 25
hWnd_lblBt_CaretSize = TextGadget (#PB_Any, 50, y, 200, 20, "Caret size (full / half) :", #PB_Text_Right)
SetGadgetColor(hWnd_lblBt_CaretSize, #PB_Gadget_BackColor, Color_WindowBackground)
hWnd_Bt_CaretSize = ButtonGadget (#PB_Any, 260, y, 50, 20, "", #PB_Button_Toggle)
SetWindowTheme_(GadgetID(hWnd_Bt_CaretSize), "", "")
SetGadgetState(hWnd_Bt_CaretSize, Bt_CaretSize)
If Bt_CaretSize
SetGadgetText(hWnd_Bt_CaretSize, "Half")
Else
SetGadgetText(hWnd_Bt_CaretSize, "Full")
EndIf
RedrawWindow_(WindowID(hWnd_Windows),#NUL,#NUL,#RDW_ALLCHILDREN|#RDW_INVALIDATE)
; Change la couleur du fond de la fenêtre
SetWindowColor(hWnd_Windows, Color_WindowBackground)
; Change les couleurs de la zone de saisie
; (Windows ne permettant pas de changer directement les couleurs des contrôles, nous les modifierons à travers la procèdure de CallBack)
SetWindowTheme_(GadgetID(hWnd_StringGadget), "", "") ; Supprime le thème par défaut du gadget pour permettre de changer la couleur du texte (et d'avoir un look sympa sous W10)
SetGadgetColor(hWnd_StringGadget, #PB_Gadget_BackColor, Color_InputBackground) ; Couleur du fond de la zone de saisie
; Force le focus sur la zone de saisie
SetActiveGadget(hWnd_StringGadget)
; Boucle d'attente d'événements
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
End
Case #PB_Event_Gadget
Select EventGadget()
; Couleur du fond de la fenêtre et des labels
Case hWnd_BtWindowBackground
ChooseColor.CHOOSECOLOR
ColorMemory.ColorMemory
ChooseColor\LStructSize = SizeOf(ChooseColor)
ChooseColor\hwndOwner = WindowID(hWnd_Windows)
ChooseColor\rgbResult = Color_WindowBackground
ChooseColor\lpCustColors = ColorMemory
ChooseColor\flags = #CC_ANYCOLOR | #CC_FULLOPEN | #CC_RGBINIT
ChooseColor_(@ChooseColor)
Color_WindowBackground = ChooseColor\rgbResult
SetGadgetState(hWnd_ValFaderWindowBackground, Color_WindowBackground)
SetWindowColor(hWnd_Windows, Color_WindowBackground)
SetGadgetColor(hWnd_lblFaderWindowBackground, #PB_Gadget_BackColor, Color_WindowBackground)
SetGadgetColor(hWnd_lblFaderInputBackground , #PB_Gadget_BackColor, Color_WindowBackground)
SetGadgetColor(hWnd_lblFaderInputText , #PB_Gadget_BackColor, Color_WindowBackground)
SetGadgetColor(hWnd_lblFaderInputCaret , #PB_Gadget_BackColor, Color_WindowBackground)
SetGadgetColor(hWnd_lblBt_CaretSize , #PB_Gadget_BackColor, Color_WindowBackground)
SetActiveGadget(hWnd_StringGadget)
Case hWnd_ValFaderWindowBackground
Color_WindowBackground = GetGadgetState(hWnd_ValFaderWindowBackground)
SetWindowColor(hWnd_Windows, Color_WindowBackground)
SetGadgetColor(hWnd_lblFaderWindowBackground, #PB_Gadget_BackColor, Color_WindowBackground)
SetGadgetColor(hWnd_lblFaderInputBackground , #PB_Gadget_BackColor, Color_WindowBackground)
SetGadgetColor(hWnd_lblFaderInputText , #PB_Gadget_BackColor, Color_WindowBackground)
SetGadgetColor(hWnd_lblFaderInputCaret , #PB_Gadget_BackColor, Color_WindowBackground)
SetGadgetColor(hWnd_lblBt_CaretSize , #PB_Gadget_BackColor, Color_WindowBackground)
SetActiveGadget(hWnd_StringGadget)
; Couleur du fond de la zone de saisie
Case hWnd_BtInputBackground
ChooseColor.CHOOSECOLOR
ColorMemory.ColorMemory
ChooseColor\LStructSize = SizeOf(ChooseColor)
ChooseColor\hwndOwner = WindowID(hWnd_Windows)
ChooseColor\rgbResult = Color_InputBackground
ChooseColor\lpCustColors = ColorMemory
ChooseColor\flags = #CC_ANYCOLOR | #CC_FULLOPEN | #CC_RGBINIT
ChooseColor_(@ChooseColor)
Color_InputBackground = ChooseColor\rgbResult
SetGadgetState(hWnd_ValFaderInputBackground, Color_InputBackground)
SetGadgetColor(hWnd_StringGadget, #PB_Gadget_BackColor, Color_InputBackground)
SetActiveGadget(hWnd_StringGadget)
Case hWnd_ValFaderInputBackground
Color_InputBackground = GetGadgetState(hWnd_ValFaderInputBackground)
SetGadgetColor(hWnd_StringGadget, #PB_Gadget_BackColor, Color_InputBackground)
SetActiveGadget(hWnd_StringGadget)
; Couleur du texte de la zone de saisie
Case hWnd_BtInputText
ChooseColor.CHOOSECOLOR
ColorMemory.ColorMemory
ChooseColor\LStructSize = SizeOf(ChooseColor)
ChooseColor\hwndOwner = WindowID(hWnd_Windows)
ChooseColor\rgbResult = Color_InputText
ChooseColor\lpCustColors = ColorMemory
ChooseColor\flags = #CC_ANYCOLOR | #CC_FULLOPEN | #CC_RGBINIT
ChooseColor_(@ChooseColor)
Color_InputText = ChooseColor\rgbResult
SetGadgetState(hWnd_ValFaderInputText, Color_InputText)
RedrawWindow_(WindowID(hWnd_Windows),#NUL,#NUL,#RDW_ALLCHILDREN|#RDW_INVALIDATE)
SetActiveGadget(hWnd_StringGadget)
Case hWnd_ValFaderInputText
Color_InputText = GetGadgetState(hWnd_ValFaderInputText)
RedrawWindow_(WindowID(hWnd_Windows),#NUL,#NUL,#RDW_ALLCHILDREN|#RDW_INVALIDATE)
SetActiveGadget(hWnd_StringGadget)
; Couleur du caret de la zone de saisie
Case hWnd_BtInputCaret
ChooseColor.CHOOSECOLOR
ColorMemory.ColorMemory
ChooseColor\LStructSize = SizeOf(ChooseColor)
ChooseColor\hwndOwner = WindowID(hWnd_Windows)
ChooseColor\rgbResult = Color_InputCaret
ChooseColor\lpCustColors = ColorMemory
ChooseColor\flags = #CC_ANYCOLOR | #CC_FULLOPEN | #CC_RGBINIT
ChooseColor_(@ChooseColor)
Color_InputCaret = ChooseColor\rgbResult
SetGadgetState(hWnd_ValFaderInputCaret, Color_InputCaret)
RedrawWindow_(WindowID(hWnd_Windows),#NUL,#NUL,#RDW_ALLCHILDREN|#RDW_INVALIDATE)
SetActiveGadget(hWnd_StringGadget)
Case hWnd_ValFaderInputCaret
Color_InputCaret = GetGadgetState(hWnd_ValFaderInputCaret)
RedrawWindow_(WindowID(hWnd_Windows),#NUL,#NUL,#RDW_ALLCHILDREN|#RDW_INVALIDATE)
SetActiveGadget(hWnd_StringGadget)
; Dimension du caret
Case hWnd_Bt_CaretSize
If GetGadgetState(hWnd_Bt_CaretSize)
; Demi hauteur demandée
SetGadgetText(hWnd_Bt_CaretSize, "Half")
Bt_CaretSize = #True
Else
; Pleine hauteur demandée"
SetGadgetText(hWnd_Bt_CaretSize, "Full")
Bt_CaretSize = #False
EndIf
SetActiveGadget(hWnd_StringGadget)
EndSelect
EndSelect
ForEver
EndIf
