I'm not sure. It's active when the button is activated for instance. I can post the code here. If I haven't done before, it's because it's including some complicated stuff that gives me a headash (due to technical stuff by dafhi) and I had not enough time to make the simplified example.
Here is the code so you can judge by yourself by watching the coordinates at top left of the checker image:
Code: Select all
'--------------------------------------
'a dahfi's IMAGEVARS refactored version
'--------------------------------------
'list of UDTs:
' V3
' P3D
' AXIS3D
' IMAGER
' AADOT
' SCRPOS
' WIDHEI
' BOX
' MONOAPPSCREEN
#include "fbgfx.bi"
extern p alias "__fb_gfx" as long ptr
nameSpace dj
'author: DJ.Peters@fb.net
function IsScreenLocked() as boolean
if screenPtr()=0 then return FALSE
#ifndef __FB_64BIT__
#define index 33
#else
#define index 44
#endif
return iif(p[index] and 1,true,false)
#undef index
end function
end nameSpace
nameSpace cst
const as double _pi => 4*atn(1)
end nameSpace
type V3
as double _x, _y, _z
as double _radius
as long _color
end type
type P3D as V3
type AXIS3D
as V3 _axisX = (1,0,0)
as V3 _axisY = (0,-1,0)
as V3 _axisZ = (0,0,1)
as double _x, _y, _z
end type
type IMAGER
declare constructor()
enum _CREATIONMODE
_asScreen = 0
_asImage = 1
end enum
declare constructor(byval CreationMode as _CREATIONMODE)
declare destructor()
private:
declare sub VarPoolInit()
declare sub ImgDestroy()
public:
declare sub ClrScr(byval Colour as ulong=&HFF000000)
declare sub ScrInf()
declare sub InitAsScreen(byval Wid as single=-1, _
byval Hei as single=-1, _
byval Bpp as uinteger=32, _
byval NumPage as integer=1, _
byval Flag as integer=0)
declare function CreateAsImage(byval Wid as long=-1, _
byval Hei as long=0, _
byval Colour as ulong=rgb(0,0,0)) _
as any ptr
declare sub CheckerCreate(byval PColor as ulong=rgba(145,145,145,255), _
byval Size as uinteger=12)
as any ptr _img, _pix
as integer _w, _h, _
_bpp, _bypp, _pitch, _
_numpage, _flag, _rate, _
_pitchBy, _wm, _hm
as boolean _isScreen
as single _midx, _midy, _
_midxm, _midym, _diag
as string _driverName
end type
constructor IMAGER()
screen 0
dim as integer deskW, deskH
screenInfo deskW, deskH
THIS.InitAsScreen(deskW, deskH, 32, 1, fb.GFX_NO_FRAME + fb.GFX_SHAPED_WINDOW)
ClrScr(rgb(255,0,255))
end constructor
constructor IMAGER(byval CreationMode as _CREATIONMODE)
select case CreationMode
case IMAGER._CREATIONMODE._asScreen
screen 0
dim as integer deskW, deskH
screenInfo deskW, deskH
THIS.InitAsScreen(deskW, deskH, 32, 1, fb.GFX_NO_FRAME + fb.GFX_SHAPED_WINDOW)
ClrScr(rgb(255,0,255))
case IMAGER._CREATIONMODE._asImage
''
end select
end constructor
destructor IMAGER()
ImgDestroy()
end destructor
sub IMAGER.VarPoolInit()
with THIS
._wm => ._w - 1
._midx => ._w/2
._midxm => ._wm/2
._hm => ._h - 1
._midy => ._h/2
._midym => ._hm/2
end with
'
THIS._diag => sqr(THIS._w*THIS._w + THIS._h*THIS._h)
'
if THIS._bypp<>0 then
THIS._pitchBy = THIS._pitch\THIS._bypp
end if
end sub
sub IMAGER.ImgDestroy()
if THIS._img<>0 then
imageDestroy(THIS._img)
THIS._img = 0
end if
end sub
sub IMAGER.ClrScr(byval Colour as ulong=&HFF000000)
line (0,0)-(THIS._wm, THIS._hm), Colour, bf
end sub
sub IMAGER.ScrInf()
with THIS
screenInfo ._w, ._h, ._bpp, _
._bypp, ._pitch, ._rate, _
._driverName
._pix => screenPtr()
end with
'
THIS.VarPoolInit()
end sub
sub IMAGER.InitAsScreen(byval Wid as single=-1, _
byval Hei as single=-1, _
byval Bpp as uinteger=32, _
byval NumPage as integer=1, _
byval Flag as integer=0)
THIS.ImgDestroy()
dim as integer ww, hh
screenInfo ww, hh
'
Wid = abs(Wid)
if Wid<=1 then
Wid *= ww
end if
Hei = abs(Hei)
if Hei<=1 then
Hei *= hh
end if
'
with THIS
._w => Wid
._h => Hei
._Bpp => Bpp
._flag or=> 8
._numpage => Numpage
._flag => Flag
._isScreen => TRUE
end with
'
screenRes Wid, _
Hei, _
Bpp, _
Numpage, _
Flag
THIS.ScrInf()
'
if NumPage> 1 then
screenSet 0, 1
end if
end sub
function IMAGER.CreateAsImage(byval Wid as long=-1, _
byval Hei as long=0, _
byval Colour as ulong=rgb(0,0,0)) _
as any ptr
THIS.ImgDestroy()
'
if Hei=0 then
THIS.ScrInf()
Wid = THIS._w
Hei = THIS._h
end if
'
THIS._img => imageCreate( Wid, Hei, Colour, 32 )
imageInfo THIS._img, _
THIS._w, _
THIS._h, _
THIS._bypp, _
THIS._pitch, _
THIS._pix
THIS._bpp = THIS._bypp*8
'
THIS.VarPoolInit()
THIS._isScreen => FALSE
'
'---->
return THIS._img
end function
sub IMAGER.CheckerCreate(byval PColor as ulong, byval Size as uinteger)
dim as uinteger sizeDouble => Size*2
dim as uinteger sizeM => Size - 1
for y as integer = 0 to THIS._hm step Size
for x as integer = -Size*( (y/sizeDouble)=int(y/sizeDouble) ) to _
THIS._wm step _
sizeDouble
line THIS._img, _
(x, y)-(x + sizeM, y + sizeM), _
PColor, _
bf
next x
next y
end sub
#macro _ALPHA256(ret, back, fore, am, a256)
ret=((_
( fore and &hFF00FF)*a256 + _
( back and &hFF00FF)*am + &h800080 ) and &hFF00FF00 or _
(_
( fore and &H00FF00)*a256 + _
( back and &h00FF00)*am + &h008000 ) and &h00FF0000) shr 8
#endMacro
type AADOT
declare constructor()
declare sub RenderTarget(byval Pti as IMAGER ptr)
declare sub DrawAadot(byval X as single=0, _
byval Y as single=0, _
byval C as ulong=&hFFFFFFFF)
as single _radius
as single _alpha
as boolean _isOutlined
as IMAGER ptr _imagerPtr
as any ptr _pixPtr
private:
as single _slope
as single _slope_X2
end type
constructor AADOT()
with THIS
._radius => 0.65
._alpha => 1.
._isOutlined => FALSE
end with
end constructor
sub AADOT.RenderTarget(byval Pti as IMAGER ptr)
if pti->_isScreen then
THIS._pixPtr = screenPtr()
else
THIS._pixPtr = Pti->_pix
end if
'
THIS._imagerPtr = Pti
end sub
sub AADOT.DrawAadot(byval X as single=0, _
byval Y as single=0, _
byval C as ulong=&hFFFFFFFF)
if THIS._imagerPtr->_h<1 then
exit sub
end if
'
THIS._slope = THIS._alpha*256
THIS._slope_X2 = THIS._slope*2
'
dim as single coneHei => THIS._radius*THIS._slope
dim as integer x1 => X - THIS._radius
dim as integer x2 => X + THIS._radius
x1 += x1*( x1<0 )
dim as integer y1 => Y - THIS._radius
dim as integer y2 => Y + THIS._radius
y1 += y1*( y1<0 )
dim as single dxClip => THIS._slope*(X - x1)
dim as single dy => THIS._slope*(Y - y1)
x2 += (x2 - THIS._imagerPtr->_wm)*(x2>THIS._imagerPtr->_wm)
y2 += (y2 - THIS._imagerPtr->_hm)*(y2>THIS._imagerPtr->_hm)
dim as integer pWidm => x2 - x1
dim as ulong ptr pCorner => THIS._pixPtr
pCorner += x1 + y1*THIS._imagerPtr->_pitchBy
'
if THIS._isOutlined then
for py as ulong ptr = pCorner to _
@pCorner[ (y2 - y1)*THIS._imagerPtr->_pitchBy ] step _
THIS._imagerPtr->_pitchBy
'
dim as single ySq => dy*dy
dim as single dx => dxClip
for px as ulong ptr = py to py + pWidm
'
dim as integer alph => coneHei - sqr(dx*dx + ySq)
if alph>THIS._slope then alph = THIS._slope_X2 - alph
if alph>0 then
dim as integer alphM => 256 - alph
_ALPHA256( *px, _
*px, _
C, _
alphM, _
alph )
end if
dx -= THIS._slope
'
next px
dy -= THIS._slope
'
next py
else
for py as ulong ptr = pCorner to _
@pCorner[ (y2 - y1)*THIS._imagerPtr->_pitchBy ] step _
THIS._imagerPtr->_pitchBy
'
dim as single ySq => dy*dy
dim as single dx => dxClip
for px as ulong ptr = py to py + pWidm
dim as integer alph => coneHei - sqr(dx*dx + ySq)
'
if alph> THIS._slope then
alph = THIS._slope
else
alph += alph*(alph<0)
end if
'
dim as integer alphM => 256 - alph
_ALPHA256( *px, _
*px, _
C, _
alphM, _
alph )
dx -= THIS._slope
next px
dy -= THIS._slope
'
next py
end if
'
end sub
type SCRPOS
as integer _scrPosX
as integer _scrPosY
End Type
type WIDHEI extends OBJECT
as integer _wid
as integer _hei
end type
type BOX
declare property Xi() as integer
declare property Xi(byval as integer)
declare property Yi() as integer
declare property Yi(byval as integer)
declare property W() as integer
declare property W(byval as integer)
declare property H() as integer
declare property H(byval as integer)
declare property Xf() as integer
declare property Xf(byval as integer)
declare property Yf() as integer
declare property Yf(byval as integer)
as SCRPOS _scrPos
as WIDHEI _widHei
end type
property BOX.Xi() as integer
'---->
return THIS._scrPos._scrPosX
end property
property BOX.Xi(byval SetValue as integer)
THIS._scrPos._scrPosX = SetValue
end property
property BOX.Yi() as integer
'---->
return THIS._scrPos._scrPosY
End Property
property BOX.Yi(byval SetValue as integer)
THIS._scrPos._scrPosY = SetValue
end property
property BOX.W() as integer
'---->
return THIS._widHei._wid
end property
property BOX.W(byval SetValue as integer)
THIS._widHei._wid = SetValue
End Property
property BOX.H() as integer
'---->
return THIS._widHei._hei
end property
property BOX.H(byval SetValue as integer)
THIS._widHei._hei = SetValue
end property
property BOX.Xf() as integer
'---->
return ( THIS._scrPos._scrPosX + THIS._widHei._wid - 1 )
end property
property BOX.Xf(byval SetValue as integer)
THIS._widHei._wid = SetValue - THIS._scrPos._scrPosX + 1
end property
property BOX.Yf() as integer
'---->
return ( THIS._scrPos._scrPosY + THIS._widHei._hei - 1 )
end property
property BOX.Yf(byval SetValue as integer)
THIS._widHei._hei = SetValue - THIS._scrPos._scrPosY + 1
end property
type MONOAPPSCREEN
declare constructor()
declare constructor(byval ImgWid as integer, _
byval ImgHei as integer)
declare constructor(byval ScreenBuffer as IMAGER, _
byval BackgroundImg as IMAGER, _
byval ZoomFactor as single, _
byval MainAxis as AXIS3D, _
ArrayOfPoint() as P3D)
declare property BckgndImgXi() as integer
declare property BckgndImgXi(byval as integer)
declare property BckgndImgYi() as integer
declare property BckgndImgYi(byval as integer)
declare property BckgndImgXf() as integer
declare property BckgndImgYf() as integer
declare sub QsortZ( Array() As P3D, Begin as long, Finish as long)
declare sub TestMouse()
declare sub DrawBorder()
declare sub DrawButton()
declare sub RenderAppScreen()
as IMAGER _screenBuffer
as IMAGER _mainBackgroundImageBuffer
as integer _mainBackgroundImageBufferTopLeftCornerX
as integer _mainBackgroundImageBufferTopLeftCornerY
as P3D _arrayOfPoint(any)
as single _zoomFactor
as AXIS3D _mainAxis
'
as BOX _topBar
'
as ulong _borderColor
as boolean _hasMouseOver
as boolean _hasMouseClick
end type
type as MONOAPPSCREEN MAS
constructor MONOAPPSCREEN()
with THIS
._screenBuffer => IMAGER(IMAGER._CREATIONMODE._asScreen)
._mainBackgroundImageBuffer => IMAGER(IMAGER._CREATIONMODE._asImage)
._zoomFactor => 1
end with
'
with THIS._mainBackgroundImageBuffer
.CreateAsImage THIS._screenBuffer._w\4, _
THIS._screenBuffer._h\4, _
rgb(48,48,48)
.CheckerCreate rgb(92,92,92), 30
end with
'
THIS.BckgndImgXi => (THIS._screenBuffer._w - THIS._mainBackgroundImageBuffer._w)\2
THIS.BckgndImgYi => (THIS._screenBuffer._h - THIS._mainBackgroundImageBuffer._h)\2
redim preserve THIS._arrayOfPoint(0)
end constructor
constructor MONOAPPSCREEN(byval ImgWid as integer, _
byval ImgHei as integer)
with THIS
._screenBuffer => IMAGER(IMAGER._CREATIONMODE._asScreen)
._mainBackgroundImageBuffer => IMAGER(IMAGER._CREATIONMODE._asImage)
._zoomFactor => 1
end with
'
with THIS._mainBackgroundImageBuffer
.CreateAsImage ImgWid, _
ImgHei, _
rgb(100,110,165)
.CheckerCreate rgb(192,192,192), 10
end with
'
THIS.BckgndImgXi => (THIS._screenBuffer._w - THIS._mainBackgroundImageBuffer._w)\2
THIS.BckgndImgYi => (THIS._screenBuffer._h - THIS._mainBackgroundImageBuffer._h)\2
redim preserve THIS._arrayOfPoint(0)
end constructor
constructor MONOAPPSCREEN(byval ScreenBuffer as IMAGER, _
byval BackgroundImg as IMAGER, _
byval ZoomFactor as single, _
byval MainAxis as AXIS3D, _
ArrayOfPoint() as P3D)
with THIS
._screenBuffer => ScreenBuffer
._mainBackgroundImageBuffer => BackgroundImg
._mainAxis => MainAxis
._zoomFactor => ZoomFactor
end with
'
redim THIS._arrayOfPoint(uBound(ArrayOfPoint) - lBound(ArrayOfPoint))
for index as integer = lBound(ArrayOfPoint) to uBound(ArrayOfPoint)
THIS._arrayOfPoint(index - lBound(ArrayOfPoint)) => ArrayOfPoint(index)
next index
'
THIS.BckgndImgXi => (THIS._screenBuffer._w - THIS._mainBackgroundImageBuffer._w)\2
THIS.BckgndImgYi => (THIS._screenBuffer._h - THIS._mainBackgroundImageBuffer._h)\2
end constructor
property MAS.BckgndImgXi() as integer
'---->
return THIS._mainBackgroundImageBufferTopLeftCornerX
end property
property MAS.BckgndImgXi(byval SetValue as integer)
THIS._mainBackgroundImageBufferTopLeftCornerX = SetValue
end property
property MAS.BckgndImgYi() as integer
'---->
return THIS._mainBackgroundImageBufferTopLeftCornerY
end property
property MAS.BckgndImgYi(byval SetValue as integer)
THIS._mainBackgroundImageBufferTopLeftCornerY = SetValue
end property
property MAS.BckgndImgXf() as integer
'---->
return ( THIS._mainBackgroundImageBufferTopLeftCornerX + THIS._mainBackgroundImageBuffer._w - 1)
end property
property MAS.BckgndImgYf() as integer
'---->
return ( THIS._mainBackgroundImageBufferTopLeftCornerY + THIS._mainBackgroundImageBuffer._h - 1)
end property
sub MAS.QsortZ( Array() As P3D, Begin as long, Finish as long)
'author: dodicat@fb.net
dim as long i => Begin
dim as long j => Finish
'
dim as P3D item => Array( ( (i + j)\2 ) )
'
while i<=j
while Array(i)._z>item._z : i += 1 : wend
while Array(j)._z<item._z : j -= 1 : wend
if i<j then
swap Array(i), Array(j)
i += 1
j -= 1
elseIf i=j then
i += 1
j -= 1
end if
wend
'
if j>Begin then QsortZ( array() , Begin, j )
if i<Finish then QsortZ( array(), i, Finish)
end sub
sub MAS.TestMouse()
dim as integer gmX, gmY, gmWheel, gmBtn
getMouse gmX, gmY, gmWheel, gmBtn
'
draw string (THIS.BckgndImgXi, THIS.BckgndImgYi), str(gmX) &".."& str(gmY)
if gmX>=THIS.BckgndImgXi andAlso _
gmX<=THIS.BckgndImgXf andAlso _
gmY>=THIS.BckgndImgYi andAlso _
gmY<=THIS.BckgndImgYf then
if not THIS._hasMouseOver then THIS._hasMouseOver = TRUE
if gmBtn>0 then
if not THIS._hasMouseClick then THIS._hasMouseClick = TRUE
else
if THIS._hasMouseClick then THIS._hasMouseClick = FALSE
end if
else
if THIS._hasMouseOver then THIS._hasMouseOver = FALSE
if THIS._hasMouseClick then THIS._hasMouseClick = FALSE
end if
end sub
sub MAS.DrawBorder()
THIS.TestMouse()
'
if THIS._hasMouseClick then
THIS._borderColor => rgb(190,175,175)
elseIf THIS._hasMouseOver then
THIS._borderColor => rgb(190,190,105)
else
THIS._borderColor => rgb(90,90,105)
end if
'
line (THIS.BckgndImgXi, THIS.BckgndImgYi)-_
(THIS.BckgndImgXf, THIS.BckgndImgYf), _
THIS._borderColor, _
b
THIS._mainBackgroundImageBuffer.CheckerCreate THIS._borderColor, 10
end sub
sub MAS.RenderAppScreen()
dim as boolean isInitiallyScreenLocked => dj.IsScreenLocked
if not isInitiallyScreenLocked then
screenLock()
end if
put (THIS.BckgndImgXi, THIS.BckgndImgYi), _
THIS._mainBackgroundImageBuffer._img, _
PSET
'
dim as AADOT dot
dot.RenderTarget (@THIS._screenBuffer)
dot._alpha => 0.75
dim as single zPointScale => 0.011
'
THIS.QsortZ( THIS._arrayOfPoint(), _
lBound(THIS._arrayOfPoint), _
uBound(THIS._arrayOfPoint) )
'
for pt as P3D ptr = @THIS._arrayOfPoint(lBound(THIS._arrayOfPoint)) to _
@THIS._arrayOfPoint(uBound(THIS._arrayOfPoint))
dim as single rz1 => ( THIS._mainAxis._z + _
THIS._mainAxis._axisZ._z*pt->_z + _
0*THIS._mainAxis._axisX._z*pt->_x + _
0*THIS._mainAxis._axisY._z*pt->_y )
if rz1>0.1 then
dim as single rz2 => THIS._zoomFactor/rz1
dim as single y => THIS._screenBuffer._midy - _
rz2*(THIS._mainAxis._y + _
THIS._mainAxis._axisY._y*pt->_y + _
THIS._mainAxis._axisZ._y*pt->_z + _
THIS._mainAxis._AxisX._y*pt->_x)
dim as single x => THIS._screenBuffer._midx + _
rz2*(THIS._mainAxis._x + _
THIS._mainAxis._axisX._x*pt->_x + _
THIS._mainAxis._axisY._x*pt->_y + _
THIS._mainAxis._axisZ._x*pt->_z)
'
dot._radius = zPointScale*rz2*pt->_radius
dot.DrawAadot(x, y, pt->_color)
end if
next pt
if not isInitiallyScreenLocked then
screenUnlock()
end if
'
end sub
'-------------------------------------------------MAIN---
'-------------------------------------------------INIT---
dim as MONOAPPSCREEN mono => MONOAPPSCREEN(640, 480)
redim preserve mono._arrayOfPoint( 1000 )
for index as integer = 0 to uBound(mono._arrayOfPoint)
mono._arrayOfPoint(index)._x = 0
mono._arrayOfPoint(index)._y = 0
mono._arrayOfPoint(index)._z = .1
mono._arrayOfPoint(index)._radius = 100
mono._arrayOfPoint(index)._color = rgb(200,0,0)
next index
mono._mainAxis._z = .1
mono._zoomFactor = 1
do
screenLock
mono.RenderAppScreen()
mono.DrawBorder()
screenUnlock
'
sleep 25
loop until inkey()=chr(27)
'-------------------------------------------------____---
getKey()
'(eof)
