Wozu man aber in der Exe prüfen müsste, welche Proceduren es gibt, erschliest sich für mich immer noch nicht!
Das mit dem *Package auch noch nicht, da ich Globale Daten über alle Instanzen einfach im Modul mit Global oder Define bestimmen kann.
Was sorgt dafür, dass es "einfacher" wird.
1. Das Interface hat immer den selben Namen (IClass), egal in welcher Klasse! Das geht problemlos, da wir die Klasse in ein Modul packen müssen. Dadurch ist es egal, wenn es den InterfaceNamen mehrmals gibt. Ist ja immer in einem separaten Modul!
2. Die Struktur der Instanzdaten hat ebenfalls immer den selben Namen *This.TThis
Hier das Beispiel: Mit Vererbung und überschreiben von Methoden. Vererbung ist theoretisch über unendlich viele Ebenen möglich!
Es funktioniert, ist aber noch eine "SchnellVersion", da ist nicht alles bis zum letzten geprüft!
Code: Alles auswählen
; ***********************************************************************************
; B A S E C L A S S O O P
; ***********************************************************************************
DeclareModule OOP
EnableExplicit
; Every User-Class has to integerate this Interface
Interface IClass Extends IUnknown ; create the Interface based on IUnknown; the COM-Basic-Interface
EndInterface
Structure TThis ; Structure for the Instance Data
; iUnknown
*VTable ; Pointer to VirtalMethodeTable (Addresslist of Methodes declared in the Interface)
cntRef.i ; Object reference counter
Mutex.i ; Object Mutex! Only if object used by different Treads! It shows that the Object is in operation by a Thread!
EndStructure
Macro mac_Procedure_Clone()
Procedure.i Clone(*This.TThis)
Protected *retVal.TThis
If *This
*retVal = New()
If *retVal
CopyStructure(*This, *retVal, TThis)
EndIf
EndIf
ProcedureReturn *retVal
EndProcedure
EndMacro
Declare.i Release(*This.TThis) ; make Release() Public, so it's possible to call over Interface or direct call
Declare.i CopyVTable(*Source, *Destination, ByteSize)
Declare.i Inherit_VTable(*Destination_VTable)
; ============================================================================
; NAME: Inherit_VTable
; DESC: This Procedure has to be called from the derivate class to copy
; DESC: the VTable of the OOP BaseClass into the derivate class!
; DESC: It will be converted into a CopyMemory command
; DESC: CopyMemory(OOP::@VTable(), *Destination_VTable, SizeOf(IClass)
; DESC: This is the inheritance of the BaseClass-Methods
; ============================================================================
EndDeclareModule
Module OOP
EnableExplicit
Global Dim VTable.a(SizeOf(IClass)-1) ; create VTable with the Size of the Interface
; Macro to write MethodeAdress into VTable. Use it in this way: EndProcedure : AsMethode(MethodeName)
Macro AsMethode(MethodeName)
PokeI(@VTable() + OffsetOf(IClass\MethodeName()), @MethodeName())
EndMacro
; ======================================================================
; Implement the Methodes of iUnknown
; ======================================================================
; IUnknow is the BaseInterface of Windows-COM-Objects
Procedure.i QueryInterface(*This.TThis, *riid, *addr)
; ======================================================================
; NAME: QueryInterface()
; DESC: IUnknown\QueryInterface()
; VAR(*This.TThis): Pointer To the instance Data
; VAR(*riid):
; VAR(*addr):
; RET.i: $80004002 ; (#E_NOINTERFACE)
; ======================================================================
ProcedureReturn $80004002 ; (#E_NOINTERFACE)
EndProcedure : AsMethode(QueryInterface)
;PokeI(@VTable() + OffsetOf(IClass\QueryInterface()), @QueryInterface()) ; Write Methode Address into VTable
Procedure.i AddRef(*This.TThis)
; ======================================================================
; NAME: AddRef()
; DESC: IUnknown\AddRef()
; DESC: Increments the ReferenceCounter! This is used for Multithreading
; DESC: if 1 ObjectInstance is referenced from 2 different Threads.
; VAR(*This.TThis): Pointer to the instance data
; RET.i: Value of reference counter
; ======================================================================
If *This
LockMutex(*This\Mutex)
*This\cntRef + 1
UnlockMutex(*This\Mutex)
ProcedureReturn *This\cntRef
Else
ProcedureReturn 0
EndIf
EndProcedure : AsMethode(AddRef)
;PokeI(@VTable() + OffsetOf(IClass\AddRef()), @AddRef()) ; Write Methode Address into VTable
Procedure.i Release(*This.TThis)
; ======================================================================
; NAME: Release()
; DESC: IUnknown\Release()
; DESC: Decrement the ReferenceCounter! Destroy the object?
; DESC: If we do Multithreading and the object is referenced by more than 1
; DESC: Thread, only the reference counter will be decremented.
; DESC: If it is the last reference to the object it will be destroyed.
; DESC: This is the normal way for single threaded programms were we have
; DESC: only 1 reference!
; VAR(*This.TThis): Pointer to the instance data
; RET.i: Value of reference counter; 0 if Object deleted
; ======================================================================
If *This
With *This
LockMutex(\Mutex)
If \cntRef = 1 ; If it is the last reference THEN delete the object
;
; Maybe further operations here for cleanup
; ---
; Dispose(*this)
; ---
FreeMutex(\Mutex) ; Delete the Mutes
FreeStructure(*This) ; Relase the allocated memory; kill the instance
ProcedureReturn 0
Else
\cntRef - 1 ; Decrement No of referenced threads
EndIf
UnlockMutex(\Mutex)
ProcedureReturn \cntRef
EndWith
Else
ProcedureReturn #PB_Default ; -1
EndIf
EndProcedure : AsMethode(Release)
; PokeI(@VTable() + OffsetOf(IClass\Release()), @Release()) ; Write Methodes Address into VTable
Procedure.i CopyVTable(*Source, *Destination, ByteSize)
; ======================================================================
; NAME: CopyVTable()
; DESC: Copy a VTable to an other! From BaseClass to DerivateClass
; DESC: This function will be called by Inherit_VTable in each Class.
; VAR(*Source): Pointer to the Source-VTable, form BaseClass
; VAR(*Destination): Pointer to the Destination-VTable, from DerivateClass
; VAR(ByteSize): Bytes to Copy; SizeOf(BaseClass-Interface)
; RET.i: Value of reference counter
; ======================================================================
If *Source And *Destination And ByteSize
CopyMemory(*Source, *Destination, ByteSize)
ProcedureReturn ByteSize
EndIf
ProcedureReturn 0
EndProcedure
Procedure.i Inherit_VTable(*Destination_VTable)
; ============================================================================
; NAME: Inherit_VTable
; DESC: This Procedure has to be called from the derivate class to copy
; DESC: the VTable of the OOP BaseClass into the derivate class!
; DESC: This is the inheritance of the BaseClass-Methods
; VAR(*Destination_VTable): Pointer to destination VTable
; RET.i: Bytes copied
; ============================================================================
ProcedureReturn OOP::CopyVTable(@VTable(), *Destination_VTable, SizeOf(IClass))
EndProcedure
; Debug "VTable Adress of IUnknown"
; Debug @VTable()
; Debug @VTable(0)
EndModule
; ***********************************************************************************
; C A R S
; ***********************************************************************************
DeclareModule Cars
EnableExplicit
; hier den Namen der Klasse eintragen, von welcher wir ableiten!
Macro BaseClass
OOP
EndMacro
; Public Methods
Interface IClass Extends BaseClass::IClass ; create the Interface IOOP based on IUnknown
getType.s()
setType.s(Type.s)
getColor.s()
setColor(Color.s)
getWheels()
setWheels(Count)
getDriver.s()
setDriver(Driver.s)
Count()
EndInterface
; Public Attributes
Structure TThis Extends BaseClass::TThis ; Structure for the Instance Data
Type.s
Color.s
Wheels.i
Driver.s
EndStructure
; Create Object
Declare New()
Declare.i Inherit_VTable(*Destination_VTable)
EndDeclareModule
Module Cars
EnableExplicit
Global CarCounter ; über alle Instanzen gültig!
Global Dim VTable.a(SizeOf(IClass)-1) ; create VTable with the Size of the Interface
BaseClass::Inherit_VTable(@VTable()) ; Inherit the Methodes of BaseClass (copy BaseClass::VTable => VTable)
; Macro to write MethodeAdress into VTable. Use it after EndProcedure : AsMethode(MethodeName)
Macro AsMethode(MethodeName)
PokeI(@VTable() + OffsetOf(IClass\MethodeName()), @MethodeName())
EndMacro
; Overwrite wird versendet, wenn der ProcedurName <> MethodeName ist!
; (Ja, das ist nicht ganz die richtige Bezeichnung dafür!)
Macro Overwrite(MethodeName, ProcedureName)
PokeI(@VTable() + OffsetOf(IClass\MethodeName()), @ProcedureName())
EndMacro
Procedure.s getType(*This.TThis)
ProcedureReturn *This\Type
EndProcedure : AsMethode(getType)
Procedure setType(*This.TThis, Type.s)
*This\Type = Type
EndProcedure : AsMethode(setType)
; ----
Procedure.s getColor(*This.TThis)
ProcedureReturn *This\Color
EndProcedure : AsMethode(getColor)
Procedure setColor(*This.TThis, Color.s)
*This\Color = Color
EndProcedure : AsMethode(setColor)
; ----
Procedure getWheels(*This.TThis)
ProcedureReturn *This\Wheels
EndProcedure : AsMethode(getWheels)
Procedure setWheels(*This.TThis, Wheels)
*This\Wheels = Wheels
EndProcedure : AsMethode(setWheels)
; ----
Procedure.s getDriver(*This.TThis)
ProcedureReturn *This\Driver
EndProcedure : AsMethode(getDriver)
Procedure setDriver(*This.TThis, Driver.s)
*This\Driver = Driver
EndProcedure : AsMethode(setDriver)
; ----
Procedure Count(*This.TThis)
ProcedureReturn CarCounter
EndProcedure : AsMethode(Count)
; hier implementieren wir unsere eigene Release-Methode, da wir Cars zählen wollen
; und CarCouter verringer müssen, wenn eine Instanz gelöscht wurde
Procedure.i My_Release(*This.TThis)
Protected ret
ret = OOP::Release(*This) ; Release existiert doppelt: 1x über Interface, 1x über direct Call
Select ret
Case 0 ; Object released
CarCounter - 1
; Debug CarCounter
Case #PB_Default ; -1, *This was 0
Default ; Refcounter returned
EndSelect
ProcedureReturn ret
EndProcedure : Overwrite(Release, My_Release)
Procedure New()
; ======================================================================
; NAME: New
; DESC: Create a New Instance of the ClassObject
; DESC: Call it: *myObj=MyClassModul::NEW()
; RET.i: *This; The Pointer to the allocated memory or 0 if if
; could not get the memory from OS
; ======================================================================
Protected *obj.TThis
; Step 1: Allocate memory for the instance data; Structure TThis
*obj = AllocateStructure(TThis)
; Step 2: If we got a valid pointer to the structure then create standard values
If *obj
*obj\VTable = @VTable() ; Pointer to the virtual Methode Table
*obj\Mutex = CreateMutex() ; Mutex to prevent the RefCounter, needed for MultiThread referenced objects
*obj\cntRef = 1 ; Reference counter
; If you use a NEW() Functionw with Paramenters, add further code hier
CarCounter + 1
EndIf
ProcedureReturn *obj
EndProcedure
Procedure.i Inherit_VTable(*Destination_VTable)
; ============================================================================
; NAME: Inherit_VTable
; DESC: This Procedure has to be called from the derivate class to copy
; DESC: the VTable of the OOP BaseClass into the derivate class!
; DESC: This is the inheritance of the BaseClass-Methods
; VAR(*Destination_VTable): Pointer to destination VTable
; RET.i: Bytes copied
; ============================================================================
ProcedureReturn OOP::CopyVTable(@VTable(), *Destination_VTable, SizeOf(IClass))
EndProcedure
EndModule
Define.Cars::IClass obj1, obj2, obj3
obj1 = Cars::New()
obj1\setType("Mercedes")
obj1\setColor("Green")
obj1\setWheels(4)
obj1\setDriver("Michael")
obj2 = Cars::New()
obj2\setType("Mercedes")
obj2\setColor("Gray")
obj2\setWheels(4)
obj2\setDriver("Tom")
obj3 = Cars::New()
obj3\setType("Ford")
obj3\setColor("Blue")
obj3\setWheels(4)
obj3\setDriver("Jerry")
Debug "Class Package - Count = " + obj1\Count()
Debug "Release obj2"
obj2\Release()
Debug "Class Package - Count = " + obj1\Count()
Debug "Release obj3"
obj3\Release()
Debug "Class Package - Count = " + obj1\Count()
obj3 = Cars::New()
obj3\setType("Ford")
obj3\setColor("Blue")
obj3\setWheels(4)
obj3\setDriver("Jerry")
Debug "Create New obj3"
Debug "Class Package - Count = " + obj1\Count()
Debug obj1\getType() + " - " + obj1\getDriver()
Debug obj3\getType() + " - " + obj3\getDriver()