Center a CanvasGadget point in a ScrollAreaGadget?

[rmenezes]

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

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

Any ideas? Beer?

[TI-994A]

...it would be nice if I could have the objects being drawn in the canvas centered in the viewport window (scrollarea)...

Hello rmenezes. Not quite sure if I understood correctly, but perhaps this is what you're looking for:

Code: Select all

Procedure NewObject()
  AddElement(objects())
  
  objects()\x = GetGadgetAttribute(#viewport, #PB_ScrollArea_X) + ((WindowWidth(#main) / 2) - (#objectWidth/2))
  objects()\y = GetGadgetAttribute(#viewport, #PB_ScrollArea_Y) + ((WindowHeight(#main) / 2) - (#objectHeight/2))
  
  ;objects()\x = (GadgetWidth(#canvas)/2) - (#objectWidth/2)
  ;objects()\y = (GadgetHeight(#canvas)/2) - (#objectHeight/2)
  objects()\img = NewObjectImage()
  MoveElement(objects(), #PB_List_Last)
  RefreshCanvas()
EndProcedure

The new object will be drawn in the centre of the current viewport, regardless of the scroll position or window size, as long as the window is not bigger than the canvas gadget. But that can easily be handled as well.

Hope it helps in some way.

[rmenezes]

Hey TI,

Long time no see! I must have been... what, early 80's? :p

Thanks for the reply but that was not what I was looking for.

But it pointed out to the right solution! Times 2! I've fixed the NewObject procedure, by your suggestion and from it , I derived the answer I was looking for, in CenterObjects. Beautifully simple, too. Thank you.

Here is the whole thing, revised (I hope it is useful to others as well):

Code: Select all

EnableExplicit
#canvasWidth = 1000
#canvasHeight = 1000
#viewportScrollerSize = 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, 
                   10, #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()
  Protected centerX, centerY
  AddElement(objects())
  If WindowWidth(#main) > #canvasWidth
    centerX = #canvasWidth/2
  Else
    centerX = GetGadgetAttribute(#viewport, #PB_ScrollArea_X) + ((WindowWidth(#main) / 2) - (#objectWidth/2))
  EndIf
  If WindowHeight(#main) > #canvasHeight
    centerY = #canvasHeight/2
  Else
    centerY = GetGadgetAttribute(#viewport, #PB_ScrollArea_Y) + ((WindowHeight(#main) / 2) - (#objectHeight/2))
  EndIf
  objects()\x = centerX
  objects()\y = centerY
  objects()\img = NewObjectImage()
  MoveElement(objects(), #PB_List_Last)
  RefreshCanvas()
EndProcedure

Procedure CenterObjects()
  Protected maxX, maxY, minX, minY, x, y
  Protected scrollPosX, scrollPosY
  Protected middlePosX, middlePosY
  
  ; 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 - (WindowWidth(#main)/2-#viewportScrollerSize) 
  scrollPosY = middlePosY - (WindowHeight(#main)/2-#viewportScrollerSize) 
  
  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

Cheers!