Font ListIconGadget

Just starting out? Need help? Post your questions and find answers here.
jak64
Enthusiast
Enthusiast
Posts: 502
Joined: Sat Aug 15, 2020 5:02 pm
Location: Ciboure (France)

Font ListIconGadget

Post by jak64 »

Hello,
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
fryquez
Enthusiast
Enthusiast
Posts: 362
Joined: Mon Dec 21, 2015 8:12 pm

Re: Font ListIconGadget

Post by fryquez »

The Window callback needs to return #PB_ProcessPureBasicEvents.
Also fixed x64:

Code: Select all

EnableExplicit
Declare.i NotifyCallback(WindowID.i, Message.l, wParam.i, lParam.i) ; 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.i

;----- Polices de caractères
Global FontReg.i
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.i NotifyCallback(WindowID.i, Message.l, wParam.i, lParam.i)
  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 
  EndIf 
  
  ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure
jak64
Enthusiast
Enthusiast
Posts: 502
Joined: Sat Aug 15, 2020 5:02 pm
Location: Ciboure (France)

Re: Font ListIconGadget

Post by jak64 »

Great, thanks fryquez
jak64
Enthusiast
Enthusiast
Posts: 502
Joined: Sat Aug 15, 2020 5:02 pm
Location: Ciboure (France)

Re: Font ListIconGadget

Post by jak64 »

Hello,
I have another problem, I can no longer color a line (see code line 166) while it is colored if I comment out line 164!

Code: Select all

EnableExplicit

;----- Déclaration des procédures
Declare JustifierColonne(Gadget, Column, FMT) ; Pour justifier les colonnes
Declare.i NotifyCallback(WindowID.i, Message.l, wParam.i, lParam.i)


;----- Enumeration
Enumeration
  #FenetreWindows
  #ListeOperation
  #DateOperation
EndEnumeration

;----- Constantes
#LargeurApplication=1366
#HauteurApplication=768
#OptionsFenetre= #PB_Window_MinimizeGadget
#Gauche=0
#Centre=1
#Droite=2

; 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 Event.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
Global DateDuJour.l
Global LigneDateDuJour.l


;----- Polices de caractères
Global FontReg.l, FontBold.l 
FontReg = LoadFont(1, "Tahoma", 10) 
FontBold = LoadFont(2, "Tahoma", 16, #PB_Font_Bold) 
LoadFont(3,"Arial", 16, #PB_Font_StrikeOut)

;----- 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 1366 x 768 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, 1100, 484, "Date", 100,
               #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_GridLines  )
AddGadgetColumn(#ListeOperation, 1, "Libellé opération", 500)
AddGadgetColumn(#ListeOperation,2,"Débit",100)
AddGadgetColumn(#ListeOperation,3,"Crédit",100)
AddGadgetColumn(#ListeOperation,4,"Solde",120)
DateOperation=Date()-86400*50
AncS=0
For i=0 To 100
  DateOperation+86400
  If DateOperation>ParseDate("%dd/%mm/%yyyy", "31/12/2037")
    Break
  EndIf
  If DateDuJour=0 And DateOperation>=Date()
    DateDuJour=DateOperation
    LigneDateDuJour=i
  EndIf
  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(1, -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()) 
SetGadgetState(#ListeOperation, LigneDateDuJour+10) ; Sélectionner la ligne à la date du jour ou juste au-dessus
SetGadgetItemColor(#ListeOperation, LigneDateDuJour, #PB_Gadget_BackColor , #Green, #PB_All)       

 JustifierColonne(#ListeOperation, 2, #Droite)
 JustifierColonne(#ListeOperation, 3, #Droite)
 JustifierColonne(#ListeOperation, 4, #Droite)



DateGadget(#DateOperation, 10, 500, 100, 30)



;----- Boucle principale
Repeat
  Event = WaitWindowEvent()
   Select Event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #ListeOperation
          Select EventType()
            Case #PB_EventType_LeftDoubleClick
              DateOperation=ParseDate("%dd/%mm/%yyyy",  GetGadgetItemText(#ListeOperation, GetGadgetState(#ListeOperation), 0))
              SetGadgetState(#DateOperation, DateOperation)
          EndSelect
      EndSelect
    EndSelect
Until Event = #PB_Event_CloseWindow 

Procedure JustifierColonne(Gadget, Colonne, FMT) ; Code de MLD à  https://www.purebasic.fr/french/viewtopic.php?t=12420
  Protected lvc.LV_COLUMN
  Lvc\Mask = #LVCF_FMT
  Select FMT
    Case 0
      Lvc\FMT = #LVCFMT_LEFT
    Case 1
      Lvc\FMT = #LVCFMT_CENTER
    Case 2
      Lvc\FMT = #LVCFMT_RIGHT
  EndSelect
  SendMessage_(GadgetID(Gadget), #LVM_SETCOLUMN, Colonne , @Lvc)
EndProcedure

; window callback routine to color listview rows 
Procedure.i NotifyCallback(WindowID.i, Message.l, wParam.i, lParam.i)
  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 
  EndIf 
  
  ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure
fryquez
Enthusiast
Enthusiast
Posts: 362
Joined: Mon Dec 21, 2015 8:12 pm

Re: Font ListIconGadget

Post by fryquez »

Comment out "ProcedureReturn #CDRF_NEWFONT"
jak64
Enthusiast
Enthusiast
Posts: 502
Joined: Sat Aug 15, 2020 5:02 pm
Location: Ciboure (France)

Re: Font ListIconGadget

Post by jak64 »

Too strong !
thank you
Post Reply