Code: Alles auswählen
;- BASE class
Interface iBASE
SetS(s.s)
GetS.s()
SetL(l.l)
GetL.l()
SetF(f.f)
GetF.f()
EndInterface
Structure cBASEVT
SetS.l
GetS.l
SetL.l
GetL.l
SetF.l
GetF.l
EndStructure
Structure cBASE
*VTable.cBASEVT
;Data
s.s
l.l
f.f
EndStructure
;- OBJ class
Interface iOBJ Extends iBASE
SetW(w.w)
GetW.w()
SetB(b.b)
GetB.b()
EndInterface
Structure cOBJVT Extends cBASEVT
SetW.l
GetW.l
SetB.l
GetB.l
EndStructure
Structure cOBJ Extends cBASE
w.w
b.b
EndStructure
;- BASE functions
Procedure base_SetS(*this.cBASE, s.s)
*this\s = s
EndProcedure
Procedure.s base_GetS(*this.cBASE)
ProcedureReturn *this\s
EndProcedure
Procedure base_SetL(*this.cBASE, l.l)
*this\l = l
EndProcedure
Procedure.l base_GetL(*this.cBASE)
ProcedureReturn *this\l
EndProcedure
Procedure base_SetF(*this.cBASE, f.f)
*this\f = f
EndProcedure
Procedure.f base_GetF(*this.cBASE)
ProcedureReturn *this\f
EndProcedure
;- BASE constructor
Procedure.l new_base()
Protected *p.cBASE
Static *VTable.cBASEVT
If *VTable = 0
*VTable = AllocateMemory(SizeOf(cBASEVT))
*VTable\SetS = @base_SetS()
*VTable\GetS = @base_GetS()
*VTable\SetL = @base_SetL()
*VTable\GetL = @base_GetL()
*VTable\SetF = @base_SetF()
*VTable\GetF = @base_GetF()
EndIf
*p = AllocateMemory(SizeOf(cBASE))
*p\VTable = *VTable
ProcedureReturn *p
EndProcedure
;- OBJ functions
Procedure obj_SetW(*this.cOBJ, w.w)
*this\w = w
EndProcedure
Procedure.w obj_GetW(*this.cOBJ)
ProcedureReturn *this\w
EndProcedure
Procedure obj_SetB(*this.cOBJ, b.b)
*this\b = b
EndProcedure
Procedure.b obj_GetB(*this.cOBJ)
ProcedureReturn *this\b
EndProcedure
;- OBJ constructor
Procedure.l new_obj()
Protected *p.cOBJ, *vt.cOBJVT
*p = ReAllocateMemory(new_base(), SizeOf(cOBJ))
*p\VTable = ReAllocateMemory(*p\VTable, SizeOf(cOBJVT))
If *p\VTable <> 0
*vt = *p\VTable
*vt\SetW = @obj_SetW()
*vt\GetW = @obj_GetW()
*vt\SetB = @obj_SetB()
*vt\GetB = @obj_GetB()
EndIf
ProcedureReturn *p
EndProcedure
DefType.iBASE b
b = new_base()
b\SetS("hallo")
b\SetL(20)
b\SetF(21.023)
Debug b\GetS()
Debug b\GetL()
Debug b\GetF()
Debug "### Nun das Objekt ###"
DefType.iOBJ o
o = new_obj()
o\SetS("obj")
o\SetL(666)
o\SetF(616)
o\SetB(11)
o\SetW(12)
Debug o\GetS()
Debug o\GetL()
Debug o\GetF()
Debug o\GetB()
Debug o\GetW()erben kann.
Tricky, funzt aber.
Wer sich damit auskennt (und das sollte man auch, bevor man mit Vererbung
anfängt), wird das Beispiel schon verstehen.
greetz
Remi
