Listicon and mouse

Everything else that doesn't fall into one of the other PB categories.
User avatar
a_carignan
User
User
Posts: 81
Joined: Sat Feb 21, 2009 2:01 am
Location: Canada

Listicon and mouse

Post by a_carignan »

Hello, I would like to know if there is a way to follow the mouse in a listicon, without changing the color of the line under the mouse. for example using a command of type

Code: Select all

SetWindowLongPtr_ (GadgetID (#treeview_virement_compte_revenu), # GWL_STYLE, GetWindowLongPtr_ (GadgetID (#treeview_virement_compte_revenu), # GWL_STYLE) | #TVS_TRACKSELECT)
Please help me.
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8425
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Listicon and mouse

Post by netmaestro »

You can make the listicon's selection track the cursor but it'll show highlighted, not underlined like the treegadget. If you want it to show underlined you have to ownerdraw the listicon. Anyway here it is with normal selection tracking the mouse:

Code: Select all

Macro HIWORD(val)
  val>>16
EndMacro

Macro LOWORD(val)
  val&$FFFF
EndMacro

Procedure ListProc(hWnd, Msg, wParam, lParam)
  oldproc = GetProp_(hWnd, "oldproc")
  Select Msg
    Case #WM_NCDESTROY
      RemoveProp_(hWnd, "oldproc")
      
    Case #WM_NCHITTEST 
      With this.POINT
        \x = LOWORD(lParam)
        \y = HIWORD(lParam)
      EndWith
      MapWindowPoints_(0, hWnd, @this, 1)
      With ht.LVHITTESTINFO
        \pt\x=this\x 
        \pt\y=this\y 
      EndWith
      SendMessage_(hWnd,#LVM_HITTEST,0,@ht)
      If ht\flags & #LVHT_ONITEM
        If Not GetGadgetItemState(0, ht\iItem) & #PB_ListIcon_Selected
          SetGadgetItemState(0, ht\iItem, #PB_ListIcon_Selected)
        EndIf
      EndIf
  EndSelect
  CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
EndProcedure

OpenWindow(0,0,0,320,240,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
ListIconGadget(0, 10,10,230,200,"Name",120)
SetProp_(GadgetID(0),"oldproc",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")
SetActiveGadget(0)
Repeat:Until WaitWindowEvent()=#PB_Event_CloseWindow
BERESHEIT
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Listicon and mouse

Post by RASHAD »

Hi NM
I think he meant the color of the row under the mouse (as if been selected)

#1 :

Code: Select all

Procedure IsMouseOver(hWnd)
    GetWindowRect_(hWnd,r.RECT)
    GetCursorPos_(p.POINT)
    Result = PtInRect_(r,p\y << 32 + p\x)
    ProcedureReturn Result
EndProcedure
 
LoadFont(0,"Georgia",14)
OpenWindow(0, 0, 0, 800, 400, "ListIconGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  ListIconGadget(0,  10,  10, 600, 380, "Column 0", 120,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
  SetGadgetFont(0,FontID(0))
  For x = 1 To 6     
    AddGadgetColumn(0, x, "Column " + Str(x), 120)
  Next
  For x = 0 To 20
      AddGadgetItem(0, -1, "Row : "+Str(x)+Chr(10)+"Item 1"+Chr(10)+"Item 2"+Chr(10)+"Item 3"+Chr(10)+"Item 4"+Chr(10)+"Item 5")
  Next
  TextGadget(1,620,10,170,380,"",#WS_BORDER)
  SetGadgetFont(1,FontID(0)) 
  i.LVHITTESTINFO   
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
          Quit = 1
         
    Case #WM_MOUSEMOVE
      If IsMouseOver(GadgetID(0))
        GetCursorPos_(p.POINT)
        ScreenToClient_ (GadgetID(0), @p)            
        i\pt\x = p\x : i\pt\y = p\y
        SendMessage_(GadgetID(0),#LVM_SUBITEMHITTEST ,0,@i)
        text$ = " Row : "+Str(i\iItem)+#CRLF$+" Column : "+Str(i\iSubItem)+#CRLF$
        r.RECT
        r\top = i\iSubItem 
        r\left = #LVIR_BOUNDS 
        SendMessage_(GadgetID(0), #LVM_GETSUBITEMRECT, i\iItem, r)
        If i\iSubItem = 0
           r\right = SendMessage_(GadgetID(0), #LVM_GETCOLUMNWIDTH, 0, 0)
        EndIf
        text$ = text$ +" X : "+Str(r\left)+#CRLF$+" Y : "+Str(r\top) +#CRLF$+" W : "+Str(r\right-r\left)+#CRLF$+" H : " +Str(r\bottom-r\top)
        SetGadgetText(1,text$)
      EndIf

  EndSelect
Until Quit = 1
#2 :

Code: Select all

Global oldCallback,i.LVHITTESTINFO

Procedure liCB(hWnd, uMsg, wParam, lParam) 
  Select uMsg
      
    Case #WM_MOUSEMOVE
      SetGadgetState(0,-1)
      GetCursorPos_(p.POINT)
      ScreenToClient_ (GadgetID(0), @p)            
      i\pt\x = p\x : i\pt\y = p\y
      SendMessage_(GadgetID(0),#LVM_SUBITEMHITTEST ,0,@i)
      text$ = " Row : "+Str(i\iItem)+#CRLF$+" Column : "+Str(i\iSubItem)+#CRLF$
      r.RECT
      r\top = i\iSubItem 
      r\left = #LVIR_BOUNDS 
      SendMessage_(GadgetID(0), #LVM_GETSUBITEMRECT, i\iItem, r)
      If i\iSubItem = 0
         r\right = SendMessage_(GadgetID(0), #LVM_GETCOLUMNWIDTH, 0, 0)
      EndIf
      text$ = text$ +" X : "+Str(r\left)+#CRLF$+" Y : "+Str(r\top) +#CRLF$+" W : "+Str(r\right-r\left)+#CRLF$+" H : "+Str(r\bottom-r\top)
      SetGadgetText(1,text$)
        
  EndSelect
  ProcedureReturn CallWindowProc_(oldCallback, hWnd, uMsg, wParam, lParam)
EndProcedure

 
LoadFont(0,"Georgia",14)
OpenWindow(0, 0, 0, 800, 400, "ListIconGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  ListIconGadget(0,  10,  10, 600, 380, "Column 0", 120,#PB_ListIcon_GridLines)
  SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE,0,SendMessage_(GadgetID(0),#LVM_GETEXTENDEDLISTVIEWSTYLE,0,0)| #LVS_EX_TRACKSELECT)

  SetGadgetFont(0,FontID(0))
  For x = 1 To 6     
    AddGadgetColumn(0, x, "Column " + Str(x), 120)
  Next
  For x = 0 To 20
      AddGadgetItem(0, -1, "Row : "+Str(x)+Chr(10)+"Item 1"+Chr(10)+"Item 2"+Chr(10)+"Item 3"+Chr(10)+"Item 4"+Chr(10)+"Item 5")
  Next
  TextGadget(1,620,10,170,380,"",#WS_BORDER)
  SetGadgetFont(1,FontID(0)) 
  
  oldCallback = SetWindowLongPtr_(GadgetID(0), #GWL_WNDPROC, @liCB())   
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
          Quit = 1

  EndSelect
Until Quit = 1
Egypt my love
User avatar
a_carignan
User
User
Posts: 81
Joined: Sat Feb 21, 2009 2:01 am
Location: Canada

Re: Listicon and mouse

Post by a_carignan »

Thank you for your collaboration. I would like to differentiate the line under the mouse, while keeping the selected line intact while avoiding using the color of the line. Because, I plan to put color in the listicon.
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8425
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Listicon and mouse

Post by netmaestro »

Your option for that is ownerdraw.
BERESHEIT
User avatar
a_carignan
User
User
Posts: 81
Joined: Sat Feb 21, 2009 2:01 am
Location: Canada

Re: Listicon and mouse

Post by a_carignan »

netmaestro wrote:Your option for that is ownerdraw.
what do you mean exactly? :?:
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8425
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Listicon and mouse

Post by netmaestro »

I mean that by OR'ing LVS_OWNERDRAWFIXED into your ListIconGadget style, you take over full responsibility for all drawing of the gadget. You have full control over colors, fonts, sizes, the works. Here's an example which does what you're asking for. Study it and you will see it's easy to go from where it is to choosing colors, fonts, even images for each individual cell. Anyway here it is:

Code: Select all

; Yet another useless program from netmaestro

Global oldproc, currentitem = -1, WhiteBrush = CreateSolidBrush_(#White)

LoadFont(0, "verdana", 10)
LoadFont(1, "verdana", 10, #PB_Font_Underline)

Procedure MainWindowCallBack(hwnd, msg, wparam, lparam)
  result = #PB_ProcessPureBasicEvents
  Select msg
    Case #WM_DRAWITEM
      *lpdis.DRAWITEMSTRUCT = lparam
      Dim itemrect.RECT(1)
      For i = 0 To 1
        RtlZeroMemory_(@itemrect(i),SizeOf(RECT))
        itemrect(i)\top = i
        SendMessage_(*lpdis\hwndItem, #LVM_GETSUBITEMRECT, *lpdis\itemid, @itemrect(i)) ; Get the specific subitem rectangle we're drawing to
        text$ = GetGadgetItemText(*lpdis\CtlID, *lpdis\itemid, i)                       ; Get the text to write from the gadget
        SelectObject_(*lpdis\hDC, GetStockObject_(#NULL_PEN))
        SelectObject_(*lpdis\hDC, WhiteBrush)                                           ; Choose a background color
        With itemrect(i)
          Rectangle_(*lpdis\hDC, \left+4, \top+4, \right, \bottom)                      ; Fill the rectangle with it
        EndWith
        If *lpdis\itemid = currentitem And i=0                                          ; Is the mouse on the item? (i=0 only underlines first column)
          SelectObject_(*lpdis\hDc, FontID(1))                                          ; If yes, choose the underlined font
        Else
          SelectObject_(*lpdis\hDc, FontID(0))                                          ; If no, choose the normal font
        EndIf
        TextOut_(*lpdis\hDC, itemrect(i)\left+4, itemrect(i)\top+4, text$, Len(text$))  ; Draw the text in the chosen font
      Next
      
    Case #WM_MEASUREITEM
      *lpmis.MEASUREITEMSTRUCT = lparam
      *lpmis\itemheight = 20
      
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure SubClass_LV(hwnd, msg, wparam, lparam)
  If msg = #WM_MOUSEMOVE
    GetCursorPos_(@cp.POINT)
    MapWindowPoints_(0,hwnd,@cp,1)
    HitInfo.LVHITTESTINFO
    Hitinfo\pt\x = cp\x
    HitInfo\pt\y = cp\y
    SendMessage_(hwnd, #LVM_HITTEST , 0, @HitInfo)
    thisitem = HitInfo\iItem
    If thisitem <> currentitem
      currentitem=thisitem
      InvalidateRect_(hwnd, 0, 1)
    EndIf
  EndIf
  ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wparam, lparam)
EndProcedure

OpenWindow(0,0,0,320,240,"",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
SetWindowCallback(@MainWindowCallBack())

ListIconGadget(0,0,0,320,240,"FirstName",100,#PB_ListIcon_GridLines|#LVS_OWNERDRAWFIXED)
oldproc = SetWindowLong_(GadgetID(0), #GWL_WNDPROC, @SubClass_LV())
AddGadgetColumn(0,1,"LastName",100)
AddGadgetItem(0, -1, "Lloyd" + Chr(10) + "Gallant" )
AddGadgetItem(0, -1, "Eric" + Chr(10) + "Penrose"   )
AddGadgetItem(0, -1, "Mark" + Chr(10) + "Dutton"     )
AddGadgetItem(0, -1, "Tim" + Chr(10) + "Knechtel"   )

Repeat : EventID = WaitWindowEvent() : Until EventID = #PB_Event_CloseWindow
Just remember that if you go this route, things like SetGadgetFont, SetGadgetItemColor, etc. aren't going to have any effect because you've assumed control of virtually all drawing decisions. SetGadgetItemText will still work fine.
BERESHEIT
User avatar
a_carignan
User
User
Posts: 81
Joined: Sat Feb 21, 2009 2:01 am
Location: Canada

Re: Listicon and mouse

Post by a_carignan »

Here is the example of operation that I would like to have. This method uses the setgadgetcolor command, which I would have liked to have avoided. But, at worst, it may very well suit me.

Code: Select all

Procedure IsMouseOver(hWnd) 
    GetWindowRect_(hWnd,r.RECT) 
    GetCursorPos_(p.POINT) 
    Result = PtInRect_(r,p\y << 32 + p\x) 
    ProcedureReturn Result 
EndProcedure 
 
LoadFont(0,"Georgia",14)
OpenWindow(0, 0, 0, 640, 340, "ListIconGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ListIconGadget(0,  10,  10, 300, 280, "Column 0", 120,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
;TreeGadget(0,10,10,300,280,#PB_Tree_AlwaysShowSelection)
    SetGadgetFont(0,FontID(0))
      For x = 1 To 6     
        AddGadgetColumn(0, x, "Column " + Str(x), 120)
      Next
      For x = 0 To 5
        AddGadgetItem(0, -1, "Row : "+Str(x)+Chr(10)+"Item 1"+Chr(10)+"Item 2"+Chr(10)+"Item 3"+Chr(10)+"Item 4"+Chr(10)+"Item 5")
        ;AddGadgetItem(0, -1, "Row : "+Str(x))
      Next
 
  ListIconGadget(1,  330,  10, 300, 280, "Column 0", 120,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
      For x = 1 To 6     
        AddGadgetColumn(1, x, "Column " + Str(x), 120)
      Next
      For x = 0 To 20
          AddGadgetItem(1, -1, "Row : "+Str(x)+Chr(10)+"Item 1"+Chr(10)+"Item 2"+Chr(10)+"Item 3"+Chr(10)+"Item 4"+Chr(10)+"Item 5")
        Next
        SetGadgetItemColor(0,3,#PB_Gadget_BackColor,#Red,#PB_All)
        oldcolor=#PB_Default
        olditem=-1
        
Repeat
  Select WaitWindowEvent() 
        Case #PB_Event_CloseWindow
              Quit = 1
             
        Case #WM_MOUSEMOVE
          If IsMouseOver(GadgetID(0))           
            item = SendMessage_(GadgetID(0),#LVM_GETHOTITEM ,0,0)
            If olditem>-1
                SetGadgetItemColor(0,olditem,#PB_Gadget_BackColor,oldcolor,#PB_All)
              EndIf
            If item >= 0                
              ;SetGadgetItemColor(0,olditem,#PB_Gadget_BackColor,oldcolor)
              oldcolor=GetGadgetItemColor(0,item,#PB_Gadget_BackColor,#PB_All)
              SetGadgetItemColor(0,item,#PB_Gadget_BackColor,$00FF00)
              olditem = item
            ;Else
            ;If item>-1
              ;SetGadgetItemColor(0,item,#PB_Gadget_BackColor,-1)
            EndIf
          EndIf
      EndSelect
    Until Quit = 1
    
    
Thank you for these example, which could be useful to me possibly. :D
Post Reply