Needed a scrollable canvas gadget so wrote this. No API.
The canvas is in a container gadget and is simply moved around.
I can get the scroll bars to move the canvas and I can set the start point of the canvas from the main programme.
I can also get the canvas to move with the left mouse button down, the vertical scroll can also be done with the mouse wheel the only thing I cannot get hold of is horizontal movement from say a rollerball or the mac magic mouse.
If anyone looks at this are there any limitations I should be aware of?
First the module ScrollCanvas.pbi
Code: Select all
DeclareModule ScrollCanvas
Declare.i Create(Vx,Vy,Vw,Vh,Cw,Ch)
Declare ProgScrollx(x.i)
Declare ProgScrollY(Y.i)
EndDeclareModule
Module ScrollCanvas
Global ViewHeight.i,ViewWidth.i
Global Canvas,CanvasWidth.i,CanvasHeight.i
Global VScroll.i,HScroll.i
Global VScrollValue
Procedure HandleVScroll()
VScrollValue = GetGadgetState(VScroll); - (GetGadgetState(VScroll) * 2)
If VScrollValue < 0
VScrollValue = 0
EndIf
If VScrollValue > CanvasHeight - ViewHeight
VScrollValue = CanvasHeight - ViewHeight
EndIf
VScrollValue = GetGadgetState(VScroll) - (GetGadgetState(VScroll) * 2)
ResizeGadget(Canvas,#PB_Ignore,VScrollValue,#PB_Ignore,#PB_Ignore)
EndProcedure
Procedure HandleHScroll()
HScrollValue = GetGadgetState(HScroll); - (GetGadgetState(VScroll) * 2)
If HScrollValue < 0
HScrollValue = 0
EndIf
If HScrollValue > CanvasWidth - ViewWidth
HScrollValue = CanvasWidth - ViewWidth
EndIf
HScrollValue = GetGadgetState(HScroll) - (GetGadgetState(HScroll) * 2)
ResizeGadget(Canvas,HScrollValue,#PB_Ignore,#PB_Ignore,#PB_Ignore)
EndProcedure
Procedure ProgScrollx(x.i)
ResizeGadget(Canvas,x,#PB_Ignore,#PB_Ignore,#PB_Ignore)
SetGadgetState(HScroll,-x)
EndProcedure
Procedure ProgScrollY(y.i)
ResizeGadget(Canvas,#PB_Ignore,Y,#PB_Ignore,#PB_Ignore)
SetGadgetState(VScroll,-y)
EndProcedure
Procedure.i Create(Vx,Vy,Vw,Vh,Cw,Ch)
CanvasWidth = Cw
CanvasHeight = Ch
ViewHeight= Vh - 20
ViewWidth = Vw - 20
View = ContainerGadget(#PB_Any, Vx, Vy, ViewWidth, ViewHeight, #PB_Container_Single)
Canvas = CanvasGadget(#PB_Any, 0, 0, Cw, Ch)
CloseGadgetList()
HScroll = ScrollBarGadget(#PB_Any, Vx,Vy + ViewHeight,ViewWidth, 20,0, CanvasWidth - ViewWidth,1)
VScroll = ScrollBarGadget(#PB_Any, Vx + ViewWidth,Vy,20, ViewHeight,0, CanvasHeight - ViewHeight,1)
BindGadgetEvent(VScroll,@HandleVScroll())
BindGadgetEvent(HScroll,@HandleHScroll())
Debug CanvasHeight - ViewHeight
Debug CanvasWidth - ViewWidth
ProcedureReturn Canvas
EndProcedure
EndModule
Now a little test programme. ScrollCanvastest.pb
Code: Select all
IncludeFile "ScrollCanvas.pbi"
Global Window_0
Global DrawCanvas.i
Procedure TestDraw()
StartVectorDrawing(CanvasVectorOutput(DrawCanvas))
MovePathCursor(0,0)
AddPathLine(800,900)
MovePathCursor(800,0)
AddPathLine(0,900)
StrokePath(1)
EndProcedure
Window_0 = OpenWindow(#PB_Any, 0, 0, 850, 450, "Scroll Canvas", #PB_Window_SystemMenu)
DrawCanvas = ScrollCanvas::Create(20,25,700,400,800,900)
TestDraw()
;Show Centre of canvas
ScrollCanvas::ProgScrollY(-260)
ScrollCanvas::ProgScrollX(-60)
Define Event.i
Repeat
Event = WaitWindowEvent()
Select event
Case #PB_Event_CloseWindow
End
Case #PB_Event_Menu
Select EventMenu()
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
EndSelect
EndSelect
ForEver
Any use?
CD