ZOOM IN\OUT ListIcon Gadget [Windows]

[RASHAD]

Tested with PB 4.6 x84 Win 7 x64

Code: Select all

  LoadFont(0,"Arial",10)
  LoadFont(1,"Broadway",14)

  If OpenWindow(0, 0, 0, 640, 300, "ListIconGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered|#PB_Window_SizeGadget)
    ListIconGadget(0,  10,  10, 620, 280, "Column 0", 200,#PB_ListIcon_GridLines)
      For x = 1 To 9 
        AddGadgetColumn(0, x, "Column " + Str(x), 300)
      Next
      For x = 0 To 8
        AddGadgetItem(0, x, "Item 0"+Chr(10)+"Item 1"+Chr(10)+"Item 2"+Chr(10)+"Item 3"+Chr(10)+"Item 4"+Chr(10)+"Item 5"+Chr(10))
      Next
      header = SendMessage_(GadgetID(0),#LVM_GETHEADER,0,0)
      SendMessage_(GadgetID(0),#WM_SETFONT,FontID(0),1)
      SendMessage_(header,#WM_SETFONT,FontID(1),1)      
           
      FSize_1 = 10
      FSize_2 = 14
      Col_No = 9
            
      Global Dim width(Col_No)
Repeat
  Select WaitWindowEvent()
      
      Case #PB_Event_CloseWindow
            Quit = 1
       
      
      Case #PB_Event_Gadget
            Select EventGadget()
             Case 0            
            EndSelect
            
            
      Case #WM_SIZE
            ResizeGadget(0,10,10,WindowWidth(0)-20,WindowHeight(0)-20)
            
          
      Case #WM_ENTERSIZEMOVE            
            HSpos.d = GetScrollPos_(GadgetID(0),#SB_HORZ)            
            WWidth.d = WindowWidth(0)
            For i = 0 To Col_No
                width(i) = GetGadgetItemAttribute(0, 0, #PB_ListIcon_ColumnWidth ,i)
            Next
          
      Case #WM_EXITSIZEMOVE
            Scale.d = WindowWidth(0)/WWidth
            FSize_1 = Int(Round((FSize_1 * Scale),1))
            FSize_2 = Int(Round((FSize_2 * Scale),1))          
            For i = 0 To Col_No
                SetGadgetItemAttribute(0, 0, #PB_ListIcon_ColumnWidth ,Round(Scale*width(i),#PB_Round_Up),i)
            Next

            LoadFont(0,"Arial",FSize_1)
            LoadFont(1,"Broadway",FSize_2)
            
            SendMessage_(GadgetID(0),#WM_SETFONT,FontID(0),1)
            SendMessage_(header,#WM_SETFONT,FontID(1),1)
            
            SendMessage_(GadgetID(0), #LVM_SCROLL,- GetScrollPos_(GadgetID(0),#SB_HORZ), 0)
            SendMessage_(GadgetID(0), #LVM_SCROLL,Scale*HSpos, 0)
      
  EndSelect
Until Quit = 1
EndIf

[dige]

@Rashad: could you explain pls, how to use it? What is the initial action to enter
the #WM_ENTERSIZEMOVE?

I mean are there others actions than change the size of the window...

[RASHAD]

Hi dige
The main purpose is to change the size of the ListIcon proportional to the initial size
And at the same time keep the Hal. scrollbar at the previous position
Let us start by setting the Hal. scrollbar between Column 3 and Column 4 for example
Then resize the window to see what I mean
So you can read what you want easily

[IdeasVacuum]

Hi Rashad - it's working really nicely on WinXP 32bit

The crème de la crème would be to zoom in-out on the gadget via middle-mouse drag or scroll (without necessarily changing window size).

[RASHAD]

Hi IdeasVacuum
It is your idea after all
Take it as a start

Code: Select all

  LoadFont(0,"Arial",10)
  LoadFont(1,"Broadway",14)

  If OpenWindow(0, 0, 0, 800, 500, "ListIconGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    ListIconGadget(0,  10,  10, 780, 480, "Column 0", 200,#PB_ListIcon_GridLines)
      For x = 1 To 9 
        AddGadgetColumn(0, x, "Column " + Str(x), 300)
      Next
      For x = 0 To 8
        AddGadgetItem(0, x, "Item 0"+Chr(10)+"Item 1"+Chr(10)+"Item 2"+Chr(10)+"Item 3"+Chr(10)+"Item 4"+Chr(10)+"Item 5"+Chr(10))
      Next
      header = SendMessage_(GadgetID(0),#LVM_GETHEADER,0,0)
      ;
      SendMessage_(GadgetID(0),#WM_SETFONT,FontID(0),1)      ;
      SendMessage_(header,#WM_SETFONT,FontID(1),1)
      
      Col_No = 9            
      Global Dim width(Col_No)
Repeat
  Select WaitWindowEvent()
      
      Case #PB_Event_CloseWindow
            Quit = 1
       
      
      Case #PB_Event_Gadget
            Select EventGadget()
             Case 0            
            EndSelect
            
            
      Case #WM_MOUSEWHEEL
          HSpos.d = GetScrollPos_(GadgetID(0),#SB_HORZ) 
          For i = 0 To Col_No
                width(i) = SendMessage_(GadgetID(0), #LVM_GETCOLUMNWIDTH, i, 0)
          Next
          Scale.d = 1
          If EventwParam() < 0
               Scale = Scale * 1.1
          Else
               Scale = Scale * 0.9
          EndIf
          
          For i = 0 To Col_No
                SendMessage_(GadgetID(0), #LVM_SETCOLUMNWIDTH, i,Round(Scale*width(i),#PB_Round_Up))
          Next
           SendMessage_(GadgetID(0), #LVM_SCROLL,- GetScrollPos_(GadgetID(0),#SB_HORZ), 0)
           SendMessage_(GadgetID(0), #LVM_SCROLL,Scale*HSpos, 0)
      
  EndSelect
Until Quit = 1
EndIf

[Kwai chang caine]

The first code is like usually splendid
Thanks a lot for sharing and for this amazing new behaviour of the ListIcon

[IdeasVacuum]

Clever stuff

[Num3]

LOL!

I like it! Nice idea