Center a CanvasGadget point in a ScrollAreaGadget?
Posted: Tue Nov 25, 2014 10:22 pm
I was playing around with a simple diagram editor and felt that it would be nice if I could have the objects being drawn in the canvas centered in the viewport window (scrollarea). After trying to understand the intrincacies of the scrollbar for a few days -- with no success, I decided to post this question here in the forum.
Here is a sample code to illustrate the problem
Any ideas? Beer?
Here is a sample code to illustrate the problem
Code: Select all
EnableExplicit
#canvasWidth = 1000
#canvasHeight = 1000
#viewportScrollStep = 10
#objectWidth = 100
#objectHeight = 50
#mainWidth = 400
#mainHeight = 300
Enumeration
#main
#viewport
#canvas
EndEnumeration
Structure Object
x.i
y.i
img.i
EndStructure
Global objectBeingDragged, currentObject
Global deltaX, deltaY, mouseX, mouseY
Global NewList objects.Object()
Procedure LoadCanvas()
ScrollAreaGadget(#viewport, 0,0, #mainWidth, #mainHeight,
#canvasWidth, #canvasHeight,
#viewportScrollStep, #PB_ScrollArea_BorderLess | #PB_ScrollArea_Center)
CanvasGadget(#canvas, 0, 0, #canvasWidth, #canvasHeight)
CloseGadgetList()
SetGadgetAttribute(#viewport, #PB_ScrollArea_X, (#canvasWidth-GadgetWidth(#viewport))/2)
SetGadgetAttribute(#viewport, #PB_ScrollArea_Y, (#canvasHeight-GadgetHeight(#viewport))/2)
EndProcedure
Procedure RefreshCanvas()
StartDrawing(CanvasOutput(#canvas))
Box(0, 0, #canvasWidth, #canvasHeight, #White)
ForEach objects()
DrawImage(ImageID(objects()\img), objects()\x, objects()\y)
Next
StopDrawing()
EndProcedure
Procedure NewObjectImage()
Protected newImage
newImage = CreateImage(#PB_Any, #objectWidth, #objectHeight)
StartDrawing(ImageOutput(newImage))
DrawingMode(#PB_2DDrawing_Transparent)
Box(0, 0, #objectWidth, #objectHeight, RGB(Random(255),Random(255),Random(255)))
Box(2, 2, #objectWidth-4, #objectHeight-4, $CCCCCC)
StopDrawing()
ProcedureReturn newImage
EndProcedure
Procedure ObjectAt(x,y)
currentObject = #False
LastElement(objects())
Repeat
With objects()
If (x >= \x) And (x < \x+#objectWidth) And (y >= \y) And (y < \y+#objectHeight)
deltaX = x - \x
deltaY = y - \y
currentObject = #True
MoveElement(objects(), #PB_List_Last)
ProcedureReturn currentObject
EndIf
EndWith
Until PreviousElement(objects()) = 0
ProcedureReturn currentObject
EndProcedure
Procedure DoMouseLeftClick()
If currentObject
objectBeingDragged = #True
EndIf
RefreshCanvas()
EndProcedure
Procedure DoMouseMove()
mouseX = GetGadgetAttribute(#canvas, #PB_Canvas_MouseX)
mouseY = GetGadgetAttribute(#canvas, #PB_Canvas_MouseY)
If objectBeingDragged
LastElement(objects())
objects()\x = mouseX - deltaX
objects()\y = mouseY - deltaY
RefreshCanvas()
Else
If ObjectAt(mouseX,mouseY)
SetGadgetAttribute(#canvas, #PB_Canvas_Cursor, #PB_Cursor_Hand)
Else
SetGadgetAttribute(#canvas, #PB_Canvas_Cursor, #PB_Cursor_Default)
EndIf
EndIf
EndProcedure
Procedure DoMouseUp()
currentObject = #False
objectBeingDragged = #False
EndProcedure
Procedure NewObject()
AddElement(objects())
objects()\x = (GadgetWidth(#canvas)/2) - (#objectWidth/2)
objects()\y = (GadgetHeight(#canvas)/2) - (#objectHeight/2)
objects()\img = NewObjectImage()
MoveElement(objects(), #PB_List_Last)
RefreshCanvas()
EndProcedure
Procedure CenterObjects()
Protected maxX, maxY, minX, minY, x, y
Protected maxScrollWidthValue, maxScrollHeightValue, scrollPosX, scrollPosY
Protected middlePosX, middlePosY
; Isn't there a cross-platform solution for this?
Protected si.SCROLLINFO
With si
\cbSize = SizeOf(SCROLLINFO)
\fMask = #SIF_PAGE|#SIF_RANGE
EndWith
GetScrollInfo_(GadgetID(#viewport), #SB_HORZ, si)
maxScrollWidthValue = si\nMax - si\nMin + 1 - si\nPage
GetScrollInfo_(GadgetID(#viewport), #SB_VERT, si)
maxScrollHeightValue = si\nMax - si\nMin + 1 - si\nPage
; Find the middlepoint of all objects
minX = #canvasWidth
minY = #canvasHeight
maxX = 0
maxY = 0
ForEach objects()
x = objects()\x + #objectWidth/2
y = objects()\y + #objectHeight/2
If x < minX : minX = x : EndIf
If y < minY : minY = y : EndIf
If x > maxX : maxX = x : EndIf
If y > maxY : maxY = y : EndIf
Next
middlePosX = minX + ((maxX-MinX)/2)
middlePosY = minY + ((maxY-MinY)/2)
; Try to calculate a scrollbar value that would center
; the viewport (scroll area) on the target point (middlePosX, middlePosY)
; located on the canvas gadget...
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
scrollPosX = middlePosX*maxScrollWidthValue/#canvasWidth ;; This does not
scrollPosY = middlePosY*maxScrollHeightValue/#canvasHeight ;; work!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SetGadgetAttribute(#viewport, #PB_ScrollArea_X, scrollPosX)
SetGadgetAttribute(#viewport, #PB_ScrollArea_Y, scrollPosY)
EndProcedure
Procedure ResizeGadgets()
ResizeGadget(#viewport, #PB_Ignore, #PB_Ignore, WindowWidth(#main), WindowHeight(#main))
RefreshCanvas()
EndProcedure
OpenWindow(#main, 0, 0, #mainWidth, #mainHeight, "Right-click to add, double-click to center objects",
#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
LoadCanvas()
BindEvent(#PB_Event_SizeWindow, @ResizeGadgets())
BindGadgetEvent(#canvas,@DoMouseLeftClick(),#PB_EventType_LeftButtonDown)
BindGadgetEvent(#canvas,@DoMouseMove(),#PB_EventType_MouseMove)
BindGadgetEvent(#canvas,@DoMouseUP(),#PB_EventType_LeftButtonUp)
BindGadgetEvent(#canvas,@NewObject(),#PB_EventType_RightClick)
BindGadgetEvent(#canvas,@CenterObjects(),#PB_EventType_LeftDoubleClick)
NewObject()
RefreshCanvas()
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
End
