PureBasic Forums - English

Posted: **Mon Jul 15, 2019 9:50 am**

Hi
- Very flexible
- All data types are supported
Have fun


#ItemCount = 350000

#LVSICF_NOINVALIDATEALL = 1
#LVN_ODCACHEHINT = #LVN_FIRST - 13

Structure Licon
 index.i
 item1.s
 item2.f
 item3.s
EndStructure

Global Dim myItems.licon(#ItemCount),sort
sort = 1

For i = 0 To #ItemCount
  myItems(i)\index = i
  myItems(i)\item1 = "PureBasic " + Str(i)
  myItems(i)\item2 = Random(#ItemCount)/14
  myItems(i)\item3 = "TEST3 " + Str(i)
Next

Procedure SetHeaderImage(Gadget, Column, TextAlign, Arrow)
  Header = SendMessage_(GadgetID(Gadget), #LVM_GETHEADER, 0, 0)
  Columntxt.s = GetGadgetItemText(Gadget,-1,Column)
  Hdr.HDITEM\mask = #HDI_BITMAP | #HDI_FORMAT | #HDI_TEXT
  Hdr\fmt = #HDF_BITMAP | TextAlign | #HDF_STRING | Arrow
  Hdr\hbm = 0
  Hdr\pszText = @Columntxt
  Hdr\cchTextMax = #MAX_PATH
  SendMessage_(Header, #HDM_SETITEM, Column, @Hdr)
EndProcedure

Procedure winCB(hWnd, uMsg, wParam, lParam)
 result = #PB_ProcessPureBasicEvents
 Select uMsg
    Case #WM_NOTIFY
      *pnmh.NMHDR = lParam
      Select *pnmh\code
        Case #LVN_ODCACHEHINT
          result = 0
         
        Case #LVN_ODFINDITEM
          result = -1
         
        Case #LVN_GETDISPINFO                ;
          *pnmlvdi.NMLVDISPINFO = lParam
          If *pnmlvdi\item\mask & #LVIF_TEXT
            If *pnmlvdi\item\iSubItem = 0
              PokeS(*pnmlvdi\item\pszText ,Str(PeekL(@myItems(*pnmlvdi\item\iItem)\index)))
            ElseIf *pnmlvdi\item\iSubItem = 1
              PokeS(*pnmlvdi\item\pszText , PeekS(@myItems(*pnmlvdi\item\iItem)\item1),-1,#PB_Unicode)
            ElseIf *pnmlvdi\item\iSubItem = 2
              PokeS(*pnmlvdi\item\pszText ,StrF(PeekF(@myItems(*pnmlvdi\item\iItem)\item2)))
            ElseIf *pnmlvdi\item\iSubItem = 3
              PokeS(*pnmlvdi\item\pszText , PeekS(@myItems(*pnmlvdi\item\iItem)\item3),-1,#PB_Unicode)
            EndIf
          EndIf
         
        Case #LVN_COLUMNCLICK
          *nmlv.NM_LISTVIEW = lParam
          col = *nmlv\iSubItem
          If col = 0
            SortStructuredArray(myItems(),sort, OffsetOf(Licon\index), TypeOf(Licon\index))
          ElseIf col = 1
            SortStructuredArray(myItems(),sort, OffsetOf(Licon\item1), TypeOf(Licon\item1))
          ElseIf col = 2
            SortStructuredArray(myItems(),sort, OffsetOf(Licon\item2), TypeOf(Licon\item2))
          ElseIf col = 3
            SortStructuredArray(myItems(),sort, OffsetOf(Licon\item3), TypeOf(Licon\item3))
          EndIf
         
          InvalidateRect_(WindowID(0),0,1)
          sort ! 1
          For index = 0 To 3
            SetHeaderImage(0, index, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_STRING)
          Next
          If sort = 0
            SetHeaderImage(0, col, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_SORTUP)
          Else
            SetHeaderImage(0, col, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_SORTDOWN)
          EndIf
              ;
      EndSelect
   
    Case #WM_SIZE
      MoveWindow_(GadgetID(0),10,10,WindowWidth(0)-20,WindowHeight(0)-20,1)
       
 EndSelect
 ProcedureReturn result
EndProcedure

LoadFont(0,"Tahoma",12)
;
If OpenWindow(0, 0, 0, 600, 410, "Virtual ListIconGadget", #PB_Window_SystemMenu | #PB_Window_Invisible | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)

  Licon = ListIconGadget(0,10,10,580,390,"Name",100,#LVS_OWNERDATA| #PB_ListIcon_GridLines)
  SetGadgetFont(0,FontID(0))
  SetGadgetColor(0,#PB_Gadget_BackColor,$DEFEFE)
  AddGadgetColumn(0,1,"PureBasic",150)
  AddGadgetColumn(0,2,"TEST2",150)
  AddGadgetColumn(0,3,"TEST3",150)

  SetWindowCallback(@winCB())
  HideWindow(0,0)  
  SendMessage_(Licon, #LVM_SETITEMCOUNT, #ItemCount, #LVSICF_NOINVALIDATEALL)
  Repeat
      Select WaitWindowEvent()
        Case  #PB_Event_CloseWindow
          Quit = 1
         

      EndSelect
  Until Quit = 1
EndIf

Edit : Fixed Bug according to RSBasic catch (PureBasic x64)
Edit 2 : Speed optimization

Posted: **Mon Jul 15, 2019 11:02 am**

When I click on the column "PureBasic":

PureBasic wrote:[12:00:00] [ERROR] Line: 74
[12:00:00] [ERROR] Invalid memory access. (Read error at address 18446744073709551615)

Windows 10, PureBasic 5.70 LTS (x64)

Posted: **Mon Jul 15, 2019 11:50 am**

Hi RSBasic

Previous post updated
Thanks for the catch

Posted: **Mon Jul 15, 2019 11:52 am**

It's working now. Thank you

Posted: **Wed Jul 17, 2019 6:29 am**

ps. perfect example of why we need more generic 'lookup' commands:

*nmlv.NM_LISTVIEW = lParam
col = *nmlv\iSubItem
If col = 0
SortStructuredArray(myItems(),sort, OffsetOf(Licon\index), TypeOf(Licon\index))
ElseIf col = 1
SortStructuredArray(myItems(),sort, OffsetOf(Licon\item1), TypeOf(Licon\item1))
ElseIf col = 2
SortStructuredArray(myItems(),sort, OffsetOf(Licon\item2), TypeOf(Licon\item2))
ElseIf col = 3
SortStructuredArray(myItems(),sort, OffsetOf(Licon\item3), TypeOf(Licon\item3))
EndIf

That could be easily replaced with one line IF the language supported generic programming: SortStructuredArray(myItems(),sort, OffsetOfColumn(Licon, col), TypeOfColumn(Licon, col))

Posted: **Wed Jul 17, 2019 9:10 am**

Would something like this work? It's shorter but I have no use case for it to test it:

Code: Select all

Select col
  Case 0  : itemno.i = index
  Case 1  : itemno.i = (Whatever item1 equals)
  Case 2  : itemno.i = (Whatever item2 equals)
  Case 3  : itemno.i = (Whatever item3 equals)
EndSelect

SortStructuredArray(myItems(),sort, OffsetOf(Licon\itemno.i), TypeOf(Licon\itemno.i))

Posted: **Wed Jul 17, 2019 4:13 pm**

Hi Fang
It will not work because there are different types (integer ,float ...) in the same structure which is the purpose of this snippet
A little bit modified one

Code: Select all

#ItemCount = 350000

#LVSICF_NOINVALIDATEALL = 1
#LVN_ODCACHEHINT = #LVN_FIRST - 13

Structure Licon Align 1 ;#PB_Structure_AlignC
 index.i
 item1.s
 item2.f
 item3.s
EndStructure

Global Dim myItems.licon(#ItemCount) ,Dim ssort(3,1),sort
sort = 1

ssort(0,0) = OffsetOf(Licon\index)
ssort(0,1) = TypeOf(Licon\index)
ssort(1,0) = OffsetOf(Licon\item1)
ssort(1,1) = TypeOf(Licon\item1)
ssort(2,0) = OffsetOf(Licon\item2)
ssort(2,1) = TypeOf(Licon\item2)
ssort(3,0) = OffsetOf(Licon\item3)
ssort(3,1) = TypeOf(Licon\item3)

For i = 0 To #ItemCount
  myItems(i)\index = i
  myItems(i)\item1 = "PureBasic " + Str(i)
  myItems(i)\item2 = Random(#ItemCount)/14
  myItems(i)\item3 = "TEST3 " + Str(i)
Next

Procedure SetHeaderImage(Gadget, Column, TextAlign, Arrow)
  Header = SendMessage_(GadgetID(Gadget), #LVM_GETHEADER, 0, 0)
  Columntxt.s = GetGadgetItemText(Gadget,-1,Column)
  Hdr.HDITEM\mask = #HDI_BITMAP | #HDI_FORMAT | #HDI_TEXT
  Hdr\fmt = #HDF_BITMAP | TextAlign | #HDF_STRING | Arrow
  Hdr\hbm = 0
  Hdr\pszText = @Columntxt
  Hdr\cchTextMax = #MAX_PATH
  SendMessage_(Header, #HDM_SETITEM, Column, @Hdr)
EndProcedure

Procedure winCB(hWnd, uMsg, wParam, lParam)
 result = #PB_ProcessPureBasicEvents
 Select uMsg
    Case #WM_NOTIFY
      *pnmh.NMHDR = lParam
      Select *pnmh\code
        Case #LVN_ODCACHEHINT
          result = 0
         
        Case #LVN_ODFINDITEM
          result = -1
         
        Case #LVN_GETDISPINFO                ;
          *pnmlvdi.NMLVDISPINFO = lParam
          If *pnmlvdi\item\mask & #LVIF_TEXT
            If *pnmlvdi\item\iSubItem = 0
              PokeS(*pnmlvdi\item\pszText ,Str(PeekL(@myItems(*pnmlvdi\item\iItem)\index)))
            ElseIf *pnmlvdi\item\iSubItem = 1
              PokeS(*pnmlvdi\item\pszText , PeekS(@myItems(*pnmlvdi\item\iItem)\item1),-1,#PB_Unicode)
            ElseIf *pnmlvdi\item\iSubItem = 2
              PokeS(*pnmlvdi\item\pszText ,StrF(PeekF(@myItems(*pnmlvdi\item\iItem)\item2)))
            ElseIf *pnmlvdi\item\iSubItem = 3
              PokeS(*pnmlvdi\item\pszText , PeekS(@myItems(*pnmlvdi\item\iItem)\item3),-1,#PB_Unicode)
            EndIf
          EndIf
         
        Case #LVN_COLUMNCLICK
          *nmlv.NM_LISTVIEW = lParam
          col = *nmlv\iSubItem
          
          SortStructuredArray(myItems(),sort, ssort(col,0), ssort(col,1))
          RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE | #RDW_UPDATENOW|#RDW_ERASE)
          
          sort ! 1
          For index = 0 To 3
            SetHeaderImage(0, index, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_STRING)
          Next
          If sort = 0
            SetHeaderImage(0, col, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_SORTUP)
          Else
            SetHeaderImage(0, col, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_SORTDOWN)
          EndIf
              ;
      EndSelect
   
    Case #WM_SIZE
      MoveWindow_(GadgetID(0),10,10,WindowWidth(0)-20,WindowHeight(0)-20,1)
       
 EndSelect
 ProcedureReturn result
EndProcedure

LoadFont(0,"Tahoma",12)
;
If OpenWindow(0, 0, 0, 600, 410, "Virtual ListIconGadget", #PB_Window_SystemMenu | #PB_Window_Invisible | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
  ;SetWindowColor(0,0)
  Licon = ListIconGadget(0,10,10,580,390,"Name",100,#LVS_OWNERDATA| #PB_ListIcon_GridLines)
  SetGadgetFont(0,FontID(0))
  SetGadgetColor(0,#PB_Gadget_BackColor,$DEFEFE) 
  AddGadgetColumn(0,1,"PureBasic",150)
  AddGadgetColumn(0,2,"TEST2",150)
  AddGadgetColumn(0,3,"TEST3",150)

  SetWindowCallback(@winCB())
  ;While WindowEvent(): Wend
  HideWindow(0,0)
 SendMessage_(Licon, #LVM_SETITEMCOUNT, #ItemCount, #LVSICF_NOINVALIDATEALL)
  Repeat
      Select WaitWindowEvent()
        Case  #PB_Event_CloseWindow
          Quit = 1        

      EndSelect
  Until Quit = 1
EndIf

Edit : Speed optimization

Posted: **Thu Jul 18, 2019 1:47 am**

Ah, thanks RASHAD. I was tinkering around trying to make it shorter. This freezing cold is making it hard to focus.

Posted: **Thu Jul 18, 2019 9:35 am**

With my windows XP 32, text headers disappear except the header with the arrow, so i need to change

Code: Select all

Hdr\fmt = #HDF_BITMAP | TextAlign | #HDF_STRING | Arrow

into

Code: Select all

If Arrow=#HDF_STRING
	    Hdr\fmt = TextAlign | #HDF_STRING; | Arrow  
	  Else 
	    Hdr\fmt = #HDF_BITMAP | TextAlign | #HDF_STRING | Arrow 
	  EndIf

to keep all the text headers visible.

M.

Posted: **Thu Jul 18, 2019 10:31 pm**

Previous posts updated for speed optimization

Posted: **Sat Jul 20, 2019 5:16 pm**

Waouuh !!! works perfectly and quickly

Thanks a lot master RASHAD

I love virtual listIcon, since the first time that i saw them thanks to you

The only one problem, it's they are several code for try to replace the native ListIcon of PB, but i have not see something with a virtual ListIcon, so too much slow for manage thousands lines quickly

The top, is have a VirtualListicon easyly modifiable, by double click like EXCEL
Like that, we has the fast management and furious change

I have try without succes there are a long time, by mixing great codes, and even try to ask to the great maestro if it's possible to modify his code, without answer, so i have abandoned

viewtopic.php?p=495729#p495729

Posted: **Sat Jul 20, 2019 8:46 pm**

Hi KCC
Next is a Virtual ListIcon using List() to make it easy to add ,remove ,edit and so on
- Rbutton for PopUp Menu
- Left Dblclick to edit cell
- Enter to accept edit
- Esc to cancel edit
Remember you are dealing with the List()
The Virtual Listicon() just to view the data
You can use any Database or CSV file or any other method to populate the List() and save the data again
Have fun

Code: Select all

#ItemCount = 350000

#LVSICF_NOINVALIDATEALL = 1
#LVSICF_NOSCROLL = 2 
#LVN_ODCACHEHINT = #LVN_FIRST - 13

#HDF_IMAGE = $800
#HDI_IMAGE = $20

Structure Licon Align 4 ;#PB_Structure_AlignC
 index.i
 item1.s
 item2.f
 item3.s
EndStructure

Global NewList myItems.licon() ,Dim ssort(3,1),sort
Global oldproc, header_h , hi.HDITEM, Header 

sort = 1

ssort(0,0) = OffsetOf(Licon\index)
ssort(0,1) = TypeOf(Licon\index)
ssort(1,0) = OffsetOf(Licon\item1)
ssort(1,1) = TypeOf(Licon\item1)
ssort(2,0) = OffsetOf(Licon\item2)
ssort(2,1) = TypeOf(Licon\item2)
ssort(3,0) = OffsetOf(Licon\item3)
ssort(3,1) = TypeOf(Licon\item3)

For i = 0 To #ItemCount
  AddElement(myItems())
  myItems()\index = i
  myItems()\item1 = "PureBasic " + Str(i)
  myItems()\item2 = Random(#ItemCount)/14
  myItems()\item3 = "TEST3 " + Str(i)
Next

Procedure SetHeaderImage(Gadget, Column, TextAlign, Arrow)
  Header = SendMessage_(GadgetID(Gadget), #LVM_GETHEADER, 0, 0)
  Columntxt.s = GetGadgetItemText(Gadget,-1,Column)
  Hdr.HDITEM\mask = #HDI_BITMAP | #HDI_FORMAT | #HDI_TEXT
  Hdr\fmt = #HDF_BITMAP | TextAlign | #HDF_STRING | Arrow
  Hdr\hbm = 0
  Hdr\pszText = @Columntxt
  Hdr\cchTextMax = #MAX_PATH
  SendMessage_(Header, #HDM_SETITEM, Column, @Hdr)
EndProcedure

Procedure Hheight(hWnd, uMsg, wParam, lParam)
  result = CallWindowProc_(oldproc, hWnd, uMsg, wParam, lParam)
  Select uMsg
    Case #HDM_LAYOUT
      *hdlayout.HD_LAYOUT = lParam
      If *hdlayout\prc <> 0
          *rect.RECT = *hdlayout\prc
          *rect\top = header_h
      EndIf
      If *hdlayout\pwpos <> 0
          *windowpos.WINDOWPOS = *hdlayout\pwpos
          *windowpos\cy = header_h
      EndIf
           
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure winCB(hWnd, uMsg, wParam, lParam)
 result = #PB_ProcessPureBasicEvents
 Select uMsg
    Case #WM_NOTIFY
      *pnmh.NMHDR = lParam
      Select *pnmh\code
        Case #LVN_ODCACHEHINT
          result = 0
         
        Case #LVN_ODFINDITEM
          result = -1
         
        Case #LVN_GETDISPINFO                ;
          *pnmlvdi.NMLVDISPINFO = lParam
          If *pnmlvdi\item\mask & #LVIF_TEXT
            SelectElement(myItems(), *pnmlvdi\item\iItem)
            If *pnmlvdi\item\iSubItem = 0
              PokeS(*pnmlvdi\item\pszText ,Str(PeekI(@myItems()\index)))
            ElseIf *pnmlvdi\item\iSubItem = 1
              PokeS(*pnmlvdi\item\pszText , PeekS(@myItems()\item1),-1,#PB_Unicode)
            ElseIf *pnmlvdi\item\iSubItem = 2
              PokeS(*pnmlvdi\item\pszText ,StrF(PeekF(@myItems()\item2)))
            ElseIf *pnmlvdi\item\iSubItem = 3
              PokeS(*pnmlvdi\item\pszText , PeekS(@myItems()\item3),-1,#PB_Unicode)
            EndIf
          EndIf
         
        Case #LVN_COLUMNCLICK
          *nmlv.NM_LISTVIEW = lParam
          col = *nmlv\iSubItem
          SetGadgetState(0,-1)
          SortStructuredList(myItems(),sort, ssort(col,0), ssort(col,1))
          RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE| #RDW_UPDATENOW|#RDW_ERASE)
          
          sort ! 1
          For index = 0 To 3
            SetHeaderImage(0, index, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_STRING)
          Next
          If sort = 0
            SetHeaderImage(0, col, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_SORTUP)
          Else
            SetHeaderImage(0, col, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_SORTDOWN)
          EndIf
              ;
      EndSelect
   
    Case #WM_SIZE
      MoveWindow_(GadgetID(0),10,10,WindowWidth(0)-20,WindowHeight(0)-20,1)
       
 EndSelect
 ProcedureReturn result
EndProcedure

LoadFont(0,"Tahoma",12)
;
If OpenWindow(0, 0, 0, 600, 410, "Virtual ListIconGadget", #PB_Window_SystemMenu |  #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
  ;SetWindowColor(0,0)
  If CreatePopupImageMenu(0, #PB_Menu_ModernLook)
    MenuItem(1, "Add before")
    MenuItem(2, "Add after")
    MenuItem(3, "Delete")
;     MenuItem(4, "Move up")
;     MenuItem(5, "Move down")
    MenuItem(6, "Quit")
  EndIf

  SetWindowCallback(@winCB())
  ListIconGadget(0,10,10,580,390,"Name",100,#LVS_OWNERDATA| #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
  SetGadgetFont(0,FontID(0))
  SetGadgetColor(0,#PB_Gadget_BackColor,$DEFEFE)
  AddGadgetColumn(0,1,"PureBasic",150)
  AddGadgetColumn(0,2,"TEST2",150)
  AddGadgetColumn(0,3,"TEST3",150)
  
header_h = 35
Header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)
SendMessage_(header,#HDM_SETBITMAPMARGIN,-2,0)
SendMessage_(header,#WM_SETFONT,FontID(0),0)

oldproc = SetWindowLongPtr_(Header, #GWL_WNDPROC, @Hheight())
SendMessage_(GadgetID(0), #LVM_SETITEMCOUNT, #ItemCount, #LVSICF_NOINVALIDATEALL|#LVSICF_NOSCROLL)

StringGadget(100,0,0,0,0,"")
SetGadgetColor(100,#PB_Gadget_FrontColor,$0000FF)
SetGadgetColor(100,#PB_Gadget_BackColor,$FFFFFF)
SetGadgetFont(100,GetGadgetFont(0))
SetWindowLongPtr_( GadgetID(100), #GWL_HWNDPARENT,WindowID(0))

AddKeyboardShortcut(0,#PB_Shortcut_Return,10)
AddKeyboardShortcut(0,#PB_Shortcut_Escape,20)
lv.LVHITTESTINFO
r0.RECT
out = GetSystemMetrics_(#SM_CXSCREEN)
Repeat
  Select WaitWindowEvent()
    Case  #PB_Event_CloseWindow
      Quit = 1
      
    Case #WM_RBUTTONDOWN
      DisplayPopupMenu(0, WindowID(0))
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          Select EventType()
            Case #PB_EventType_LeftDoubleClick              
              GetCursorPos_(@p.POINT)
              ScreenToClient_(GadgetID(0), p)
              lv\pt\x = p\x : lv\pt\y = p\y  
              SendMessage_(GadgetID(0),#LVM_SUBITEMHITTEST,0,@lv)
              r0\top = lv\iSubItem 
              r0\left = #LVIR_BOUNDS 
              SendMessage_(GadgetID(0), #LVM_GETSUBITEMRECT, lv\iItem, @r0)
              text$ = GetGadgetItemText(0,lv\iItem,lv\iSubItem)
              If lv\iSubItem = 0
                ww = SendMessage_(GadgetID(0), #LVM_GETCOLUMNWIDTH, 0,0)
                ResizeGadget(100,r0\left+GadgetX(0)+2,r0\top+GadgetY(0)+2,ww,r0\bottom-r0\top)
              Else
                ResizeGadget(100,r0\left+GadgetX(0)+2,r0\top+GadgetY(0)+2,r0\right-r0\left,r0\bottom-r0\top)
              EndIf
              SetGadgetText(100,text$)
              SetActiveGadget(100)
              finish = 0                    
          EndSelect
          
        Case 100
          Select EventType()
            Case #PB_EventType_LostFocus
              If finish = 0
                SetGadgetItemText(0,lv\iItem,GetGadgetText(100),lv\iSubItem)
                ResizeGadget(100,-out,0,0,0)
                SetGadgetText(100,"")
              EndIf
          EndSelect            
      EndSelect 
          
    Case #PB_Event_Menu 
      Select EventMenu()
        Case 1
          SelectElement(myItems(), GetGadgetState(0)-1)
          AddElement(myItems())
          myItems()\index = 10
          myItems()\item1 = "PureBasic " + Str(10)
          myItems()\item2 = Random(#ItemCount)/14
          myItems()\item3 = "TEST3 " + Str(10)
          RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE| #RDW_UPDATENOW|#RDW_ERASE)
        Case 2
          
        Case 3
          SelectElement(myItems(), GetGadgetState(0))
          DeleteElement(myItems(),1)
          RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE| #RDW_UPDATENOW|#RDW_ERASE)
        Case 4
        Case 5
        Case 6
          End
        Case 7
        
        Case 10
          If GetActiveGadget() = 100
            SelectElement(myItems(), lv\iItem)
            edit$ = GetGadgetText(100)
            Select lv\iSubItem
              Case 0
                myItems()\index = ValD(edit$)
              Case 1
                myItems()\item1 = edit$
              Case 2
                myItems()\item2 = ValF(edit$)
              Case 3
                myItems()\item3 = edit$
            EndSelect
            RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE| #RDW_UPDATENOW|#RDW_ERASE)
            ResizeGadget(100,-out,0,0,0)
            SetGadgetText(100,"")
            finish = 1
          EndIf
          
        Case 20
          If GetActiveGadget() = 100
            ResizeGadget(100,-out,0,0,0)
            SetGadgetText(100,"")
            finish = 1
          EndIf
      EndSelect

  EndSelect
Until Quit = 1
EndIf

Posted: **Sun Jul 21, 2019 10:20 am**

Hi Rashad!

Nice work!

I would recommend to change code for menu.
If you insert a line before the first entry you
would get negativ entry number and throw an
error.

Code: Select all

        Case 1
          If GetGadgetState(0)
            SelectElement(myItems(), GetGadgetState(0)-1)
            AddElement(myItems())
            myItems()\index = 10
            myItems()\item1 = "PureBasic " + Str(10)
            myItems()\item2 = Random(#ItemCount)/14
            myItems()\item3 = "TEST3 " + Str(10)
          Else
            NewList TempList.licon(); not neccessary if an empty List is declared before
            AddElement(TempList())
            TempList()\index = 10
            TempList()\item1 = "PureBasic " + Str(10)
            TempList()\item2 = Random(#ItemCount)/14
            TempList()\item3 = "TEST3 " + Str(10)
            MergeLists(TempList(), myItems(), #PB_List_First )
            FreeList(TempList()); or ClearList() for further use
          EndIf
          RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE| #RDW_UPDATENOW|#RDW_ERASE)

Posted: **Sun Jul 21, 2019 6:46 pm**

Waaaooouhhh !!!!

Very nice !!!

I dance of joy

Works perfect, one thousand of thanks RASHAD

And i suppose, if i need enter image in the first column, i just need to replace ListView by ListIcon ?

Posted: **Mon Jul 22, 2019 3:54 am**

Hi Lord
Thanks mate

Hi KCC
New version with Images

Code: Select all

#ItemCount = 350000

#LVSICF_NOINVALIDATEALL = 1
#LVSICF_NOSCROLL = 2 
#LVN_ODCACHEHINT = #LVN_FIRST - 13

#HDF_IMAGE = $800
#HDI_IMAGE = $20

Structure Licon Align 4 ;#PB_Structure_AlignC
 imgID.i
 index.i
 item1.s
 item2.f
 item3.s
EndStructure

Global NewList myItems.licon() ,Dim ssort(4,1),sort
Global oldproc, header_h , hi.HDITEM, Header

sort = 1

ssort(1,0) = OffsetOf(Licon\index)
ssort(1,1) = TypeOf(Licon\index)
ssort(2,0) = OffsetOf(Licon\item1)
ssort(2,1) = TypeOf(Licon\item1)
ssort(3,0) = OffsetOf(Licon\item2)
ssort(3,1) = TypeOf(Licon\item2)
ssort(4,0) = OffsetOf(Licon\item3)
ssort(4,1) = TypeOf(Licon\item3)

Procedure SetHeaderImage(Gadget, Column, TextAlign, Arrow)
  Header = SendMessage_(GadgetID(Gadget), #LVM_GETHEADER, 0, 0)
  Columntxt.s = GetGadgetItemText(Gadget,-1,Column)
  Hdr.HDITEM\mask = #HDI_BITMAP | #HDI_FORMAT | #HDI_TEXT
  Hdr\fmt = #HDF_BITMAP | TextAlign | #HDF_STRING | Arrow
  Hdr\hbm = 0
  Hdr\pszText = @Columntxt
  Hdr\cchTextMax = #MAX_PATH
  SendMessage_(Header, #HDM_SETITEM, Column, @Hdr)
EndProcedure

Procedure Hheight(hWnd, uMsg, wParam, lParam)
  result = CallWindowProc_(oldproc, hWnd, uMsg, wParam, lParam)
  Select uMsg
    Case #HDM_LAYOUT
      *hdlayout.HD_LAYOUT = lParam
      If *hdlayout\prc <> 0
          *rect.RECT = *hdlayout\prc
          *rect\top = header_h
      EndIf
      If *hdlayout\pwpos <> 0
          *windowpos.WINDOWPOS = *hdlayout\pwpos
          *windowpos\cy = header_h
      EndIf
           
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure winCB(hWnd, uMsg, wParam, lParam)
 result = #PB_ProcessPureBasicEvents
 Select uMsg
    Case #WM_NOTIFY
      *pnmh.NMHDR = lParam
      Select *pnmh\code
        Case #LVN_ODCACHEHINT
          result = 0
         
        Case #LVN_ODFINDITEM
          result = -1
         
        Case #LVN_GETDISPINFO                ;
          *pnmlvdi.NMLVDISPINFO = lParam
          row = *pnmlvdi\item\iItem
          SelectElement(myItems(), row)
          If *pnmlvdi\item\mask & #LVIF_IMAGE And *pnmlvdi\item\iSubItem = 0
            *pnmlvdi\item\iImage = PeekI(@myItems()\imgID)
          EndIf
          If *pnmlvdi\item\mask & #LVIF_TEXT            
            Select *pnmlvdi\item\iSubItem
              Case 1
                PokeS(*pnmlvdi\item\pszText ,Str(PeekI(@myItems()\index)))
              Case 2
                PokeS(*pnmlvdi\item\pszText , PeekS(@myItems()\item1),-1, #PB_Unicode)
              Case 3
                PokeS(*pnmlvdi\item\pszText ,StrF(PeekF(@myItems()\item2)))
              Case 4
                PokeS(*pnmlvdi\item\pszText , PeekS(@myItems()\item3),-1, #PB_Unicode)
            EndSelect
          EndIf
         
        Case #LVN_COLUMNCLICK
          *nmlv.NM_LISTVIEW = lParam
          col = *nmlv\iSubItem
          If col > 0
            SetGadgetState(0,-1)
            SortStructuredList(myItems(),sort, ssort(col,0), ssort(col,1))
            RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW| #RDW_ERASE)
            
            sort ! 1
            For index = 1 To 4
              SetHeaderImage(0, index, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_STRING)
            Next
            If sort = 0
              SetHeaderImage(0, col, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_SORTUP)
            Else
              SetHeaderImage(0, col, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_SORTDOWN)
            EndIf
          EndIf
              ;
      EndSelect
   
    Case #WM_SIZE
      MoveWindow_(GadgetID(0),10,10,WindowWidth(0)-20,WindowHeight(0)-20,1)
       
 EndSelect
 ProcedureReturn result
EndProcedure

LoadFont(0,"Tahoma",12)
;
If OpenWindow(0, 0, 0, 700, 410, "Virtual ListIconGadget", #PB_Window_SystemMenu |  #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
  If CreatePopupImageMenu(0, #PB_Menu_ModernLook)
    MenuItem(1, "Add before")
    MenuItem(2, "Add after")
    MenuItem(3, "Delete")
;     MenuItem(4, "Move up")
;     MenuItem(5, "Move down")
    MenuItem(6, "Quit")
  EndIf

  SetWindowCallback(@winCB())
  ListIconGadget(0,10,10,680,390,"Image",60,#LVS_OWNERDATA| #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
  ;SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE , #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)
  SetGadgetFont(0,FontID(0))
  SetGadgetColor(0,#PB_Gadget_BackColor,$DEFEFE)
  AddGadgetColumn(0,1,"Index",80)
  AddGadgetColumn(0,2,"TEST2",150)
  AddGadgetColumn(0,3,"TEST3",150)
  AddGadgetColumn(0,4,"TEST4",150)
  
li = ImageList_Create_(32,32,#ILC_COLOR32| #ILC_MASK, 0, #ItemCount)
file$ = "Shell32.dll"
;num_icons = ExtractIconEx_(file$, -1, #Null, #Null, #Null)
Dim sicon(35)
;Dim licon(35)
For icon = 0 To 35
  ExtractIconEx_(file$, icon, 0, sicon(), 35)
  ImageList_AddIcon_(li,sicon(icon))
Next
SendMessage_(GadgetID(0), #LVM_SETIMAGELIST, #LVSIL_SMALL, li)
  
header_h = 35
Header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)
SendMessage_(header,#HDM_SETBITMAPMARGIN,-2,0)
SendMessage_(header,#WM_SETFONT,FontID(0),0)

oldproc = SetWindowLongPtr_(Header, #GWL_WNDPROC, @Hheight())
SendMessage_(GadgetID(0), #LVM_SETITEMCOUNT, #ItemCount, #LVSICF_NOINVALIDATEALL| #LVSICF_NOSCROLL)

For i = 0 To #ItemCount
  AddElement(myItems())
  myItems()\imgID = i
  myItems()\index = i
  myItems()\item1 = "PureBasic " + Str(i)
  myItems()\item2 = Random(#ItemCount)/14
  myItems()\item3 = "TEST3 " + Str(i)
Next

StringGadget(100,0,0,0,0,"")
SetGadgetColor(100,#PB_Gadget_FrontColor,$0000FF)
SetGadgetColor(100,#PB_Gadget_BackColor,$FFFFFF)
SetGadgetFont(100,GetGadgetFont(0))
SetWindowLongPtr_( GadgetID(100), #GWL_HWNDPARENT,WindowID(0))

AddKeyboardShortcut(0,#PB_Shortcut_Return,10)
AddKeyboardShortcut(0,#PB_Shortcut_Escape,20)
lv.LVHITTESTINFO
r0.RECT
out = GetSystemMetrics_(#SM_CXSCREEN)
Repeat
  Select WaitWindowEvent()
    Case  #PB_Event_CloseWindow
      Quit = 1
      
    Case #WM_RBUTTONDOWN
      DisplayPopupMenu(0, WindowID(0))
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          Select EventType()
            Case #PB_EventType_LeftDoubleClick              
              GetCursorPos_(@p.POINT)
              ScreenToClient_(GadgetID(0), p)
              lv\pt\x = p\x : lv\pt\y = p\y  
              SendMessage_(GadgetID(0),#LVM_SUBITEMHITTEST,0,@lv)
              r0\top = lv\iSubItem 
              r0\left = #LVIR_BOUNDS 
              SendMessage_(GadgetID(0), #LVM_GETSUBITEMRECT, lv\iItem, @r0)
              text$ = GetGadgetItemText(0,lv\iItem,lv\iSubItem)
              If lv\iSubItem = 0
                ww = SendMessage_(GadgetID(0), #LVM_GETCOLUMNWIDTH, 0,0)
                ResizeGadget(100,r0\left+GadgetX(0)+2,r0\top+GadgetY(0)+2,ww, r0\bottom-r0\top)
              Else
                ResizeGadget(100,r0\left+GadgetX(0)+2,r0\top+GadgetY(0)+2,r0\right-r0\left, r0\bottom-r0\top)
              EndIf
              SetGadgetText(100,text$)
              SetActiveGadget(100)
              finish = 0                    
          EndSelect
          
        Case 100
          Select EventType()
            Case #PB_EventType_LostFocus
              If finish = 0
                SetGadgetItemText(0,lv\iItem,GetGadgetText(100),lv\iSubItem)
                ResizeGadget(100,-out,0,0,0)
                SetGadgetText(100,"")
              EndIf
          EndSelect            
      EndSelect 
          
    Case #PB_Event_Menu 
      Select EventMenu()
        Case 1
          SelectElement(myItems(), GetGadgetState(0)-1)
          AddElement(myItems())
          myItems()\imgID = 0
          myItems()\index = 10
          myItems()\item1 = "PureBasic " + Str(10)
          myItems()\item2 = Random(#ItemCount)/14
          myItems()\item3 = "TEST3 " + Str(10)
          RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW| #RDW_ERASE)
        Case 2
          
        Case 3
          SelectElement(myItems(), GetGadgetState(0))
          DeleteElement(myItems(),1)
          RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW| #RDW_ERASE)
        Case 4
        Case 5
        Case 6
          End
        Case 7
        
        Case 10
          If GetActiveGadget() = 100
            SelectElement(myItems(), lv\iItem)
            edit$ = GetGadgetText(100)
            Select lv\iSubItem
              Case 1
                myItems()\index = ValD(edit$)
              Case 2
                myItems()\item1 = edit$
              Case 3
                myItems()\item2 = ValF(edit$)
              Case 4
                myItems()\item3 = edit$
            EndSelect
            RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW| #RDW_ERASE)
            ResizeGadget(100,-out,0,0,0)
            SetGadgetText(100,"")
            finish = 1
          EndIf
          
        Case 20
          If GetActiveGadget() = 100
            ResizeGadget(100,-out,0,0,0)
            SetGadgetText(100,"")
            finish = 1
          EndIf
      EndSelect

  EndSelect
Until Quit = 1
EndIf

PureBasic Forums - English

Sort Virtual ListIcon Gadget [Windows]

Sort Virtual ListIcon Gadget [Windows]

Re: Sort Virtual ListIcon Gadget [Windows]

Re: Sort Virtual ListIcon Gadget [Windows]

Re: Sort Virtual ListIcon Gadget [Windows]

Re: Sort Virtual ListIcon Gadget [Windows]

Re: Sort Virtual ListIcon Gadget [Windows]

Re: Sort Virtual ListIcon Gadget [Windows]

Re: Sort Virtual ListIcon Gadget [Windows]

Re: Sort Virtual ListIcon Gadget [Windows]

Re: Sort Virtual ListIcon Gadget [Windows]

Re: Sort Virtual ListIcon Gadget [Windows]

Re: Sort Virtual ListIcon Gadget [Windows]

Re: Sort Virtual ListIcon Gadget [Windows]

Re: Sort Virtual ListIcon Gadget [Windows]

Re: Sort Virtual ListIcon Gadget [Windows]