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

Share your advanced PureBasic knowledge/code with the community.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4663
Joined: Sun Apr 12, 2009 6:27 am

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

Post by RASHAD »

- Right click for Drop down Menu
- Edit any cell by Dblleftclick
- Sort by any column [except Images column]
- Print from page to page [A4 size portrait for now]
- Delete any item
- Add item
And more

Code: Select all

#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

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 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)
  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 PrintListIconGadget (Gadget)
  Header = SendMessage_(GadgetID(gadget),#LVM_GETHEADER,0,0)
  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
            LockWindowUpdate_(GadgetID(100)) 
            MoveWindow_(GadgetID(100),r\left,r\top,r\right-r\left,r\bottom-r\top,1)
            SetFocus_(GadgetID(100))
            LockWindowUpdate_(0)
            UpdateWindow_(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
          SelectElement(myItems(), row)       
          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_IMAGE And *pnmlvdi\item\iSubItem = 1
            SelectElement(state(), PeekI(@myItems()\index))
            *pnmlvdi\item\iImage = state()
          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
         
       Case #LVN_COLUMNCLICK ;Click Header item
          *nmlv.NM_LISTVIEW = lParam
          col = *nmlv\iSubItem
          If col <> 2
            SetGadgetState(0,-1)
            SortStructuredList(myItems(),sort, ssort(col,0), ssort(col,1))
            ;SortList(state(),sort, ssort(col,0), ssort(col,1))
            RedrawWindow_(WindowID(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
            LockWindowUpdate_(GadgetID(100))
            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
            LockWindowUpdate_(0)
            UpdateWindow_(GadgetID(100))    
          Else
            ResizeGadget(100,-out,0,0,0)
          EndIf
         
        Case #NM_CLICK ;LV Row Click
          HitInfo.LVHITTESTINFO
          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
          ResizeGadget(100,-out,0,0,0)         
          If col = 1 And Hitinfo\pt\x > GadgetX(0)+10 And Hitinfo\pt\x < GadgetX(0)+20
            SelectElement(state(), row)
            If state() = 35
              state() = 36
            ElseIf state() = 36
              state() = 35
            EndIf
          EndIf
          SetGadgetState(0,row)
          editflag = 0
      EndSelect
   
    Case #WM_SIZE
      ResizeGadget(100,-out,0,0,0)
      MoveWindow_(GadgetID(0),10,10,WindowWidth(0)-20,WindowHeight(0)-20,1)
       
 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, "Print")
    ;MenuItem(5, "Print")
    MenuItem(6, "Quit")
  EndIf

  SetWindowCallback(@winCB())
  ListIconGadget(0,10,10,680,390,"Index",0,#LVS_OWNERDATA| #PB_ListIcon_CheckBoxes | #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect | #PB_ListIcon_CheckBoxes)
  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
  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)
out = GetSystemMetrics_(#SM_CXSCREEN)
Repeat
  Select WaitWindowEvent()
    
    Case  #PB_Event_CloseWindow
      Quit = 1
     
    Case #WM_RBUTTONDOWN
      DisplayPopupMenu(0, WindowID(0))     
         
    Case #PB_Event_Menu
      Select EventMenu()
        Case 1
          SelectElement(myItems(), GetGadgetState(0)-1)
          AddElement(state())
          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
          ;Fullitem(0,10 , 2)
          ;Debug imgH
          ;Debug ttext$
         
        Case 3
          draw = GetGadgetState(0)
          SelectElement(myItems(),draw)
          SelectElement(state(), draw)
          DeleteElement(myItems())          
          DeleteElement(state())
          RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW| #RDW_ERASE)
          
        Case 4
          DisableGadget(0,1)
          HideGadget(cont1,0)
          ResizeGadget(cont1,WindowWidth(0)/2-100,WindowHeight(0)/2-50,200,110)
        
        Case 5
          
        Case 6
          End
        Case 7
       
        Case 10
          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)
            ResizeGadget(100,-out,0,0,0)
            SetGadgetText(100,"")
            editflag = 0
          EndIf
         
        Case 20
          If GetActiveGadget() = 100
            ResizeGadget(100,-out,0,0,0)
            SetGadgetText(100,"")
            editflag = 0
          EndIf
      EndSelect
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case fromp
          start = GetGadgetState(fromp)
        
        Case top
          finish = GetGadgetState(top)
        
        Case okb
          HideGadget(cont1,1)
          DisableGadget(0,0)          
          PrintListIconGadget(0)
          
        Case cancelb
          HideGadget(cont1,1)
          DisableGadget(0,0)
      EndSelect
  EndSelect
Until Quit = 1
EndIf
Edit : Bug fixed
Last edited by RASHAD on Wed Dec 16, 2020 7:52 am, edited 3 times in total.
Egypt my love
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5353
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

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

Post by Kwai chang caine »

Hello MASTER of my heart :D

Waooouuh !!! the new EXCEL is born :wink:

1/ I have testing a little bit your code and see when i click on header column the title disappear :shock:
2/ Is it hard to can move the column ?

Other, numerous thanks for sharing this splendid code 8)
ImageThe happiness is a road...
Not a destination
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4663
Joined: Sun Apr 12, 2009 6:27 am

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

Post by RASHAD »

Hi Kwai
Tested OK with PB 5.73 x86 - Windows 10 x64
What is your configuration ?
Egypt my love
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5353
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

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

Post by Kwai chang caine »

Incredible !!! the same configuration than my MASTER :shock:

I don't understand....for try your code i have clicked everywhere, enter whatever in case, and i can't reproduce what i have do :shock: or dreamed :oops:

So excuse me, for the bad alert :oops:

Image

Apparently ...this history proof another time, that the configuration is not enough, and the same thing ... than knowledge :mrgreen: :oops:

Again numerous thanks for sharing this jewel code 8)
ImageThe happiness is a road...
Not a destination
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5353
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

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

Post by Kwai chang caine »

It's worst that i thinking ...ghost is in the place :shock:

Image

I run your code another time, and the header disappears a new time...i'm affraid :shock:

Image

You too, you not believe me.... :|
This is the proof with W10 X64/v5.73(LTS) X86 !!

Image
ImageThe happiness is a road...
Not a destination
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4663
Joined: Sun Apr 12, 2009 6:27 am

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

Post by RASHAD »

Hi KCC
Previous post updated
Check now
Egypt my love
BarryG
Addict
Addict
Posts: 3324
Joined: Thu Apr 18, 2019 8:17 am

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

Post by BarryG »

Hi Rashad, just trying this now and it's great so far! Two requests (sorry):

(1) I tried adding #PB_ListIcon_MultiSelect but it doesn't work; the selections get cleared to one.
(2) It doesn't currently support Ctrl+A keyboard shortcut to select all items (related to number 1).

Are you able to make these two additions, please? Thank you.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4663
Joined: Sun Apr 12, 2009 6:27 am

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

Post by RASHAD »

@KCC
Enable modern theme please :lol:
I forgot that you make such problem to me always

@BarryG
Next as per your requests
But please do not ask me to do any staff with 350000 items :)

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
          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)
      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, "Print")
    ;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)
  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
  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)
Repeat
  Select WaitWindowEvent()
    
    Case  #PB_Event_CloseWindow
      If IsLibrary(1)
        CloseLibrary(1)
      EndIf
      Quit = 1
     
    Case #WM_RBUTTONDOWN
      If selno > 1        
        MessageRequester("Error","More than one item selected not suppoted",#MB_OK|#MB_ICONERROR)
      Else
        DisplayPopupMenu(0, WindowID(0)) 
      EndIf     
         
    Case #PB_Event_Menu
      Select EventMenu()
        Case 1  ;Add
          If SelectElement(myItems(), GetGadgetState(0)-1) <> 0
            AddElement(state())
            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)
          EndIf
        
        Case 2  ;Get full text
          ;Fullitem(0,10 , 2)
          ;Debug imgH
          ;Debug ttext$
         
        Case 3  ;Delete        
          draw = GetGadgetState(0)
          SetGadgetState(0,-1)
          SelectElement(myItems(),draw)
          SelectElement(state(), draw)
          DeleteElement(myItems())          
          DeleteElement(state())
          RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW| #RDW_ERASE)
          
        Case 4  ;Print
          DisableGadget(0,1)
          HideGadget(cont1,0)
          ResizeGadget(cont1,WindowWidth(0)/2-100,WindowHeight(0)/2-50,200,110)
        
        Case 5
          
        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 : Updated
Edit2 :Update 2
Edit3 :Update 3
Edit4
Edit5
Last edited by RASHAD on Tue Dec 15, 2020 6:58 pm, edited 10 times in total.
Egypt my love
BarryG
Addict
Addict
Posts: 3324
Joined: Thu Apr 18, 2019 8:17 am

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

Post by BarryG »

Thanks for replying, Rashad, but now some of the context pop-up menu items don't work, or crash when multiple items are selected. My fault, of course, because that menu is intended for single items. So, maybe disable that menu if >1 item is selected? Although, deleting all selected items, or inserting before all selected items, would be nice to be able to do. I'm a pain, I know.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4663
Joined: Sun Apr 12, 2009 6:27 am

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

Post by RASHAD »

Hi BarryG
That is what I am afraid of :lol:
It needs more time to handle the StrucuredList()
Previous post updated
Egypt my love
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5353
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

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

Post by Kwai chang caine »

Master wrote:Enable modern theme please :lol:
I forgot that you make such problem to me always
Yessss you have right !!!!! it's that !!!! :shock:
You know i'm an old man, so all that is modern and me ...... :mrgreen:
Perhaps there are a way for test if this parameter is checked ? or better checked it by code :idea: to spare your future hours lost with me :wink: :lol:
In all case, thanks a lot for your present and your patience 8)

Another question... is it normal, the chexkbox can't be checked ?
ImageThe happiness is a road...
Not a destination
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4663
Joined: Sun Apr 12, 2009 6:27 am

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

Post by RASHAD »

Previous post updated for checking CheckBox
Egypt my love
BarryG
Addict
Addict
Posts: 3324
Joined: Thu Apr 18, 2019 8:17 am

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

Post by BarryG »

Which post has the latest code? I'm lost, now. I suggest keeping the first post edited with the latest code, because that's what newbies will see first.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4663
Joined: Sun Apr 12, 2009 6:27 am

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

Post by RASHAD »

@BarryG
The first post is the original will keep it as it's
The second one to answer the forum members request
Edit : Updated
Edit2 :Update 2
Egypt my love
BarryG
Addict
Addict
Posts: 3324
Joined: Thu Apr 18, 2019 8:17 am

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

Post by BarryG »

Understood. Thanks for your work!
Post Reply