I put the mesa routine to choose the font in a ListIconGadget
https://www.purebasic.fr/french/viewtopic.php?t=16351
But then, the program no longer detects when I double left click on a line of ListIconGadget!!!
I put a small sample program below
Thank you for your help
Code: Select all
EnableExplicit
Declare.l NotifyCallback(WindowID.l, Message.l, wParam.l, lParam.l) ; window callback routine to color listview rows
;----- Enumeration
Enumeration
#FenetreWindows
#ListeOperation
EndEnumeration
;----- Constantes
#LargeurApplication=800
#HauteurApplication=600
#OptionsFenetre= #PB_Window_MinimizeGadget
; Constantes pour police et couleur Des éléments de la LitsIconGadget
#NM_CUSTOMDRAW = #NM_FIRST - 12
#CDDS_ITEM = $10000
#CDDS_SUBITEM = $20000
#CDDS_PREPAINT = $1
#CDDS_ITEMPREPAINT = #CDDS_ITEM | #CDDS_PREPAINT
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM | #CDDS_ITEMPREPAINT
#CDRF_DODEFAULT = $0
#CDRF_NEWFONT = $2
#CDRF_NOTIFYITEMDRAW = $20
#CDRF_NOTIFYSUBITEMDRAW = $20
;----- Variables
Global LargeurBureau.w
Global HauteurBureau.w
Global ScaleH.f
Global ScaleV.f
Global LargeurApplication.w
Global HauteurApplication.w
Global XApplication.w
Global YApplication.w
Global Evenement.l
Global DateOperation.l
Global LibelleOperation.s
Global D.l
Global Debit.s
Global C.l
Global Credit.s
Global S.l
Global Solde.s
Global AncS.l
Global AncienSolde.s
Global Element.l
Global i.w, j.w, r.w
Global ListGadget.l
;----- Polices de caractères
Global FontReg.l
FontReg = LoadFont(1, "Tahoma", 12)
;----- Dimensionnement de l'application
ExamineDesktops()
LargeurBureau=DesktopWidth(0)
HauteurBureau=DesktopHeight(0)
ScaleH=DesktopScaledX(100)/100
ScaleV=DesktopScaledY(100)/100
LargeurBureau=LargeurBureau/ScaleH
HauteurBureau=HauteurBureau/ScaleV
If LargeurBureau<1366 Or HauteurBureau<768
MessageRequester("Résolution", "Affichage 800 x 600 minimum")
End
EndIf
LargeurApplication=#LargeurApplication
HauteurApplication=#HauteurApplication
If LargeurApplication>LargeurBureau
LargeurApplication=LargeurBureau
EndIf
If HauteurApplication+68>HauteurBureau
HauteurApplication=HauteurBureau-68
EndIf
XApplication=(LargeurBureau-LargeurApplication)/2
If HauteurBureau > HauteurApplication + 68
YApplication= (HauteurBureau - HauteurApplication - 68)/2
Else
YApplication=0
EndIf
OpenWindow(#FenetreWindows,XApplication,YApplication,LargeurApplication,HauteurApplication,
"Gestion budget v0.00 - Ma Fouaaa - 2022",#OptionsFenetre)
;----- Création des gadgets
ListGadget=ListIconGadget(#ListeOperation, 5, 5, 800, 400, "Date", 100,
#PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_GridLines )
AddGadgetColumn(#ListeOperation, 1, "Libellé opération", 250)
AddGadgetColumn(#ListeOperation,2,"Débit",100)
AddGadgetColumn(#ListeOperation,3,"Crédit",100)
AddGadgetColumn(#ListeOperation,4,"Solde",100)
DateOperation=Date()-86400*500
AncS=0
For i=0 To 100
DateOperation+86400
LibelleOperation=""
r=Random(20,10)
For j=1 To r
LibelleOperation+Chr(Random(90,65))
Next j
If Random(10,1)<10
D=Random(100000)
C=0
Else
D=0
C=Random(1200000)
EndIf
S=AncS+C-D
AncS=S
If C=0
Credit=""
Debit=FormatNumber(D/100,2,","," ") + " €"
EndIf
If D=0
Debit=""
Credit=FormatNumber(C/100,2,","," ") + " €"
EndIf
If S=0
Solde=""
Else
Solde=FormatNumber(S/100,2,","," ") + " €"
EndIf
AddGadgetItem(#ListeOperation, -1, FormatDate("%dd/%mm/%yyyy",DateOperation) + Chr(10) +
LibelleOperation + Chr(10) +
Debit + Chr(10) +
Credit + Chr(10) +
Solde + Chr(10))
Next i
; set callback routine
SetWindowCallback(@NotifyCallback())
;----- Boucle principale
Repeat
Evenement = WaitWindowEvent()
Select Evenement
Case #PB_Event_MoveWindow ; Repositionne automatiquement la fenêtre si on tente de la déplacer
If GetWindowState(#FenetreWindows) = #PB_Window_Normal
ResizeWindow(#FenetreWindows,XApplication,YApplication,LargeurApplication,HauteurApplication)
EndIf
Case #PB_Event_Gadget
Select EventGadget()
Case #ListeOperation
Select EventType()
Case #PB_EventType_LeftDoubleClick
Debug GetGadgetState(#ListeOperation)
EndSelect
EndSelect
EndSelect
Until Evenement = #PB_Event_CloseWindow
; window callback routine to color listview rows
Procedure.l NotifyCallback(WindowID.l, Message.l, wParam.l, lParam.l)
Protected Row.l, Col.l
Protected *LVCDHeader.NMLVCUSTOMDRAW
; process NOTIFY message only
If Message = #WM_NOTIFY
; set stucture pointer
*LVCDHeader.NMLVCUSTOMDRAW = lParam
; CUSTOMDRAW message from desired gadget?
If *LVCDHeader\nmcd\hdr\hWndFrom = ListGadget And *LVCDHeader\nmcd\hdr\code = #NM_CUSTOMDRAW
Select *LVCDHeader\nmcd\dwDrawStage
Case #CDDS_PREPAINT
ProcedureReturn #CDRF_NOTIFYITEMDRAW
Case #CDDS_ITEMPREPAINT
ProcedureReturn #CDRF_NOTIFYSUBITEMDRAW
Case #CDDS_SUBITEMPREPAINT
; simple example - change background colors every other row
; change text colors every other row, only in column 3
; text in first column is bold
Row.l = *LVCDHeader\nmcd\dwItemSpec
Col.l = *LVCDHeader\iSubItem
SelectObject_(*LVCDHeader\nmcd\hDC, FontReg)
ProcedureReturn #CDRF_NEWFONT
EndSelect
EndIf
Else
ProcedureReturn #PB_ProcessPureBasicEvents
EndIf
EndProcedure