PureBasic Forums - English

Posted: **Thu Feb 07, 2008 7:05 pm**

No topics found on PB Forums about #PB_ScrollArea_InnerWidth and #PB_ScrollArea_InnerHeight, so here is a small tip to change ScrollAreaGadget inner sizes on the fly.

Code: Select all

;Change ScrollAreaGadget inner sizes
;by einander - feb 2008 - PB 4.10 

Structure SAGInnerSize
     SAG.l
     HorSpin.l
     VerSpin.l 
     IMG.l
     ImGad.l
     TmpIMG.l
EndStructure

Global _InfoSize
iSag.SAGInnerSize

Procedure  SAGSiz(*iSag.SAGInnerSize)
     With *iSag
          If IsImage(\TmpIMG):FreeImage(\TmpIMG):EndIf
          \TmpIMG=GrabImage(\IMG,-1,0,0,ImageWidth(\IMG),ImageHeight(\IMG))
          ResizeImage(\TmpIMG,GetGadgetState(\HorSpin)-24,GetGadgetState(\VerSpin)-46)
          SetGadgetState(\ImGad,ImageID(\TmpIMG))
          SetGadgetAttribute(\SAG, #PB_ScrollArea_InnerWidth ,ImageWidth(\TmpIMG))       
          SetGadgetAttribute(\SAG, #PB_ScrollArea_InnerHeight ,ImageHeight(\TmpIMG))       
          SetGadgetText(_InfoSize,Str(GetGadgetState(\HorSpin))+"  "+Str(GetGadgetState(\VerSpin)))
     EndWith
EndProcedure 

Macro GadgetBottom(Gad) :  GadgetY(Gad)+GadgetHeight(Gad) : EndMacro 
Macro GadgetRight(Gad) :  GadgetX(Gad)+GadgetWidth(Gad) : EndMacro
Macro NoFlick(Gad)
     SetWindowLong_(GadgetID(Gad), #GWL_EXSTYLE, GetWindowLong_(GadgetID(Gad), #GWL_EXSTYLE) |  #WS_EX_COMPOSITED)
EndMacro

;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
hwnd=OpenWindow(0,0,0,400,300,"ScrollArea Inner Resize",#WS_OVERLAPPEDWINDOW | #PB_Window_ScreenCentered)
StickyWindow(0,1)
Wi=WindowWidth(0):He=WindowHeight(0)
CreateGadgetList(hwnd)
iSag\IMG=LoadImage(-1,"c:\test1.bmp")  ; <<<<<<<<<<<<<  Here Your Image  <<<<<<<<<<<<<<<<<<<<<<<<<<<<<
iSag\HorSpin=TrackBarGadget(-1,0,0,0,0,80,5000)
SetGadgetState(iSag\HorSpin,WindowWidth(0))
iSag\VerSpin=TrackBarGadget(-1,0,0,0,0,80,5000,#PB_TrackBar_Vertical)
SetGadgetState(iSag\VerSpin,WindowHeight(0))
_BtnFit=ButtonGadget(-1,0,0,0,0,"Fit to window")
_InfoSize=TextGadget(-1,0,0,0,0,"",#PB_Text_Border)
iSag\SAG=ScrollAreaGadget(-1,0,0,0,0,GetGadgetState(iSag\HorSpin),GetGadgetState(iSag\VerSpin),10,#PB_ScrollArea_Center)
NoFlick(iSag\SAG)
               
iSag\ImGad=ImageGadget(-1,0,0,0,0,0)
SetGadgetColor(iSag\SAG, #PB_Gadget_BackColor,$BBBBBB)

Repeat
     If GetAsyncKeyState_(#VK_ESCAPE):End:EndIf
     Ev = WaitWindowEvent()
     Select Ev
          Case #PB_Event_SizeWindow
               Wi=WindowWidth(0):He=WindowHeight(0)
               ResizeGadget(iSag\SAG,0,0,Wi-20,He-42)
               ResizeGadget(iSag\HorSpin,2,GadgetBottom(iSag\SAG)+2,GadgetWidth(iSag\SAG)-2,16)      
               ResizeGadget(iSag\VerSpin,GadgetRight(iSag\SAG)+2,2,16,GadgetHeight(iSag\SAG)-2)      
               ResizeGadget(_BtnFit,2,GadgetBottom(iSag\HorSpin)+2,80,20)      
               ResizeGadget(_InfoSize,GadgetRight(_BtnFit)+2,GadgetBottom(iSag\HorSpin)+2,80,20)      
               SAGSiz(iSag)
          Case #PB_Event_Gadget
               Select EventGadget()
                    Case iSag\HorSpin,iSag\VerSpin
                         SAGSiz(iSag)
                    Case _BtnFit
                         SetGadgetState(iSag\HorSpin,Wi)
                         SetGadgetState(iSag\VerSpin,He)
                         SAGSiz(iSag)
               EndSelect
          Case #PB_Event_CloseWindow: End
     EndSelect
ForEver

Posted: **Tue Feb 12, 2008 9:52 pm**

Good one!
Thanks you for the code!

Posted: **Wed Feb 13, 2008 1:48 am**

@Pshychophanta
You're welcome

Another twist:

Code: Select all

UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
UseJPEGImageEncoder()
UsePNGImageEncoder()

Enumeration
     #TB=0
     #FIT
     #WinSiz
     #Orig
EndEnumeration

Structure SAG
     SAG.l
     HorTB.l
     VerTB.l 
     IMG.l
     ImGad.l
     TmpIMG.l
EndStructure

Global _BtnFit,_BtnOrig,_OrigFile$
    
Macro GadgetBottom(Gad) :  GadgetY(Gad)+GadgetHeight(Gad) : EndMacro ;-GadgetBottom(Gad) 
Macro GadgetRight(Gad) :  GadgetX(Gad)+GadgetWidth(Gad) : EndMacro ;- GadgetRight(Gad)

Macro NoFlick(GadNUM) ;- NoFlick(GadNUM)
     SetWindowLong_(GadgetID(GadNUM), #GWL_EXSTYLE, GetWindowLong_(GadgetID(GadNUM), #GWL_EXSTYLE) |  #WS_EX_COMPOSITED)
EndMacro

Procedure LoadIMG(DefaultFile$="*.*",Title.s="Load Image") ; Load Image - Ret ImageNum StandardFile$ = "i:\" ; set initial file+path to display
     Pattern$ = "Image Files (*.bmp, *.jpg, *.png, *.tif)|*.bmp;*.jpg;*.png;*.tif"
     _OrigFile$ = OpenFileRequester("Choose image file to load", DefaultFile$, Pattern$, 0) 
     If _OrigFile$
          IMG=LoadImage(-1, _OrigFile$)
          ProcedureReturn IMG
     Else
          MessageRequester( "Info","Image Not loaded.",0)
     EndIf
EndProcedure

Procedure SaveIMG(IMG,DefaultFile$="",Title.s="Save Image") ; Save Image 
     Pattern$="Windows or OS/2 Bitmap (*.bmp)|*.bmp|JFIF - JPEG Format (*.jpg)|*.jpg|Portable Networks Graphics Format (*.png)|*.png"
     File$=SaveFileRequester("Please Choose The File Name To Save", DefaultFile$, Pattern$, 0)
     If File$
          If SelectedFilePattern()=0
               If GetExtensionPart(File$)<>"bmp":  File$+".bmp" :EndIf
               SaveImage(IMG,File$,#PB_ImagePlugin_BMP)
          ElseIf SelectedFilePattern()=1 
               If GetExtensionPart(File$)<>"jpg" :  File$+".jpg":EndIf
               SaveImage(IMG,File$,#PB_ImagePlugin_JPEG,10)
          ElseIf SelectedFilePattern()=2 
               If  GetExtensionPart(File$)<>"png" :  File$+".png" :EndIf
               SaveImage(IMG,File$,#PB_ImagePlugin_PNG)
          EndIf 
     Else
          MessageRequester("info","file Not Saved",0)
     EndIf    
EndProcedure

Procedure SagSiz(*S.SAG,Typ)
     Wi=WindowWidth(0):He=WindowHeight(0)
     InnerWi=Wi-20 : InnerHe=He-80
     With *S  
          If Typ<>#WinSiz Or IsImage(\TmpIMG)=0
               If IsImage(\TmpIMG):FreeImage(\TmpIMG):EndIf
               \TmpIMG=GrabImage(\IMG,-1,0,0,ImageWidth(\IMG),ImageHeight(\IMG))
          EndIf
          If Typ=#TB  ; si entra trackbar, resize TmpImg con trackbar
               ResizeImage(\TmpIMG,GetGadgetState(\HorTB),GetGadgetState(\VerTB))
          ElseIf Typ=#FIT
               ResizeImage(\TmpIMG,InnerWi-6,InnerHe-6)
               SetGadgetState(\HorTB,ImageWidth(\TmpIMG))
               SetGadgetState(\VerTB,ImageHeight(\TmpIMG))
               InnerWi-6:InnerHe-6
          ElseIf Typ=#Orig  ; deja \tmpImg=\Img
               SetGadgetState(\HorTB,ImageWidth(\IMG))
               SetGadgetState(\VerTB,ImageHeight(\IMG))
          ElseIf Typ=#WinSiz
               ResizeGadget(\SAG,0,0,InnerWi,InnerHe)
               ResizeGadget(\HorTB,2,GadgetBottom(\SAG)+2,GadgetWidth(\SAG)-2,16)      
               ResizeGadget(\VerTB,GadgetRight(\SAG)+2,2,16,GadgetHeight(\SAG)-2)      
               ResizeGadget(_BtnFit,2,GadgetBottom(\HorTB)+2,80,20)      
               ResizeGadget(_BtnOrig,GadgetRight(_BtnFit)+2,GadgetBottom(\HorTB)+2,80,20)      
          EndIf
          
          SetGadgetState(\ImGad,ImageID(\TmpIMG))
          SetGadgetAttribute(\SAG, #PB_ScrollArea_InnerWidth ,ImageWidth(\TmpIMG))       
          SetGadgetAttribute(\SAG, #PB_ScrollArea_InnerHeight ,ImageHeight(\TmpIMG))       
          StatusBarText(1,0,"Image : "+Str(ImageWidth(\TmpIMG))+" X "+Str(ImageHeight(\TmpIMG))+"  -  Display : "+Str(InnerWi)+" X "+Str(InnerHe))
     EndWith 
EndProcedure 

Procedure  InitSag(*S.SAG,TBMin,TBMax,BackRGB=#White)
     With *S
          Wi=WindowWidth(0):He=WindowHeight(0)
          \IMG=LoadIMG()
          If \IMG=0 :End:EndIf
          \HorTB=TrackBarGadget(-1,0,0,0,0,   TBMin,TBMax)
          SetGadgetState(\HorTB,Wi)
          \VerTB=TrackBarGadget(-1,0,0,0,0,TBMin,TBMax,#PB_TrackBar_Vertical)
          SetGadgetState(\VerTB,He)
          \SAG=ScrollAreaGadget(-1,0,0,0,0,Wi,He,10,#PB_ScrollArea_Center)
          NoFlick(\SAG)
          \ImGad=ImageGadget(-1,0,0,0,0,0)
          SetGadgetColor(\SAG, #PB_Gadget_BackColor,BackRGB)
     EndWith
EndProcedure 

Procedure Menu()
     CreateMenu(0, WindowID(0))    ; menu creation starts....
     MenuTitle("Options")
     MenuItem(1, "Load Image"   +Chr(9)+"Ctrl+L")
     MenuItem(2, "Save Image"   +Chr(9)+"Ctrl+S")
     MenuItem(3, "Save Image As"+Chr(9)+"Ctrl+A")
     MenuItem(4, "Quit"  +Chr(9)+"Ctrl+Q")
EndProcedure

;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

hwnd=OpenWindow(0,0,0,600,400,"ScrollArea Inner Resize",#WS_OVERLAPPEDWINDOW | #PB_Window_ScreenCentered)
StickyWindow(0,1)
Wi=WindowWidth(0):He=WindowHeight(0)
CreateStatusBar(1,hwnd); <<<<<<<<<< como hacer resize del statusbar??????
AddStatusBarField(Wi)

Menu()
CreateGadgetList(hwnd)
_BtnFit=ButtonGadget(-1,0,0,0,0,"Fit to display")
_BtnOrig=ButtonGadget(-1,0,0,0,0,"Original size")

iSag.SAG
With iSag
     InitSag(iSag,80,4000,$FFFFDC)   
     Repeat
          If GetAsyncKeyState_(#VK_ESCAPE):End:EndIf
          Ev = WaitWindowEvent()
          Select Ev
               Case #PB_Event_Gadget 
                    Select EventGadget()
                         Case \HorTB,\VerTB  :  SagSiz(iSag,#TB) ; da igual si va 0 como 2do param 
                         Case _BtnFit :  SagSiz(iSag,#FIT)
                         Case _BtnOrig : SagSiz(iSag,#Orig)
                    EndSelect
               Case #PB_Event_SizeWindow  :  SagSiz(iSag,#WinSiz)
               Case  #PB_Event_Menu
                    Select EventMenu()
                         Case 1 ;load
                              \IMG=LoadIMG()
                              SagSiz(iSag,#Orig)       
                         Case 2 ;save
                              Select LCase(GetExtensionPart(_OrigFile$))
                                   Case "bmp" :  SaveImage(\TmpIMG,_OrigFile$,#PB_ImagePlugin_BMP)
                                   Case "jpg" :  SaveImage(\TmpIMG,_OrigFile$,#PB_ImagePlugin_JPEG,10)
                                   Case "png" :  SaveImage(\TmpIMG,_OrigFile$,#PB_ImagePlugin_PNG)
                                   Default :  MessageRequester("Info","Image not saved",0)
                              EndSelect
                         Case 3 ;save as
                              SaveIMG(\TmpIMG)
                         Case 4 : End ;quit
                    EndSelect
               Case #PB_Event_CloseWindow: End
          EndSelect
     ForEver
EndWith
; IDE Options = PureBasic 4.20 Beta 2 (Windows - x86)

Posted: **Wed Feb 13, 2008 3:02 pm**

Indeed this one is better.

It is strange that never before appeared this feature in the forum.

Posted: **Wed Feb 13, 2008 3:44 pm**

lol. Neat!

Nice one, and thanks.

Psychophanta wrote:It is strange that never before appeared this feature in the forum.

True.

Posted: **Wed Feb 13, 2008 3:52 pm**

Psychophanta wrote:Indeed this one is better.
It is strange that never before appeared this feature in the forum.

It's an often overlooked and, therefore, under-used, attribute of scroll area gadgets. Indeed this facility makes scroll areas one of the most useful and versatile PB gadgets.