Voici donc le module de base, il contient la classe générique 'Class', qui est mère de toutes les autres :
Code : Tout sélectionner
;{ MODULE Class
CompilerIf Defined(Class, #PB_Module) = #False
DeclareModule Class
Structure ClassInfo
*vTable
ClassName.s
*ClassParent.ClassInfo
function_count.l
Object_Instance.l
EndStructure
Global ClassInfo.ClassInfo
; Function
Interface Function
Free()
GetClassInfo.i()
EndInterface
; Structure Data holder
Structure Struct_DATA
*vTable
*Class.ClassInfo
EndStructure
; Creator declaration (a macro for convience)
Macro Init(_obj_)
_obj_ = AllocateMemory(SizeOf(Struct_DATA))
InitializeStructure(_obj_, Struct_DATA)
_obj_\vTable = ClassInfo\vTable
_obj_\Class = @ClassInfo
ClassInfo\Object_Instance + 1
EndMacro
Macro Destroy(_obj_)
FreeMemory(_obj_)
ClassInfo\Object_Instance - 1
EndMacro
; Macro for vTable manipulation
Macro Function_INHERIT_FROM_CLASS(_Class_)
ClassInfo\vTable = AllocateMemory(SizeOf(Function))
ClassInfo\ClassName = #PB_Compiler_Module
ClassInfo\ClassParent = _Class_#@ClassInfo
; héritage
CopyMemory(_Class_#ClassInfo\vTable, ClassInfo\vTable, SizeOf(_Class_#Function))
ClassInfo\function_count = SizeOf(_Class_#Function) / SizeOf(Integer)
EndMacro
Macro Function_OVERRIDE(_Function_)
PokeI(ClassInfo\vTable + OffsetOf(Function\_Function_), @_Function_)
EndMacro
Macro Function_ADD(_Function_)
PokeI(ClassInfo\vTable + ClassInfo\function_count * SizeOf(Integer), @_Function_)
ClassInfo\function_count + 1
EndMacro
EndDeclareModule
Module Class
ClassInfo\vTable = AllocateMemory(SizeOf(Function))
ClassInfo\ClassName = #PB_Compiler_Module
; Commodity
Procedure.i Get_Class_Info(*obj.Struct_DATA)
ProcedureReturn *obj\Class
EndProcedure
; Destructor
Procedure Free(*obj.Struct_DATA)
ClearStructure(*obj, Struct_DATA)
Destroy(*obj)
EndProcedure
; Add function in vTable
Function_ADD(Free())
Function_ADD(Get_Class_Info())
EndModule
CompilerEndIf
;}
;{ MODULE CLASS_NAME_HERE : parent = PARENT_CLASS_NAME_HERE (Template)
CompilerIf 0 ; TO REMOVE
DeclareModule CLASS_NAME_HERE
Global ClassInfo.Class::ClassInfo
; Function
Interface Function Extends PARENT_CLASS_NAME_HERE::Function
; TO DO : yourNEW_function.l(param1)
EndInterface
; Structure Data holder
Structure Struct_DATA Extends PARENT_CLASS_NAME_HERE::Struct_DATA
; TO DO : champ1.l
EndStructure
; Inheritance of existing functions
Class::Function_INHERIT_FROM_CLASS(PARENT_CLASS_NAME_HERE::)
; Creator declaration
Declare.i Create()
EndDeclareModule
Module CLASS_NAME_HERE
; Constructor
Procedure.i Create()
Class::Init(*obj.Struct_DATA)
; TO DO : *obj\champ1 = ...
ProcedureReturn *obj
EndProcedure
; Methods
; TO DO : Procedure.l your_new_function(*obj.Struct_DATA, param1, ...)
; Destructor
Procedure Free(*obj.Struct_DATA)
; TO DO : ClearStructure(*obj, Struct_DATA)
Class::Destroy(*obj)
EndProcedure
; Destructor override
Class::Function_OVERRIDE(Free())
; Add function in vTable
; TO DO : Class::Function_ADD(your_new_function())
EndModule
CompilerEndIf ; TO REMOVE
;}
- CLASS_NAME_HERE par le nom de votre classe
- PARENT_CLASS_NAME_HERE par le nom de la classe parent ('Class' si il n'y a pas encore de parent)
Pour voir ce que cela donne, nommez le code ci-dessus "MODULE_Class.pb" puis lancez le code ci-dessous :
Code : Tout sélectionner
; EXAMPLE :
IncludeFile "MODULE_Class.pb"
;{ MODULE Voiture : parent = Class
DeclareModule Voiture
Global ClassInfo.Class::ClassInfo
; Function
Interface Function Extends Class::Function
Avance(Vitesse.d)
GetPuissance.l()
EndInterface
; Structure Data holder
Structure Struct_DATA Extends Class::Struct_DATA
Puissance.i
Couleur.i
x.l
EndStructure
; Inheritance of existing functions
Class::Function_INHERIT_FROM_CLASS(Class::)
; Creator declaration
Declare.i Create()
EndDeclareModule
Module Voiture
; Constructor
Procedure.i Create()
Class::Init(*obj.Struct_DATA)
*obj\x = 50
*obj\Puissance = 1000
ProcedureReturn *obj
EndProcedure
; Methods
Procedure Avance(*v.Struct_DATA, v.d)
*v\x + v
Debug *v\x
EndProcedure
Procedure.l Get_Puissance(*v.Struct_DATA)
ProcedureReturn *v\Puissance
EndProcedure
; Destructor
Procedure Free(*obj.Struct_DATA)
Debug "Destructor for Class : Voiture"
ClearStructure(*obj, Struct_DATA)
Class::Destroy(*obj)
EndProcedure
; Destructor override
Class::Function_OVERRIDE(Free())
; Add function in vTable
Class::Function_ADD(Avance())
Class::Function_ADD(Get_Puissance())
EndModule
;}
;{ MODULE Peugeot : parent = Voiture
DeclareModule Peugeot
Global ClassInfo.Class::ClassInfo
; Function
Interface Function Extends Voiture::Function
GetName.s()
EndInterface
; Structure Data holder
Structure Struct_DATA Extends Voiture::Struct_DATA
name.s
EndStructure
; Inheritance of existing functions
Class::Function_INHERIT_FROM_CLASS(Voiture::)
; Creator declaration
Declare.i Create()
EndDeclareModule
Module Peugeot
; Constructor
Procedure.i Create()
Class::Init(*obj.Struct_DATA)
*obj\x = 50
*obj\Puissance = 2000
*obj\name = "Ma belle peugeot"
ProcedureReturn *obj
EndProcedure
; Methods
Procedure.s Get_Name(*v.Struct_DATA)
ProcedureReturn *v\name
EndProcedure
; Destructor
Procedure Free(*obj.Struct_DATA)
Debug "Destructor for Class : Peugeot"
ClearStructure(*obj, Struct_DATA)
Class::Destroy(*obj)
EndProcedure
; Destructor override
Class::Function_OVERRIDE(Free())
; Add function in vTable
Class::Function_ADD(Get_Name())
EndModule
;}
Debug "voiture"
Debug " "
*Voiture.Voiture::Function = Voiture::Create()
*Voiture\Avance(1)
Debug *Voiture\GetPuissance()
Debug " "
Debug "Peugeot"
Debug " "
*my_car.Peugeot::Function = Peugeot::Create()
*my_car\Avance(10)
Debug *my_car\GetPuissance()
Debug *my_car\GetName()
Debug ""
Debug "info générale : "
Debug ""
Debug "Class : " + Voiture::ClassInfo\ClassName
Debug "Nb instance : " + Voiture::ClassInfo\Object_Instance
Debug "Class Parent : " + Voiture::ClassInfo\ClassParent\ClassName
Debug ""
Debug "Class : " + Peugeot::ClassInfo\ClassName
Debug "Nb instance : " + Peugeot::ClassInfo\Object_Instance
Debug "Class Parent : " + Peugeot::ClassInfo\ClassParent\ClassName
Debug ""
Debug "info on '*my_car' : "
Debug ""
*class_info.Class::ClassInfo = *my_car\GetClassInfo()
Debug "Class : " + *class_info\ClassName
Debug "Nb instance : " + *class_info\Object_Instance
Debug "Class Parent : " + *class_info\ClassParent\ClassName
Ce n'est pas encore parfait, mais ça fonctionne.
Cela tient au fait que je ne suis pas du tout un expert en POO ! Je ne l'utilise que très rarement en vb.net (Youhou !).
Il y a peut-être des comportements qui sont normalement définit dans les classes des langages POO qui ne sont pas pris en charge ici.
Si vous avez des améliorations, n'hésitez pas à les poster !
Si vous voulez troller, passez votre chemin, la question n'est PAS de savoir si la POO, c'est cool.