Thanks SARG.
A little experiment, send Run time Type information (rtti) in a static lib file, to be used in another program.
Code: Select all
' shapes.bas
#cmdline "-lib"
Type Shape Extends Object
Declare Abstract Sub DrawShape()
Declare abstract Sub Moveshape(As Long,As Long,As Long,Byref As Long=0,Byref As Long=0,Byref As Long=0)
End Type
Type Point
As Single x,y
End Type
' First shape
Type Rectangle Extends Shape
Private:
As Long x,y
As Long rx,ry
As Long angle
As Ulong fillcol
As Ulong col
As Long paintflag
As Point r(1 To 4)
As Point centre
Public:
Declare Constructor(xx As Long,yy As Long,rxx As Long,ryy As Long,ang As Long,fill As Ulong,clr As Ulong,pf As Long)
Declare Sub rectangle()
Declare Sub DrawShape()
Declare Sub moveshape(As Long,As Long,As Long,Byref As Long=0,Byref As Long=0,Byref As Long=0)
End Type
Constructor Rectangle(xx As Long,yy As Long,rxx As Long,ryy As Long,ang As Long,fill As Ulong,clr As Ulong,pf As Long)
x=xx:y=yy:rx=rxx:ry=ryy:angle=ang:fillcol=fill:col=clr:paintflag=pf
End Constructor
Sub Rectangle.rectangle
Print "rectangle"
#macro rotate(pivot,p,a,d)
Type<Point>(d*(Cos(a*.0174533)*(p.x-pivot.x)-Sin(a*.0174533)*(p.y-pivot.y)) +pivot.x,_
d*(Sin(a*.0174533)*(p.x-pivot.x)+Cos(a*.0174533)*(p.y-pivot.y)) +pivot.y)
#endmacro
Dim As Point p(1 To 4)={(x,y),(x+rx,y),(x+rx,y+ry),(x,y+ry)}
centre=Type(x+rx/2,y+ry/2)
For n As Long=1 To 4
r(n)=rotate(centre,p(n),angle,1)
Next n
End Sub
Sub Rectangle.DrawShape()
rectangle
Line(r(1).x,r(1).y)-(r(2).x,r(2).y),col
Line(r(2).x,r(2).y)-(r(3).x,r(3).y),col
Line(r(3).x,r(3).y)-(r(4).x,r(4).y),col
Line (r(4).x,r(4).y)-(r(1).x,r(1).y),col
If paintflag Then Paint(centre.x,centre.y),fillcol,col
End Sub
Sub rectangle.moveshape(xx As Long,yy As Long, ang As Long,Byref rx As Long=0,Byref ry As Long=0,Byref ra As Long=0)
x+=xx:y+=yy:angle+=ang
rx=x:ry=y:ra=ang
End Sub
' Second shape
Type Oval Extends Shape
Private:
As Long x,y
As Long rx,ry
As Ulong angle
As Ulong fillcol
As Ulong col
As Ulong paintflag
Public:
Declare Constructor(As Long,As Long,As Long,As Long,As Ulong,As Ulong,As Ulong,As Ulong)
Declare Function oval() As String
Declare Sub DrawShape()
Declare Sub moveshape(As Long,As Long,As Long,Byref As Long=0,Byref As Long=0,Byref As Long=0)
End Type
Constructor oval(xx As Long,yy As Long,rxx As Long,ryy As Long,ang As Ulong, col1 As Ulong,pf As Ulong,fill As Ulong)
x=xx:y=yy:rx=rxx:ry=ryy:angle=ang:col=col1:paintflag=pf:fillcol=fill
End Constructor
Function oval.oval() As String
Print "oval"
Dim As String s="Ta" &angle &"Bm" &x &"," &y:s+="Bm+" &rx &"," & 0:s+="C" &col
Dim As Single pi2=8*Atn(1)
Dim As Long lx,ly
For z As Single=0 To pi2*1.1 Step pi2/60 '60 steps
If z>pi2 Then Exit For
Dim As Long xpos=rx*Cos(z)
Dim As Long ypos=ry*Sin(z)
If z<>0 Then s+="M+" &(xpos-lx) &"," &(ypos-ly)
lx=xpos:ly=ypos
Next z
If paintflag Then s+="BM" &x &"," &y &"P" & fillcol &"," & col
Return s
End Function
Sub Oval.DrawShape()
Draw oval
End Sub
Sub oval.moveshape(xx As Long,yy As Long, ang As Long,Byref rx As Long=0,Byref ry As Long=0,Byref ra As Long=0)
x+=xx:y+=yy:angle+=ang
rx=x:ry=y:ra=ang
End Sub
' SET UP
Dim As shape Ptr objR,objO
objO = New Oval(512,300,150,120,45,4,3,1)
objR= New Rectangle(512-200,300,400,100,45,5,3,1)
Type info
As Uinteger L(20) 'big enough to hold any field
End Type
Dim Shared As info I1,I2
For m As Long=0 To 13 '13 fields of rectangle
i1.L(m)= Cast(Uinteger,(Cptr(Any Ptr Ptr, objR)[m])) ' if m=0 get rtti else get the fields
Next m
For m As Long=0 To 8 '8 fields of oval
i2.L(m)= Cast(Uinteger,(Cptr(Any Ptr Ptr, objO)[m])) ' if m=0 get rtti else get the fields
Next m
Sub getrtti(Byref p1 As Any Ptr,Byref p2 As Any Ptr) ' EXTERNAL
p1=@i1:p2=@i2
End Sub
Delete objO
Delete objR
Code: Select all
#inclib "shapes"
Type Shape Extends Object
Declare Abstract Sub DrawShape()
Declare abstract Sub moveshape(As Long,As Long,As Long,Byref As Long=0,Byref As Long=0,Byref As Long=0)
End Type
Declare Sub getrtti(Byref p1 As Any Ptr,Byref p2 As Any Ptr)
Dim As shape Ptr y(1 To 2)
Dim As Any Ptr ir,io ' rtti information
getrtti(ir,io)
y(1)=io 'load the passed information to y()
y(2)=ir
#macro motion(z)
Static As Long rx=1,ry=1
Static As Long xpos,ypos
If xpos>800 Or xpos<z Then rx=-rx
If ypos>600 Or ypos<200 Then ry=-ry
#endmacro
Screen 20
Color ,7
Do
Screenlock
Cls
For n As Long=1 To 2
Select Case n
Case 1
motion(200)
y(n)->moveshape(rx,ry,1,xpos,ypos)
Case 2
motion(0)
y(n)->moveshape(rx,ry,1,xpos,ypos)
End Select
y(n)->DrawShape
Next n
Screenunlock
Sleep 5
Loop Until Inkey=Chr(27)
Sleep