PureBasic Forums - English

Code: Select all

;By Celtic88 (c) 2017
;More info about Virtual List-View:https://msdn.microsoft.com/en-us/library/windows/desktop/bb774735(v=vs.85).aspx#Virtual_ListView_Style

Procedure.s RandomString(len=10)
  Protected Ranstr.s,oklm
  For oklm=1 To len
    Ranstr + Chr(Random(90,64))
  Next
  ProcedureReturn Ranstr
EndProcedure

Global Dim ItemInfo.s(1,100000)
Global LvHwnd

Structure NMLVSCROLL
  hdr.NMHDR;NMHDR structure that contains information about a LVN_ENDSCROLL or a LVN_BEGINSCROLL notification code.
  dx.l     ;Value of type int that specifies in pixels the horizontal position where a scrolling operation should begin or end.
  dy.l     ;Value of type int that specifies in pixels the vertical position where a scrolling operation should begin or end.
EndStructure

Procedure WinCallback(hWnd, uMsg, WParam, LParam) 
  Protected *pNMLVSCROLL.NMLVSCROLL
  Select uMsg
    Case #WM_NOTIFY
      Protected *tNMHDR.NMHDR = LParam
      Select *tNMHDR\hwndFrom
        Case LvHwnd
          Select *tNMHDR\code
            Case #LVN_BEGINSCROLL
              *pNMLVSCROLL = LParam
              Debug " #LVN_BEGINSCROLL : x = " + Str(*pNMLVSCROLL\dx) + " y= " + Str(*pNMLVSCROLL\dy)
              
            Case #LVN_ENDSCROLL
              *pNMLVSCROLL = LParam
              Debug " #LVN_ENDSCROLL : x = " + Str(*pNMLVSCROLL\dx) + " y= " + Str(*pNMLVSCROLL\dy)
              
            Case #LVN_GETDISPINFO
              Protected *tNMLVDISPINFO.NMLVDISPINFO = LParam
              With *tNMLVDISPINFO
                If \item\mask & #LVIF_TEXT
                  \item\pszText = @ItemInfo(\item\iSubItem,\item\iItem)
                  \item\cchTextMax = Len(ItemInfo(\item\iSubItem,\item\iItem))
                EndIf
              EndWith
          EndSelect
      EndSelect
  EndSelect
  
  ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure 

If OpenWindow(0, 100, 100, 500, 600, "Test Virtual List-View", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  ListIconGadget(0, 5, 5, 490, 590, "Nom", 100, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection|#LVS_OWNERDATA)
  LvHwnd = GadgetID(0)
  AddGadgetColumn(0, 1, "Adresse", 250)
  
  SetWindowCallback(@WinCallback(),0)
  
  Debug "preparing list.."
  itemCount = 10000
  For u=0 To itemCount-1
    For ii=0 To 1
      ItemInfo(ii,u) =  Str(u) + " " + RandomString(5)
    Next
  Next
  Debug "End preparing list.."
  
  SendMessage_( LvHwnd, #LVM_SETITEMCOUNT, itemCount, 0 )
  
  Repeat
    Evenement = WaitWindowEvent()
  Until Evenement = #PB_Event_CloseWindow
EndIf

Code: Select all

OpenWindow(0,10,10,500,500,"Testing")

ListIconGadget(1,4,20-5,15+10+40+40+30+15+600-20+10+5+4+4+4-300-10-5-5-2,300-30+5+40,"#",30+40+10+5,#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_CheckBoxes)
AddGadgetColumn(1,1,"Words",100+10+20+20+10)
AddGadgetColumn(1,2,"Tags",150+5+15)

For f=1 To 10
  AddGadgetItem(1,-1,"Line #"+Str(f)+#LF$+"blah"+#LF$+"The vertical scroll gadget will be virtual")
Next f

; Keyboard shortcuts
AddKeyboardShortcut(0,#PB_Shortcut_Scroll,1000)

Repeat
  
  event=WaitWindowEvent()
  
    ; Shortcut for mouse-wheel
    If event=#PB_Event_Menu And EventMenu()=1000
      Debug "MOUSE-WHEEL pressed"
    EndIf  
  
ForEver

Code: Select all

Declare populateList(g, start)
wFlags = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
lFlags = #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_CheckBoxes
mainWin = OpenWindow(#PB_Any, #PB_Ignore, #PB_Ignore, 500, 300, "MouseWheel Example", wFlags)
mainCanvas = CanvasGadget(#PB_Any, 0, 0, 500, 300, #PB_Canvas_Keyboard | #PB_Canvas_Container)
mainList = ListIconGadget(#PB_Any, 0, 0, 490, 300, "#", 100, lFlags)
CloseGadgetList()

StartDrawing(CanvasOutput(mainCanvas))
  Box(0, 0, 500, 300, RGB(200, 200, 200))
StopDrawing()
AddGadgetColumn(mainList, 1, "Words", 180)
AddGadgetColumn(mainList, 2, "Tags", 180)
populateList(mainList, 1)
;DisableGadget(mainList, 1)   ;list is always scrollable but not selectable
SetActiveGadget(mainCanvas)
listCount = 1

MessageRequester("MouseWheel Example", "Click on the GREY area before scrolling.")

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      appQuit = 1
    Case #PB_Event_Gadget
      Select EventGadget()
        Case mainCanvas
          Select EventType()
            Case #PB_EventType_MouseWheel
              delta = GetGadgetAttribute(EventGadget(), #PB_Canvas_WheelDelta)
              If delta = 1
                If listCount > 1
                  listCount - 10
                  update = #True
                EndIf
              ElseIf delta < 0
                listCount + 10
                update = #True
              EndIf                  
              If update
                update = #False
                populateList(mainList, listCount)
              EndIf
          EndSelect
      EndSelect
  EndSelect
Until appQuit = 1 

Procedure populateList(g, start)
  ClearGadgetItems(g)
  For populate = start To start + 9
    AddGadgetItem(g, -1, "Line #" + Str(populate) + #LF$ + 
                         "Dummy Text " + Str(populate)  + #LF$ + 
                         "More dummy text " + Str(populate) )
  Next
EndProcedure