ImageScroller Object

[Daniel-pb]

Hi all,
I thought the pb does not object to display large images and also functions for zooming the image.

[infratec]

Hi,

a 'pure' solution:

Code: Select all

UseJPEGImageDecoder()
UseJPEG2000ImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()


Filename$ = OpenFileRequester("", "", "*.*", 0)
If Filename$
  
  If LoadImage(0, Filename$)
    
    OpenWindow(0, 0, 0, 800, 600, "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
    
    ScrollAreaGadget(0, 0, 0, 800, 600, ImageWidth(0) , ImageHeight(0))
    ImageGadget(1, 0, 0, 0, 0, ImageID(0))
    CloseGadgetList()
    
    Repeat
      
      Event = WaitWindowEvent()
      
      Select Event
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 1
              Select EventType()
                Case #PB_EventType_LeftClick
                  ResizeImage(0, ImageWidth(0) * 1.2, ImageHeight(0) * 1.2)
                  SetGadgetState(1, ImageID(0))
                  SetGadgetAttribute(0, #PB_ScrollArea_InnerWidth, ImageWidth(0))
                  SetGadgetAttribute(0, #PB_ScrollArea_InnerHeight, ImageHeight(0))
                Case #PB_EventType_RightClick
                  ResizeImage(0, ImageWidth(0) * 0.8, ImageHeight(0) * 0.8)
                  SetGadgetState(1, ImageID(0))
                  SetGadgetAttribute(0, #PB_ScrollArea_InnerWidth, ImageWidth(0))
                  SetGadgetAttribute(0, #PB_ScrollArea_InnerHeight, ImageHeight(0))
              EndSelect
          EndSelect
        Case #PB_Event_CloseWindow
          Exit = #True
      EndSelect
      
    Until Exit
    
  EndIf
  
EndIf

Bernd

[davido]

Hi Bernd,

Really nice compact demo.
Thank you for sharing.

One small problem: Reducing the image size freezes the quality to a lower level.
I presume that copying the original image each time will overcome this.

[infratec]

One small problem: Reducing the image size freezes the quality to a lower level.
I presume that copying the original image each time will overcome this.

Yes that's right.
If you keep the orignal image as copy and resize always from the original image,
than the quality after up and downs is better.
It was only a 'quicky'.

Bernd

[infratec]

Maybe this results in a better quality:

Code: Select all

UseJPEGImageDecoder()
UseJPEG2000ImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()


Filename$ = OpenFileRequester("", "", "*.*", 0)
If Filename$
 
  If LoadImage(0, Filename$)
    CopyImage(0, 1)
    
    OpenWindow(0, 0, 0, 800, 600, "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
   
    ScrollAreaGadget(0, 0, 0, 800, 600, ImageWidth(1) , ImageHeight(1))
    ImageGadget(1, 0, 0, 0, 0, ImageID(1))
    CloseGadgetList()
    
    Factor.f = 1.0
    
    Repeat
     
      Event = WaitWindowEvent()
     
      Select Event
        Case #PB_Event_Gadget
          Select EventGadget()
            Case 1
              Select EventType()
                Case #PB_EventType_LeftClick
                  Factor + 0.1
                  CopyImage(0, 1)
                  ResizeImage(1, ImageWidth(1) * Factor, ImageHeight(1) * Factor, #PB_Image_Smooth)
                  SetGadgetState(1, ImageID(1))
                  SetGadgetAttribute(0, #PB_ScrollArea_InnerWidth, ImageWidth(1))
                  SetGadgetAttribute(0, #PB_ScrollArea_InnerHeight, ImageHeight(1))
                Case #PB_EventType_RightClick
                  If Factor > 0.1
                    Factor - 0.1
                    CopyImage(0, 1)
                    ResizeImage(1, ImageWidth(1) * Factor, ImageHeight(1) * Factor, #PB_Image_Smooth)
                    SetGadgetState(1, ImageID(1))
                    SetGadgetAttribute(0, #PB_ScrollArea_InnerWidth, ImageWidth(1))
                    SetGadgetAttribute(0, #PB_ScrollArea_InnerHeight, ImageHeight(1))
                  EndIf
              EndSelect
          EndSelect
        Case #PB_Event_CloseWindow
          Exit = #True
      EndSelect
     
    Until Exit
   
  EndIf
 
EndIf

Bernd