http://www.purebasic.fr/english/viewtop ... 12&t=70628
update code:
Code: Select all
;- EXAMPLE
CompilerIf #PB_Compiler_IsMainFile
; IncludePath "C:\Users\as\Documents\GitHub\"
; XIncludeFile "module_scroll.pbi"
EnableExplicit
Structure canvasitem
img.i
x.i
y.i
width.i
height.i
alphatest.i
EndStructure
Enumeration
#MyCanvas = 1 ; just to test whether a number different from 0 works now
EndEnumeration
Global *s.Scroll::_S_scroll=AllocateStructure(Scroll::_S_scroll)
Global isCurrentItem=#False
Global currentItemXOffset.i, currentItemYOffset.i
Global Event.i, x.i, y.i, drag.i, hole.i, Width, Height
Global NewList Images.canvasitem()
Procedure AddImage (List Images.canvasitem(), x, y, img, alphatest=0)
If AddElement(Images())
Images()\img = img
Images()\x = x
Images()\y = y
Images()\width = ImageWidth(img)
Images()\height = ImageHeight(img)
Images()\alphatest = alphatest
EndIf
EndProcedure
Procedure Draw (canvas.i, List Images.canvasitem())
Protected iWidth = Scroll::X(*s\v), iHeight = Scroll::Y(*s\h)
If StartDrawing(CanvasOutput(canvas))
DrawingMode(#PB_2DDrawing_Default)
Box(0, 0, OutputWidth(), OutputHeight(), RGB(255,255,255))
ClipOutput(0,0, *s\h\Page\Len, *s\v\Page\Len)
DrawingMode(#PB_2DDrawing_AlphaBlend)
ForEach Images()
DrawImage(ImageID(Images()\img),Images()\x - *s\h\Page\Pos,Images()\y - *s\v\Page\Pos) ; draw all images with z-order
Next
UnclipOutput()
Scroll::Draw(*s\v)
Scroll::Draw(*s\h)
StopDrawing()
EndIf
EndProcedure
Procedure.i HitTest (List Images.canvasitem(), x, y)
Shared currentItemXOffset.i, currentItemYOffset.i
Protected alpha.i, isCurrentItem.i = #False
If LastElement(Images()) ; search for hit, starting from end (z-order)
Repeat
If x >= Images()\x - *s\h\Page\Pos And x < Images()\x - *s\h\Page\Pos + Images()\width
If y >= Images()\y - *s\v\Page\Pos And y < Images()\y - *s\v\Page\Pos + Images()\height
alpha = 255
If Images()\alphatest And ImageDepth(Images()\img)>31
If StartDrawing(ImageOutput(Images()\img))
DrawingMode(#PB_2DDrawing_AlphaChannel)
alpha = Alpha(Point(x-Images()\x, y-Images()\y)) ; get alpha
StopDrawing()
EndIf
EndIf
If alpha
MoveElement(Images(), #PB_List_Last)
isCurrentItem = #True
currentItemXOffset = x - Images()\x
currentItemYOffset = y - Images()\y
Break
EndIf
EndIf
EndIf
Until PreviousElement(Images()) = 0
EndIf
ProcedureReturn isCurrentItem
EndProcedure
AddImage(Images(), 10, 10, LoadImage(#PB_Any, #PB_Compiler_Home + "Examples/Sources/Data/PureBasic.bmp"))
AddImage(Images(), 100,100, LoadImage(#PB_Any, #PB_Compiler_Home + "Examples/Sources/Data/GeeBee2.bmp"))
AddImage(Images(), 50,200, LoadImage(#PB_Any, #PB_Compiler_Home + "Examples/Sources/Data/AlphaChannel.bmp"))
hole = CreateImage(#PB_Any,100,100,32)
If StartDrawing(ImageOutput(hole))
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0,0,100,100,RGBA($00,$00,$00,$00))
Circle(50,50,48,RGBA($00,$FF,$FF,$FF))
Circle(50,50,30,RGBA($00,$00,$00,$00))
StopDrawing()
EndIf
AddImage(Images(),170,70,hole,1)
Macro GetScrollCoordinate()
ScrollX = Images()\x
ScrollY = Images()\Y
ScrollWidth = Images()\x+Images()\width
ScrollHeight = Images()\Y+Images()\height
PushListPosition(Images())
ForEach Images()
If ScrollX > Images()\x : ScrollX = Images()\x : EndIf
If ScrollY > Images()\Y : ScrollY = Images()\Y : EndIf
If ScrollWidth < Images()\x+Images()\width : ScrollWidth = Images()\x+Images()\width : EndIf
If ScrollHeight < Images()\Y+Images()\height : ScrollHeight = Images()\Y+Images()\height : EndIf
Next
PopListPosition(Images())
EndMacro
Procedure ScrollUpdates(*v.Scroll::_S_widget, *h.Scroll::_S_widget, ScrollArea_X, ScrollArea_Y, ScrollArea_Width, ScrollArea_Height)
Protected iWidth = Scroll::X(*v), iHeight = Scroll::Y(*h)
Static hPos, vPos : vPos = *v\Page\Pos : hPos = *h\Page\Pos
; Вправо работает как надо
If ScrollArea_Width<*h\Page\Pos+iWidth
ScrollArea_Width=*h\Page\Pos+iWidth
; Влево работает как надо
ElseIf ScrollArea_X>*h\Page\Pos And
ScrollArea_Width=*h\Page\Pos+iWidth
ScrollArea_Width = iWidth
EndIf
; Вниз работает как надо
If ScrollArea_Height<*v\Page\Pos+iHeight
ScrollArea_Height=*v\Page\Pos+iHeight
; Верх работает как надо
ElseIf ScrollArea_Y>*v\Page\Pos And
ScrollArea_Height=*v\Page\Pos+iHeight
ScrollArea_Height = iHeight
EndIf
If ScrollArea_X>0 : ScrollArea_X=0 : EndIf
If ScrollArea_Y>0 : ScrollArea_Y=0 : EndIf
If ScrollArea_X<*h\Page\Pos : ScrollArea_Width-ScrollArea_X : EndIf
If ScrollArea_Y<*v\Page\Pos : ScrollArea_Height-ScrollArea_Y : EndIf
If *v\Max<>ScrollArea_Height : Scroll::SetAttribute(*v, #PB_ScrollBar_Maximum, ScrollArea_Height) : EndIf
If *h\Max<>ScrollArea_Width : Scroll::SetAttribute(*h, #PB_ScrollBar_Maximum, ScrollArea_Width) : EndIf
If *v\Page\len<>iHeight : Scroll::SetAttribute(*v, #PB_ScrollBar_PageLength, iHeight) : EndIf
If *h\Page\len<>iWidth : Scroll::SetAttribute(*h, #PB_ScrollBar_PageLength, iWidth) : EndIf
If ScrollArea_Y<0 : Scroll::SetState(*v, (ScrollArea_Height-ScrollArea_Y)-ScrollArea_Height) : EndIf
If ScrollArea_X<0 : Scroll::SetState(*h, (ScrollArea_Width-ScrollArea_X)-ScrollArea_Width) : EndIf
*v\Hide = Scroll::Resize(*v, #PB_Ignore, #PB_Ignore, #PB_Ignore, #PB_Ignore, *h)
*h\Hide = Scroll::Resize(*h, #PB_Ignore, #PB_Ignore, #PB_Ignore, #PB_Ignore, *v)
; If *v\Hide : *v\Page\Pos = 0 : Else : *v\Page\Pos = vPos : *h\Width = iWidth+*v\Width : EndIf
; If *h\Hide : *h\Page\Pos = 0 : Else : *h\Page\Pos = hPos : *v\Height = iHeight+*h\Height : EndIf
If *v\Hide : *v\Page\Pos = 0 : If vPos : *v\Hide = vPos : EndIf : Else : *v\Page\Pos = vPos : EndIf
If *h\Hide : *h\Page\Pos = 0 : If hPos : *h\Hide = hPos : EndIf : Else : *h\Page\Pos = hPos : EndIf
ProcedureReturn Bool(ScrollArea_Height>=iHeight Or ScrollArea_Width>=iWidth)
EndProcedure
Procedure CallBack()
Protected Repaint
Protected Event = EventType()
Protected Canvas = EventGadget()
Protected MouseX = GetGadgetAttribute(Canvas, #PB_Canvas_MouseX)
Protected MouseY = GetGadgetAttribute(Canvas, #PB_Canvas_MouseY)
Protected Buttons = GetGadgetAttribute(EventGadget(), #PB_Canvas_Buttons)
Protected WheelDelta = GetGadgetAttribute(EventGadget(), #PB_Canvas_WheelDelta)
Protected Width = GadgetWidth(Canvas)
Protected Height = GadgetHeight(Canvas)
Protected ScrollX, ScrollY, ScrollWidth, ScrollHeight
If Scroll::CallBack(*s\v, Event, MouseX, MouseY, WheelDelta)
Repaint = #True
EndIf
If Scroll::CallBack(*s\h, Event, MouseX, MouseY, WheelDelta)
Repaint = #True
EndIf
Select Event
Case #PB_EventType_LeftButtonUp
GetScrollCoordinate()
If (ScrollX<0 Or ScrollY<0)
PushListPosition(Images())
ForEach Images()
If ScrollX<0
*s\h\Page\Pos =- ScrollX
Images()\X-ScrollX
EndIf
If ScrollY<0
*s\v\Page\Pos =- ScrollY
Images()\Y-ScrollY
EndIf
Next
PopListPosition(Images())
EndIf
EndSelect
If (*s\h\from Or *s\v\from)
Select Event
Case #PB_EventType_LeftButtonUp
Debug "----------Up---------"
GetScrollCoordinate()
ScrollUpdates(*s\v,*s\h, ScrollX, ScrollY, ScrollWidth, ScrollHeight)
; Protected iWidth = Width-Scroll::Width(*s\v), iHeight = Height-Scroll::Height(*s\h)
;
; Debug ""+*s\h\Hide+" "+ScrollX+" "+Str(ScrollWidth-iWidth)
; Debug ""+*s\v\Hide+" "+ScrollY+" "+Str(ScrollHeight-iHeight)
PushListPosition(Images())
ForEach Images()
; If *s\h\Hide And (ScrollWidth-Width)>0 : Images()\X-(ScrollWidth-Width) : EndIf
; If *s\v\Hide And (ScrollHeight-Height)>0 : Images()\Y-(ScrollHeight-Height) : EndIf
If *s\h\Hide>1 : Images()\X-*s\h\Hide : EndIf
If *s\v\Hide>1 : Images()\Y-*s\v\Hide : EndIf
Next
PopListPosition(Images())
EndSelect
Else
Select Event
Case #PB_EventType_LeftButtonUp : Drag = #False
Case #PB_EventType_LeftButtonDown
isCurrentItem = HitTest(Images(), Mousex, Mousey)
If isCurrentItem
Repaint = #True
Drag = #True
EndIf
Case #PB_EventType_MouseMove
If Drag = #True
If isCurrentItem
If LastElement(Images())
Images()\x = Mousex - currentItemXOffset
Images()\y = Mousey - currentItemYOffset
SetWindowTitle(EventWindow(), Str(Images()\x))
GetScrollCoordinate()
Repaint = Scroll::Updates(*s, ScrollX, ScrollY, ScrollWidth, ScrollHeight)
EndIf
EndIf
EndIf
Case #PB_EventType_Resize : ResizeGadget(Canvas, #PB_Ignore, #PB_Ignore, #PB_Ignore, #PB_Ignore) ; Bug (562)
GetScrollCoordinate()
If *s\h\Max<>ScrollWidth : Scroll::SetAttribute(*s\h, #PB_ScrollBar_Maximum, ScrollWidth) : EndIf
If *s\v\Max<>ScrollHeight : Scroll::SetAttribute(*s\v, #PB_ScrollBar_Maximum, ScrollHeight) : EndIf
Scroll::Resizes(*s, 0, 0, Width, Height)
Repaint = #True
EndSelect
EndIf
If Repaint
Draw(#MyCanvas, Images())
EndIf
EndProcedure
Procedure ResizeCallBack()
ResizeGadget(#MyCanvas, #PB_Ignore, #PB_Ignore, WindowWidth(EventWindow(), #PB_Window_InnerCoordinate)-20, WindowHeight(EventWindow(), #PB_Window_InnerCoordinate)-20)
EndProcedure
If Not OpenWindow(0, 0, 0, 420, 420, "Move/Drag Canvas Image", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
MessageRequester("Fatal error", "Program terminated.")
End
EndIf
;
CanvasGadget(#MyCanvas, 10, 10, 400, 400)
*s\v = Scroll::Gadget(380, 0, 20, 380, 0, 0, 0, #PB_ScrollBar_Vertical, 9)
*s\h = Scroll::Gadget(0, 380, 380, 20, 0, 0, 0, 0, 9)
PostEvent(#PB_Event_Gadget, 0,#MyCanvas,#PB_EventType_Resize)
BindGadgetEvent(#MyCanvas, @CallBack())
BindEvent(#PB_Event_SizeWindow, @ResizeCallBack(), 0)
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
CompilerEndIf
