Machmal ist es vom Vorteil auch unter Purebasic mit Objekten zu arbeiten.
Purebasic unterstütz von sich aus die Verwendung von externen Objekten. Somit auch die Programmierung von eigenen Objekten.
Der Aufwand ist ein wenig größer, aber durchaus im sinnvollen Rahmen verwendbar.
Hier schon mal ein kleiner Anfang. Bitte meine Beschreibung überarbeiten.
Basis Klasse
Code: Alles auswählen
;- TOP
; OOP Programmierung unter Purebasic
;
; Programmierung von Klassen ohne Macros oder Pre-Compiler. Dazu bieten sich Module zur Kapelsung gut an.
;
; Grundlagen:
; - Interfaces
; Interfaces sind eine Beschreibung der Funktionen (Methoden) und Paramter der Klasse.
; Die Funktionen (Methoden) der Klasse werden immer indirekt über eine Tabelle mit der Funktionsadresse aufgerufen.
; Die Tabelle mit den Funktionsadressen muss immer die gleiche Reihenfolge haben wie diese im Interface
; beschrieben wurde.
;
; - Struktur:
; Zur Verwendung einer Klasse benötigen wir eine Struktur. Diese muss immer folgenden Aufbau haben.
; + *vTable : Ein Zeiger auf die Tabelle mit Zeigern auf die Funktionen der Klasse.
; Diese muss immer an der ersten Stelle vorhanden sein.
; + Daten : Dahinter können die Daten der Klasse angelegt werden.
;
; - Funktion (Methode):
; Wird eine Funktion (Methode) der Klasse aufgerufen, ist der erste Parameter IMMER ein Zeiger auf sich selbst (*This).
; Danach kommen erst die Paramter wie diese im Interface beschrieben sind.
;
; - Objekt:
; Um ein Objekt aus der Klasse zu erstellen benötigen wir eine Funktion die das Objekt anlegt.
; Diese können wir zum Beispiel 'New' oder 'Create' nennen.
; Diese Funktion muss den erforderlichen Speicher für das Objekt anlegen und den Zeiger auf die Funktiontabelle eintragen.
;
; Fangen wir mit eine Basisklasse an. Ein abgeleitete Klasse (Vererbung) folgt später.
; Wenn ich eine Basisklasse erstelle, lege ich immer alle Funktionen von den Interface Type 'IUnknown' an.
; Somit kann, wenn man möchte, das Interface auch später für andere Sprachen exportieren.
DeclareModule BaseClass
; Beschreibung der Klasse
Interface iBaseClass
; Anfang IUnknown
QueryInterface(*riid, *addr)
AddRef()
Release()
; Ende IUnkwown
SetText.s(Text.s)
AddText.s(Text.s)
GetText.s()
LenOfText()
EndInterface
; Strukture von der Klasse. Diese muss auch Public sein, damit die Vererbt werden kann
Structure sBaseClass
; Basis
*vTable ; Zeiger auf die Funktionstabelle. Immer an erste Stelle
cntRef.i ; Anzahl wie oft das Objekt verwendet wird
objMutex.i ; Wird benötig wenn das angelegte Objekt von verschiedenen Thread verwendet wird
; Daten
Text.s
LenOfText.i
; ***
EndStructure
; Definieren der Funktion zum anlegen eines Objektes aus der Klasse
Declare New()
EndDeclareModule
Module BaseClass
EnableExplicit
; Basis-Methoden anlegen (IUnknown)
; QueryInterface : Gehört zu IUnknown. wird noch nicht benötigt
Procedure QueryInterface(*This.sBaseClass, *riid, *addr)
ProcedureReturn $80004002 ; (#E_NOINTERFACE)
EndProcedure
; ---------------------------------------------------------------------------
; AddRef : Damit wird die Anzahl der Verwendung des Objekt erhöht.
Procedure AddRef(*This.sBaseClass)
LockMutex(*This\objMutex)
*This\cntRef + 1
UnlockMutex(*This\objMutex)
ProcedureReturn *This\cntRef
EndProcedure
; ---------------------------------------------------------------------------
; Release : Damit wird der Speicher des Objekts wieder Freigegeben.
; Aber nur wenn das Objekt nicht mehr verwendet wird.
Procedure Release(*This.sBaseClass)
Protected index, cnt
With *This
LockMutex(\objMutex)
If \cntRef = 0
; Weitere bearbeitung vor dem freigben des Objekts
; Zum Beispiel eine Funktion zum aufräumen aufrufen:
; ---
; Dispose(*this)
; ---
FreeMutex(*This\objMutex) ; Mutex wider freigeben
FreeStructure(*This) ; Speicher wieder freigeben
ProcedureReturn 0
Else
\cntRef - 1 ; Die Anzahl der Verwendung des Objekt reduzieren
EndIf
UnlockMutex(*This\objMutex)
ProcedureReturn \cntRef
EndWith
EndProcedure
; ---------------------------------------------------------------------------
; Methoden anlegen
Procedure.s SetText(*This.sBaseClass, Text.s) ; Ergebnis : Vorheriger Text
Protected result.s
With *This
result = \Text
\Text = Text
\LenOfText = Len(Text)
EndWith
ProcedureReturn result
EndProcedure
Procedure.s AddText(*This.sBaseClass, Text.s) ; Ergebnis : Vorheriger Text
Protected result.s
With *This
result = \Text
\Text + Text
\LenOfText = Len(Text)
EndWith
ProcedureReturn result
EndProcedure
Procedure.s GetText(*This.sBaseClass) ; Ergebnis : Aktueller Text
Protected result.s
With *This
result = \Text
EndWith
ProcedureReturn result
EndProcedure
Procedure LenOfText(*This.sBaseClass, Text.s) ; Ergebnis : Länge vom Text
Protected result.i
With *This
result = \LenOfText
EndWith
ProcedureReturn result
EndProcedure
; Funktion zum anlegen eines Objektes
Procedure New() ; Ergebnis : Zeiger auf das Objekt. Null wenn das Objekt nich angelgt werden konnte
Protected *Object.sBaseClass
; Schritt 1: Speicher anfordern. Dazu bietet sich AllocateStructure an, weil diese auch den Speicher initialsiert
*Object = AllocateStructure(sBaseClass)
; Schritt 2: Erforderlich Zeiger setzen und Mutex anlegen. Aber nur wenn speicher vorhanden ist (Out Of Memory ?)
If *Object
*Object\vTable = ?vtBaseClass ; Zeiger auf die Funktionstabelle setzen (Methoden). Siehe weiter unten.
*Object\objMutex = CreateMutex() ; Mutex zum Schutz des RefCounter anlegen, kann auch in den Funktionen verwendet werden
; Zum Beipiel wenn auf das Objekt aus verschiedenen Threads zugegriffen wird
*Object\cntRef = 0 ;
; Eventuelle weitere Zuweisungen. Zum Beipiel eine New-Funktion mit Parametern
EndIf
ProcedureReturn *Object
EndProcedure
; Tabelle für die Funktionen (Methoden) anlegen. Dazu bietet sich die DataSection gut an.
; Die Reihenfolge in der DataSection muss die gleiche sein wie die im Interface beschiebene Funktionen (Methoden)
DataSection
vtBaseClass:
Data.i @QueryInterface()
Data.i @AddRef()
Data.i @Release()
Data.i @SetText()
Data.i @AddText()
Data.i @GetText()
Data.i @LenOfText()
EndDataSection
EndModule
;-Test
; Objekte anlegen und aufrufen. Die Objekte sind nicht als Struktur zu definieren, sondern als Interface.
; Am besten immer als Pointer definieren. Lässt sich besser lesen.
Define *Obj1.BaseClass::iBaseClass
Define *Obj2.BaseClass::iBaseClass
Define r1.s, r2.s, r3.s
*Obj1 = BaseClass::New()
*Obj2 = BaseClass::New()
*Obj1\SetText("Hallo ")
*Obj2\SetText("Welt")
r1 = *Obj1\GetText()
Debug r1
r2 = *Obj2\GetText()
Debug r2
*Obj1\AddText(*Obj2\GetText())
r3 = *Obj1\GetText()
Debug r3
; Objekte freigeben
c1 = *Obj1\Release()
Debug c1
c2 = *Obj2\Release()
Debug c2