(New) Virtual ListIcon with Check Boxes & Images [Windows]

Share your advanced PureBasic knowledge/code with the community.
zikitrake
Addict
Addict
Posts: 834
Joined: Thu Mar 25, 2004 2:15 pm
Location: Spain

Re: (New) Virtual ListIcon with Check Boxes & Images [Windows]

Post by zikitrake »

zikitrake wrote: Tue May 18, 2021 11:21 am Dear, RASHAD.

Is it possible to work with two or more listicons?...
Hi, Zikitrake, I am a self-replier :) there is the solution

Code: Select all

#ItemCount = 350000

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

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

Global NewList myItems.licon()
Global NewList myItems2.licon()
Global header, header_h

Procedure winCBLicon(hWnd, uMsg, wParam, lParam)
  result = #PB_ProcessPureBasicEvents
  
  Protected oneItem.licon
  Protected row, col
  
  Select uMsg
    Case #WM_NOTIFY
      *pnmh.NMHEADER = lParam
      If *pnmh\hdr\hwndFrom = header Or *pnmh\hdr\hwndFrom = header2
        If *pnmh\iItem = 0
          ProcedureReturn 1
        EndIf
      EndIf
      Select *pnmh\hdr\code

        Case #NM_CLICK          
          *nmlv.NM_LISTVIEW = lParam
          col = *nmlv\iSubItem
          row = *nmlv\iItem
          
          If row >=0 And col >= 0
            Debug Str(row) + " | " + Str(col)
            If *nmlv\hdr\hwndFrom = GadgetID(0)
              Debug GetGadgetItemText(0, row, col)
            ElseIf *nmlv\hdr\hwndFrom = GadgetID(1)
              Debug GetGadgetItemText(1, row, col)
            EndIf
          EndIf          
        Case #LVN_GETDISPINFO                ;
          *pnmlvdi.NMLVDISPINFO = lParam
          row                   = *pnmlvdi\item\iItem
          
          If *pnmlvdi\hdr\hwndFrom = GadgetID(0)
            SelectElement(myItems(), row)
            oneItem = myItems()
          ElseIf *pnmlvdi\hdr\hwndFrom = GadgetID(1)
            SelectElement(myItems2(), row)
            oneItem = myItems2()
          EndIf    
          
          If *pnmlvdi\item\mask & #LVIF_IMAGE And *pnmlvdi\item\iSubItem = 2
            *pnmlvdi\item\mask & #LVIF_IMAGE | #LVIF_STATE | #LVIF_TEXT
            *pnmlvdi\item\iImage = PeekI(@oneItem\imgID)
          EndIf
          
          If *pnmlvdi\item\mask & #LVIF_TEXT
            
            Select *pnmlvdi\item\iSubItem
              Case 1
                PokeS(*pnmlvdi\item\pszText, Str(PeekI(@oneItem\index)))
              Case 3
                PokeS(*pnmlvdi\item\pszText, PeekS(@oneItem\item1), -1, #PB_Unicode)
              Case 4
                PokeS(*pnmlvdi\item\pszText, StrF(PeekF(@oneItem\item2)))
              Case 5
                PokeS(*pnmlvdi\item\pszText, PeekS(@oneItem\item3), -1, #PB_Unicode)
            EndSelect
          EndIf
          
      EndSelect
      
  EndSelect
  
  ProcedureReturn result
EndProcedure

;
If OpenWindow(0, 0, 0, 700, 810, "Virtual ListIconGadget", #PB_Window_SystemMenu |  #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
  
  ListIconGadget(0, 10, 10, 680, 390, "Index", 0, #LVS_OWNERDATA | #PB_ListIcon_CheckBoxes | #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect | #PB_ListIcon_CheckBoxes)
  AddGadgetColumn(0, 1, "Index", 100)
  AddGadgetColumn(0, 2, "Image", 80)
  AddGadgetColumn(0, 3, "TEST2", 150)
  AddGadgetColumn(0, 4, "TEST3", 150)
  AddGadgetColumn(0, 5, "TEST4", 150)
  ListIconGadget(1, 10, 400, 680, 390, "Index", 0, #LVS_OWNERDATA | #PB_ListIcon_CheckBoxes | #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect | #PB_ListIcon_CheckBoxes)
  AddGadgetColumn(1, 1, "IndexB", 100)
  AddGadgetColumn(1, 2, "ImageB", 80)
  AddGadgetColumn(1, 3, "TEST2B", 150)
  AddGadgetColumn(1, 4, "TEST3B", 150)
  AddGadgetColumn(1, 5, "TEST4B", 150)
  
  SetWindowCallback(@winCBLicon())
  
  SendMessage_(GadgetID(0), #LVM_SETITEMCOUNT, #ItemCount, #LVSICF_NOINVALIDATEALL | #LVSICF_NOSCROLL)
  SendMessage_(GadgetID(1), #LVM_SETITEMCOUNT, #ItemCount, #LVSICF_NOINVALIDATEALL | #LVSICF_NOSCROLL)
  
  For i = 0 To #ItemCount
    AddElement(myItems())
    myItems()\index = i
    myItems()\imgID = i
    myItems()\item1 = "PureBasic A" + Str(i)
    myItems()\item2 = Random(#ItemCount) / 14
    myItems()\item3 = "TEST A" + Str(i)
    AddElement(myItems2())
    myItems2()\index = i
    myItems2()\imgID = i
    myItems2()\item1 = "PureBasic B" + Str(i)
    myItems2()\item2 = Random(#ItemCount) / 14
    myItems2()\item3 = "TEST B" + Str(i)
  Next
    Repeat
    Select WaitWindowEvent()
      Case  #PB_Event_CloseWindow
        Quit = 1
    EndSelect
  Until Quit = 1
EndIf
techniker
New User
New User
Posts: 2
Joined: Mon Sep 17, 2018 11:14 am

Re: (New) Virtual ListIcon with Check Boxes & Images [Windows]

Post by techniker »

Thanks RASHAD for the code! :D

But I still have one question:
How can I activate the "Three-State-Mode" for the checkbox?
Mesa
Enthusiast
Enthusiast
Posts: 345
Joined: Fri Feb 24, 2012 10:19 am

Re: (New) Virtual ListIcon with Check Boxes & Images [Windows]

Post by Mesa »

Thank you.

I've a crash when i add an item before the first one.

So i've modified the code like that, it works but i don' know if it's the better way.

Code: Select all

...
Case #PB_Event_Menu
      Select EventMenu()
      	Case 1
      		If GetGadgetState(0)<=0
      			SelectElement(myItems(), 0)
      			InsertElement(myItems())
      		Else
      			SelectElement(myItems(), GetGadgetState(0)-1)	
      			AddElement(myItems())
      		EndIf	
      		
      		AddElement(state())
      		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)
      		
...
      		
M.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: (New) Virtual ListIcon with Check Boxes & Images [Windows]

Post by RASHAD »

Hi guys
- Fixed add and delete element even with element index 0
- Rearranged items index after add or delete
- Fixed the proper row to add or delete when multi items selected
Hope it's OK
It's 2 years old snippet after all :lol:

Code: Select all

Procedure ThemesEnabled()
  dll.DLLVERSIONINFO
  dll\cbsize=SizeOf(dll)
  lib=OpenLibrary(#PB_Any,"comctl32.dll")
  If lib
    CallFunction(lib,"DllGetVersion",@dll)
    DLLVersion = dll\dwMajorVersion
    CloseLibrary(lib)
  EndIf
  If DLLVersion = 6
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

If ThemesEnabled() = 0
  MessageRequester("Error","Please Enable Modern them first",#MB_OK|#MB_ICONERROR)
  End
EndIf

#ItemCount = 350000

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

#HDF_IMAGE = $800
#HDI_IMAGE = $20

Prototype.i p_PrintWindow(hWnd, hdc, flags)
OpenLibrary(1, "User32.dll")
Global PrintWindow.p_PrintWindow = GetFunction(1, "PrintWindow")
Global start,finish,selno

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

Global NewList myItems.licon() ,NewList state() ,Dim ssort(5,1)
Global sort ,ii.lv_item,oldproc,header, header_h,row,col,rowed,coled ,editflag ,out ,imgH , ttext$
Global cont1,start,finish
sort = 1

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

ii\mask     = #LVIF_IMAGE

Procedure setItemImg(Row,Col,Img)  
  ii\iItem    = Row
  ii\iSubItem = Col
  ii\iImage   = Img
  SendMessage_(GadgetID(0), #LVM_SETITEM, 0, @ii)
EndProcedure

Procedure SetHeaderImage(Gadget, Column, TextAlign, Arrow)
  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 PrintListIconGadget (Gadget)
  RowCount = SendMessage_(GadgetID(Gadget),#LVM_GETITEMCOUNT, 0, 0)
  ColumnCount = SendMessage_(Header, #HDM_GETITEMCOUNT, 0, 0)
  SendMessage_(GadgetID(gadget), #LVM_ENSUREVISIBLE, 0, #True)
  x = GadgetX(gadget)
  y = GadgetY(gadget)
  w = GadgetWidth(gadget)
  h = GadgetHeight(gadget)  
  SendMessage_(GadgetID(gadget), #LVM_GETITEMRECT, RowCount - 1,r.RECT)
  NoPages = RowCount/30
  SetGadgetState(gadget,-1)
  PrintRequester()  
  If StartPrinting("ListIcon")
    SendMessage_(GadgetID(gadget), #LVM_SCROLL, 0,start*1000)
    ResizeGadget(gadget,x,y,r\right+50,1025)
    CreateImage(1,r\right+50,1025, 24)         
    For sc = start To finish
      For col = 0 To ColumnCount
        SendMessage_(GadgetID(gadget), #LVM_SETCOLUMNWIDTH,col,#LVSCW_AUTOSIZE_USEHEADER & #LVSCW_AUTOSIZE)
      Next
      ShowScrollBar_(GadgetID(gadget),#SB_BOTH,0)
      hdc = StartDrawing(ImageOutput(1))
      If hdc
        If sc >= start And sc <= finish
          PrintWindow(GadgetID(gadget), hdc, 0)
        EndIf
        StopDrawing()
      EndIf            
      If StartDrawing(PrinterOutput())
        DrawImage(ImageID(1), 400, 400 ,ImageWidth(1)*6,ImageHeight(1)*6)
        If sc < finish
          NewPrinterPage()
        EndIf    
       StopDrawing()
      EndIf      
      InvalidateRect_(GadgetID(gadget),0,#True)
      SendMessage_(GadgetID(gadget), #LVM_SCROLL, 0,1000)
    Next
    StopPrinting()
  EndIf
  If IsImage(1)
    FreeImage(1)
  EndIf
  ResizeGadget(gadget,x,y,w,h)
  SendMessage_(GadgetID(gadget), #LVM_ENSUREVISIBLE, 0, #True)
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.NMHEADER = lParam
      If *pnmh\hdr\hwndFrom = header
        If *pnmh\iItem = 0
          ProcedureReturn 1            
        EndIf
      EndIf    
      Select *pnmh\hdr\code
        Case #HDN_ITEMCHANGED
          If editflag = 1
            r.RECT\top = coled
            r.RECT\left = #LVIR_BOUNDS
            SendMessage_(GadgetID(0), #LVM_GETSUBITEMRECT, rowed, r)
            If coled = 0
              r\left+trimx + 2
              r\right = r\left +  SendMessage_(GadgetID(0),#LVM_GETCOLUMNWIDTH,0,0)
            EndIf 
            MoveWindow_(GadgetID(100),r\left,r\top,r\right-r\left,r\bottom-r\top,1)
            SetFocus_(GadgetID(100))        
          EndIf
          
        Case #HDN_DIVIDERDBLCLICK
          ResizeGadget(100,-out,0,0,0)
          editflag = 0
 
        Case #LVN_ODCACHEHINT
          result = 0
         
        Case #LVN_ODFINDITEM
          result = -1
         
        Case #LVN_GETDISPINFO                ;
          *pnmlvdi.NMLVDISPINFO = lParam
          row = *pnmlvdi\item\iItem
          If SelectElement(myItems(), row) <> 0 
            If *pnmlvdi\item\mask & #LVIF_IMAGE And *pnmlvdi\item\iSubItem = 1
              If SelectElement(state(), PeekI(@myItems()\index)) <> 0
                *pnmlvdi\item\iImage = state()
              EndIf
            EndIf      
            If *pnmlvdi\item\mask & #LVIF_IMAGE And *pnmlvdi\item\iSubItem = 2
              *pnmlvdi\item\mask & #LVIF_IMAGE|#LVIF_STATE|#LVIF_TEXT
              *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 3
                  PokeS(*pnmlvdi\item\pszText , PeekS(@myItems()\item1),-1, #PB_Unicode)
                Case 4
                  PokeS(*pnmlvdi\item\pszText ,StrF(PeekF(@myItems()\item2)))
                Case 5
                  PokeS(*pnmlvdi\item\pszText , PeekS(@myItems()\item3),-1, #PB_Unicode)
              EndSelect
            EndIf
          EndIf
          
        Case #LVN_BEGINSCROLL
          editflag = 0
          If IsWindowVisible_(GadgetID(100))
            ShowWindow_(GadgetID(100),#SW_HIDE)
            UpdateWindow_(GadgetID(100))            
          EndIf 
         
        Case #LVN_COLUMNCLICK ;Click Header item
          HitInfo.LVHITTESTINFO
          SendMessage_(GadgetID(0), #LVM_HITTEST, 0, @HitInfo)
          *nmlv.NM_LISTVIEW = lParam
          col = *nmlv\iSubItem
          If IsWindowVisible_(GadgetID(100))
            ShowWindow_(GadgetID(100),#SW_HIDE	)
            RedrawWindow_(GadgetID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW | #RDW_ERASE)
            ;UpdateWindow_(GadgetID(100))            
          EndIf
          If col <> 2
            SortStructuredList(myItems(),sort, ssort(col,0), ssort(col,1))
            RedrawWindow_(GadgetID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW | #RDW_ERASE)            
            sort ! 1
            For index = 1 To 5
              SetHeaderImage(0, index, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, 0)
            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          
          
        Case #NM_DBLCLK  ;LV Cell Double Click
          HitInfo.LVHITTESTINFO          
          Hitinfo\pt\x = WindowMouseX(0)
          HitInfo\pt\y = WindowMouseY(0) - GadgetY(0)
          SendMessage_(GadgetID(0), #LVM_SUBITEMHITTEST, 0, @HitInfo)
          rowed = hitinfo\iItem
          coled = hitinfo\iSubItem
          r.RECT\top = coled
          r.RECT\left = #LVIR_BOUNDS
          SendMessage_(GadgetID(0), #LVM_GETSUBITEMRECT, rowed, r)
          If coled > 2
            ShowWindow_(GadgetID(100),#SW_SHOW)
            MoveWindow_(GadgetID(100),r\left,r\top,r\right-r\left,r\bottom-r\top,1)
            SetGadgetText(100,GetGadgetItemText(0,rowed,coled))
            SetFocus_(GadgetID(100))
            editflag = 1   
          Else
            If IsWindowVisible_(GadgetID(100))
              ShowWindow_(GadgetID(100),#SW_HIDE	)
              UpdateWindow_(GadgetID(100))            
            EndIf
          EndIf
        
        Case #NM_CLICK ;LV Row Click  
          HitInfo.LVHITTESTINFO; = lParam
          Hitinfo\pt\x = WindowMouseX(0)
          HitInfo\pt\y = WindowMouseY(0) - GadgetY(0)
          SendMessage_(GadgetID(0), #LVM_SUBITEMHITTEST, 0, @HitInfo)
          row = hitinfo\iItem
          col = hitinfo\iSubItem
          If IsWindowVisible_(GadgetID(100))
            ShowWindow_(GadgetID(100),#SW_HIDE	)
            UpdateWindow_(GadgetID(100))            
          EndIf 
          If SelectElement(myItems(), row)
            SelectElement(state(), row)
            st = state()
            If selno =10000000
              selno = 0
            EndIf
            If col = 1
              If st = 35
                state() = 36
                selno + 1
              ElseIf st = 36
                state() = 35
                selno - 1 
              EndIf
            Else
              state() = st
            EndIf
            SendMessage_(GadgetID(0), #LVM_REDRAWITEMS ,row,row)
          Else
            SetGadgetState(0,-1)
            MessageRequester("Info","The checked row is empty",#MB_OK)
          EndIf
      EndSelect
   
    Case #WM_SIZE
      If IsWindowVisible_(GadgetID(100))
        ShowWindow_(GadgetID(100),#SW_HIDE	)
        UpdateWindow_(GadgetID(100))            
      EndIf
      MoveWindow_(GadgetID(0),10,10,WindowWidth(0)-20,WindowHeight(0)-20,1)
      
    Case #WM_EXITSIZEMOVE
      If IsWindowVisible_(GadgetID(cont1))
        ResizeGadget(cont1,WindowWidth(0)/2-100,WindowHeight(0)/2-50,200,110)
      EndIf
       
 EndSelect
 ProcedureReturn result
EndProcedure

LoadFont(0,"Tahoma",12)
LoadFont(1,"consolas",16,#PB_Font_Bold )
;
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, "Get Full Text")
    MenuItem(3, "Delete")
    MenuItem(4, "Save")
    MenuItem(5, "Print")
    MenuItem(6, "Quit")
  EndIf

  SetWindowCallback(@winCB())
  ListIconGadget(0,10,10,680,390,"Index",0,#LVS_OWNERDATA| #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect |#PB_ListIcon_MultiSelect| #PB_ListIcon_CheckBoxes)
  GetClientRect_(GadgetID(0), @lr.RECT)
  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",100)
  AddGadgetColumn(0,2,"Image",80)
  AddGadgetColumn(0,3,"TEST2",150)
  AddGadgetColumn(0,4,"TEST3",150)
  AddGadgetColumn(0,5,"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

FreeArray(sicon())

stateli = SendMessage_(GadgetID(0),#LVM_GETIMAGELIST,#LVSIL_STATE,0)

CreateImage(0,32,32,32,#PB_Image_Transparent)
hdc = StartDrawing(ImageOutput(0))
  ImageList_Draw_(stateli,0,hdc,6,10,#ILD_NORMAL)
StopDrawing()

CreateImage(1,32,32,32,#PB_Image_Transparent)
hdc = StartDrawing(ImageOutput(1))
  ImageList_Draw_(stateli,1,hdc,6,10,#ILD_NORMAL)
StopDrawing()

ImageList_Add_(li,ImageID(0),0)
ImageList_Add_(li,ImageID(1),0)

FreeImage(0)
FreeImage(1)

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 - 50
  AddElement(state())
  state() = 35
  AddElement(myItems())
  myItems()\index = i  
  myItems()\imgID = i
  myItems()\item1 = "PureBasic " + Str(i)
  myItems()\item2 = Random(#ItemCount)/14
  myItems()\item3 = "TEST3 " + Str(i)
Next

StringGadget(100,0,0,0,0,"")
SetGadgetFont(100,FontID(1))
SetParent_(GadgetID(100),GadgetID(0))

  cont1 = ContainerGadget(#PB_Any,WindowWidth(0)/2-100,WindowHeight(0)/2-50,200,110,#PB_Container_Flat)
  SetGadgetColor(cont1,#PB_Gadget_BackColor,$DEFEFE)
    tx1 = TextGadget(#PB_Any,10,10,100,24,"From page :")
    SetGadgetColor(tx1,#PB_Gadget_BackColor,$DEFEFE)
    fromp = SpinGadget(#PB_Any,110,10,80,24,0,1000,#PB_Spin_Numeric)
    SetGadgetState(fromp,0)
    tx2 = TextGadget(#PB_Any,10,40,100,24,"To page :")
    SetGadgetColor(tx2,#PB_Gadget_BackColor,$DEFEFE)
    top = SpinGadget(#PB_Any,110,40,80,24,1,1000,#PB_Spin_Numeric)
    SetGadgetState(top,0)
    okb = ButtonGadget(#PB_Any,10,75,60,24,"Print")
    cancelb = ButtonGadget(#PB_Any,130,75,60,24,"Cancel")
  CloseGadgetList()
  HideGadget(cont1,1)
AddKeyboardShortcut(0,#PB_Shortcut_Return,10)
AddKeyboardShortcut(0,#PB_Shortcut_Escape,20)
AddKeyboardShortcut(0,#PB_Shortcut_Control|#PB_Shortcut_A,30)
out = GetSystemMetrics_(#SM_CXSCREEN)
hi.LVHITTESTINFO
Repeat
  Select WaitWindowEvent()
    
    Case  #PB_Event_CloseWindow
      If IsLibrary(1)
        CloseLibrary(1)
      EndIf
      Quit = 1
     
    Case #WM_RBUTTONDOWN      
      HitInfo.LVHITTESTINFO; = lParam
      Hitinfo\pt\x = WindowMouseX(0)
      HitInfo\pt\y = WindowMouseY(0) - GadgetY(0)
      SendMessage_(GadgetID(0), #LVM_SUBITEMHITTEST, 0, @HitInfo)
      row = hitinfo\iItem
      If SelectElement(myItems(), row)        
        SetGadgetState(0,row)  
        DisplayPopupMenu(0, WindowID(0))
      Else
        SetGadgetState(0,-1) 
        MessageRequester("Info","The checked row is empty",#MB_OK)
      EndIf     
         
    Case #PB_Event_Menu
      Select EventMenu()
        Case 1  ;Add       
          SelectElement(myItems(), row)
          InsertElement(state())
          state() = 35 
          InsertElement(myItems())
          myItems()\imgID = 0
          myItems()\index = ListSize(myItems())
          myItems()\item1 = "PureBasic " + Str(myItems())
          myItems()\item2 = Random(#ItemCount)/14
          myItems()\item3 = "TEST3 " + Str(myItems())
          ResetList(myItems())
          i = 0
          While NextElement(myItems())
            myItems()\index = i
            i+1
          Wend
          RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW| #RDW_ERASE)
        
        Case 2  ;Get full text
          ;Fullitem(0,10 , 2)
          ;Debug imgH
          ;Debug ttext$
         
        Case 3  ;Delete
          SelectElement(myItems(),row)
          SelectElement(state(), row)
          DeleteElement(myItems())          
          DeleteElement(state())
          ResetList(myItems())
          i = 0
          While NextElement(myItems())
            myItems()\index = i
            i+1
          Wend
          RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW| #RDW_ERASE)
        
        Case 4 ;Save
          OpenFile(0,GetTemporaryDirectory()+"test.txt")
          ResetList(myItems())
          While NextElement(myItems())
            WriteString(0,Str(myItems()\index)+";"+Str(myItems()\imgID)+";"+myItems()\item1+";"+StrF(myItems()\item2)+";"+myItems()\item3+#CRLF$)
          Wend
          CloseFile(0)
          
        Case 5  ;Print
          DisableGadget(0,1)
          HideGadget(cont1,0)
          ResizeGadget(cont1,WindowWidth(0)/2-100,WindowHeight(0)/2-50,200,110)
          
        Case 6  ;Quit
          If IsLibrary(1)
            CloseLibrary(1)
          EndIf
          End
          
        Case 7
       
        Case 10 ;Return to accept
          If GetActiveGadget() = 100
            SelectElement(myItems(), rowed)
            edit$ = GetGadgetText(100)
            Select coled
              Case 1
                myItems()\index = ValD(edit$)
              Case 3
                myItems()\item1 = edit$
              Case 4
                myItems()\item2 = ValF(edit$)
              Case 5
                myItems()\item3 = edit$
            EndSelect
            RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW| #RDW_ERASE)
            If IsWindowVisible_(GadgetID(100))
              ShowWindow_(GadgetID(100),#SW_HIDE	)
              UpdateWindow_(GadgetID(100))           
            EndIf
            SetGadgetText(100,"")
            editflag = 0
          EndIf
         
        Case 20 ;Esc to dismiss
          If GetActiveGadget() = 100
            If IsWindowVisible_(GadgetID(100))
              ShowWindow_(GadgetID(100),#SW_HIDE	)
              UpdateWindow_(GadgetID(100))           
            EndIf
            SetGadgetText(100,"")
            editflag = 0
          EndIf
          
        Case 30 ;Select all
          HitInfo.LVHITTESTINFO
          SendMessage_(GadgetID(0), #LVM_HITTEST, 0, @HitInfo)
          SetGadgetItemState(0, HitInfo\iItem, #PB_ListIcon_Checked|#PB_ListIcon_Selected)
          selno =10000000
          
      EndSelect
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case fromp  ;From Page
          start = GetGadgetState(fromp)
        
        Case top  ;To Page
          finish = GetGadgetState(top)
        
        Case okb  ;Print
          HideGadget(cont1,1)
          DisableGadget(0,0)          
          PrintListIconGadget(0)
          
        Case cancelb  ;Cancel printing
          HideGadget(cont1,1)
          DisableGadget(0,0)
      EndSelect
  EndSelect
Until Quit = 1
If IsLibrary(1)
  CloseLibrary(1)
EndIf
EndIf
Edit :
- Bug fixed
- Added save the data to a file
Last edited by RASHAD on Wed Jan 18, 2023 10:44 pm, edited 2 times in total.
Egypt my love
morosh
Enthusiast
Enthusiast
Posts: 293
Joined: Wed Aug 03, 2011 4:52 am
Location: Beirut, Lebanon

Re: (New) Virtual ListIcon with Check Boxes & Images [Windows]

Post by morosh »

Thanks Rashad for your wonderfull work:
But, scrolling to the end and clicking on a white line after 349950, causes error:
The list doesn't have a current element
PureBasic: Surprisingly simple, diabolically powerful
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: (New) Virtual ListIcon with Check Boxes & Images [Windows]

Post by RASHAD »

Hi morosh
Previous post updated
Added save the data to a file in the temp directory
Egypt my love
Post Reply