it's based on Danilo's example.
I added :
- a structure storing.
- copy object
Code: Select all
;=========================================================================================
;-INCLUDE OOP.pbi
;=========================================================================================
;get vars
Procedure GetObjectVars(*this)
Protected *objectVarStruct
*objectVarStruct=*this+8
ProcedureReturn *objectVarStruct
EndProcedure
;set proc
Procedure SetObjectProc(*this,offsetProc,ProcAdress)
Protected *objectFuncTable
*objectFuncTable=PeekL(*this)
PokeL(*objectFuncTable+offsetProc,ProcAdress)
EndProcedure
;copy
Procedure CopyObject(*this)
Protected *object
Protected *obj
Protected objectSize
Protected offsetFuncTable
objectSize=PeekL(*this+4)
offsetFuncTable=(PeekL(*this)-*this)
*object = AllocateMemory(objectSize)
If *object
*obj=*object
CopyMemory(*this,*obj,objectSize)
PokeL(*obj,*object+offsetFuncTable)
EndIf
ProcedureReturn *object
EndProcedure
;create
Procedure CreateObject(sizeObjectVar,sizeObjectInterface)
Protected *object
Protected *obj
Protected objectSize
Protected offsetFuncTable
objectSize=8+sizeObjectVar+sizeObjectInterface
offsetFuncTable=8+sizeObjectVar
*object = AllocateMemory(objectSize)
If *object
*obj=*object
PokeL(*obj,*object+offsetFuncTable):*obj+4 ;offset function table
PokeL(*obj,objectSize):*obj+4 ;object size in bytes
PokeL(*obj,0):*obj+sizeObjectVar ;object variables: zeros init
PokeL(*obj,@GetObjectVars()):*obj+4 ;object default procedure: getVars()
PokeL(*obj,@SetObjectProc()):*obj+4 ;object default procedure: SetProc()
PokeL(*obj,@CopyObject()):*obj+4 ;object default procedure: Copy()
EndIf
ProcedureReturn *object
EndProcedure
;basic interface
Interface OBJECT
GetVars()
SetProc(offsetProc,ProcAdress)
Copy()
EndInterface
;=========================================================================================
;-Create a new kind of object : THING
;=========================================================================================
; -------------------
; OBJECT Variables
; -------------------
Structure THING_VAR
a.i
b.i
c.i
EndStructure
; -------------------
; OBJECT Procedures
; -------------------
Interface THING Extends OBJECT
Procedure1()
Procedure2.s(txt$)
EndInterface
Procedure THING_Procedure1(*this.THING)
;update object variables
Protected *variables.THING_VAR
*variables=*this\GetVars()
*variables\a=Random(1000)
Result=*variables\a
ProcedureReturn Result
EndProcedure
Procedure.s THING_Procedure2(*this.THING, txt$)
;get object variables
Protected *variables.THING_VAR
*variables=*this\GetVars()
Result.s=txt$+" "+Str(*variables\a)+" "+Str(*variables\b)+" "+Str(*variables\c)
ProcedureReturn Result
EndProcedure
; -------------------
; OBJECT Constructor
; -------------------
Procedure CreateThing(a,b,c)
;create object
Protected *object.OBJECT
*object = CreateObject(SizeOf(THING_VAR),SizeOf(THING))
If *object=0 : ProcedureReturn 0 : EndIf
;init object proc
*object\SetProc(OffsetOf(THING\Procedure1()),@THING_Procedure1())
*object\SetProc(OffsetOf(THING\Procedure2()),@THING_Procedure2())
;init object variables
Protected *variables.THING_VAR
*variables=*object\GetVars()
*variables\a=a
*variables\b=b
*variables\c=c
ProcedureReturn *object
EndProcedure
;=========================================================================================
;-How to use
;=========================================================================================
myThing1.THING = CreateThing(1,2,3)
myThing2.THING = CreateThing(2,0,0)
Debug myThing1\Procedure1()
Debug myThing1\Procedure2("variables: ")
Debug myThing2\Procedure2("variables: ")
myThing3.THING = myThing2\Copy()
Debug myThing3\Procedure1()
Debug myThing3\Procedure2("variables: ")