Zoomable ListIconGadget (Windows)

[firace]

Use CTRL+mousewheel (or pinch mousepad on laptop) to zoom in or out
Improvements welcome!

Note: Code might need a bit of cleanup

Code: Select all

; v002

Procedure LoadCSVtoLIG(LIGadget, file$, fileHasHeaders=1)
  separator$ = ","
  
  SetWindowTitle(0, "Loading " + GetFilePart(file$) + "..." )
  
  Shared nbcolumns
  
  FreeGadget(LIGadget)
  
  ListIconGadget(LIGadget,   20, 20, 900, 520, "X", 200, #PB_ListIcon_FullRowSelect | #PB_ListIcon_HeaderDragDrop | #PB_ListIcon_MultiSelect )
  
  
  RemoveGadgetColumn(LIGadget, 0)
  
  SetGadgetFont(LIGadget, FontID(1))
  
  SendMessage_(GadgetID(LIGadget),   #LVM_SETEXTENDEDLISTVIEWSTYLE, 0, SendMessage_(GadgetID(LIGadget),   #LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0) | #LVS_EX_LABELTIP  | #LVS_EX_GRIDLINES  | #LVS_EX_DOUBLEBUFFER)
  
  
  For a = 1 To 8
    AddGadgetColumn(LIGadget,   a, "header " + a, 140)
  Next 
  
  SendMessage_(GadgetID(LIGadget) ,$0B, 0, 0)
  
  
  For oio = 1 To 2500
    AddGadgetItem(LIGadget, -1, "jfzhkzh"+#LF$+Random(7368638367383)+#LF$+Random(7368638367383)+#LF$+"72893923JLKfskhf"+#LF$+"zrjkzhrz")
  Next 
  
  
  SendMessage_(GadgetID(LIGadget) ,$0B, 1, 0)
  
  SetWindowTitle(0, "Investigating " + GetFilePart(file$) + " -- Loaded " + nbentries + " rows")
EndProcedure



OpenWindow(0, 100, 35, 990, 650, "CSV-Viewer - Drag a CSV file to open" , #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)

Fname$ = "Consolas"
fsize = 10

LoadFont(1,Fname$ , fsize ) 


ListIconGadget(1, 20,  20, 950, 520, "", 200)
ListIconGadget(2, 20, 560, 950,  60, "", 200, #LVS_NOCOLUMNHEADER)   : HideGadget(2, 1)

SetGadgetFont(1, FontID(1))


LoadCSVtoLIG(1,  "d") 


Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow :   Quit = 1
      
    Case #WM_MOUSEWHEEL
      
      fsizechange = 0
      
      If EventwParam() & $FFFF = #MK_CONTROL
        Wheel.w = (EventwParam() & $FFFF0000) >> 16
        If Wheel < 0
          fsizechange = -1
        ElseIf Wheel > 0
          fsizechange = 1
        EndIf
      EndIf
      
      fsize = fsize + fsizechange
      
      SendMessage_(GadgetID(1) ,#WM_SETREDRAW, 0, 0)
      
      If fsize < 8 : fsize = 8 : EndIf 
      LoadFont(1,Fname$, fsize)
      SetGadgetFont(1, FontID(1))
      
      If fsizechange <> 0
        For a = 0 To 8
          SendMessage_(GadgetID(1),#LVM_SETCOLUMNWIDTH,a ,#LVSCW_AUTOSIZE_USEHEADER)  ; ? 
        Next 
      EndIf
      
      SendMessage_(GadgetID(1) ,#WM_SETREDRAW, 1, 0)
      
  EndSelect
Until Quit = 1  

[HeX0R]

I don't like those hard coded values, since we are here in tricks 'n' tipps and not in "guess what happens", I would suggest to change it into:

Code: Select all

Case #WM_MOUSEWHEEL

    	fsizechange = 0
    	
    	If EventwParam() & $FFFF = #MK_CONTROL
    		Wheel.w = (EventwParam() & $FFFF0000) >> 16
    		If Wheel < 0
    			fsizechange = -1
    		ElseIf Wheel > 0
    			fsizechange = 1
    		EndIf
      EndIf
      
      fsize = fsize + fsizechange
      
      SendMessage_(GadgetID(1) ,#WM_SETREDRAW, 0, 0)
      
      If fsize < 4 : fsize = 4 : EndIf 
      LoadFont(1,Fname$, fsize)
      SetGadgetFont(1, FontID(1))
      SetGadgetFont(2, FontID(1))
      
      If fsizechange <> 0
        For a = 0 To 8
          SendMessage_(GadgetID(1),#LVM_SETCOLUMNWIDTH,a ,#LVSCW_AUTOSIZE_USEHEADER)  ; ? 
        Next 
      EndIf
      
      SendMessage_(GadgetID(1) ,#WM_SETREDRAW, 1, 0)

btw.:
You need to hold CTRL to make it happen

[firace]

I don't like those hard coded values, since we are here in tricks 'n' tipps and not in "guess what happens", I would suggest to change it into:

Thanks, updated as per your feedback