PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Photoshop-like canvas scroll bars

https://www.purebasic.fr/english/viewtopic.php?t=28812

Page 1 of 1

Photoshop-like canvas scroll bars

Posted: Thu Sep 20, 2007 2:24 am
by Mistrel
I'm writing a heightmap editor and I'm trying to give the UI a Photoshop feel to it. Here is the code I'm using to add photoshop-like scroll bars to the canvas area.

A big thanks to everyone who helped me with solutions for problems I encountered along the way. :)

Code: Select all

Procedure GrabResizeHandle(hwnd)
	SendMessage_(hwnd,#WM_NCLBUTTONDOWN,#HTCAPTION,0)
EndProcedure

Procedure SetScrollAttribute(Gadget.l, Attribute.l, Value.l)
   Protected Handle.l
   Protected HoldInfo.SCROLLINFO
   Protected IsDisabled.l
   If GadgetType(Gadget)<>#PB_GadgetType_ScrollBar
   	ProcedureReturn
   EndIf
   Handle=GadgetID(Gadget)
   IsDisabled=GetWindowLong_(Handle, #GWL_STYLE)&#WS_DISABLED
   HoldInfo\cbSize=SizeOf(SCROLLINFO)
   HoldInfo\fMask=#SIF_ALL

   GetScrollInfo_(Handle, #SB_CTL, @HoldInfo)
   If Attribute=#PB_ScrollBar_Minimum
      HoldInfo\nMin=Value
   ElseIf Attribute=#PB_ScrollBar_Maximum
      HoldInfo\nMax=Value
   ElseIf Attribute=#PB_ScrollBar_PageLength
      HoldInfo\nPage=Value
   Else
      ProcedureReturn
   EndIf
   If IsDisabled
   	SetScrollInfo_(Handle, #SB_CTL, @HoldInfo, #False)
   Else
   	SetScrollInfo_(Handle, #SB_CTL, @HoldInfo, #True)
   EndIf
EndProcedure

Procedure UpdateScrollAreaX(sa_h,sb_h)
	SetGadgetAttribute(sa_h,#PB_ScrollArea_X,GetGadgetState(sb_h))
EndProcedure

Procedure UpdateScrollAreaY(sa_h,sb_h)
	; sa_h, ScrolbarArea gadget hwnd
	; sb_h, vertical scrollbar gadget hwnd
	SetGadgetAttribute(sa_h,#PB_ScrollArea_Y,GetGadgetState(sb_h))
EndProcedure

Procedure ForceGadgetZOrder(gadget)
	;/ Flip the gadget draw order and force
	;/ the topmost gadget to recieve focus
	;/ first for overlapping gadgets
	SetWindowLong_(GadgetID(gadget),#GWL_STYLE,GetWindowLong_(GadgetID(gadget),#GWL_STYLE)|#WS_CLIPSIBLINGS)
	SetWindowPos_(GadgetID(gadget),#HWND_TOP,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE)
EndProcedure

Procedure SendGadgetToBottom(gadget)
	;/ Sends the gadget to the bottom of
	;/ the gadget stack
	SetWindowLong_(GadgetID(gadget),#GWL_STYLE,GetWindowLong_(GadgetID(gadget),#GWL_STYLE)|#WS_CLIPSIBLINGS)
	SetWindowPos_(GadgetID(gadget),#HWND_BOTTOM,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE)
EndProcedure

Structure SBtoSBArea_struct ; scrollbar to scrollbar area link-map structure
	sb_area.l
	sb_horizontal.l
	sb_vertical.l
EndStructure

NewList SBtoSBArea.SBtoSBArea_struct()

Procedure LinkSBtoSBArea(sb_a,sb,sb_type)
	;/ Link Scrollbar to Scrollbar Area
	;/ sb_a, scrollbar area gadget#
	;/ sb,	scrollbar gadget#
	;/ sb_type, scrollbar type. #SB_HORZ=0 #SB_VERT=1

	;{ Scan for invalid gadgets and duplicate 
	; entries before adding new gadgets to
	; the list.
	; Scrollbar areas can be duplicates,
	; because more than one scrollbar can
	; affect it. But duplicates of scrollbars
	; will be purged.
	Shared SBtoSBArea()
	If CountList(SBtoSBArea())
		FirstElement(SBtoSBArea())
		For i=1 To CountList(SBtoSBArea())
			If Not IsGadget(GetProp_(SBtoSBArea()\sb_area,"PB_ID"))
				SBtoSBArea()\sb_area=0
			EndIf
			If SBtoSBArea()\sb_horizontal=GadgetID(sb)
				SBtoSBArea()\sb_horizontal=0
			ElseIf Not IsGadget(GetProp_(SBtoSBArea()\sb_horizontal,"PB_ID"))
				SBtoSBArea()\sb_horizontal=0
			EndIf
			If SBtoSBArea()\sb_vertical=GadgetID(sb)
				SBtoSBArea()\sb_vertical=0
			ElseIf Not IsGadget(GetProp_(SBtoSBArea()\sb_horizontal,"PB_ID"))
				SBtoSBArea()\sb_vertical=0
			EndIf
			If SBtoSBArea()\sb_area=0 And SBtoSBArea()\sb_horizontal=0 And SBtoSBArea()\sb_vertical=0
				DeleteElement(SBtoSBArea())
				i=i+1
			EndIf
			NextElement(SBtoSBArea())
		Next i
		;}
	EndIf
	AddElement(SBtoSBArea())
	id=GadgetID(sb_a)
	SBtoSBArea()\sb_area=id
	If sb_type=#SB_HORZ
		SBtoSBArea()\sb_horizontal=GadgetID(sb)
	ElseIf sb_type=#SB_VERT
		SBtoSBArea()\sb_vertical=GadgetID(sb)
	EndIf
EndProcedure
	
Procedure GetSBAreaFromSB(sb,sb_type)
	;/ Get Scrollbar Area from Scrollbar
	Shared SBtoSBArea()
	If CountList(SBtoSBArea())
		FirstElement(SBtoSBArea())
		For i=1 To CountList(SBtoSBArea())
			If sb_type=#SB_HORZ
				If GadgetID(sb)=SBtoSBArea()\sb_horizontal
					ProcedureReturn  GetProp_(SBtoSBArea()\sb_area,"PB_ID")
				EndIf
			ElseIf sb_type=#SB_VERT
				If GadgetID(sb)=SBtoSBArea()\sb_vertical
					ProcedureReturn GetProp_(SBtoSBArea()\sb_area,"PB_ID")
				EndIf
			EndIf		
			NextElement(SBtoSBArea())
		Next i
	EndIf
EndProcedure

Procedure Callback(Handle.l, uMsg.l, wParam.l, lParam.l)
	Static offset.POINT
   Protected lResult.l
   Protected AllowScroll.l
   Protected HoldInfo.SCROLLINFO
   Static scrollbar_focus,scrollbar_type
   If uMsg = #WM_HSCROLL
      ;{ User is scrolling a horizontal scrollbar.
      ; If lParam = GadgetID(0)
      ;/ This would be a place to test which scrollbar is used.
      HoldInfo\cbSize = SizeOf(SCROLLINFO)
      HoldInfo\fMask = #SIF_ALL
      GetScrollInfo_(lParam, #SB_CTL, @HoldInfo)
      AllowScroll = #True
      ; Allow scrolling by default.
      If wParam & $FFFF = #SB_THUMBTRACK
         HoldInfo\nPos = HoldInfo\nTrackPos
      ElseIf wParam & $FFFF = #SB_LINERIGHT
         HoldInfo\nPos + 1
      ElseIf wParam & $FFFF = #SB_LINELEFT
         HoldInfo\nPos - 1
      ElseIf wParam & $FFFF = #SB_PAGERIGHT
         HoldInfo\nPos + 3
      ElseIf wParam & $FFFF = #SB_PAGELEFT
         HoldInfo\nPos - 3
      Else
         ; The scroll message is unhandled.
         AllowScroll = #False
         ; Do not allow the user to scroll.
      EndIf
      If AllowScroll
			If lParam
				scrollbar_focus=lParam
				scrollbar_type=#SB_HORZ
			EndIf
         If HoldInfo\nPos <> offset\X
            offset\X = HoldInfo\nPos
         Else
            ProcedureReturn #True
         EndIf
      Else
      	scrollbar_focus=0
         ProcedureReturn #True
      EndIf
      ;}
   ElseIf uMsg = #WM_VSCROLL
      ;{ User is scrolling a vertical scrollbar.
      ; If lParam = GadgetID(1)
      ;/ This would be a place to test which scrollbar is used.
      HoldInfo\cbSize = SizeOf(SCROLLINFO)
      ; Store the size of the ScrollInfo structure.
      HoldInfo\fMask = #SIF_ALL
      ; All settings are needed.
      GetScrollInfo_(lParam, #SB_CTL, @HoldInfo)
      ; Retrieve information on the scrollbar.
      AllowScroll = #True
      ; Allow scrolling by default.
      If wParam & $FFFF = #SB_THUMBTRACK
         HoldInfo\nPos = HoldInfo\nTrackPos
      ElseIf wParam & $FFFF = #SB_LINEUP
         HoldInfo\nPos - 1
      ElseIf wParam & $FFFF = #SB_LINEDOWN
         HoldInfo\nPos + 1
      ElseIf wParam & $FFFF = #SB_PAGEUP
         HoldInfo\nPos - 3
      ElseIf wParam & $FFFF = #SB_PAGEDOWN
         HoldInfo\nPos + 3
      Else
         ; The scroll message is unhandled.
         AllowScroll = #False
         ; Do not allow the user to scroll.
      EndIf
      If AllowScroll
			If lParam
				scrollbar_focus=lParam
				scrollbar_type=#SB_VERT
			EndIf
         If HoldInfo\nPos <> offset\Y
            offset\Y = HoldInfo\nPos
         Else
            ProcedureReturn #True
         EndIf
      Else
         ; The user is not allowed to scroll to the desired position.
         scrollbar_focus=0
         ProcedureReturn #True
         ; Do not process the scrollbar event.
      EndIf
      ;}
   EndIf
   If scrollbar_focus
   	gadgetid=GetProp_(scrollbar_focus,"PB_ID")
   	If scrollbar_type=#SB_HORZ
			UpdateScrollAreaX(GetSBAreaFromSB(gadgetid,#SB_HORZ),gadgetid)
		ElseIf scrollbar_type=#SB_VERT
			UpdateScrollAreaY(GetSBAreaFromSB(gadgetid,#SB_VERT),gadgetid)
		EndIf
	EndIf
	ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

img=CreateImage(#PB_Any,80,80)
resize_handle_img=CreateImage(#PB_Any,15,15)

w=640
h=480
scrollbar_w=15
scrollbar_sysw=GetSystemMetrics_(#SM_CXVSCROLL)

If OpenWindow(main_window, 0, 0, w, h, "ScrollAreaGadget", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget) And CreateGadgetList(WindowID(0))
	CreateGadgetList(WindowID(main_window))

	hwnd=WindowID(main_window)
	SetWindowPos_(hwnd,0,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE|#SWP_NOZORDER|#SWP_FRAMECHANGED)
	
	scroll_area=ScrollAreaGadget(#PB_Any,0,0,w,h,w,h,30,#PB_ScrollArea_BorderLess)
	ImageGadget(image_g,10,10,80,80,ImageID(img))
	CloseGadgetList()
	SendGadgetToBottom(scroll_area)
	hscroll_g=ScrollBarGadget(#PB_Any,0,WindowHeight(main_window)-scrollbar_w,WindowWidth(main_window)-scrollbar_w,scrollbar_w,0,GetGadgetAttribute(scroll_area,#PB_ScrollArea_InnerWidth),0)
	vscroll_g=ScrollBarGadget(#PB_Any,WindowWidth(main_window)-scrollbar_w,0,scrollbar_w,WindowHeight(main_window)-scrollbar_w,0,GetGadgetAttribute(scroll_area,#PB_ScrollArea_InnerHeight),0,#PB_ScrollBar_Vertical)
	LinkSBtoSBArea(scroll_area,hscroll_g,#SB_HORZ)
	LinkSBtoSBArea(scroll_area,vscroll_g,#SB_VERT)
	
	resize_handle_g=ImageGadget(#PB_Any,0,0,scrollbar_w,scrollbar_w,ImageID(resize_handle_img))
	StartDrawing(ImageOutput(resize_handle_img))
	color_3dface=GetSysColor_(#COLOR_3DFACE)
	Box(0,0,16,16,RGB(Red(color_3dface),Green(color_3dface),Blue(color_3dface)))
	Line(3,13,11,-11,RGB(254,254,253))
	Line(4,13,10,-10,RGB(129,129,129))
	Line(5,13,9,-9,RGB(129,129,129))
	Line(7,13,7,-7,RGB(254,254,253))
	Line(8,13,6,-6,RGB(129,129,129))
	Line(9,13,5,-5,RGB(129,129,129))
	Line(11,13,3,-3,RGB(254,254,253))
	Line(12,13,2,-2,RGB(129,129,129))
	Line(13,13,1,-1,RGB(129,129,129))
	StopDrawing()
	SetGadgetState(resize_handle_g,ImageID(resize_handle_img))

	ForceGadgetZOrder(scroll_area)
	ForceGadgetZOrder(hscroll_g)
	ForceGadgetZOrder(vscroll_g)
	ForceGadgetZOrder(resize_handle_g)
	
	SetWindowCallback(@Callback())
    Repeat
    	SmartWindowRefresh(main_window,1)
		
	   event=WaitWindowEvent()
	   If event
	   	eventtype=EventType()
	   	eventgadget=EventGadget()
	   Else
	   	event=0
	   	eventtype=0
	   	eventgadget=0
	   EndIf

		If (event=#PB_Event_Gadget And eventgadget=resize_handle_g) Or event=#PB_Event_SizeWindow
			resize_win=1
		EndIf
		
		If resize_win=1 And GetAsyncKeyState_(#VK_LBUTTON)&32768
			SendMessage_(WindowID(main_window),#WM_NCLBUTTONDOWN,#HTBOTTOMRIGHT,0) ; resize window
			If GetGadgetAttribute(scroll_area,#PB_ScrollArea_InnerWidth)<=WindowWidth(main_window)
				If Not GetWindowLong_(GadgetID(hscroll_g), #GWL_STYLE) & #WS_DISABLED
					DisableGadget(hscroll_g,1)
				EndIf
			Else
				If GetWindowLong_(GadgetID(hscroll_g), #GWL_STYLE) & #WS_DISABLED
					DisableGadget(hscroll_g,0)
				EndIf
			EndIf
			
			If GetGadgetAttribute(scroll_area,#PB_ScrollArea_InnerHeight)<=WindowHeight(main_window)
				If Not GetWindowLong_(GadgetID(vscroll_g), #GWL_STYLE) & #WS_DISABLED
					DisableGadget(vscroll_g,1)
				EndIf
			Else
				If GetWindowLong_(GadgetID(vscroll_g), #GWL_STYLE) & #WS_DISABLED
					DisableGadget(vscroll_g,0)
				EndIf
			EndIf
		Else
			resize_win=0
		EndIf
		
		If Not GetAsyncKeyState_(#VK_LBUTTON)&32768
			resize_win=0
		EndIf

	   If event
	     GetCursorPos_(@cp.point)
	     GetWindowRect_(GadgetID(resize_handle_g),gr.RECT)
	     If PtInRect_(@gr, cp\x, cp\y)   
	         SetCursor_(LoadCursor_(0,#IDC_SIZENWSE))
	      EndIf
	   EndIf
    	If event=#PB_Event_SizeWindow
    	
    		ResizeGadget(scroll_area,0,0,WindowWidth(main_window)+scrollbar_sysw-scrollbar_w,WindowHeight(main_window)+scrollbar_sysw-scrollbar_w)
 			ResizeGadget(vscroll_g,WindowWidth(main_window)-scrollbar_w,0,#PB_Ignore,WindowHeight(main_window)-scrollbar_w)
 			ResizeGadget(hscroll_g,0,WindowHeight(main_window)-scrollbar_w,WindowWidth(main_window)-scrollbar_w,#PB_Ignore)
 			ResizeGadget(resize_handle_g,WindowWidth(main_window)-scrollbar_w,WindowHeight(main_window)-scrollbar_w,#PB_Ignore,#PB_Ignore)
 			SetScrollAttribute(vscroll_g,#PB_ScrollBar_PageLength,WindowHeight(main_window))
 			SetScrollAttribute(hscroll_g,#PB_ScrollBar_PageLength,WindowWidth(main_window))
    	EndIf
    	
    	SetGadgetState(image_g,ImageID(img))
      Select event
        Case  #PB_Event_CloseWindow
          End
      EndSelect
    ForEver
  EndIf

Posted: Thu Sep 20, 2007 10:24 pm
by Mistrel
Bug fixes and more gadget-like functionality. You can now have multiple instances of this scroll bar canvas in its own window.

Code: Select all

Procedure GrabResizeHandle(hwnd)
	SendMessage_(hwnd,#WM_NCLBUTTONDOWN,#HTCAPTION,0)
EndProcedure

Procedure SetScrollAttribute(Gadget.l, Attribute.l, Value.l)
   Protected Handle.l
   Protected HoldInfo.SCROLLINFO
   Protected IsDisabled.l
   If GadgetType(Gadget)<>#PB_GadgetType_ScrollBar
   	ProcedureReturn
   EndIf
   Handle=GadgetID(Gadget)
   IsDisabled=GetWindowLong_(Handle, #GWL_STYLE)&#WS_DISABLED
   HoldInfo\cbSize=SizeOf(SCROLLINFO)
   HoldInfo\fMask=#SIF_ALL

   GetScrollInfo_(Handle, #SB_CTL, @HoldInfo)
   If Attribute=#PB_ScrollBar_Minimum
      HoldInfo\nMin=Value
   ElseIf Attribute=#PB_ScrollBar_Maximum
      HoldInfo\nMax=Value
   ElseIf Attribute=#PB_ScrollBar_PageLength
      HoldInfo\nPage=Value
   Else
      ProcedureReturn
   EndIf
   If IsDisabled
   	SetScrollInfo_(Handle, #SB_CTL, @HoldInfo, #False)
   Else
   	SetScrollInfo_(Handle, #SB_CTL, @HoldInfo, #True)
   EndIf
EndProcedure

Procedure UpdateScrollAreaX(sa_h,sb_h)
	;Debug Str(GetGadgetAttribute(sb_h,#PB_ScrollArea_X))+"\"+Str(GetGadgetState(sb_h))+" width "+Str(GadgetHeight(sa_h))
	SetGadgetAttribute(sa_h,#PB_ScrollArea_X,GetGadgetState(sb_h))
EndProcedure

Procedure UpdateScrollAreaY(sa_h,sb_h)
	; sa_h, ScrolbarArea gadget hwnd
	; sb_h, vertical scrollbar gadget hwnd
	SetGadgetAttribute(sa_h,#PB_ScrollArea_Y,GetGadgetState(sb_h))
EndProcedure

Procedure ForceGadgetZOrder(gadget)
	;/ Flip the gadget draw order and force
	;/ the topmost gadget to recieve focus
	;/ first for overlapping gadgets
	SetWindowLong_(GadgetID(gadget),#GWL_STYLE,GetWindowLong_(GadgetID(gadget),#GWL_STYLE)|#WS_CLIPSIBLINGS)
	SetWindowPos_(GadgetID(gadget),#HWND_TOP,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE)
EndProcedure

Procedure SendGadgetToBottom(gadget)
	;/ Sends the gadget to the bottom of
	;/ the gadget stack
	SetWindowLong_(GadgetID(gadget),#GWL_STYLE,GetWindowLong_(GadgetID(gadget),#GWL_STYLE)|#WS_CLIPSIBLINGS)
	SetWindowPos_(GadgetID(gadget),#HWND_BOTTOM,0,0,0,0,#SWP_NOSIZE|#SWP_NOMOVE)
EndProcedure

Structure SBtoSBArea_struct ; scrollbar to scrollbar area link-map structure
	sb_area.l
	sb_horizontal.l
	sb_vertical.l
EndStructure

NewList SBtoSBArea.SBtoSBArea_struct()

Procedure LinkSBtoSBArea(sb_a,sb,sb_type)
	;/ Link Scrollbar to Scrollbar Area
	;/ sb_a, scrollbar area gadget#
	;/ sb,	scrollbar gadget#
	;/ sb_type, scrollbar type. #SB_HORZ=0 #SB_VERT=1

	;{ Scan for invalid gadgets and duplicate 
	; entries before adding new gadgets to
	; the list.
	Shared SBtoSBArea()
	If CountList(SBtoSBArea())
		FirstElement(SBtoSBArea())
		If CountList(SBtoSBArea())
		For i=1 To CountList(SBtoSBArea())
			If Not IsGadget(GetProp_(SBtoSBArea()\sb_area,"PB_ID"))
				SBtoSBArea()\sb_area=0
			EndIf
			If SBtoSBArea()\sb_horizontal=GadgetID(sb)
				SBtoSBArea()\sb_horizontal=0
			ElseIf Not IsGadget(GetProp_(SBtoSBArea()\sb_horizontal,"PB_ID")) And SBtoSBArea()\sb_horizontal<>0
				SBtoSBArea()\sb_horizontal=0
			EndIf
			If SBtoSBArea()\sb_vertical=GadgetID(sb)
				SBtoSBArea()\sb_vertical=0
			ElseIf Not IsGadget(GetProp_(SBtoSBArea()\sb_vertical,"PB_ID")) And SBtoSBArea()\sb_vertical<>0
				SBtoSBArea()\sb_vertical=0
			EndIf
			If SBtoSBArea()\sb_area=0 And SBtoSBArea()\sb_horizontal=0 And SBtoSBArea()\sb_vertical=0
				DeleteElement(SBtoSBArea())
				i=i+1
			EndIf
			If SBtoSBArea()\sb_area=GadgetID(sb_a)
				sba_dup=ListIndex(SBtoSBArea())+1 ; Scrollbar area duplicate. This gadget is already present
			EndIf
			NextElement(SBtoSBArea())
		Next i
		EndIf
		;}
	EndIf
	If Not sba_dup
		AddElement(SBtoSBArea())
		SBtoSBArea()\sb_area=GadgetID(sb_a)
		If sb_type=#SB_HORZ
			SBtoSBArea()\sb_horizontal=GadgetID(sb)
		ElseIf sb_type=#SB_VERT
			SBtoSBArea()\sb_vertical=GadgetID(sb)
		EndIf
	Else
		SelectElement(SBtoSBArea(),sba_dup-1)
		If sb_type=#SB_HORZ
			SBtoSBArea()\sb_horizontal=GadgetID(sb)
		ElseIf sb_type=#SB_VERT
			SBtoSBArea()\sb_vertical=GadgetID(sb)
		EndIf
	EndIf
EndProcedure
	
Procedure GetSBAreaFromSB(sb,sb_type)
	;/ Get Scrollbar Area from Scrollbar
	Shared SBtoSBArea()
	If CountList(SBtoSBArea())
		FirstElement(SBtoSBArea())
		For i=1 To CountList(SBtoSBArea())
			If sb_type=#SB_HORZ
				If GadgetID(sb)=SBtoSBArea()\sb_horizontal
					ProcedureReturn  GetProp_(SBtoSBArea()\sb_area,"PB_ID")
				EndIf
			ElseIf sb_type=#SB_VERT
				If GadgetID(sb)=SBtoSBArea()\sb_vertical
					ProcedureReturn GetProp_(SBtoSBArea()\sb_area,"PB_ID")
				EndIf
			EndIf		
			NextElement(SBtoSBArea())
		Next i
	EndIf
EndProcedure

Structure sac_struct
	scrollarea_g.l
	canvas_g.l
	canvas_img.l
	canvasbg_g.l
	canvasbg_img.l
	hscroll_g.l
	vscroll_g.l
	gripper_g.l
	scrollbarwidth.l
	parent.l
	x.l
	y.l
EndStructure

Procedure ScrollAreaCanvas(*VarStruct.sac_struct,x,y,CanvasWidth,CanvasHeight,ScrollStep,Flags=0)
	ScrollBarWidth=15
	scrollbar_sysw=GetSystemMetrics_(#SM_CXVSCROLL)
	gadget=ButtonGadget(#PB_Any,0,0,0,0,"")
	parent=GetParent_(GadgetID(gadget))
	FreeGadget(gadget)
	If IsWindow(GetProp_(parent,"PB_WindowID")-1)
		parent=GetProp_(parent,"PB_WindowID")-1
	ElseIf IsGadget(GetProp_(parent,"PB_ID"))
		MessageRequester("Error","ScrollAreaCanvas() cannot be used within another gadget.")
		End
	Else
		MessageRequester("Error","Unhandled Exception at line"+Str(GetErrorLineNR())+".")
		End
	EndIf

	width=WindowWidth(parent)-x
	height=WindowHeight(parent)-y
	
	canvas_img=CreateImage(#PB_Any,CanvasWidth,CanvasHeight)
	gripper_img=CreateImage(#PB_Any,15,15)
	scrollarea_g=ScrollAreaGadget(#PB_Any,x,y,width-ScrollBarWidth+scrollbar_sysw,height-ScrollBarWidth+scrollbar_sysw,width,height,ScrollStep,Flags)
	canvas_g=ImageGadget(#PB_Any,(width-scrollbarwidth)/2-CanvasWidth/2,(height-scrollbarwidth)/2-CanvasHeight/2,CanvasWidth,CanvasHeight,ImageID(canvas_img))
	CloseGadgetList()
	SetGadgetColor(scrollarea_g,#PB_Gadget_BackColor,RGB(128,128,128))

	hscroll_g=ScrollBarGadget(#PB_Any,0,height-ScrollBarWidth,width-ScrollBarWidth,ScrollBarWidth,0,CanvasWidth,width)
	vscroll_g=ScrollBarGadget(#PB_Any,width-ScrollBarWidth,0,ScrollBarWidth,height-ScrollBarWidth,0,CanvasHeight,height,#PB_ScrollBar_Vertical)
	If width>=CanvasWidth
		DisableGadget(hscroll_g,1)
	EndIf
	If height>=CanvasHeight
		DisableGadget(vscroll_g,1)
	EndIf
	LinkSBtoSBArea(scrollarea_g,hscroll_g,#SB_HORZ)
	LinkSBtoSBArea(scrollarea_g,vscroll_g,#SB_VERT)
	
	gripper_g=ImageGadget(#PB_Any,width-ScrollBarWidth,height-ScrollBarWidth,ScrollBarWidth,ScrollBarWidth,ImageID(gripper_img))
	StartDrawing(ImageOutput(gripper_img))
	color_3dface=GetSysColor_(#COLOR_3DFACE)
	Box(0,0,15,15,RGB(Red(color_3dface),Green(color_3dface),Blue(color_3dface)))
	Line(3,13,11,-11,RGB(254,254,253))
	Line(4,13,10,-10,RGB(129,129,129))
	Line(5,13,9,-9,RGB(129,129,129))
	Line(7,13,7,-7,RGB(254,254,253))
	Line(8,13,6,-6,RGB(129,129,129))
	Line(9,13,5,-5,RGB(129,129,129))
	Line(11,13,3,-3,RGB(254,254,253))
	Line(12,13,2,-2,RGB(129,129,129))
	Line(13,13,1,-1,RGB(129,129,129))
	StopDrawing()
	SetGadgetState(gripper_g,ImageID(gripper_img))

	StartDrawing(ImageOutput(canvas_img))
	
	Line(0,0,GadgetWidth(canvas_g),GadgetHeight(canvas_g),RGB(254,254,253))
	
	StopDrawing()
	
	ForceGadgetZOrder(scrollarea_g)
	ForceGadgetZOrder(hscroll_g)
	ForceGadgetZOrder(vscroll_g)
	ForceGadgetZOrder(gripper_g)

	;SetGadgetState(canvas_g,ImageID(canvas_img))
	
	*VarStruct\scrollarea_g=scrollarea_g
	*VarStruct\canvas_g=canvas_g
	*VarStruct\canvas_img=canvas_img
; 	*VarStruct\canvasbg_g
; 	*VarStruct\canvasbg_img
	*VarStruct\hscroll_g=hscroll_g
	*VarStruct\vscroll_g=vscroll_g
	*VarStruct\gripper_g=gripper_g
	*VarStruct\scrollbarwidth=scrollbarwidth
	*VarStruct\parent=parent
	*VarStruct\x=x
	*VarStruct\y=y
EndProcedure

Procedure ResizeScrollAreaCanvas(event,eventtype,*sac_struct.sac_struct)
	scrollarea_g=*sac_struct\scrollarea_g
 	canvas_g=*sac_struct\canvas_g
	canvas_img=*sac_struct\canvas_img
; 	*sac_struct\canvasbg_g
; 	*sac_struct\canvasbg_img
	hscroll_g=*sac_struct\hscroll_g
	vscroll_g=*sac_struct\vscroll_g
	gripper_g=*sac_struct\gripper_g
	scrollbarwidth=*sac_struct\scrollbarwidth
	parent=*sac_struct\parent
	x=*sac_struct\x
	y=*sac_struct\y
	scrollbar_sysw=GetSystemMetrics_(#SM_CXVSCROLL)
	width=WindowWidth(parent)-x-scrollbarwidth
	height=WindowHeight(parent)-y-scrollbarwidth

	If event
		GetCursorPos_(@cp.point)
		GetWindowRect_(GadgetID(gripper_g),gr.RECT)
		If PtInRect_(@gr, cp\x, cp\y)
			If GetAsyncKeyState_(#VK_LBUTTON)&32768
				SendMessage_(WindowID(parent),#WM_NCLBUTTONDOWN,#HTBOTTOMRIGHT,0) ; resize window
			EndIf
			SetCursor_(LoadCursor_(0,#IDC_SIZENWSE))
		EndIf
	EndIf

	If event=#PB_Event_SizeWindow
		If width>=GadgetWidth(canvas_g)
			DisableGadget(hscroll_g,1)
			ResizeGadget(canvas_g,width/2-GadgetWidth(canvas_g)/2,#PB_Ignore,#PB_Ignore,#PB_Ignore)
			SetGadgetAttribute(scrollarea_g,#PB_ScrollArea_InnerWidth,GadgetWidth(scrollarea_g))
		Else
			If height>=GadgetHeight(canvas_g)
				ResizeGadget(canvas_g,0,height/2-GadgetHeight(canvas_g)/2,#PB_Ignore,#PB_Ignore)
			Else
				ResizeGadget(canvas_g,0,0,#PB_Ignore,#PB_Ignore)
			EndIf
			DisableGadget(hscroll_g,0)
			SetGadgetAttribute(scrollarea_g,#PB_ScrollArea_InnerWidth,GadgetWidth(canvas_g))
		EndIf
		If height>=GadgetHeight(canvas_g)
			DisableGadget(vscroll_g,1)
			ResizeGadget(canvas_g,#PB_Ignore,height/2-GadgetHeight(canvas_g)/2,#PB_Ignore,#PB_Ignore)
			SetGadgetAttribute(scrollarea_g,#PB_ScrollArea_InnerHeight,GadgetHeight(scrollarea_g))
		Else
			If width>=GadgetWidth(canvas_g)
				ResizeGadget(canvas_g,width/2-GadgetWidth(canvas_g)/2,0,#PB_Ignore,#PB_Ignore)
			Else
				ResizeGadget(canvas_g,0,0,#PB_Ignore,#PB_Ignore)
			EndIf
			DisableGadget(vscroll_g,0)
			SetGadgetAttribute(scrollarea_g,#PB_ScrollArea_InnerHeight,GadgetHeight(canvas_g))
		EndIf
		ResizeGadget(scrollarea_g,0,0,WindowWidth(parent)+scrollbar_sysw-scrollbarwidth,#PB_Ignore)
		ResizeGadget(scrollarea_g,0,0,#PB_Ignore,WindowHeight(parent)+scrollbar_sysw-scrollbarwidth)
		ResizeGadget(vscroll_g,WindowWidth(parent)-scrollbarwidth,0,#PB_Ignore,WindowHeight(parent)-scrollbarwidth)
		ResizeGadget(hscroll_g,0,WindowHeight(parent)-scrollbarwidth,WindowWidth(parent)-scrollbarwidth,#PB_Ignore)
		ResizeGadget(gripper_g,WindowWidth(parent)-scrollbarwidth,WindowHeight(parent)-scrollbarwidth,#PB_Ignore,#PB_Ignore)
		SetScrollAttribute(vscroll_g,#PB_ScrollBar_PageLength,WindowHeight(parent))
		SetScrollAttribute(hscroll_g,#PB_ScrollBar_PageLength,WindowWidth(parent))
		SetGadgetState(canvas_g,ImageID(canvas_img))
	EndIf
EndProcedure

Procedure ScrollAreaCanvasCallback(Handle.l, uMsg.l, wParam.l, lParam.l)
	Static offset.POINT
   Protected lResult.l
   Protected AllowScroll.l
   Protected HoldInfo.SCROLLINFO
   Static scrollbar_focus,scrollbar_type
   If uMsg = #WM_HSCROLL
      ;{ User is scrolling a horizontal scrollbar.
      ; If lParam = GadgetID(0)
      ;/ This would be a place to test which scrollbar is used.
      HoldInfo\cbSize = SizeOf(SCROLLINFO)
      HoldInfo\fMask = #SIF_ALL
      GetScrollInfo_(lParam, #SB_CTL, @HoldInfo)
      AllowScroll = #True
      ; Allow scrolling by default.
      If wParam & $FFFF = #SB_THUMBTRACK
         HoldInfo\nPos = HoldInfo\nTrackPos
      ElseIf wParam & $FFFF = #SB_LINERIGHT
         HoldInfo\nPos + 1
      ElseIf wParam & $FFFF = #SB_LINELEFT
         HoldInfo\nPos - 1
      ElseIf wParam & $FFFF = #SB_PAGERIGHT
         HoldInfo\nPos + 3
      ElseIf wParam & $FFFF = #SB_PAGELEFT
         HoldInfo\nPos - 3
      Else
         ; The scroll message is unhandled.
         AllowScroll = #False
         ; Do not allow the user to scroll.
      EndIf
      If AllowScroll
			If lParam
				scrollbar_focus=lParam
				scrollbar_type=#SB_HORZ
			EndIf
         If HoldInfo\nPos <> offset\X
            offset\X = HoldInfo\nPos
         Else
            ProcedureReturn #True
         EndIf
      Else
      	scrollbar_focus=0
         ProcedureReturn #True
      EndIf
      ;}
   ElseIf uMsg = #WM_VSCROLL
      ;{ User is scrolling a vertical scrollbar.
      ; If lParam = GadgetID(1)
      ;/ This would be a place to test which scrollbar is used.
      HoldInfo\cbSize = SizeOf(SCROLLINFO)
      ; Store the size of the ScrollInfo structure.
      HoldInfo\fMask = #SIF_ALL
      ; All settings are needed.
      GetScrollInfo_(lParam, #SB_CTL, @HoldInfo)
      ; Retrieve information on the scrollbar.
      AllowScroll = #True
      ; Allow scrolling by default.
      If wParam & $FFFF = #SB_THUMBTRACK
         HoldInfo\nPos = HoldInfo\nTrackPos
      ElseIf wParam & $FFFF = #SB_LINEUP
         HoldInfo\nPos - 1
      ElseIf wParam & $FFFF = #SB_LINEDOWN
         HoldInfo\nPos + 1
      ElseIf wParam & $FFFF = #SB_PAGEUP
         HoldInfo\nPos - 3
      ElseIf wParam & $FFFF = #SB_PAGEDOWN
         HoldInfo\nPos + 3
      Else
         ; The scroll message is unhandled.
         AllowScroll = #False
         ; Do not allow the user to scroll.
      EndIf
      If AllowScroll
			If lParam
				scrollbar_focus=lParam
				scrollbar_type=#SB_VERT
			EndIf
         If HoldInfo\nPos <> offset\Y
            offset\Y = HoldInfo\nPos
         Else
            ProcedureReturn #True
         EndIf
      Else
         ; The user is not allowed to scroll to the desired position.
         scrollbar_focus=0
         ProcedureReturn #True
         ; Do not process the scrollbar event.
      EndIf
      ;}
   EndIf
   If scrollbar_focus
   	gadgetid=GetProp_(scrollbar_focus,"PB_ID")
   	If scrollbar_type=#SB_HORZ
   		If GetSBAreaFromSB(gadgetid,#SB_HORZ) ; If this is a mapped scrollbar
				UpdateScrollAreaX(GetSBAreaFromSB(gadgetid,#SB_HORZ),gadgetid)
			EndIf
		ElseIf scrollbar_type=#SB_VERT
			If GetSBAreaFromSB(gadgetid,#SB_VERT) ; If this is a mapped scrollbar
				UpdateScrollAreaY(GetSBAreaFromSB(gadgetid,#SB_VERT),gadgetid)
			EndIf
		EndIf
	EndIf
EndProcedure

Procedure Callback(Handle.l,uMsg.l,wParam.l,lParam.l)
	ScrollAreaCanvasCallback(Handle,uMsg,wParam,lParam)
	ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

w=640
h=480

OpenWindow(6,400,200,w,h,"ScrollAreaGadget",#PB_Window_SystemMenu|#PB_Window_SizeGadget)
CreateGadgetList(WindowID(6))
ScrollAreaCanvas(@test_canvas.sac_struct,0,0,320,240,30,#PB_ScrollArea_BorderLess)

If OpenWindow(main_window, 0, 0, w, h, "ScrollAreaGadget", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget) And CreateGadgetList(WindowID(main_window))
	CreateGadgetList(WindowID(main_window))

	hwnd=WindowID(main_window)
	SetWindowPos_(hwnd,0,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE|#SWP_NOZORDER|#SWP_FRAMECHANGED)
	
	ScrollAreaCanvas(@heightmap_canvas.sac_struct,0,0,320,240,30,#PB_ScrollArea_BorderLess)
EndIf

SetWindowCallback(@Callback())
Repeat
	SmartWindowRefresh(main_window,1)
	SmartWindowRefresh(6,1)
	
	event=WaitWindowEvent()
	If event
		eventtype=EventType()
		eventgadget=EventGadget()
	Else
		event=0
		eventtype=0
		eventgadget=0
	EndIf
	
	ResizeScrollAreaCanvas(event,eventtype,@heightmap_canvas.sac_struct)
	ResizeScrollAreaCanvas(event,eventtype,@test_canvas.sac_struct)
		
	Select event
	  Case  #PB_Event_CloseWindow
	    End
	EndSelect
Until event=#PB_Event_CloseWindow
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited