PureBasic Forums - English

Posted: **Wed Jun 19, 2013 4:49 pm**

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

Posted: **Wed Jun 19, 2013 7:51 pm**

Hi,

a 'pure' solution:

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

Posted: **Wed Jun 19, 2013 9:05 pm**

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.

Posted: **Wed Jun 19, 2013 9:18 pm**

davido wrote: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

Posted: **Wed Jun 19, 2013 9:26 pm**

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

PureBasic Forums - English

ImageScroller Object

ImageScroller Object

Re: ImageScroller Object

Re: ImageScroller Object

Re: ImageScroller Object

Re: ImageScroller Object