ProgressBar in ListIcon (Windows only)

[Thorium]

I wanted to have progress bar gadgets in a list icon gadget, so i made a little subclassing code that does it.

Things it supports:

• adding progress bar gadgets to list icon gadget columns
• multiple list icon gadgets at once
• multiple columns per list icon gadget at once
• dynamical managment of progress bar gadget count to save ressources for not displayed progress bar gadgets

Things it does not support right now:

• adding and removing columns, if you do so progress bars will end up on wrong column
• sorting rows, if you do so progress bars will not be sorted and end up on wrong row
• adding a single progress bar, only full columns are supported

Only works if list icon gadget is in report display mode.

Procedures:

Add(ListIcon.i, Column.i, Min.i, Max.i, Flags.i)
Adds progress bars to a list icon gadget column.

ListIcon = PB gadget number
Column = column index starting at 0
Min = minimum value for progress bars
Max = maximum value for progress bars
Flags = PB progress bar flags

Remove(ListIcon.i, Column.i)
Removes progress bars that was been added with this module.
You need to do this befor closing the window or freeing the list icon gadget to prevent memory leak!

ListIcon = PB gadget number
Column = column index starting at 0

SetValue(ListIcon.i, Column.i, Row.i, Value.i)
Sets the value of a progress bar added with this module.

ListIcon = PB gadget number
Column = column index starting at 0
Row = row index starting at 0
Value = number within the bounds of min and max

GetValue(ListIcon.i, Column.i, Row.i)
Returns the value of a progress bar added with this module.

ListIcon = PB gadget number
Column = column index starting at 0
Row = row index starting at 0

Example screen shots:

Code: Select all

;/------------------\
;| ListIconProgress |
;|                  |
;| v0.02            |
;| by Thorium       |
;| PureBaic 5.20    |
;\------------------/

;change log
;--------------------
;v0.02
;-fixed: if last row was displayed only partially it was not redrawn on progress change
;--------------------
;v0.01
;-initial release

EnableExplicit

DeclareModule ListIconProgress
  Declare Add(ListIcon.i, Column.i, Min.i, Max.i, Flags.i)
  Declare Remove(ListIcon.i, Column.i)
  Declare SetValue(ListIcon.i, Column.i, Row.i, Value.i)
  Declare.i GetValue(ListIcon.i, Column.i, Row.i)
EndDeclareModule

Module ListIconProgress

;holds information about the added progress bars
Structure ProgressGadgetInfo
  ProgressBarNum.i
  ProgressBarId.i
  Item.i
  SubItem.i
EndStructure

Structure ProgressInfo
  Column.i
  Min.i
  Max.i
  Flags.i
  List Values.i()
  Array ProgressGadgets.ProgressGadgetInfo(0)
EndStructure

;holds information about all list icon gadgets progress bars was been added to
Structure ListIconInfo
  ListIconNum.i
  ListIconId.i
  OldListIconProc.i
  RowCnt.i
  VisibleRows.i
  List ProgressColumns.ProgressInfo()
EndStructure

Global NewList ListIcons.ListIconInfo()

;finds the list icon gadget information for the specified list icon gadget
;returns #True if found and sets the found element to the current list element
;returns #False if not found
Procedure.i FindListIcon(ListIcon.i)
  
  ForEach ListIcons()
    
    If ListIcons()\ListIconNum = ListIcon
      ProcedureReturn #True
    EndIf

  Next
  
  ProcedureReturn #False
  
EndProcedure

;finds the list icon gadget information for the specified list icon gadget by it's hWnd
;returns #True if found and sets the found element to the current list element
;returns #False if not found
Procedure.i FindListIconByHandle(hWnd.i)
  
  ForEach ListIcons()
    
    If ListIcons()\ListIconId = hWnd
      ProcedureReturn #True
    EndIf

  Next
  
  ProcedureReturn #False
  
EndProcedure

;findes the column information for the specified list icon gadget column
;searches in the current element of ListIcons()
;returns #True if found and sets the found element to the current list element
;returns #False if not found
Procedure.i FindProgressColumn(Column.i)
  
  ForEach ListIcons()\ProgressColumns()
    
    If ListIcons()\ProgressColumns()\Column = Column
      ProcedureReturn #True
    EndIf

  Next
  
  ProcedureReturn #False

EndProcedure

;finds the progress bar gadget information for the specified list icon gadget row
;searches the current element of ListIcons()\ProgressColumns()
;returns the array index of ListIcons()\ProgressColumns()\ProgressGadgets
;returns #False if not found
Procedure.i FindProgressGadget(Row.i)
  
  Protected i.i
  
  For i = 1 To ListIcons()\VisibleRows
    If ListIcons()\ProgressColumns()\ProgressGadgets(i)\Item = Row
      ProcedureReturn i
    EndIf  
  Next
  
  ProcedureReturn #False
  
EndProcedure

;checks if a row of the current list view gadget is visible
Procedure.i IsRowVisible(Row.i)
  
  Protected FirstVisibleRow.i
  Protected VisibleRowCnt.i
  
  ;get visible rows
  FirstVisibleRow = SendMessage_(ListIcons()\ListIconId, #LVM_GETTOPINDEX, 0, 0)
  VisibleRowCnt = SendMessage_(ListIcons()\ListIconId, #LVM_GETCOUNTPERPAGE, 0, 0) + 1
  
  ;check if row is within visible range
  If (Row >= FirstVisibleRow) And (Row < (FirstVisibleRow + VisibleRowCnt))
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
  
EndProcedure

;creates the progress bars for a list icon column
;uses the current element of ListIcons()\ProgressColumns()
Procedure CreateProgressBars()
  
  Protected i.i
  Protected VisibleRowCnt.i
  
  VisibleRowCnt = SendMessage_(ListIcons()\ListIconId, #LVM_GETCOUNTPERPAGE, 0, 0) + 1
  ReDim ListIcons()\ProgressColumns()\ProgressGadgets.ProgressGadgetInfo(VisibleRowCnt)
  For i = 1 To VisibleRowCnt
    ListIcons()\ProgressColumns()\ProgressGadgets(i)\ProgressBarNum = ProgressBarGadget(#PB_Any, 0, 0, 10, 10, ListIcons()\ProgressColumns()\Min, ListIcons()\ProgressColumns()\Max, ListIcons()\ProgressColumns()\Flags)
    ListIcons()\ProgressColumns()\ProgressGadgets(i)\ProgressBarId = GadgetID(ListIcons()\ProgressColumns()\ProgressGadgets(i)\ProgressBarNum)
    SetParent_(ListIcons()\ProgressColumns()\ProgressGadgets(i)\ProgressBarId, ListIcons()\ListIconId)
  Next
  
  ListIcons()\VisibleRows = VisibleRowCnt
  
EndProcedure

;creates or frees progress bar gadgets if count of visible rows in list icon gadget changed
Procedure ManageProgressBars()
  
  Protected i.i
  Protected VisibleRowCnt.i
  
  VisibleRowCnt = SendMessage_(ListIcons()\ListIconId, #LVM_GETCOUNTPERPAGE, 0, 0) + 1
  
  If VisibleRowCnt > ListIcons()\VisibleRows
    
    ForEach ListIcons()\ProgressColumns()
      ReDim ListIcons()\ProgressColumns()\ProgressGadgets.ProgressGadgetInfo(VisibleRowCnt)
      For i = ListIcons()\VisibleRows + 1 To VisibleRowCnt
        ListIcons()\ProgressColumns()\ProgressGadgets(i)\ProgressBarNum = ProgressBarGadget(#PB_Any, 0, 0, 10, 10, ListIcons()\ProgressColumns()\Min, ListIcons()\ProgressColumns()\Max, ListIcons()\ProgressColumns()\Flags)
        ListIcons()\ProgressColumns()\ProgressGadgets(i)\ProgressBarId = GadgetID(ListIcons()\ProgressColumns()\ProgressGadgets(i)\ProgressBarNum)
        SetParent_(ListIcons()\ProgressColumns()\ProgressGadgets(i)\ProgressBarId, ListIcons()\ListIconId)
      Next
    Next

  ElseIf VisibleRowCnt < ListIcons()\VisibleRows
    
    ForEach ListIcons()\ProgressColumns()
      For i = ListIcons()\VisibleRows To VisibleRowCnt + 1 Step -1
        FreeGadget(ListIcons()\ProgressColumns()\ProgressGadgets(i)\ProgressBarNum)
      Next
      ReDim ListIcons()\ProgressColumns()\ProgressGadgets.ProgressGadgetInfo(VisibleRowCnt)
    Next
    
  EndIf

  ListIcons()\VisibleRows = VisibleRowCnt
  
EndProcedure

;updates the position, size and value of the progress bar gadgets
Procedure UpdateProgressBars()
  
  Protected i.i
  Protected FirstVisibleRow.i
  Protected SubItemRect.RECT
  
  FirstVisibleRow = SendMessage_(ListIcons()\ListIconId, #LVM_GETTOPINDEX, 0, 0)
  
  ForEach ListIcons()\ProgressColumns()
  
    For i = 0 To ListIcons()\VisibleRows - 1
      
      If i+FirstVisibleRow > ListIcons()\RowCnt-1
        
        ;row is in visible range but has no item so we need to hide the progress bar gadget
        ListIcons()\ProgressColumns()\ProgressGadgets(i+1)\Item    = -1
        ListIcons()\ProgressColumns()\ProgressGadgets(i+1)\SubItem = ListIcons()\ProgressColumns()\Column
        HideGadget(ListIcons()\ProgressColumns()\ProgressGadgets(i+1)\ProgressBarNum, #True)
        
      Else

        ;store information about the progress bar gadget
        ListIcons()\ProgressColumns()\ProgressGadgets(i+1)\Item    = i + FirstVisibleRow
        ListIcons()\ProgressColumns()\ProgressGadgets(i+1)\SubItem = ListIcons()\ProgressColumns()\Column
        
        ;get position and size of sub item for progress bar
        SubItemRect\top  = ListIcons()\ProgressColumns()\Column
        SubItemRect\left = #LVIR_LABEL
        SendMessage_(ListIcons()\ListIconId, #LVM_GETSUBITEMRECT, FirstVisibleRow + i, @SubItemRect)
        
        ;update position and size of progress bar gadget
        ResizeGadget(ListIcons()\ProgressColumns()\ProgressGadgets(i + 1)\ProgressBarNum, SubItemRect\left+1, SubItemRect\top+1, SubItemRect\right - SubItemRect\left - 2, SubItemRect\bottom - SubItemRect\top - 2)
        
        ;update value of progress bar gadget
        SelectElement(ListIcons()\ProgressColumns()\Values(), i + FirstVisibleRow)
        SetGadgetState(ListIcons()\ProgressColumns()\ProgressGadgets(i + 1)\ProgressBarNum, ListIcons()\ProgressColumns()\Values())
        HideGadget(ListIcons()\ProgressColumns()\ProgressGadgets(i + 1)\ProgressBarNum, #False)
        
      EndIf

    Next
    
  Next
  
  RedrawWindow_(ListIcons()\ListIconId, 0, 0, #RDW_INVALIDATE)
  
EndProcedure

;hook procedure for the subclassing of the list icon gadgets
;all messages going to the list icon gadget windows will go to this procedure first
;needed to handle resize, move, item add, item delete, etc.
Procedure.i WindowProcHook(hwnd.i, msg.i, wparam.i, lparam.i)
  
  Protected Result.i
  Protected *HeaderNotification.NMHDR

  ;check if we actualy got this window hooked
  If FindListIconByHandle(hwnd) = #False
    ProcedureReturn #False
  EndIf
  
  ;call the original window proc and save the return value
  Result = CallWindowProc_(ListIcons()\OldListIconProc, hwnd, msg, wparam, lparam)
  ;if the message processing failed we dont need to do any actions
  If Result = -1
    ProcedureReturn -1
  EndIf
  
  ;check if we got a message which needs us to update the progress bar gadgets
  Select msg
    
    Case #WM_NOTIFY
      *HeaderNotification = lparam
      If *HeaderNotification\code = #HDN_ITEMCHANGED
        ;a column header has been changed
        ManageProgressBars()
        UpdateProgressBars()
      EndIf
      
    Case #WM_VSCROLL, #WM_HSCROLL, #WM_SIZE, #LVM_SCROLL, #LVM_SETCOLUMNWIDTH
      ;list icon gadget was been scrolled or changed in size or a column changed in size
      ManageProgressBars()
      UpdateProgressBars()
      
    Case #LVM_DELETEALLITEMS
      ;all items have been deleted
      ListIcons()\RowCnt = 0
      ForEach ListIcons()\ProgressColumns()
        ClearList(ListIcons()\ProgressColumns()\Values())
      Next
      UpdateProgressBars()

    Case #LVM_DELETEITEM
      ;a item has been deleted
      ForEach ListIcons()\ProgressColumns()
        SelectElement(ListIcons()\ProgressColumns()\Values(), wparam)
        DeleteElement(ListIcons()\ProgressColumns()\Values())
      Next
      ListIcons()\RowCnt = ListIcons()\RowCnt - 1
      UpdateProgressBars()

    Case #LVM_INSERTITEM
      ;a item has been inserted
      ForEach ListIcons()\ProgressColumns()
        If Result = 0
          FirstElement(ListIcons()\ProgressColumns()\Values())
          InsertElement(ListIcons()\ProgressColumns()\Values())
        Else          
          SelectElement(ListIcons()\ProgressColumns()\Values(), Result - 1)
          AddElement(ListIcons()\ProgressColumns()\Values())
        EndIf
      Next
      ListIcons()\RowCnt = ListIcons()\RowCnt + 1
      UpdateProgressBars()

  EndSelect

  ProcedureReturn Result
  
EndProcedure

;adds a progress bar to a list icon gadget column
Procedure Add(ListIcon.i, Column.i, Min.i, Max.i, Flags.i)
  
  Protected i.i
  
  ;get list icon gadget information entry
  If FindListIcon(ListIcon) = #False
    
    ;it's a new list icon gadget
    
    AddElement(ListIcons())
    
    ;get informations about the new list icon gadget
    ListIcons()\ListIconNum = ListIcon.i
    ListIcons()\ListIconId  = GadgetID(ListIcon)
    ListIcons()\RowCnt      = CountGadgetItems(ListIcons()\ListIconNum)

    ;install window hook on the list icon gadget for subclassing
    ListIcons()\OldListIconProc = GetWindowLongPtr_(ListIcons()\ListIconId, #GWLP_WNDPROC)
    SetWindowLongPtr_(ListIcons()\ListIconId, #GWLP_WNDPROC, @WindowProcHook())

  EndIf
  
  ;store informations about the progress column
  AddElement(ListIcons()\ProgressColumns())
  ListIcons()\ProgressColumns()\Column = Column
  ListIcons()\ProgressColumns()\Min    = Min
  ListIcons()\ProgressColumns()\Max    = Max
  ListIcons()\ProgressColumns()\Flags  = Flags
  
  ;create list of progress values
  For i = 1 To ListIcons()\RowCnt
    AddElement(ListIcons()\ProgressColumns()\Values())
  Next

  ;manages count of progress bars
  CreateProgressBars()
  
  ;update position, size and value of the progress bar gadgets
  UpdateProgressBars()
  
EndProcedure

;removes a progress bar from a list icon gadget column
Procedure Remove(ListIcon.i, Column.i)
  
  Protected i.i
  
  If FindListIcon(ListIcon) = #True    
    If FindProgressColumn(Column) = #True
      
      ;free all progress bar gadgets associated with the list view gadget column
      For i = 1 To ListIcons()\VisibleRows
        FreeGadget(ListIcons()\ProgressColumns()\ProgressGadgets(i)\ProgressBarNum)
      Next
      
      ;remove stored informations about the list icon gadget column
      DeleteElement(ListIcons()\ProgressColumns())
      
      ;if the column was the last remaining progress column of the list icon remove the list icon from stored information
      If ListSize(ListIcons()\ProgressColumns()) = 0
        ;uninstall window hook
        SetWindowLongPtr_(ListIcons()\ListIconId, #GWLP_WNDPROC, ListIcons()\OldListIconProc)
        ;remove stored informations about the list icon gadget
        DeleteElement(ListIcons())
      EndIf
  
    EndIf
  EndIf
  
EndProcedure

;sets the value of a progress bar of a list icon gadget
Procedure SetValue(ListIcon.i, Column.i, Row.i, Value.i)
  
  If FindListIcon(ListIcon) = #True
    If FindProgressColumn(Column) = #True
      SelectElement(ListIcons()\ProgressColumns()\Values(), Row)
      ListIcons()\ProgressColumns()\Values() = Value
      If IsRowVisible(Row) = #True
        SetGadgetState(ListIcons()\ProgressColumns()\ProgressGadgets(FindProgressGadget(Row))\ProgressBarNum, Value)
      EndIf
    EndIf
  EndIf
  
EndProcedure

;gets the value of a progress bar of a list icon gadget
Procedure.i GetValue(ListIcon.i, Column.i, Row.i)
  
  If FindListIcon(ListIcon) = #True
    If FindProgressColumn(Column) = #True
      SelectElement(ListIcons()\ProgressColumns()\Values(), Row)
      ProcedureReturn ListIcons()\ProgressColumns()\Values()
    EndIf
  EndIf
  
  ProcedureReturn #False

EndProcedure

EndModule

[sec]

Look great, how about add #Gadget for your barprocess?

So it will easy to pass to the procedure in thread, looks same:

Code: Select all

SetValue(#BarProcessNumr, State) ; insead of pass listicongadget, column, ....

Could you make it crossplatform so it's very nice

I want to use your moudle in HashSW tool, but it's abit hard to use now, you can to fix:

Code: Select all

XIncludeFile "ListIconProgress.pbi"
XIncludeFile "SHA3.pbi"  ; http://www.purebasic.fr/english/viewtopic.php?f=40&t=56420



Structure poi
  filename$
  hash$
  id.i
EndStructure


Procedure h(*a.poi)
  
  *a\hash$=sha3::filefingerprint(*a\filename$,224,0,0,2)
  
  SetGadgetItemText(1, *a\id,*a\hash$,0)
  ClearStructure(*a,poi)
  FreeMemory(*a)
  
EndProcedure

If OpenWindow(0,-1,-1,460+200,200,"SHA3 - Hash by SW",  #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
  
  
  ProgressBarGadget(2,  0, 175, 460+200,  25, 0, 100, #PB_ProgressBar_Smooth)
  ListIconGadget(1,-1,-1,460+200,175,"SHA3",350,#PB_ListIcon_GridLines|#PB_ListView_MultiSelect)
  
  ListIconProgress::add(1,1,0,100,#PB_ProgressBar_Smooth)
  
  AddGadgetColumn(1,1,"FileName", 100+200)
  EnableGadgetDrop(1,  #PB_Drop_Files, #PB_Drag_Copy)

  Define Event, i, Quit, oneFile$,ListFile$

  Repeat
    Event = WaitWindowEvent()
    Select Event
        
      Case #PB_Event_CloseWindow  ; If the user has pressed on the close button
        Quit = 1
        
      Case  #PB_Event_GadgetDrop, #PB_Event_WindowDrop
        
        If  EventDropType() = #PB_Drop_Files
          
          ListFile$ = EventDropFiles()
          
          i = 1
          For i = 1 To CountString(ListFile$,#LF$) + 1
            oneFile$ = StringField(ListFile$,i,#LF$)       
            If oneFile$ <>""
              Select FileSize(oneFile$)
                Case -1, -2 ; is directory or not found
                Default     ; is file

                  Define *pam.poi= AllocateMemory(SizeOf(poi))
                  *pam\filename$ = oneFile$
                  *pam\id = CountGadgetItems(1)
                  
                  AddGadgetItem(1,-1,""+#LF$+oneFile$)
                  
                  CreateThread(@h(),*pam)
                  
                  
              EndSelect     
            EndIf
          Next
          
        EndIf
        
    EndSelect
    
  Until Quit = 1
EndIf

Thanks

[Thorium]

Unfortunatly the module is not thread save. You can make it thread save by adding some mutexes around the linked list using.

Adding the gadget number is actualy not possible with my system. It's based on the idea that every item in a column has a progress bar. Internaly there are actualy only as many progress bar gadgets existing as are visible. The code manages dynamicly which column item belongs to which progress bar gadget.

So you have a list icon gadget with 20 items (rows) in it but the size of the list icon gadget only allows you to see 10 rows. In this case the module will only create 10 progress bar gadgets. Gadget #1 gets assigned to row 1, #2 gets assigned to row 2 and so on.
If you scoll now one row down, there are still only 10 progress bar gadgets but they are assigned to different rows, so now gadget #1 gets assigned to row 2, #2 gets assigned to row 3 and so on.

I made this so you can have huge lists with hundretes of entries but you dont end up having to manage hundrets of progress bar gadgets.

Thats why you can't just add a single progress bar. To do so you would need to rewrite some of the code to work differently.

[Thorium]

Source in first post updated to version 0.02, fixed a minor bug.

I wanted to implement threadsafe but after hours of trying i gave up. It's to complicated because of the hooked window procs. For using it with threads you should not call any procedure of the module directly from a thread other than the main thread. Instead let the threads write the progress updates to a array and read that array in the main thread.

I wrote a example to demonstrate using it threaded:
Runs 30 threads that make progress reports.

Code: Select all

Structure Progress
  Row.i
  StartProgress.i
EndStructure

Global Dim ProgressArray.i(29)

Procedure ProgressThread(*StartProgress.Progress)
  
  Protected Progress.i
  
  Progress = *StartProgress\StartProgress
  
  Repeat
    Progress = Progress + 1
    If Progress = 100
      Progress = 0
    EndIf
    ProgressArray(*StartProgress\Row) = Progress
    Delay(100)
  ForEver
  
EndProcedure

Define Event.i
Define i.i
Dim Progress.Progress(29)

OpenWindow(0, 10, 10, 420, 420,"progress bars on List icon gadget")

ListIconGadget(1, 10, 10, 400, 400, "File", 100, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
AddGadgetColumn(1,1,"Progress",100)
AddGadgetColumn(1,2,"Time",80)

For i = 0 To 29
  AddGadgetItem(1, -1, "FileName" + Str(i) + ".zip")
Next

ListIconProgress::Add(1, 1, 0, 100, #PB_ProgressBar_Smooth)

For i = 0 To 29
  Progress(i)\Row      = i
  Progress(i)\StartProgress = i * 2
  CreateThread(@ProgressThread(), @Progress(i))
Next

Repeat
  
  Event=WaitWindowEvent(20)
  
  For i = 0 To 29
    ListIconProgress::SetValue(1, 1, i, ProgressArray(i))
  Next
  
Until Event = #PB_Event_CloseWindow

[Kwai chang caine]

Yeaaah !! very nice, and works great
Thanks for sharing