Part2, with the small corrections... thanks (working now on 1.06 win10, 64 as said above)
Code: Select all
'part2 -> to join to previous code
' ----------------------
' RESIZABLERECTANGLE UDT
' ----------------------
type RESIZABLERECTANGLE extends DRAGGABLERECTANGLE
declare constructor()
declare constructor(byval as long, _
byval as long)
declare constructor(byval as long, _
byval as long, _
byval as long, _
byval as long)
declare sub InitializeResizableRectangle()
declare destructor()
declare property TLCXanchored() as boolean
declare property TLCX() as long
declare property TLCX(byval as long)
declare property TLCYanchored() as boolean
declare property TLCY() as long
declare property TLCY(byval as long)
declare property TRCXanchored() as boolean
declare property TRCX() as long
declare property TRCX(byval as long)
declare property TRCYanchored() as boolean
declare property TRCY() as long
declare property TRCY(byval as long)
declare property BRCXanchored() as boolean
declare property BRCX() as long
declare property BRCX(byval as long)
declare property BRCYanchored() as boolean
declare property BRCY() as long
declare property BRCY(byval as long)
declare property BLCXanchored() as boolean
declare property BLCX() as long
declare property BLCX(byval as long)
declare property BLCYanchored() as boolean
declare property BLCY() as long
declare property BLCY(byval as long)
declare property Thckns() as long
declare property Thckns(byval as long)
declare property MouseOverAnyBoundary() as boolean
declare property MouseClickAnyBoundary() as boolean
declare property AnchorCount() as long
declare sub ResetAnchorList()
enum _ANCHORPOINT
_allCorner = +0
_topLeftCorner = +1
_topRightCorner = +2
_bottomRightCorner = +3
_bottomLeftCorner = +4
end enum '_ANCHORPOINT
declare function IsAnchor(byval as _ANCHORPOINT) as boolean
declare sub AddAnchor(byval as _ANCHORPOINT=_ANCHORPOINT._allCorner)
enum _FILLBOXOPTION
_contour = -1
_fill = -0
end enum '_FILLBOXOPTION
declare sub DrawThickContourElement overload(byval as long, _
byval as long, _
byval as long, _
byval as long, _
byval as ulong, _
byval as _FILLBOXOPTION=_FILLBOXOPTION._fill)
declare sub DrawThickContourElement(byval as XY, _
byval as XY, _
byval as ulong, _
byval as _FILLBOXOPTION=_FILLBOXOPTION._fill)
declare sub RefreshAnchorArray()
declare sub SetResizeTimeInitialOffset()
declare sub TranslateCornerCoordinate(byval as long=0, _
byval as long=0)
declare sub TestResizableRectangleForMouse()
declare sub DrawResizableRectangle()
as long _borderThickness
as boolean _resizeEnabled
as boolean _resizeStarted
as long _xAtResizeTime
as long _yAtResizeTime
as long _tlcXoffsetAtResizeTime
as long _tlcYoffsetAtResizeTime
as long _trcXoffsetAtResizeTime
as long _trcYoffsetAtResizeTime
as long _brcXoffsetAtResizeTime
as long _brcYoffsetAtResizeTime
as long _blcXoffsetAtResizeTime
as long _blcYoffsetAtResizeTime
as boolean _mouseOverLeftBorder
as boolean _mouseOverTopBorder
as boolean _mouseOverRightBorder
as boolean _mouseOverBottomBorder
as boolean _mouseOverTopLeftCorner
as boolean _mouseOverTopRightCorner
as boolean _mouseOverBottomRightCorner
as boolean _mouseOverBottomLeftCorner
as boolean _mouseClickLeftBorder
as boolean _mouseClickTopBorder
as boolean _mouseClickRightBorder
as boolean _mouseClickBottomBorder
as boolean _mouseClickTopLeftCorner
as boolean _mouseClickTopRightCorner
as boolean _mouseClickBottomRightCorner
as boolean _mouseClickBottomLeftCorner
private:
as boolean _mouseOverBoundary
as boolean _mouseClickBoundary
as long _anchorPointCount
as _ANCHORPOINT _anchorArray(any)
end type 'RESIZABLERECTANGLE <-- DRAGGABLERECTANGLE <-- RECTANGLE <-- OBJECT
type RSZ as RESIZABLERECTANGLE
'inheritance lineage:
'RESIZABLERECTANGLE <-- DRAGGABLERECTANGLE <-- RECTANGLE <-- OBJECT
constructor RESIZABLERECTANGLE()
BASE()
THIS.InitializeResizableRectangle()
end constructor 'RESIZABLERECTANGLE default explicit constructor
constructor RESIZABLERECTANGLE(byval MaxW as long, _
byval MaxH as long)
BASE(MaxW,MaxH)
THIS.InitializeResizableRectangle()
end constructor 'RESIZABLERECTANGLE(valLNG, valLNG)
constructor RESIZABLERECTANGLE(byval TCLX as long, _
byval TCLY as long, _
byval Wid as long, _
byval Hei as long)
BASE(TCLX,TCLY,Wid,Hei)
THIS.InitializeResizableRectangle()
end constructor 'RESIZABLERECTANGLE(valLNG, valLNG, valLNG, valLNG)
sub RESIZABLERECTANGLE.InitializeResizableRectangle()
with THIS
._borderThickness => 6
._resizeEnabled => TRUE
._mouseOverLeftBorder => FALSE
._mouseOverTopBorder => FALSE
._mouseOverRightBorder => FALSE
._mouseOverBottomBorder => FALSE
._mouseOverTopLeftCorner => FALSE
._mouseOverTopRightCorner => FALSE
._mouseOverBottomRightCorner => FALSE
._mouseOverBottomLeftCorner => FALSE
._mouseClickLeftBorder => FALSE
._mouseClickTopBorder => FALSE
._mouseClickRightBorder => FALSE
._mouseClickBottomBorder => FALSE
._mouseClickTopLeftCorner => FALSE
._mouseClickTopRightCorner => FALSE
._mouseClickBottomRightCorner => FALSE
._mouseClickBottomLeftCorner => FALSE
end with 'THIS
THIS._mouseOverBoundary => FALSE
THIS._mouseClickBoundary => FALSE
THIS.ResetAnchorList()
end sub 'RESIZABLERECTANGLE.InitializeResizableRectangle()
destructor RESIZABLERECTANGLE()
'
end destructor 'RESIZABLERECTANGLE default explicit destructor
property RESIZABLERECTANGLE.TLCXanchored() as boolean
if THIS.IsAnchor(RSZ._ANCHORPOINT._topLeftCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._bottomLeftCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._allCorner) then
'---->
return TRUE
else
'---->
return FALSE
end if
end property 'get BOOL:=RESIZABLERECTANGLE.TLCXanchored
property RESIZABLERECTANGLE.TLCX() as long
'---->
return THIS.Xi
end property 'get LNG:=RESIZABLERECTANGLE.TLCX
property RESIZABLERECTANGLE.TLCX(byval SetValue as long)
if not THIS.TLCXanchored then
THIS.W = THIS.W - (SetValue - THIS.Xi + 1*sgn(SetValue - THIS.Xi))
THIS.Xi = SetValue
end if
end property 'set RESIZABLERECTANGLE.TLCX(valLNG)
property RESIZABLERECTANGLE.TLCYanchored() as boolean
if THIS.IsAnchor(RSZ._ANCHORPOINT._topLeftCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._topRightCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._allCorner) then
'---->
return TRUE
else
'---->
return FALSE
end if
end property 'get BOOL:=RESIZABLERECTANGLE.TLCYanchored
property RESIZABLERECTANGLE.TLCY() as long
'---->
return THIS.Yi
end property 'get LNG:=RESIZABLERECTANGLE.TLCY
property RESIZABLERECTANGLE.TLCY(byval SetValue as long)
if not THIS.TLCYanchored then
THIS.H = THIS.H - (SetValue - THIS.Yi + 1*sgn(SetValue - THIS.Xi))
THIS.Yi = SetValue
end if
end property 'set RESIZABLERECTANGLE.TLCY(valLNG)
property RESIZABLERECTANGLE.TRCXanchored() as boolean
if THIS.IsAnchor(RSZ._ANCHORPOINT._topRightCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._bottomRightCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._allCorner) then
'---->
return TRUE
else
'---->
return FALSE
end if
end property 'get BOOL:=RESIZABLERECTANGLE.TRCXanchored
property RESIZABLERECTANGLE.TRCX() as long
'---->
return THIS.Xf
end property 'get LNG:=RESIZABLERECTANGLE.TRCX
property RESIZABLERECTANGLE.TRCX(byval SetValue as long)
if not THIS.TRCXanchored then
THIS.Xf = SetValue
end if
end property 'set RESIZABLERECTANGLE.TRCX(valLNG)
property RESIZABLERECTANGLE.TRCYanchored() as boolean
if THIS.IsAnchor(RSZ._ANCHORPOINT._topRightCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._topLeftCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._allCorner) then
'---->
return TRUE
else
'---->
return FALSE
end if
end property 'get BOOL:=RESIZABLERECTANGLE.TRCYanchored
property RESIZABLERECTANGLE.TRCY() as long
'---->
return THIS.Yi
end property 'get LNG:=RESIZABLERECTANGLE.TRCY
property RESIZABLERECTANGLE.TRCY(byval SetValue as long)
if not THIS.TRCYanchored then
THIS.Yi = SetValue
end if
end property 'set RESIZABLERECTANGLE.TRCY(valLNG)
property RESIZABLERECTANGLE.BRCXanchored() as boolean
if THIS.IsAnchor(RSZ._ANCHORPOINT._bottomRightCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._topRightCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._allCorner) then
'---->
return TRUE
else
'---->
return FALSE
end if
end property 'get BOOL:=RESIZABLERECTANGLE.BRCXanchored
property RESIZABLERECTANGLE.BRCX() as long
'---->
return THIS.Xf
end property 'get LNG:=RESIZABLERECTANGLE.BRCX
property RESIZABLERECTANGLE.BRCX(byval SetValue as long)
if not THIS.BRCXanchored then
THIS.Xf = SetValue
end if
end property 'set RESIZABLERECTANGLE.BRCX(valLNG)
property RESIZABLERECTANGLE.BRCYanchored() as boolean
if THIS.IsAnchor(RSZ._ANCHORPOINT._bottomRightCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._bottomLeftCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._allCorner) then
'---->
return TRUE
else
'---->
return FALSE
end if
end property 'get BOOL:=RESIZABLERECTANGLE.BRCYanchored
property RESIZABLERECTANGLE.BRCY() as long
'---->
return THIS.Yf
end property 'get LNG:=RESIZABLERECTANGLE.BRCY
property RESIZABLERECTANGLE.BRCY(byval SetValue as long)
if not THIS.BRCYanchored then
THIS.Yf = SetValue
end if
end property 'set RESIZABLERECTANGLE.BRCY(valLNG)
property RESIZABLERECTANGLE.BLCXanchored() as boolean
if THIS.IsAnchor(RSZ._ANCHORPOINT._bottomLeftCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._topLeftCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._allCorner) then
'---->
return TRUE
else
'---->
return FALSE
end if
end property 'get BOOL:=RESIZABLERECTANGLE.BLCXanchored
property RESIZABLERECTANGLE.BLCX() as long
'---->
return THIS.Xi
end property 'get LNG:=RESIZABLERECTANGLE.BLCX
property RESIZABLERECTANGLE.BLCX(byval SetValue as long)
if not THIS.BLCXanchored then
THIS.Xi = SetValue
end if
end property 'set RESIZABLERECTANGLE.BLCX(valLNG)
property RESIZABLERECTANGLE.BLCYanchored() as boolean
if THIS.IsAnchor(RSZ._ANCHORPOINT._bottomLeftCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._bottomRightCorner) or _
THIS.IsAnchor(RSZ._ANCHORPOINT._allCorner) then
'---->
return TRUE
else
'---->
return FALSE
end if
end property 'get BOOL:=RESIZABLERECTANGLE.BLCYanchored
property RESIZABLERECTANGLE.BLCY() as long
'---->
return THIS.Yf
end property 'get LNG:=RESIZABLERECTANGLE.BLCY
property RESIZABLERECTANGLE.BLCY(byval SetValue as long)
if not THIS.BLCYanchored then
THIS.Yf = SetValue
end if
end property 'set RESIZABLERECTANGLE.BLCY(valLNG)
property RESIZABLERECTANGLE.Thckns() as long
'---->
return THIS._borderThickness
end property 'get LNG:=RESIZABLERECTANGLE.Thckns
property RESIZABLERECTANGLE.Thckns(byval SetValue as long)
THIS._borderThickness = SetValue
end property 'set RESIZABLERECTANGLE.Thckns(valLNG)
property RESIZABLERECTANGLE.MouseOverAnyBoundary() as boolean
THIS._mouseOverBoundary = FALSE
if THIS._mouseOverLeftBorder orElse _
THIS._mouseOverTopBorder orElse _
THIS._mouseOverRightBorder orElse _
THIS._mouseOverBottomBorder orElse _
THIS._mouseOverTopLeftCorner orElse _
THIS._mouseOverTopRightCorner orElse _
THIS._mouseOverBottomRightCorner orElse _
THIS._mouseOverBottomLeftCorner then
THIS._mouseOverBoundary = TRUE
end if
'---->
return THIS._mouseOverBoundary
end property 'BOOL:=RESIZABLERECTANGLE.MouseOverAnyBoundary
property RESIZABLERECTANGLE.MouseClickAnyBoundary() as boolean
THIS._mouseClickBoundary = FALSE
if THIS._mouseClickLeftBorder orElse _
THIS._mouseClickTopBorder orElse _
THIS._mouseClickRightBorder orElse _
THIS._mouseClickBottomBorder orElse _
THIS._mouseClickTopLeftCorner orElse _
THIS._mouseClickTopRightCorner orElse _
THIS._mouseClickBottomRightCorner orElse _
THIS._mouseClickBottomLeftCorner then
THIS._mouseClickBoundary = TRUE
end if
'---->
return THIS._mouseClickBoundary
end property 'BOOL:=RESIZABLERECTANGLE.MouseClickAnyBoundary
property RESIZABLERECTANGLE.AnchorCount() as long
THIS._anchorPointCount = uBound(THIS._anchorArray) + 1
'---->
return THIS._anchorPointCount
end property 'LNG:=RESIZABLERECTANGLE.AnchorPointCount
sub RESIZABLERECTANGLE.ResetAnchorList()
'free anchor array
erase THIS._anchorArray
end sub 'RESIZABLERECTANGLE.ResetAnchorList()
function RESIZABLERECTANGLE.IsAnchor(byval Corner as RESIZABLERECTANGLE._ANCHORPOINT) as boolean
'search anchor array for corner candidate
for index as integer = 0 to (THIS.AnchorCount - 1)
if THIS._anchorArray(index)=Corner then
'--->
return TRUE
end if
next index
'---->
return FALSE
end function 'BOOL:=RESIZABLERECTANGLE.IsAnchor(valRESIZABLERECTANGLE._ANCHORPOINT)
sub RESIZABLERECTANGLE.AddAnchor(byval CornerSet as RSZ._ANCHORPOINT=RSZ._ANCHORPOINT._allCorner)
if CornerSet=RSZ._ANCHORPOINT._allCorner then
THIS.ResetAnchorList()
redim THIS._anchorArray(3)
THIS._anchorArray(0) = RSZ._ANCHORPOINT._topLeftCorner
THIS._anchorArray(1) = RSZ._ANCHORPOINT._topRightCorner
THIS._anchorArray(2) = RSZ._ANCHORPOINT._bottomRightCorner
THIS._anchorArray(3) = RSZ._ANCHORPOINT._bottomLeftCorner
else
if not THIS.IsAnchor(CornerSet) then
redim preserve THIS._anchorArray(uBound(THIS._anchorArray) + 1)
THIS._anchorArray(uBound(THIS._anchorArray)) = CornerSet
end if
end if
end sub 'RESIZABLERECTANGLE.AddAnchor(valRESIZABLERECTANGLE_ANCHORPOINT[0])
sub RESIZABLERECTANGLE.DrawThickContourElement(byval X1 as long, _
byval Y1 as long, _
byval X2 as long, _
byval Y2 as long, _
byval C as ulong, _
byval FO as RSZ._FILLBOXOPTION=RSZ._FILLBOXOPTION._fill)
select case FO
case RESIZABLERECTANGLE._FILLBOXOPTION._contour
line (X1, Y1)-(X2, Y2), C, b
case else '_FILLBOXOPTION._fill
line (X1, Y1)-(X2, Y2), C, bf
end select 'FO
end sub 'RESIZABLERECTANGLE.DrawThickContourElement({valLNG}*4,valULNG,val_FILLBOXOPTION[0])
sub RESIZABLERECTANGLE.DrawThickContourElement(byval XY1 as XY, _
byval XY2 as XY, _
byval C as ulong, _
byval FO as RSZ._FILLBOXOPTION=RSZ._FILLBOXOPTION._fill)
select case FO
case RESIZABLERECTANGLE._FILLBOXOPTION._contour
line (XY1._x, XY1._y)-(XY2._x, XY2._y), C, b
case else '_FILLBOXOPTION._fill
line (XY1._x, XY1._y)-(XY2._x, XY2._y), C, bf
end select 'FO
end sub 'RESIZABLERECTANGLE.DrawThickContourElement({valXY}*2,valULNG,val_FILLBOXOPTION[0])
sub RESIZABLERECTANGLE.RefreshAnchorArray()
if THIS._mouseClickLeftBorder then
THIS.ResetAnchorList()
THIS.AddAnchor(RSZ._ANCHORPOINT._topRightCorner)
THIS.AddAnchor(RSZ._ANCHORPOINT._bottomRightCorner)
elseif THIS._mouseClickTopBorder then
THIS.ResetAnchorList()
THIS.AddAnchor(RSZ._ANCHORPOINT._bottomLeftCorner)
THIS.AddAnchor(RSZ._ANCHORPOINT._bottomRightCorner)
elseif THIS._mouseClickRightBorder then
THIS.ResetAnchorList()
THIS.AddAnchor(RSZ._ANCHORPOINT._topLeftCorner)
THIS.AddAnchor(RSZ._ANCHORPOINT._bottomLeftCorner)
elseif THIS._mouseClickBottomBorder then
THIS.ResetAnchorList()
THIS.AddAnchor(RSZ._ANCHORPOINT._topLeftCorner)
THIS.AddAnchor(RSZ._ANCHORPOINT._topRightCorner)
elseif THIS._mouseClickTopLeftCorner then
THIS.ResetAnchorList()
THIS.AddAnchor(RSZ._ANCHORPOINT._bottomRightCorner)
elseif THIS._mouseClickTopRightCorner then
THIS.ResetAnchorList()
THIS.AddAnchor(RSZ._ANCHORPOINT._bottomLeftCorner)
elseif THIS._mouseClickBottomRightCorner then
THIS.ResetAnchorList()
THIS.AddAnchor(RSZ._ANCHORPOINT._topLeftCorner)
elseif THIS._mouseClickBottomLeftCorner then
THIS.ResetAnchorList()
THIS.AddAnchor(RSZ._ANCHORPOINT._topRightCorner)
else
THIS.ResetAnchorList()
THIS.AddAnchor(RSZ._ANCHORPOINT._allCorner)
end if
end sub 'RESIZABLERECTANGLE.RefreshAnchorArray()
sub RESIZABLERECTANGLE.SetResizeTimeInitialOffset()
THIS._tlcXoffsetAtResizeTime = THIS._xAtResizeTime - THIS.TLCX
THIS._tlcYoffsetAtResizeTime = THIS._yAtResizeTime - THIS.TLCY
'
THIS._trcXoffsetAtResizeTime = THIS._xAtResizeTime - THIS.TRCX
THIS._trcYoffsetAtResizeTime = THIS._yAtResizeTime - THIS.TRCY
'
THIS._brcXoffsetAtResizeTime = THIS._xAtResizeTime - THIS.BRCX
THIS._brcYoffsetAtResizeTime = THIS._yAtResizeTime - THIS.BRCY
'
THIS._blcXoffsetAtResizeTime = THIS._xAtResizeTime - THIS.BLCX
THIS._blcYoffsetAtResizeTime = THIS._yAtResizeTime - THIS.BLCY
end sub '
sub RESIZABLERECTANGLE.TranslateCornerCoordinate(byval DX as long=0, _
byval DY as long=0)
THIS.TLCX = THIS.TLCX + DX/2
THIS.TLCY = THIS.TLCY + DY/2
'
THIS.TRCX = THIS.TRCX + DX/2
THIS.TRCY = THIS.TRCY + DY/2
'
THIS.BRCX = THIS.BRCX + DX/2
THIS.BRCY = THIS.BRCY + DY/2
'
THIS.BLCX = THIS.BLCX + DX/2
THIS.BLCY = THIS.BLCY + DY/2
end sub 'RESIZABLERECTANGLE.TranslateCornerCoordinate({valLNG[0]}*2)
sub RESIZABLERECTANGLE.TestResizableRectangleForMouse()
dim as integer gmX, gmY, gmBtn1
getMouse gmX, gmY, , gmBtn1
'
'set resize event status
if THIS._resizeEnabled and _
THIS.MouseClickAnyBoundary and _
cBool(THIS._xAtResizeTime<>gmX or THIS._yAtResizeTime<>gmY) then
if THIS._resizeStarted=FALSE then
THIS._resizeStarted = TRUE
THIS.RefreshAnchorArray()
end if
else
if THIS._resizeStarted=TRUE then
THIS._resizeStarted = FALSE
end if
end if
if THIS._resizeStarted=TRUE then
THIS.TranslateCornerCoordinate(gmX - THIS._xAtResizeTime, _
gmY - THIS._yAtResizeTime)
THIS._xAtResizeTime = gmX
THIS._yAtResizeTime = gmY
exit sub
end if
'test mouse @LeftBorder
if gmX>=THIS.Xi and _
gmX<=(THIS.Xi + THIS.Thckns) and _
gmY>=(THIS.Yi + THIS.Thckns) and _
gmY<=(THIS.Yf - THIS.Thckns) then
if THIS._mouseOverLeftBorder=FALSE then THIS._mouseOverLeftBorder = TRUE
if gmBtn1=+1 then
if THIS._mouseClickLeftBorder=FALSE then
THIS._mouseClickLeftBorder = TRUE
if not THIS._resizeStarted then
THIS._xAtResizeTime = gmX
THIS._yAtResizeTime = gmY
THIS.SetResizeTimeInitialOffset()
end if
end if
else
if THIS._mouseClickLeftBorder=TRUE then THIS._mouseClickLeftBorder = FALSE
end if
else
if THIS._mouseOverLeftBorder=TRUE then THIS._mouseOverLeftBorder = FALSE
if THIS._mouseClickLeftBorder=TRUE then THIS._mouseClickLeftBorder = FALSE
end if
'test mouse @TopBorder
if gmX>=(THIS.Xi + THIS.Thckns) and _
gmX<=(THIS.Xf - THIS.Thckns) and _
gmY>=THIS.Yi and _
gmY<=(THIS.Yi + THIS.Thckns) then
if THIS._mouseOverTopBorder=FALSE then THIS._mouseOverTopBorder = TRUE
if gmBtn1=+1 then
if THIS._mouseClickTopBorder=FALSE then
THIS._mouseClickTopBorder = TRUE
if not THIS._resizeStarted then
THIS._xAtResizeTime = gmX
THIS._yAtResizeTime = gmY
THIS.SetResizeTimeInitialOffset()
end if
end if
else
if THIS._mouseClickTopBorder=TRUE then THIS._mouseClickTopBorder = FALSE
end if
else
if THIS._mouseOverTopBorder=TRUE then THIS._mouseOverTopBorder = FALSE
if THIS._mouseClickTopBorder=TRUE then THIS._mouseClickTopBorder = FALSE
end if
'test mouse @RightBorder
if gmX>=(THIS.Xf - THIS.Thckns) and _
gmX<=THIS.Xf and _
gmY>=(THIS.Yi + THIS.Thckns) and _
gmY<=(THIS.Yf - THIS.Thckns) then
if THIS._mouseOverRightBorder=FALSE then THIS._mouseOverRightBorder = TRUE
if gmBtn1=+1 then
if THIS._mouseClickRightBorder=FALSE then
THIS._mouseClickRightBorder = TRUE
if not THIS._resizeStarted then
THIS._xAtResizeTime = gmX
THIS._yAtResizeTime = gmY
THIS.SetResizeTimeInitialOffset()
end if
end if
else
if THIS._mouseClickRightBorder=TRUE then THIS._mouseClickRightBorder = FALSE
end if
else
if THIS._mouseOverRightBorder=TRUE then THIS._mouseOverRightBorder = FALSE
if THIS._mouseClickRightBorder=TRUE then THIS._mouseClickRightBorder = FALSE
end if
'test mouse @BottomBorder
if gmX>=(THIS.Xi + THIS.Thckns) and _
gmX<=(THIS.Xf - THIS.Thckns) and _
gmY>=(THIS.Yf - THIS.Thckns) and _
gmY<=THIS.Yf then
if THIS._mouseOverBottomBorder=FALSE then THIS._mouseOverBottomBorder = TRUE
if gmBtn1=+1 then
if THIS._mouseClickBottomBorder=FALSE then
THIS._mouseClickBottomBorder = TRUE
if not THIS._resizeStarted then
THIS._xAtResizeTime = gmX
THIS._yAtResizeTime = gmY
THIS.SetResizeTimeInitialOffset()
end if
end if
else
if THIS._mouseClickBottomBorder=TRUE then THIS._mouseClickBottomBorder = FALSE
end if
else
if THIS._mouseOverBottomBorder=TRUE then THIS._mouseOverBottomBorder = FALSE
if THIS._mouseClickBottomBorder=TRUE then THIS._mouseClickBottomBorder = FALSE
end if
'test mouse @TopLeftCorner
if gmX>=THIS.Xi and _
gmX<(THIS.Xi + THIS.Thckns) and _
gmY>=THIS.Yi and _
gmY<(THIS.Yi + THIS.Thckns) then
if THIS._mouseOverTopLeftCorner=FALSE then THIS._mouseOverTopLeftCorner = TRUE
if gmBtn1=+1 then
if THIS._mouseClickTopLeftCorner=FALSE then
THIS._mouseClickTopLeftCorner = TRUE
if not THIS._resizeStarted then
THIS._xAtResizeTime = gmX
THIS._yAtResizeTime = gmY
THIS.SetResizeTimeInitialOffset()
end if
end if
else
if THIS._mouseClickTopLeftCorner=TRUE then THIS._mouseClickTopLeftCorner = FALSE
end if
else
if THIS._mouseOverTopLeftCorner=TRUE then THIS._mouseOverTopLeftCorner = FALSE
if THIS._mouseClickTopLeftCorner=TRUE then THIS._mouseClickTopLeftCorner = FALSE
end if
'test mouse @TopRightCorner
if gmX>(THIS.Xf - THIS.Thckns) and _
gmX<=THIS.Xf and _
gmY>=THIS.Yi and _
gmY<(THIS.Yi + THIS.Thckns) then
if THIS._mouseOverTopRightCorner=FALSE then THIS._mouseOverTopRightCorner = TRUE
if gmBtn1=+1 then
if THIS._mouseClickTopRightCorner=FALSE then
THIS._mouseClickTopRightCorner = TRUE
if not THIS._resizeStarted then
THIS._xAtResizeTime = gmX
THIS._yAtResizeTime = gmY
THIS.SetResizeTimeInitialOffset()
end if
end if
else
if THIS._mouseClickTopRightCorner=TRUE then THIS._mouseClickTopRightCorner = FALSE
end if
else
if THIS._mouseOverTopRightCorner=TRUE then THIS._mouseOverTopRightCorner = FALSE
if THIS._mouseClickTopRightCorner=TRUE then THIS._mouseClickTopRightCorner = FALSE
end if
'test mouse @BottomRightCorner
if gmX>(THIS.Xf - THIS.Thckns) and _
gmX<=THIS.Xf and _
gmY>(THIS.Yf - THIS.Thckns) and _
gmY<=THIS.Yf then
if THIS._mouseOverBottomRightCorner=FALSE then THIS._mouseOverBottomRightCorner = TRUE
if gmBtn1=+1 then
if THIS._mouseClickBottomRightCorner=FALSE then
THIS._mouseClickBottomRightCorner = TRUE
if not THIS._resizeStarted then
THIS._xAtResizeTime = gmX
THIS._yAtResizeTime = gmY
THIS.SetResizeTimeInitialOffset()
end if
end if
else
if THIS._mouseClickBottomRightCorner=TRUE then THIS._mouseClickBottomRightCorner = FALSE
end if
else
if THIS._mouseOverBottomRightCorner=TRUE then THIS._mouseOverBottomRightCorner = FALSE
if THIS._mouseClickBottomRightCorner=TRUE then THIS._mouseClickBottomRightCorner = FALSE
end if
'test mouse @BottomLeftCorner
if gmX>=THIS.Xi and _
gmX<(THIS.Xi + THIS.Thckns) and _
gmY>(THIS.Yf - THIS.Thckns) and _
gmY<=THIS.Yf then
if THIS._mouseOverBottomLeftCorner=FALSE then THIS._mouseOverBottomLeftCorner = TRUE
if gmBtn1=+1 then
if THIS._mouseClickBottomLeftCorner=FALSE then
THIS._mouseClickBottomLeftCorner = TRUE
if not THIS._resizeStarted then
THIS._xAtResizeTime = gmX
THIS._yAtResizeTime = gmY
THIS.SetResizeTimeInitialOffset()
end if
end if
else
if THIS._mouseClickBottomLeftCorner=TRUE then THIS._mouseClickBottomLeftCorner = FALSE
end if
else
if THIS._mouseOverBottomLeftCorner=TRUE then THIS._mouseOverBottomLeftCorner = FALSE
if THIS._mouseClickBottomLeftCorner=TRUE then THIS._mouseClickBottomLeftCorner = FALSE
end if
'
end sub 'RESIZABLERECTANGLE.TestResizableRectangleForMouse()
sub RESIZABLERECTANGLE.DrawResizableRectangle()
THIS.TestResizableRectangleForMouse()
'
'preamble->
/'
? "resize started="; THIS._resizeStarted
? "TLCXanchored="; THIS.TLCXanchored
? "TLCYanchored="; THIS.TLCYanchored
? "TRCXanchored="; THIS.TRCXanchored
? "TRCYanchored="; THIS.TRCYanchored
? "BRCXanchored="; THIS.BRCXanchored
? "BRCYanchored="; THIS.BRCYanchored
? "BLCXanchored="; THIS.BLCXanchored
? "BLCYanchored="; THIS.BLCYanchored
THIS.DrawRectangle()
if THIS._dragEnabled then
THIS.DrawDraggableRectangle()
end if
'/
'
'draw left border
if THIS._mouseClickLeftBorder then
THIS.DrawThickContourElement(XY(THIS.Xi - 1, (THIS.Yi + THIS.Thckns)), _
XY((THIS.Xi + THIS.Thckns), (THIS.Yf - THIS.Thckns)), _
rgb(220,100,100), _
RSZ._FILLBOXOPTION._fill)
elseif THIS._mouseOverLeftBorder then
THIS.DrawThickContourElement(XY(THIS.Xi - 1, (THIS.Yi + THIS.Thckns)), _
XY((THIS.Xi + THIS.Thckns), (THIS.Yf - THIS.Thckns)), _
rgb(200,120,150), _
RSZ._FILLBOXOPTION._fill)
end if
THIS.DrawThickContourElement(XY(THIS.Xi, (THIS.Yi + THIS.Thckns)), _
XY((THIS.Xi + THIS.Thckns), (THIS.Yf - THIS.Thckns)), _
rgb(180,180,130), _
RSZ._FILLBOXOPTION._contour)
'draw top border
if THIS._mouseClickTopBorder then
THIS.DrawThickContourElement(XY((THIS.Xi + THIS.Thckns), THIS.Yi - 1), _
XY((THIS.Xf - THIS.Thckns), (THIS.Yi + THIS.Thckns)), _
rgb(220,100,100), _
RSZ._FILLBOXOPTION._fill)
elseif THIS._mouseOverTopBorder then
THIS.DrawThickContourElement(XY((THIS.Xi + THIS.Thckns), THIS.Yi - 1), _
XY((THIS.Xf - THIS.Thckns), (THIS.Yi + THIS.Thckns)), _
rgb(200,120,150), _
RSZ._FILLBOXOPTION._fill)
end if
THIS.DrawThickContourElement(XY((THIS.Xi + THIS.Thckns), THIS.Yi), _
XY((THIS.Xf - THIS.Thckns), (THIS.Yi + THIS.Thckns)), _
rgb(180,180,130), _
RSZ._FILLBOXOPTION._contour)
'draw right border
if THIS._mouseClickRightBorder then
THIS.DrawThickContourElement(XY((THIS.Xf - THIS.Thckns), (THIS.Yi + THIS.Thckns)), _
XY(THIS.Xf + 1, (THIS.Yf - THIS.Thckns)), _
rgb(220,100,100), _
RSZ._FILLBOXOPTION._fill)
elseif THIS._mouseOverRightBorder then
THIS.DrawThickContourElement(XY((THIS.Xf - THIS.Thckns), (THIS.Yi + THIS.Thckns)), _
XY(THIS.Xf + 1, (THIS.Yf - THIS.Thckns)), _
rgb(200,120,150), _
RSZ._FILLBOXOPTION._fill)
end if
THIS.DrawThickContourElement(XY((THIS.Xf - THIS.Thckns), (THIS.Yi + THIS.Thckns)), _
XY(THIS.Xf, (THIS.Yf - THIS.Thckns)), _
rgb(180,180,130), _
RSZ._FILLBOXOPTION._contour)
'draw bottom border
if THIS._mouseClickBottomBorder then
THIS.DrawThickContourElement(XY((THIS.Xi + THIS.Thckns), (THIS.Yf - THIS.Thckns)), _
XY((THIS.Xf - THIS.Thckns), THIS.Yf + 1), _
rgb(220,100,100), _
RSZ._FILLBOXOPTION._fill)
elseif THIS._mouseOverBottomBorder then
THIS.DrawThickContourElement(XY((THIS.Xi + THIS.Thckns), (THIS.Yf - THIS.Thckns)), _
XY((THIS.Xf - THIS.Thckns), THIS.Yf + 1), _
rgb(200,120,150), _
RSZ._FILLBOXOPTION._fill)
end if
THIS.DrawThickContourElement(XY((THIS.Xi + THIS.Thckns), (THIS.Yf - THIS.Thckns)), _
XY((THIS.Xf - THIS.Thckns), THIS.Yf), _
rgb(180,180,130), _
RSZ._FILLBOXOPTION._contour)
'draw top left corner
if THIS._mouseClickTopLeftCorner then
THIS.DrawThickContourElement(XY(THIS.Xi - 2, THIS.Yi - 2), _
XY((THIS.Xi + THIS.Thckns), (THIS.Yi + THIS.Thckns)), _
rgb(220,100,100), _
RSZ._FILLBOXOPTION._fill)
elseif THIS._mouseOverTopLeftCorner then
THIS.DrawThickContourElement(XY(THIS.Xi - 2, THIS.Yi - 2), _
XY((THIS.Xi + THIS.Thckns), (THIS.Yi + THIS.Thckns)), _
rgb(200,120,150), _
RSZ._FILLBOXOPTION._fill)
end if
THIS.DrawThickContourElement(XY(THIS.Xi - 1, THIS.Yi - 1), _
XY((THIS.Xi + THIS.Thckns), (THIS.Yi + THIS.Thckns)), _
rgb(180,180,130), _
RSZ._FILLBOXOPTION._contour)
'draw top right corner
if THIS._mouseClickTopRightCorner then
THIS.DrawThickContourElement(XY((THIS.Xf - THIS.Thckns), THIS.Yi - 2), _
XY(THIS.Xf + 2, (THIS.Yi + THIS.Thckns)), _
rgb(220,100,100), _
RSZ._FILLBOXOPTION._fill)
elseif THIS._mouseOverTopRightCorner then
THIS.DrawThickContourElement(XY((THIS.Xf - THIS.Thckns), THIS.Yi - 2), _
XY(THIS.Xf + 2, (THIS.Yi + THIS.Thckns)), _
rgb(200,120,150), _
RSZ._FILLBOXOPTION._fill)
end if
THIS.DrawThickContourElement(XY((THIS.Xf - THIS.Thckns), THIS.Yi - 1), _
XY(THIS.Xf + 1, (THIS.Yi + THIS.Thckns)), _
rgb(180,180,130), _
RSZ._FILLBOXOPTION._contour)
'draw bottom right corner
if THIS._mouseClickBottomRightCorner then
THIS.DrawThickContourElement(XY((THIS.Xf - THIS.Thckns), (THIS.Yf - THIS.Thckns)), _
XY(THIS.Xf + 2, THIS.Yf + 2), _
rgb(220,100,100), _
RSZ._FILLBOXOPTION._fill)
elseif THIS._mouseOverBottomRightCorner then
THIS.DrawThickContourElement(XY((THIS.Xf - THIS.Thckns), (THIS.Yf - THIS.Thckns)), _
XY(THIS.Xf + 2, THIS.Yf + 2), _
rgb(200,120,150), _
RSZ._FILLBOXOPTION._fill)
end if
THIS.DrawThickContourElement(XY((THIS.Xf - THIS.Thckns), (THIS.Yf - THIS.Thckns)), _
XY(THIS.Xf + 1, THIS.Yf + 1), _
rgb(180,180,130), _
RSZ._FILLBOXOPTION._contour)
'draw bottom left corner
if THIS._mouseClickBottomLeftCorner then
THIS.DrawThickContourElement(XY(THIS.Xi - 2, (THIS.Yf - THIS.Thckns)), _
XY((THIS.Xi + THIS.Thckns), THIS.Yf + 2), _
rgb(220,100,100), _
RSZ._FILLBOXOPTION._fill)
elseif THIS._mouseOverBottomLeftCorner then
THIS.DrawThickContourElement(XY(THIS.Xi - 2, (THIS.Yf - THIS.Thckns)), _
XY((THIS.Xi + THIS.Thckns), THIS.Yf + 2), _
rgb(200,120,150), _
RSZ._FILLBOXOPTION._fill)
end if
THIS.DrawThickContourElement(XY(THIS.Xi - 1, (THIS.Yf - THIS.Thckns)), _
XY((THIS.Xi + THIS.Thckns), THIS.Yf + 1), _
rgb(180,180,130), _
RSZ._FILLBOXOPTION._contour)
end sub 'RESIZABLERECTANGLE.DrawResizableRectangle()
type ICEBENCH extends RESIZABLERECTANGLE
declare constructor()
/'
:TODO:
declare constructor(byval as long, _
byval as long)
declare constructor(byval as long, _
byval as long, _
byval as long, _
byval as long)
'/
declare sub InitializeIceBench()
declare destructor()
declare property AdjustedTitleToFitBar() as string
declare property DraggableZoneXi() as long
declare property DraggableZoneYi() as long
declare property DraggableZoneXf() as long
declare property DraggableZoneYf() as long
declare property HasBoardFocus() as boolean
declare property HasBoardFocus(byval as boolean)
declare property DragEnabled() as boolean
declare property DragEnabled(byval as boolean)
declare property ResizeEnabled() as boolean
declare property ResizeEnabled(byval as boolean)
declare sub TestIceBenchForMouse()
declare sub DrawIceBench()
as long _zOrder
as string _titleBarTitle
as RECTANGLE _draggableZone
as long _draggableZoneXi
as long _draggableZoneYi
as long _draggableZoneXf
as long _draggableZoneYf
as boolean _hasBoardFocus
as boolean _mouseOverVisibleArea
as boolean _mouseClickVisibleArea
as boolean _mouseOverDraggableSubFrame
as boolean _mouseClickDraggableSubFrame
as boolean _mouseOverResizableBoundary
as boolean _mouseClickResizableBoundary
end type 'ICEBENCH <-- RESIZABLERECTANGLE <-- DRAGGABLERECTANGLE <-- RECTANGLE <-- OBJECT
constructor ICEBENCH()
BASE()
'
THIS.InitializeIceBench()
end constructor 'ICEBENCH default explicit constructor
sub ICEBENCH.InitializeIceBench()
with THIS
._titleBarTitle => ".."
.DragEnabled => FALSE
.ResizeEnabled => TRUE
._draggableZone.Xi => .DraggableZoneXi
._draggableZone.Yi => .DraggableZoneYi
._draggableZone.Xf => .DraggableZoneXf
._draggableZone.Yf => .DraggableZoneYf
._hasBoardFocus => FALSE
._mouseOverVisibleArea => FALSE
._mouseClickVisibleArea => FALSE
._mouseOverDraggableSubFrame => FALSE
._mouseClickDraggableSubFrame => FALSE
._mouseOverResizableBoundary => FALSE
._mouseClickResizableBoundary => FALSE
.Thckns => 12
end with 'THIS
end sub 'ICEBENCH.InitializeIceBench()
destructor ICEBENCH()
'
end destructor 'ICEBENCH default explicit destructor
property ICEBENCH.AdjustedTitleToFitBar() as string
dim as string stringResult
stringResult = THIS._titleBarTitle
'---->
return stringResult
end property 'get STR:=ICEBENCH.AdjustedTitleToFitBar
property ICEBENCH.DraggableZoneXi() as long
THIS._draggableZoneXi = THIS.Xi + THIS.Thckns
'---->
return THIS._draggableZoneXi
end property 'get LNG:=ICEBENCH.DraggableZoneXi
property ICEBENCH.DraggableZoneYi() as long
THIS._draggableZoneYi = THIS.Yi + THIS.Thckns
'---->
return THIS._draggableZoneYi
end property 'get LNG:=ICEBENCH.DraggableZoneYi
property ICEBENCH.DraggableZoneXf() as long
THIS._draggableZoneXf = THIS.Xf - THIS.Thckns
'---->
return THIS._draggableZoneXf
end property 'get LNG:=ICEBENCH.DraggableZoneXf
property ICEBENCH.DraggableZoneYf as long
THIS._draggableZoneYf = THIS.Yi + THIS.Thckns + 24
'---->
return THIS._draggableZoneYf
end property 'get LNG:=ICEBENCH.DraggableZoneYf
property ICEBENCH.HasBoardFocus() as boolean
'---->
return THIS._hasBoardFocus
end property 'get BOOL:=ICEBENCH.HasBoardFocus
property ICEBENCH.HasBoardFocus(byval SetValue as boolean)
THIS._hasBoardFocus = SetValue
end property 'set ICEBENCH.HasBoardFocus(valBOOL)
property ICEBENCH.DragEnabled() as boolean
if not THIS.HasBoardFocus then THIS._dragEnabled = FALSE
'---->
return THIS._dragEnabled
end property 'get BOOL:=ICEBENCH.DragEnabled
property ICEBENCH.DragEnabled(byval SetValue as boolean)
THIS._dragEnabled = SetValue
end property 'set ICEBENCH.DragEnabled(valBOOL)
property ICEBENCH.ResizeEnabled() as boolean
if not THIS.HasBoardFocus then THIS._resizeEnabled = FALSE
'---->
return THIS._resizeEnabled
end property 'get BOOL:=ICEBENCH.ResizeEnabled
property ICEBENCH.ResizeEnabled(byval SetValue as boolean)
THIS._resizeEnabled = SetValue
end property 'set ICEBENCH.ResizeEnabled(valBOOL)
sub ICEBENCH.TestIceBenchForMouse()
dim as integer gmX, gmY, gmBtn1
getMouse gmX, gmY, , gmBtn1
'
if gmX>THIS.DraggableZoneXi and _
gmX<THIS.DraggableZoneXf and _
gmY>THIS.DraggableZoneYi and _
gmY<THIS.DraggableZoneYf then
if THIS.DragEnabled=FALSE then THIS.DragEnabled = TRUE
else
if THIS.DragEnabled=TRUE then THIS.DragEnabled = FALSE
end if
'
end sub 'ICEBENCH.TestIceBenchForMouse()
sub ICEBENCH.DrawIceBench()
THIS.TestIceBenchForMouse()
if THIS.DragEnabled then
'just calling the prop.
end if
if THIS.ResizeEnabled then
'just calling the prop.
end if
if THIS._resizeStarted then
THIS.DragEnabled = FALSE
end if
if not THIS.HasBoardFocus then
THIS.Thckns = 0
'dev.note: check for redundancy! late addition:
THIS.ResizeEnabled = FALSE
else
THIS.Thckns = 10
'dev.note: check for redundancy! late addition:
THIS.ResizeEnabled = TRUE
end if
'
THIS.DrawRectangleAsFlatBackground()
THIS.DrawSilentlyDraggableRectangle()
THIS._draggableZone.Xi = THIS.DraggableZoneXi
THIS._draggableZone.Yi = THIS.DraggableZoneYi
THIS._draggableZone.Xf = THIS.DraggableZoneXf
THIS._draggableZone.Yf = THIS.DraggableZoneYf
THIS._draggableZone.DrawRectangle()
THIS.DrawResizableRectangle()
draw string (THIS._draggableZone.Xi + 4, _
THIS._draggableZone.Yi + 4), _
THIS.AdjustedTitleToFitBar, _
rgb(200,200,155)
end sub 'ICEBENCH.DrawIceBench()
' ------------
' ICEBOARD UDT
' ------------
type ICEBOARD
declare constructor()
declare destructor()
declare property IBenchCount() as long
declare property IBenchZOrderAtIndex(Index as long) as long
declare function IsIceBenchRegistred(byval as ICEBENCH ptr) as boolean
declare sub AddIceBench(byval as ICEBENCH ptr)
declare function GrantFocusToIceBenchAtIndex(byval as long) as long
declare function TestIBenchArrayForMouseOverAtIndex(byval as long, _
byval as long, _
byval as long) _
as boolean
declare sub TestIceBoardForMouse()
declare sub DrawIceBoard()
as long _benchCount
as ICEBENCH ptr _arrayOfIBenchPtr(any)
end type 'ICEBOARD
constructor ICEBOARD()
dim as integer deskTopW
dim as integer deskTopH
screenInfo deskTopW, deskTopH
'
screenRes desktopW, _
desktopH, _
32, _
1, _
fb.GFX_SHAPED_WINDOW
color ,rgba(255,0,255,0)
end constructor 'ICEBOARD default explicit constructor
destructor ICEBOARD()
'
end destructor 'ICEBOARD default explicit detructor
property ICEBOARD.IBenchCount() as long
'---->
return ( (uBound(THIS._arrayOfIBenchPtr) - _
lBound(THIS._arrayOfIBenchPtr)) + _
1 )
end property 'get LNG:=ICEBOARD.IBenchCount()
property ICEBOARD.IBenchZOrderAtIndex(Index as long) as long
if Index>=lBound(THIS._arrayOfIBenchPtr) and _
Index<=uBound(THIS._arrayOfIBenchPtr) then
'---->
return THIS._arrayOfIBenchPtr(Index)->_zOrder
else
'---->
return -1
end if
end property 'get LNG:=IBenchZOrderAtIndex(LNG_INDEX)
function ICEBOARD.IsIceBenchRegistred(byval IBenchPtr as ICEBENCH ptr) as boolean
dim as boolean returnValue => FALSE
for index as long = 0 to uBound(THIS._arrayOfIBenchPtr)
if IBenchPtr=THIS._arrayOfIBenchPtr(index) then
returnValue = TRUE
exit for
end if
next index
'---->
return returnValue
end function 'BOOL:=ICEBOARD.IsIceBenchRegistred(valICEBENCH_PTR)
sub ICEBOARD.AddIceBench(byval IBenchPtr as ICEBENCH ptr)
if THIS.IsIceBenchRegistred(IBenchPtr) or _
cBool(IBenchPtr=0) then
exit sub
else
if uBound(THIS._arrayOfIBenchPtr)>=0 then
THIS._arrayOfIBenchPtr(uBound(THIS._arrayOfIBenchPtr))->HasBoardFocus = _
FALSE
end if
redim preserve THIS._arrayOfIBenchPtr(uBound(THIS._arrayOfIBenchPtr) + 1)
THIS._arrayOfIBenchPtr(uBound(THIS._arrayOfIBenchPtr)) => IBenchPtr
THIS._arrayOfIBenchPtr(uBound(THIS._arrayOfIBenchPtr))->HasBoardFocus => TRUE
THIS._arrayOfIBenchPtr(uBound(THIS._arrayOfIBenchPtr))->_zOrder => _
uBound(THIS._arrayOfIBenchPtr)
end if
end sub 'ICEBOARD.AddIceBench(valICEBENCH_PTR)
function ICEBOARD.GrantFocusToIceBenchAtIndex(byval Index as long) as long
if Index>=lBound(THIS._arrayOfIBenchPtr) and _
Index<=uBound(THIS._arrayOfIBenchPtr) then
THIS._arrayOfIBenchPtr(Index)->HasBoardFocus = TRUE
if Index<>uBound(THIS._arrayOfIBenchPtr) then
swap THIS._arrayOfIBenchPtr(Index), _
THIS._arrayOfIBenchPtr(uBound(THIS._arrayOfIBenchPtr))
for localIndex as long = 0 to uBound(THIS._arrayOfIBenchPtr) - 1
THIS._arrayOfIBenchPtr(Index)->HasBoardFocus = FALSE
THIS._arrayOfIBenchPtr(Index)->_dragEnabled = FALSE
THIS._arrayOfIBenchPtr(Index)->_resizeStarted = FALSE
next localIndex
end if
'todo:
'rearrange according to previous zOrder (not just swap)
'---->
return +0
else
'---->
return +1
end if
end function 'LNG:=ICEBOARD.GrantFocusToIceBenchAtIndex(valLNG)
function ICEBOARD.TestIBenchArrayForMouseOverAtIndex(byval Index as long, _
byval GMX as long, _
byval GMY as long) _
as boolean
dim as boolean returnValue => FALSE
if GMX>=THIS._arrayOfIBenchPtr(Index)->Xi and _
GMX<=THIS._arrayOfIBenchPtr(Index)->Xf and _
GMY>=THIS._arrayOfIBenchPtr(Index)->Yi and _
GMY<=THIS._arrayOfIBenchPtr(Index)->Yf then
? Index
? THIS._arrayOfIBenchPtr(0)->HasBoardFocus
? THIS._arrayOfIBenchPtr(1)->HasBoardFocus
? THIS._arrayOfIBenchPtr(Index)->Xi
? THIS._arrayOfIBenchPtr(Index)->Xf
? THIS._arrayOfIBenchPtr(Index)->Yi
? THIS._arrayOfIBenchPtr(Index)->Yf
returnValue = TRUE
end if
'---->
return returnValue
end function 'BOOL:=ICEBOARD.TestIBenchArrayForMouseOverAtIndex({valLNG}*3)
sub ICEBOARD.TestIceBoardForMouse()
'
'dev.note:
'this below to prevent sudden weird partial focus flip (partial) while moving
'unfortunately that doesn't work...
if THIS._arrayOfIBenchPtr(uBound(THIS._arrayOfIBenchPtr))->_dragEnabled or _
THIS._arrayOfIBenchPtr(uBound(THIS._arrayOfIBenchPtr))->_resizeStarted then
exit sub
end if
'
dim as integer gmX, gmY, gmBtn1
getMouse gmX, gmY, , gmBtn1
'
dim as long index
for index = (THIS.IBenchCount - 1) to 0 step -1
if THIS.TestIBenchArrayForMouseOverAtIndex(index, gmX, gmY) then exit for
next index
if index<0 then
exit sub
else
if gmBtn1=+1 then
THIS.GrantFocusToIceBenchAtIndex(index)
end if
end if
end sub 'ICEBOARD.TestIceBoardForMouse()
sub ICEBOARD.DrawIceBoard()
dim as integer deskTopW
dim as integer deskTopH
screenInfo deskTopW, deskTopH
'non-priotary todo: check&update if desktop changed
'
for row as long = 200\8 to (desktopH - 200)\8
for col as long = 200\8 to (desktopW - 200)\8
locate row, col, 0 : ? ".";
next col
next row
locate (desktopH - 200)\8, 200\8 : ? "development version"
'
THIS.TestIceBoardForMouse()
'
for index as long = 0 to uBound(THIS._arrayOfIBenchPtr)
THIS._arrayOfIBenchPtr(index)->DrawIceBench()
next index
end sub 'ICEBOARD.DrawIceBoard()
'----------------------------------------------
'------------------------------------------MAIN
'--------------------------------INITIALIZATION
'screenRes 600,480,32
'color rgb(0,220,220), rgb(080,080,120)
dim as ICEBENCH testIBench1
dim as ICEBENCH testIBench2
dim as ICEBENCH testIBench3
dim as ICEBOARD testIBoard
testIBoard.AddIceBench(@testIBench1)
testIBoard.AddIceBench(@testIBench2)
testIBoard.AddIceBench(@testIBench3)
'-------------------------------------MAIN LOOP
color rgb(100,220,220)
do
screenLock
cls
testIBoard.DrawIceBoard()
screenUnlock
sleep 25
loop until inkey=chr(27)
'----------------------------------FINALIZATION
sleep
end 0
'[you've reached the end of the freebasic file]
