Callback of listicon

[a_carignan]

Hello, I would like to know if we can with a wincallback called with a command of type SetWindowLongPtr_ (GadgetID (0), #GWL_WNDPROC, @liCB ()) have access to the event similar to change of a listicon like #LVN_ITEMCHANGED?

[mk-soft]

Not ready... Not Work ???

Code: Select all

;-TOP

; Comment : Module SetGadgetCallback (Windows Only)
; Author  : mk-soft
; Version : v0.02
; Created : 10.06.2018
; Updated :
;
; Syntax Callback:
;           Procedure GadgetCB(hWnd,uMsg,wParam,lParam)
;             Select uMsg
;               ;TODO
;             EndSelect
;             ; Call previous gadget procedure
;             ProcedureReturn CallGadgetProc(hWnd,uMsg,wParam,lParam)
;           EndProcedure
;
; *****************************************************************************

DeclareModule GadgetCallback
 
  Declare SetGadgetCallback(Gadget, *lpNewFunc)
  Declare CallGadgetProc(hWnd, uMsg, wParam, lParam)
 
EndDeclareModule

Module GadgetCallback
 
  EnableExplicit
 
  Global NewMap *lpPrevFunc()
  Global MutexCB = CreateMutex()
 
  ; ---------------------------------------------------------------------------
 
  Procedure SetGadgetCallback(Gadget, *lpNewFunc)
    Protected GadgetID, GadgetKey.s
   
    GadgetID = GadgetID(Gadget)
    GadgetKey = Hex(GadgetID)
   
    ; Remove exists Callback
    If FindMapElement(*lpPrevFunc(), GadgetKey)
      SetWindowLongPtr_(GadgetID, #GWL_WNDPROC, *lpPrevFunc())
      DeleteMapElement(*lpPrevFunc())
    EndIf
   
    If *lpNewFunc
      If AddMapElement(*lpPrevFunc(), GadgetKey)
        *lpPrevFunc() = SetWindowLongPtr_(GadgetID, #GWL_WNDPROC, *lpNewFunc)
        ProcedureReturn *lpPrevFunc()
      EndIf
    EndIf
   
    ProcedureReturn 0
   
  EndProcedure
 
  ; ---------------------------------------------------------------------------
 
  Procedure CallGadgetProc(hWnd, uMsg, wParam, lParam)
    Protected result
   
    LockMutex(MutexCB)
    If FindMapElement(*lpPrevFunc(), Hex(hWnd))
      result = CallWindowProc_(*lpPrevFunc(), hWnd, uMsg, wParam, lParam)
    EndIf
    UnlockMutex(MutexCB)
   
    ProcedureReturn result
   
  EndProcedure
 
EndModule

; *****************************************************************************

; Example

CompilerIf #PB_Compiler_IsMainFile
 
  UseModule GadgetCallback
 
  Procedure ListIconProc(hWnd,uMsg,wParam,lParam)
    Protected *nmhdr.NMHDR
    Protected *Listview.NM_LISTVIEW
    Select uMsg
      Case #WM_NOTIFY
        *nmhdr = lParam
        If *nmhdr\code = #LVN_ITEMCHANGED
          ;TODO  
          *Listview = lParam
          Debug *Listview\iItem
          ;ProcedureReturn 0
        EndIf
    EndSelect
    ProcedureReturn CallGadgetProc(hWnd,uMsg,wParam,lParam)
  EndProcedure
 
  If OpenWindow(0,0,0,600,480,"Example SetGadgetCallback",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
    ListIconGadget(0,10,10,580,460, "Name", 100)
    
    AddGadgetColumn(0, 1, "Address", 250)
    AddGadgetItem(0, -1, "Harry Rannit"+Chr(10)+"12 Parliament Way, Battle Street, By the Bay")
    AddGadgetItem(0, -1, "Ginger Brokeit"+Chr(10)+"130 PureBasic Road, BigTown, CodeCity")
    
    SetGadgetCallback(0, @ListIconProc())
    
    Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
  EndIf
 
CompilerEndIf

[netmaestro]

The short answer to your question as stated is 'no'. There may be a way to wangle it but you're best off sticking to established norms.
Listview item changes are handled by WM_NOTIFY which is sent to the parent window. So the SetWindowLongPtr_( [..] ) idea doesn't apply to this task.
In this example we set the window callback which waits for the message before we create the listicon.
This way we can see the change events as we add items.
A timer waits 2 seconds and then changes the second item from 'Ginger' to 'Mary Ann'.
(If you're not from North America you might miss the significance of this, also it helps if you're pretty old)
Then you should see a third change debugged.
Ok, here goes:

Code: Select all

Procedure WinProc(hWnd, Msg, wParam, lParam)
  result = #PB_ProcessPureBasicEvents
  Select Msg
    Case #WM_NOTIFY
      *nh.NMLISTVIEW = lParam
      If *nh\hdr\code = #LVN_ITEMCHANGED
        Debug "Item " + Str(*nh\iitem) + " changed"
      EndIf
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure TimerProc()
  SetGadgetItemText(0, 1, "Mary Ann Brokeit"+Chr(10)+"130 PureBasic Road, BigTown, CodeCity")
  RemoveWindowTimer(0,1)
EndProcedure

OpenWindow(0,0,0,600,480,"Example SetGadgetCallback",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
SetWindowCallback(@WinProc())
ListIconGadget(0,10,10,580,460, "Name", 100)

AddGadgetColumn(0, 1, "Address", 250)
AddGadgetItem(0, -1, "Harry Rannit"+Chr(10)+"12 Parliament Way, Battle Street, By the Bay")
AddGadgetItem(0, -1, "Ginger Brokeit"+Chr(10)+"130 PureBasic Road, BigTown, CodeCity")

AddWindowTimer(0,1,2000)
BindEvent(#PB_Event_Timer, @TimerProc())

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow

Study the NMLISTVIEW structure to find where you can check for a specific gadget and drill down to subitems as well as items.

[a_carignan]

The use of a callback attached to the list is motivated by two things.
1) management of #wm_mouse which does not work in a callback attached to the window
2) the callback procedure attached to the list is in an interface and I would like to have only one event procedure for listicons. I specify that I want the listicon gadget of the interface is not directly accessible outside of it.
My research, to achieve my ends, used the events accessible in umsg. By managing events well, we can deduce all the changes made by the user to the list.
Eventually, I intend to create an example.
Thank you for your help.

[a_carignan]

Here is the promised example.

Code: Select all

EnableExplicit
;Global listicon_colorline_undermouse=#PB_Default;For no underlining
Global listicon_colorline_undermouse=#Green;For a green underline

Structure str_listicon
  oldproc.i
  gadget.i
EndStructure
Define listicon.str_listicon
Macro HIWORD(val)
  val>>16
EndMacro

Macro LOWORD(val)
  val&$FFFF
EndMacro
Procedure listicon_onclick(gadget,*ht.LVHITTESTINFO)
  If *ht\flags & #LVHT_ONITEM 
    If Not (*ht\flags & #LVHT_ONITEMLABEL)
      SetGadgetItemState(gadget,*ht\iItem,GetGadgetItemState(gadget,*ht\iItem) ! #PB_ListIcon_Checked | #PB_ListIcon_Selected)
    Else
      SetGadgetItemState(gadget,*ht\iItem,GetGadgetItemState(gadget,*ht\iItem) | #PB_ListIcon_Selected)
    EndIf
    SetGadgetState(gadget,*ht\iItem)
  EndIf
EndProcedure
Procedure listicon_resetcolorline(gadget,line,color)
  If line>-1
    SetGadgetItemColor(gadget,line,#PB_Gadget_BackColor,color)
  EndIf          
EndProcedure

Procedure ListProc(hWnd, Msg, wParam, lParam)
  Protected *nmlv.NM_LISTVIEW
    Static state,ht.LVHITTESTINFO
    Static oldline=-1
    Static oldcolor=-1
    Define actuelline,this.POINT,*listicon.str_listicon
    *listicon=GetProp_(hWnd, "oldproc")
    If *listicon
      Select msg
        Case #WM_LBUTTONDOWN
          listicon_onclick(*listicon\gadget,ht)
          ProcedureReturn #PB_Event_None;required for #wm_lbuttonup event
        Case #WM_LBUTTONUP
          ;Debug "Left Button up"
          ProcedureReturn #PB_Event_None  
        Case #WM_RBUTTONDOWN
            listicon_onclick(*listicon\gadget,ht)
            DisplayPopupMenu(0,WindowID(0))
          ProcedureReturn #PB_Event_None;;required for #wm_rbuttonup event
        Case #WM_RBUTTONUP              
          Debug "Right Button Up"
          ProcedureReturn #PB_Event_None
        Case #WM_KEYDOWN
          ;Debug "keydown"
        Case #WM_KEYUP
          If wParam = #VK_RETURN
            Debug "Name : "+GetGadgetItemText(*listicon\gadget,GetGadgetState(0),0)
          EndIf
          ProcedureReturn #PB_Event_None
          ;Case #WM_MOUSEMOVE
          ;Debug "WM_MOUSEMOVE"
          ;listicon_mousemoveover(*myself)
        Case #WM_NCHITTEST
          ;Debug "#WM_NCHITTEST"
          With this
            \x = LOWORD(lParam)
            \y = HIWORD(lParam)
          EndWith
          MapWindowPoints_(0, hWnd, @this, 1)
          With ht
            \pt\x=this\x
            \pt\y=this\y
          EndWith
          SendMessage_(hWnd,#LVM_HITTEST,0,@ht)
          If listicon_colorline_undermouse>#PB_Default
            listicon_resetcolorline(*listicon\gadget,oldline,oldcolor)
            oldline=ht\iItem
            If ht\flags & #LVHT_ONITEM
              oldcolor=GetGadgetItemColor(*listicon\gadget,ht\iItem,#PB_Gadget_BackColor,-1)
              SetGadgetItemColor(*listicon\gadget,ht\iItem,#PB_Gadget_BackColor,listicon_colorline_undermouse,-1)
            EndIf
          EndIf
        Case #WM_MOUSELEAVE
          If listicon_colorline_undermouse>#PB_Default
            listicon_resetcolorline(*listicon\gadget,oldline,oldcolor)
          EndIf
      EndSelect  
      ProcedureReturn CallWindowProc_(*listicon\oldproc, hWnd, Msg, wParam, lParam)
    Else
      ProcedureReturn DefWindowProc_(hWnd, Msg, wParam, lParam)
    EndIf
  EndProcedure
  

OpenWindow(0,0,0,320,240,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
If CreatePopupMenu(0)
  MenuTitle("Item")
  MenuItem(1,"Show Name")
EndIf
ListIconGadget(0, 10,10,230,200,"Name",120,#PB_ListIcon_CheckBoxes|#PB_ListIcon_FullRowSelect)
listicon\oldproc=GetWindowLongPtr_(GadgetID(0), #GWL_WNDPROC)
listicon\gadget=0
SetProp_(GadgetID(0),"oldproc",listicon)
SetWindowLongPtr_(GadgetID(0),#GWL_WNDPROC,@ListProc())
AddGadgetColumn(0, 1, "Age",100)
AddGadgetItem(0, -1, "Norman"+Chr(10)+"18")
AddGadgetItem(0, -1, "Charlene"+Chr(10)+"22")
AddGadgetItem(0, -1, "Donna"+Chr(10)+"20")
AddGadgetItem(0, -1, "Philip"+Chr(10)+"20")
AddGadgetItem(0, -1, "Arthur"+Chr(10)+"19")
AddGadgetItem(0, -1, "Norman"+Chr(10)+"18")
AddGadgetItem(0, -1, "Charlene"+Chr(10)+"22")
AddGadgetItem(0, -1, "Donna"+Chr(10)+"20")
AddGadgetItem(0, -1, "Philip"+Chr(10)+"20")
AddGadgetItem(0, -1, "Arthur"+Chr(10)+"19")
SetActiveGadget(0)
SetGadgetItemColor(0,2,#PB_Gadget_BackColor,#Red,-1)
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
    Case #PB_Event_Menu
      Select EventMenu()
        Case 1
          Debug "Name : "+GetGadgetItemText(0,GetGadgetState(0),0)
          SetActiveGadget(0)
      EndSelect
      
  EndSelect
  
ForEver