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

Share your advanced PureBasic knowledge/code with the community.
Mr.L
Enthusiast
Enthusiast
Posts: 104
Joined: Sun Oct 09, 2011 7:39 am

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

Post by Mr.L »

Really nice!

But there are two thing that may not work as intended.
1. if I cklick on a a line, it becomes checked, even if not clicked on the checkbox
2. if I move the scrollbar up or down while editing an item, the "editbox" should move also, or disappear.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

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

Post by RASHAD »

Previous post updated
- CheckBoxes in column 0
- Ctrl-E to edit cell
- No edit shown after scroll

Code optimized and cleaned for now :)
Egypt my love
camille
User
User
Posts: 66
Joined: Tue Nov 19, 2019 12:52 pm

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

Post by camille »

Thanks for the updates RASHAD.

With the latest update there is a bug.

Click the checkmark box in one row.
When you now click on any other row (e.g. in column "TEST2") then the checkmark box will automatically be filled in that row as well.
This shouldn't happen.

If you untick the checkmark box in this row again and click on the first row afterwards (where you first activated the checkmark box) it will remove it there as well.
This shouldn't happen as well.

In other words, checkboxes aren't working correctly atm.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

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

Post by RASHAD »

Previous post updated
- Added check for XP theme enabled
- CkeckBox bug fixed
- Dble-Click to edit
- Scroll bug Fixed
Egypt my love
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

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

Post by dige »

@Rashad: Thanks for the great work.

Since the last update: If you click on Sort after double-clicking and edit, the edit field appears again.
"Daddy, I'll run faster, then it is not so far..."
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

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

Post by RASHAD »

Hi dige
Nice talking to you
Previous post updated
I can't grantee that the code free of bugs yet :lol:
It is so difficult to get harmony between PB commands and API
Egypt my love
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

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

Post by RASHAD »

- Many bugs fixed
- Almost stable
- Added some flavors
have fun

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$ ,nimg
Global cont1,start,finish,oldliCB ,brush
sort = 1
brush=CreateSolidBrush_($CCFFFF) 

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 liCB(hWnd, uMsg, wParam, lParam)
  Protected hdi.hd_item
  result = CallWindowProc_(oldliCB, hWnd, uMsg, wParam, lParam)
  Select uMsg
    Case #WM_NOTIFY
      *pnmh.NMHDR = lparam
        If *pnmh\code = #NM_CUSTOMDRAW
        *pnmcd.NMCUSTOMDRAW = lparam
        Select *pnmcd\dwDrawStage
          Case #CDDS_PREPAINT
            result = #CDRF_NOTIFYITEMDRAW
          Case #CDDS_ITEMPREPAINT
            text$=GetGadgetItemText(0, -1, *pnmcd\dwItemSpec)
            If *pnmcd\uItemState & #CDIS_SELECTED
              DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH|#DFCS_PUSHED)
              *pnmcd\rc\left+2 : *pnmcd\rc\top+1
            Else
              DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH)
            EndIf
            *pnmcd\rc\bottom-1 : *pnmcd\rc\right-1
            SetBkMode_(*pnmcd\hdc,#TRANSPARENT)
            If *pnmcd\dwItemSpec&1
              FillRect_(*pnmcd\hdc, *pnmcd\rc, brush)
              SetTextColor_(*pnmcd\hdc, #Blue)
            Else
              FillRect_(*pnmcd\hdc, *pnmcd\rc, brush)
              SetTextColor_(*pnmcd\hdc, #Red)
            EndIf
            If *pnmcd\rc\right>*pnmcd\rc\left
              DrawText_(*pnmcd\hdc, @text$, Len(text$), *pnmcd\rc, #DT_CENTER|#DT_VCENTER|#DT_SINGLELINE|#DT_END_ELLIPSIS)
            EndIf
            result = #CDRF_SKIPDEFAULT
        EndSelect
      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 #NM_CUSTOMDRAW 
          *LVCDHeader.NMLVCUSTOMDRAW = lParam 
          Select *LVCDHeader\nmcd\dwDrawStage    ;               
            Case #CDDS_PREPAINT
            Case #CDDS_ITEMPREPAINT
              result = #CDRF_NOTIFYSUBITEMDRAW            
            Case #CDDS_SUBITEMPREPAINT 
              Row = *LVCDHeader\nmcd\dwItemSpec 
              Col = *LVCDHeader\iSubItem
              If Row & 1 
               If  GetDlgItem_(hwnd,wParam) = GadgetID(0)
                  *LVCDHeader\clrTextBk = $BAEEE8 
               EndIf
              EndIf                
              result = #CDRF_DODEFAULT
          EndSelect
          
        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+xed,r\top+yed,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))
            SetParent_(GadgetID(100),0)
            ShowWindow_(GadgetID(100),#SW_HIDE)     
          EndIf 
         
        Case #LVN_COLUMNCLICK ;Click Header item
          HitInfo.LVHITTESTINFO
          SendMessage_(GadgetID(0), #LVM_HITTEST, 0, @HitInfo)
          *nmlv.NM_LISTVIEW = lParam
          sortcol = *nmlv\iSubItem
          If IsWindowVisible_(GadgetID(100))
            SetParent_(GadgetID(100),0)
            ShowWindow_(GadgetID(100),#SW_HIDE) 
          EndIf
          If sortcol <> 2
            SortStructuredList(myItems(),sort, ssort(sortcol,0), ssort(sortcol,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, sortcol, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_SORTUP)
            Else
              SetHeaderImage(0, sortcol, #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
            SetParent_(GadgetID(100),GadgetID(0))
            ShowWindow_(GadgetID(100),#SW_SHOW)
            MoveWindow_(GadgetID(100),r\left+xed,r\top+yed,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))
              SetParent_(GadgetID(100),0)
              ShowWindow_(GadgetID(100),#SW_HIDE)   
            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)
          crow = hitinfo\iItem
          ccol = hitinfo\iSubItem
          If IsWindowVisible_(GadgetID(100))
            SetParent_(GadgetID(100),0)
            ShowWindow_(GadgetID(100),#SW_HIDE	)    
          EndIf
          SelectElement(state(), myItems()\index)
          st = state()
          If selno =10000000
            selno = 0
          EndIf
          Debug nimg
          If ccol = 1
             If st = nimg
              state() = nimg+1
              selno + 1
            ElseIf st = nimg+1
              state() = nimg
              selno - 1
            EndIf
          Else
            state() = st
          EndIf
          SendMessage_(GadgetID(0), #LVM_REDRAWITEMS ,row,row)
      EndSelect
   
    Case #WM_SIZE
      If IsWindowVisible_(GadgetID(100))
        SetParent_(GadgetID(100),0)
        ShowWindow_(GadgetID(100),#SW_HIDE	)    
      EndIf
      MoveWindow_(GadgetID(0),10,10,WindowWidth(0)-20,WindowHeight(0)-45,1)
      MoveWindow_(GadgetID(2),10,WindowHeight(0)-30,120,24,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, 450, "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)
  ButtonGadget(2,10,415,120,24,"Header Style")
  
  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)
nimg = 60
Dim sicon(nimg)
For icon = 0 To nimg
  ExtractIconEx_(file$, icon, 0, sicon(), nimg)
  ImageList_AddIcon_(li,sicon(icon))
Next
Dim sicon(0)

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 = 40
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())
oldliCB = SetWindowLongPtr_(GadgetID(0), #GWL_WNDPROC, @liCB())
SendMessage_(GadgetID(0), #LVM_SETITEMCOUNT, #ItemCount, #LVSICF_NOINVALIDATEALL| #LVSICF_NOSCROLL)

For i = 0 To #ItemCount
  AddElement(state())
  state() = nimg
  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))
              SetParent_(GadgetID(100),0)
              ShowWindow_(GadgetID(100),#SW_HIDE)   
            EndIf
            SetGadgetText(100,"")
            editflag = 0
          EndIf
         
        Case 20 ;Esc to dismiss
          If GetActiveGadget() = 100
            If IsWindowVisible_(GadgetID(100))
              SetParent_(GadgetID(100),0)
              ShowWindow_(GadgetID(100),#SW_HIDE)     
            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 2
          style ! 1
          If style = 1
            ;SetWindowCallback(@winCB())            
            SetWindowLongPtr_(GadgetID(0), #GWL_WNDPROC, 0)
          Else          
            oldliCB = SetWindowLongPtr_(GadgetID(0), #GWL_WNDPROC, @liCB())
          EndIf
          InvalidateRect_(GadgetID(0),0,1)
        
        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
Edit1 : Update #1
Last edited by RASHAD on Wed Dec 16, 2020 10:02 am, edited 1 time in total.
Egypt my love
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

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

Post by dige »

Hi RASHAD, thank you for the update. I gave it just a short try. The input field does not reappear after sorting anymore. *thumbsup*
What surprises me is that now no more pictures are to be seen...
"Daddy, I'll run faster, then it is not so far..."
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

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

Post by RASHAD »

Hi dige
Previous post updated
nimg : your images count

Code: Select all

nimg = 60
Egypt my love
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

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

Post by RASHAD »

Hi guys
@Mr.L
@camille

Next almost as the usual act

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

#HDF_CHECKBOX   = $40
#HDF_CHECKED    = $80
#HDS_CHECKBOXES = $400

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 ,oldproc,header, header_h,row,col,rowed,coled ,editflag 
Global cont1,start,finish,oldliCB ,brush ,crow,ccol
Global HitInfo.LVHITTESTINFO ,cbox.HDITEM

cbox\mask = #HDI_FORMAT 
cbox\fmt = #HDF_CHECKBOX | #HDF_STRING | #HDF_BITMAP_ON_RIGHT

sort = 1
brush=CreateSolidBrush_($CCFFFF) 

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)

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 liCB(hWnd, uMsg, wParam, lParam)
  Protected hdi.hd_item
  result = CallWindowProc_(oldliCB, hWnd, uMsg, wParam, lParam)
  Select uMsg
    Case #WM_NOTIFY
      *pnmh.NMHDR = lparam
        If *pnmh\code = #NM_CUSTOMDRAW
        *pnmcd.NMCUSTOMDRAW = lparam
        Select *pnmcd\dwDrawStage
          Case #CDDS_PREPAINT
            result = #CDRF_NOTIFYITEMDRAW
          Case #CDDS_ITEMPREPAINT
            text$=GetGadgetItemText(0, -1, *pnmcd\dwItemSpec)
            If *pnmcd\uItemState & #CDIS_SELECTED
              DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH|#DFCS_PUSHED)
              *pnmcd\rc\left+2 : *pnmcd\rc\top+1
            Else
              DrawFrameControl_(*pnmcd\hdc, *pnmcd\rc, #DFC_BUTTON, #DFCS_BUTTONPUSH)
            EndIf
            *pnmcd\rc\bottom-1 : *pnmcd\rc\right-1
            SetBkMode_(*pnmcd\hdc,#TRANSPARENT)
            If *pnmcd\dwItemSpec&1
              FillRect_(*pnmcd\hdc, *pnmcd\rc, brush)
              SetTextColor_(*pnmcd\hdc, #Blue)
            Else
              FillRect_(*pnmcd\hdc, *pnmcd\rc, brush)
              SetTextColor_(*pnmcd\hdc, #Red)
            EndIf
            If *pnmcd\rc\right>*pnmcd\rc\left
              DrawText_(*pnmcd\hdc, @text$, Len(text$), *pnmcd\rc, #DT_CENTER|#DT_VCENTER|#DT_SINGLELINE|#DT_END_ELLIPSIS)
            EndIf
            result = #CDRF_SKIPDEFAULT
        EndSelect
      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 #NM_CUSTOMDRAW 
          *LVCDHeader.NMLVCUSTOMDRAW = lParam 
          Select *LVCDHeader\nmcd\dwDrawStage    ;               
            Case #CDDS_PREPAINT
            Case #CDDS_ITEMPREPAINT
              result = #CDRF_NOTIFYSUBITEMDRAW            
            Case #CDDS_SUBITEMPREPAINT 
              Row = *LVCDHeader\nmcd\dwItemSpec 
              Col = *LVCDHeader\iSubItem
              If Row & 1 
               If  GetDlgItem_(hwnd,wParam) = GadgetID(0)
                  *LVCDHeader\clrTextBk = $BAEEE8 
               EndIf
              EndIf                
              result = #CDRF_DODEFAULT
          EndSelect
          
        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+xed,r\top+yed,r\right-r\left,r\bottom-r\top,1)
            SetFocus_(GadgetID(100))        
          EndIf
          
        Case #HDN_DIVIDERDBLCLICK
          If IsWindowVisible_(GadgetID(100))
            SetParent_(GadgetID(100),0)
            ShowWindow_(GadgetID(100),#SW_HIDE)     
          EndIf 
          editflag = 0
 
        Case #LVN_ODCACHEHINT
          result = 0
         
        Case #LVN_ODFINDITEM
          result = -1
         
        Case #LVN_GETDISPINFO                ;
          *pnmlvdi.NMLVDISPINFO = lParam
          row = *pnmlvdi\item\iItem
          col = *pnmlvdi\item\iSubItem
          If col = 0 And *pnmlvdi\item\mask & #LVIF_STATE
            *pnmlvdi\item\stateMask = #LVIS_STATEIMAGEMASK
            SelectElement(state(),myItems()\index)
            If state() = 0
                *pnmlvdi\item\state = 1<<12               
            Else
                *pnmlvdi\item\state = 2<<12
            EndIf
          EndIf
          If SelectElement(myItems(), row) <> 0    
            If *pnmlvdi\item\mask & #LVIF_IMAGE And *pnmlvdi\item\iSubItem = 2
              *pnmlvdi\item\mask & #LVIF_IMAGE
              *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))
            SetParent_(GadgetID(100),0)
            ShowWindow_(GadgetID(100),#SW_HIDE)     
          EndIf 
         
        Case #LVN_COLUMNCLICK ;Click Header item
          ;HitInfo.LVHITTESTINFO
          SendMessage_(GadgetID(0), #LVM_HITTEST, 0, @HitInfo)
          *nmlv.NM_LISTVIEW = lParam
          sortcol = *nmlv\iSubItem
          If IsWindowVisible_(GadgetID(100))
            SetParent_(GadgetID(100),0)
            ShowWindow_(GadgetID(100),#SW_HIDE) 
          EndIf
          If sortcol <> 0 And sortcol <> 2
            SortStructuredList(myItems(),sort, ssort(sortcol,0), ssort(sortcol,1))
            RedrawWindow_(GadgetID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW | #RDW_ERASE)            
            
            cbox\fmt = #HDF_CHECKBOX | #HDF_STRING
            SendMessage_(Header, #HDM_SETITEM, 1, @cbox) 
            For index = 0 To 5
              cbox\fmt = #HDF_STRING
              SendMessage_(Header, #HDM_SETITEM, index, @cbox) 
            Next
            
            sort ! 1
            If sort = 0
              cbox\fmt = #HDF_STRING | #HDF_SORTUP 
            Else
              cbox\fmt = #HDF_STRING | #HDF_SORTDOWN 
            EndIf
            SendMessage_(Header, #HDM_SETITEM, sortcol, @cbox)           
          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
            SetParent_(GadgetID(100),GadgetID(0))
            ShowWindow_(GadgetID(100),#SW_SHOW)
            MoveWindow_(GadgetID(100),r\left+xed,r\top+yed,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))
              SetParent_(GadgetID(100),0)
              ShowWindow_(GadgetID(100),#SW_HIDE)   
            EndIf
          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)
          crow = HitInfo\iItem
          ccol = HitInfo\iSubItem
          ;Debug GetGadgetItemText(0,crow,ccol)
          If IsWindowVisible_(GadgetID(100))
            SetParent_(GadgetID(100),0)
            ShowWindow_(GadgetID(100),#SW_HIDE	)    
          EndIf          
          If selno =10000000
            selno = 0
          EndIf
          If ccol = 0
            SelectElement(state(), myItems()\index)
            If state() = 0
              state() = 1
              selno + 1
            Else
              state() = 0
              selno - 1
            EndIf
          EndIf
          SendMessage_(GadgetID(0), #LVM_REDRAWITEMS ,crow,crow)
      EndSelect
   
    Case #WM_SIZE
      If IsWindowVisible_(GadgetID(100))
        SetParent_(GadgetID(100),0)
        ShowWindow_(GadgetID(100),#SW_HIDE	)    
      EndIf
      MoveWindow_(GadgetID(0),10,10,WindowWidth(0)-20,WindowHeight(0)-45,1)
      MoveWindow_(GadgetID(2),10,WindowHeight(0)-30,120,24,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, 450, "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,"*",30,#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,2,"Index",70)
  AddGadgetColumn(0,3,"Image",80)
  AddGadgetColumn(0,4,"TEST2",150)
  AddGadgetColumn(0,5,"TEST3",150)
  AddGadgetColumn(0,6,"TEST4",150)
  
  ButtonGadget(2,10,415,120,24,"Header Style")
 
  li = ImageList_Create_(32,32,#ILC_COLOR32| #ILC_MASK, 0, #ItemCount)
  
  file$ = "Shell32.dll"
  nimg = ExtractIconEx_(file$, -1, 0 ,0, 0)
  
  Dim sicon(nimg)
  ExtractIconEx_(file$, 0, 0 ,sicon(), nimg)
  
  For icon = 0 To nimg
    ImageList_AddIcon_(li,sicon(icon))
  Next

  FreeArray(sicon())
 
  SendMessage_(GadgetID(0), #LVM_SETIMAGELIST, #LVSIL_SMALL, li)
   
  header_h = 40
  Header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)
  SetWindowLongPtr_(Header, #GWL_STYLE, GetWindowLongPtr_(Header, #GWL_STYLE) | #HDS_CHECKBOXES)
  SendMessage_(header,#HDM_SETBITMAPMARGIN,-2,0)
  SendMessage_(header,#WM_SETFONT,FontID(0),0)
  SendMessage_(Header, #HDM_SETITEM, 1, @cbox)

  oldproc = SetWindowLongPtr_(Header, #GWL_WNDPROC, @Hheight())
  oldliCB = SetWindowLongPtr_(GadgetID(0), #GWL_WNDPROC, @liCB())
  SendMessage_(GadgetID(0), #LVM_SETITEMCOUNT, #ItemCount, #LVSICF_NOINVALIDATEALL| #LVSICF_NOSCROLL)
  
  For i = 0 To #ItemCount
    AddElement(state())
    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)  
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)
          DeleteElement(myItems())  
          SelectElement(state(), draw)                  
          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 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))
              SetParent_(GadgetID(100),0)
              ShowWindow_(GadgetID(100),#SW_HIDE)   
            EndIf
            SetGadgetText(100,"")
            editflag = 0
          EndIf
         
        Case 20 ;Esc to dismiss
          If GetActiveGadget() = 100
            If IsWindowVisible_(GadgetID(100))
              SetParent_(GadgetID(100),0)
              ShowWindow_(GadgetID(100),#SW_HIDE)     
            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 0
          Debug GetGadgetItemText(0,crow,ccol)
        Case 2
          style ! 1
          If style = 1            
            SetWindowLongPtr_(GadgetID(0), #GWL_WNDPROC, 0)
            cbox\fmt = #HDF_STRING; | #HDF_SORTUP
            SendMessage_(Header, #HDM_SETITEM, 1, @cbox)
          Else          
            oldliCB = SetWindowLongPtr_(GadgetID(0), #GWL_WNDPROC, @liCB())
          EndIf
          InvalidateRect_(GadgetID(0),0,1)
        
        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
Edit1 : Bug fixed
Last edited by RASHAD on Thu Dec 17, 2020 10:57 am, edited 1 time in total.
Egypt my love
camille
User
User
Posts: 66
Joined: Tue Nov 19, 2019 12:52 pm

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

Post by camille »

Thank you RASHAD.

A small bug (for the latest revision):

When double clicking on an editable row entry (e.g. in column "TEST2") in any row
and then (without leaving the editable text via escape / return key) clicking on a different row
will set the checkmark box for that row...
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

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

Post by RASHAD »

Hi camille
Previous post updated
It seems that I posted an old rev. :lol:
So will you excuse me
Egypt my love
camille
User
User
Posts: 66
Joined: Tue Nov 19, 2019 12:52 pm

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

Post by camille »

No problem and thanks for the update

That bug is fixed in vie
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

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

Post by Kwai chang caine »

Code: Select all

Procedure ThemesEnabled()
Can be also call

Code: Select all

Procedure ForDonkeysNotUseThemesEnabledLikeKcc()
:mrgreen: :lol:

Thanks RASHAD for sharing this new version 8)
ImageThe happiness is a road...
Not a destination
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 »

Dear, RASHAD.

Is it possible to work with two or more listicons? (I have a panel gadget with 2 tabs, first tab has 2 listicons and second tab has another listicon)

I have tried to create a second ListIconGadget() and a second list, myItems2() and put a condition in the windowscallback:
If GetActiveGadget()=... but obviously it was a disaster.

Anyone has a valid solution? Thank you in advance!
Post Reply