Modul BaseClass (Modul als Objekt)

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Modul BaseClass (Modul als Objekt programmieren)

Beitrag von GPI »

Mir war wieder mal etwas langweilig :)

Code: Alles auswählen

;-
DeclareModule __Class
  EnableExplicit  
  
  Macro MacroColon 
    :
  EndMacro
  Macro MacroQuote 
    "
  EndMacro
  Macro MacroSingleQuote
    '
  EndMacro
  Macro JoinMacroParts (P1, P2=, P3=, P4=, P5=, P6=, P7=, P8=) : P1#P2#P3#P4#P5#P6#P7#P8 : EndMacro
  Macro CreateMacro (name,macroBody=)
    __Class::JoinMacroParts (Macro name, __Class::MacroColon, macroBody, __Class::MacroColon, EndMacro) : 
  EndMacro
  Macro CreateQuote (name)
    __Class::JoinMacroParts (__Class::MacroQuote,name,__Class::MacroQuote)
  EndMacro
  Macro CreateSingleQuote (name)
    __Class::JoinMacroParts (__Class::MacroSingleQuote,name,__Class::MacroSingleQuote)
  EndMacro
  
  CompilerIf #PB_Compiler_Debugger
    Declare CheckvTable(*vTable,size)
  CompilerEndIf
  
EndDeclareModule

Module __Class
  CompilerIf #PB_Compiler_Debugger
    Procedure CheckvTable(*vTable.integer,size)
      Protected ok=#True
      While size
        If *vTable\i=0
          ok=#False
          Break
        EndIf      
        size-SizeOf(integer)
        *vTable+SizeOf(integer)
      Wend
      ProcedureReturn ok
    EndProcedure  
  CompilerEndIf
EndModule  

;-
DeclareModule __class_
  Macro This
    *self.Properties
  EndMacro
  Macro SetMethod(name,Proc=__none)
    CompilerIf __class::CreateQuote(proc)="__none"  
      PokeI(*__vTable+OffsetOf(Class\name()),@name())
    CompilerElse
      PokeI(*__vTable+OffsetOf(Class\name()),@Proc())
    CompilerEndIf
  EndMacro
  Macro AliasMethod(name,alias)
    PokeI(*__vTable+OffsetOf(Class\name()),PeekI(*__vTable+OffsetOf(Class\alias())))
  EndMacro
  Macro SuperNew
    __super New
  EndMacro
  Macro AllocateObject()
    If This=0
      This=__Allocate()
    EndIf
  EndMacro
  Macro Method(Ret,name,para) ;EndIndent
    Declare.Ret name para
    SetMethod(name)
    Procedure.ret name para 
      ProtectedSelf
    ;EndIndent    
  EndMacro
  Macro EndMethod 
      ;Indent ;Indent
    EndProcedure     
  EndMacro
  Macro ProtectedSelf
    Protected Self.Class=This
  EndMacro
  Macro MethodReturn
    ProcedureReturn
  EndMacro
  
EndDeclareModule
Module __class_
EndModule

;-
DeclareModule Class
  EnableExplicit
  Structure Properties;-properties
    *__vTable  
  EndStructure
  
  Interface Class;-class
  EndInterface  
  
  Structure SubTable;-SubTable
    free.i
    clone.i
  EndStructure
    
  
  Declare Free(*self)
  Declare Clone(*self)
    
  ;- Class handling
  Macro Begin( ExtendsClass = Class )
    EnableExplicit
    CompilerIf Not Defined(__DeclaredEnableClass,#PB_Constant)
      ;DeclareModule      
      #__DeclaredEnableClass=#True
      Global *__vTable
      Declare __Allocate()
      Declare __Free(*self,recursive=0)      
      Declare __Clone(*self,recursive=0)  
      
      ;space bevor and after : is important!
      
      __Class::CreateMacro(__Super, ExtendsClass#__Class::MacroColon#__Class::MacroColon) : 
       
      UseModule __class_
      
    CompilerElse
      ;Module
      Goto __ModuleEnd
      __ModuleStart:
      *__vTable=AllocateMemory(SizeOf(Class)+SizeOf(Class::SubTable))  +SizeOf(Class::SubTable)
      CompilerIf __Class::CreateQuote(__super)<>"Class::"
        CopyMemory(__Super *__vTable,*__vTable,SizeOf( __super Class))
      CompilerEndIf
      
      
      ;-Class::Allocate()
      Procedure __Allocate()
        Protected *self.Properties
        *self=AllocateStructure(Properties)          
        If *self
          *self\__vTable=*__vTable
        EndIf
        ProcedureReturn *self
      EndProcedure
           
      
    CompilerEndIf
  EndMacro
  
  Macro End()
    CompilerIf Not Defined(__DeclaredEndClass,#PB_Constant)
      ;DeclareModule
      #__DeclaredEndClass=#True
      CompilerIf Not Defined(New,#PB_Procedure)
        
        #__DefineNew=#True
        Declare New(This=0)
      CompilerEndIf
      
      Gosub __ModuleStart
      
    CompilerElse
      ;Module
      CompilerIf Defined(__DefineNew,#PB_Constant)
        ;-Class::New()
        Procedure New(This=0)
          AllocateObject()
          CompilerIf __Class::CreateQuote(__super)<>"Class::"
            SuperNew(This)
          CompilerEndIf      
          ProcedureReturn This
        EndProcedure
      CompilerEndIf      
      
      ;-Class::Free()
      Procedure __Free(*self.Properties,recursive=0)        
        
        CompilerIf Defined(Free,#PB_Procedure)
          Free(*self)
        CompilerEndIf
        
        CompilerIf __Class::CreateQuote(__super)<>"Class::"
          __super __Free(*self,#True)
        CompilerEndIf
        
        
        If recursive=0
          FreeStructure(*self)
        EndIf
        ProcedureReturn 0
      EndProcedure
      ;SetMethod(Free)
      PokeI(*__vTable-SizeOf(Class::SubTable)+OffsetOf(Class::SubTable\Free),@__Free())
      ;PokeI(*__vTable+OffsetOf(Class\Free()),@Free())
      
      ;-Class::Clone()
      Procedure __Clone(*self.Properties,recursive=0)        
        Protected *oldself.Properties
        If recursive=0
          *oldself=*self
          *self=AllocateStructure(Properties)
          CopyStructure(*oldself,*self,Properties)
        EndIf
        
        CompilerIf __Class::CreateQuote(__super)<>"Class::"
          __super __Clone(*self,#True)
        CompilerEndIf
        
        CompilerIf Defined(Clone,#PB_Procedure)
          Clone(*self)
        CompilerEndIf
        
        
        ProcedureReturn *self
      EndProcedure
      ;SetMethod(Free)
      PokeI(*__vTable-SizeOf(Class::SubTable)+OffsetOf(Class::SubTable\clone),@__Clone())
      
      CompilerIf #PB_Compiler_Debugger
        If Not __Class::CheckVTable(*__vTable,SizeOf(Class))
          Debug "ERROR: Missing SetMethod"
          CallDebugger
          End
        EndIf
      CompilerEndIf  
      
      Return
      __ModuleEnd:
      
    CompilerEndIf
    
  EndMacro
  
EndDeclareModule


Module Class
  Procedure Free(*self.Properties)
    Protected *proc.integer=*self\__vTable-SizeOf(SubTable)+OffsetOf(SubTable\Free)
    CallFunctionFast(*proc\i,*self,0)
  EndProcedure
  Procedure Clone(*self.Properties)
    Protected *proc.integer=*self\__vTable-SizeOf(SubTable)+OffsetOf(SubTable\clone)
    ProcedureReturn CallFunctionFast(*proc\i,*self,0)
  EndProcedure
EndModule
;-

;- Example

CompilerIf #PB_Compiler_IsMainFile
  
  ;-
  ;- Test - normal Class
  
  DeclareModule Test
    Class::Begin()
    
    Structure Properties Extends Class::Properties
      value.i
    EndStructure
    
    Interface Class Extends Class::Class
      Set(value.i)
      Get()
    EndInterface
    
    Declare Get(This)
    Declare New(This,value)
    
    Class::End()
  EndDeclareModule
  
  Module Test
    Class::Begin()
    
    Procedure Set(This,value)
      This\value=value
      ProcedureReturn value
    EndProcedure
    SetMethod(Set)
    
    Procedure Get(*self.Properties)
      ProcedureReturn *self\value
    EndProcedure
    SetMethod(Get)
    
    Procedure Free(This)
      Debug "Free:"+Hex(This)
    EndProcedure
        
    Procedure New(This,value)
      AllocateObject()
      This\value=value
      ProcedureReturn This
    EndProcedure
    
    Class::End()
  EndModule
  
  ;-
  ;- Test2 - Child Class
  
  DeclareModule Test2
    Class::Begin(Test)
    
    Structure Properties Extends Test::Properties
    EndStructure
    
    Interface Class Extends test::Class
      _oldSet(value)
    EndInterface
    
    Declare New(This,value)
    
    Class::End()
  EndDeclareModule
  
  Module Test2
    Class::Begin()  
    
    AliasMethod(_oldSet,Set)
    
    Procedure Set(This,value)
      ProtectedSelf
      self\_oldSet(value)
    EndProcedure
    SetMethod(Set)
    
    Procedure Free(This)
      Debug "Free2:"+Hex(This)
    EndProcedure
    
    Procedure New(This,value)
      AllocateObject()
      This=SuperNew(This,value*2)
      ProcedureReturn This
    EndProcedure
    
    Class::End()
  EndModule
  
  ;-
  ;- Test3 Obj in Obj
  
  DeclareModule Test3
    Class::Begin()
    
    Structure Properties Extends Class::Properties
      object.test::Class
    EndStructure
    
    Interface Class Extends Class::Class
      Get()
      Set(Value)
    EndInterface
    
    Declare New(This=0)
    
    Class::End()
  EndDeclareModule
  
  Module Test3
    Class::Begin()
    
    Procedure Get(This)
      ProcedureReturn This\Object\Get()
    EndProcedure
    SetMethod(Get)
    
    Procedure SetTestDummi(This,Value)
      This\Object\Set(Value)
    EndProcedure
    SetMethod(Set,SetTestDummi)
    
    Procedure New(This=0)
      AllocateObject()
      This\Object=test::New(0,0)
      ProcedureReturn This
    EndProcedure
    
    Procedure Clone(This)
      This\Object=Class::Clone(This\Object)
    EndProcedure
        
    Procedure Free(This)
      Class::Free(This\Object)
    EndProcedure
    
    Class::End()
  EndModule
  
  ;-
  ;- Test4 strings
  
  DeclareModule Test4
    Class::Begin()
    
    Interface Class Extends Class::Class
      Get.s()
      Set(value.s)
      Quote(value.s)
      BadQuote(value.s)
    EndInterface
    
    Structure Properties Extends Class::Properties
      Value.s
    EndStructure
    
    Class::End()
  EndDeclareModule
  
  Module Test4
    Class::Begin()
    
    Method(s,Get,(This));-Test4:Get
      ProcedureReturn This\Value
    EndMethod
    
    Method(i,Set,(This,Value.s) )   ;-Test4:Set
      This\Value=Value
    EndMethod
    
    Method(i,Quote,(This,Value.s)) ;-Test4:Quote
      self\Set(Chr(34)+value+Chr(34))
    EndMethod
    
    Method(i,BadQuote,(This,Value.s));-Test4:BadQuote
      Set(This,Chr(34)+value+Chr(34)); not Recommand!
    EndMethod
    
    
    Class::End()
  EndModule
  ;-
  ;- Test5 StringChild
  DeclareModule Test5
    Class::Begin(Test4)
    
    Interface Class Extends Test4::Class
    EndInterface
    Structure Properties Extends Test4::Properties
    EndStructure
    
    Class::End()
  EndDeclareModule
  Module Test5
    Class::Begin()
    Class::End()
  EndModule
  
  
  object.test::Class=  Test::New(0,99);THIS must be zero!
  object2.test2::Class = Test2::New(0,9);THIS must be zero!
  object3.test3::Class = Test3::New()
  object4.test4::Class = Test4::New()
  Debug "--"
  object5.test5::Class = Test5::New()
  
  Debug object\get()
  
  object\Set(20)
  Debug object\Get()
  
  Class::Free(object)
  
  
  Debug object2\Get()
  Class::Free(object2)
  
  Debug object3\Get()
  object3\set(20)
  Debug object3\Get()
  Class::Free(object3)
  
  Debug object4\Get()
  object4\Set("Testi")
  Debug object4\Get()
  object4\Quote("Ei")
  Debug object4\Get()
  object4\BadQuote("Eis")
  Debug object4\Get()
  Class::Free(object4)
  
  object5\set("Muhahaha")
  Debug object5\Get()
  Class::Free(object5)
  
  Debug "---"
  
  object=Test::New(0,99)
  object6.test::Class = Class::Clone(object)

  
  
  Debug object\get()
  Debug object6\Get()
  Debug "---"
  object\set(2)
  object6\set(3)
  Debug "---"
  
  Debug object\get()
  Debug object6\Get()
  Class::Free(object6)
  Debug object\get()
  Class::Free(object)
  Debug "---"
  object3=test3::New()
  object3\set(12)
  object7.test3::Class = Class::Clone(object3)
  
  Debug object3\get()
  Debug object7\Get()
  
  object3\set(34)
  object7\set(56)
  Debug object3\get()
  Debug object7\Get()
  Class::free(object3)
  Debug object7\Get()
  Class::Free(Object7)
  
CompilerEndIf
Module macht ein paar Sachen etwas einfacher. Weiterer Unterschied zum anderen Code von mir: Man muss die Objekte alle selbst wieder freigeben! Das wird nicht mehr automatisch gemacht. Dafür sind das jetzt nur noch 250 Zeilen anstatt 2000 :)

Sowohl bei DeclareModule und Module muss man mit Class::Begin([<parentclass>]) einleiten und Class::End() beenden. Die Datenstruktur muss immer Properties und das Interface immer Class heißen und entweder mit einer Parent-Klasse oder Class:: "extended" werden.
Methoden kann man einfach mit Proceduren realisiert werden, die als ersten Parameter zwangsweise *self.properties - oder kürzer und ohne Autovervollständigung This (Macro) sein. Die Procedure kann man anschließend mit "AsMethod(Methode [,Procedurenname])" bekannt machen. Falls der Procedurennamen mit den Methodennamen übereinstimmt, kann man den zweiten Parameter weglassen.
Wenn man in der Methode eine andere Methode aufrufen will, macht man das am besten mit " Protected Self.Class=This " oder als Macro " ProtectedSelf ". Anschließend kann man self\Methode() verwenden.
Child-Klassen können Methoden einfach überschreiben, indem man sie neu definiert. Wenn man eine alte Methode retten will, kann man mit AliasMethod() ein Alias erstellen.
Wer kürzer schreiben will, kann auch die Macros Method, EndMethod und MethodReturn benutzen.
Alles wird mindestens einmal in den Beispielen gemacht :)

Wenn in DeclareModule keine New, Free, Clone - Methoden declared werden (nicht in Interface!), wird eine Default-Variante erzeugt. AsMethod darf nicht bei Free, New und Clone angewendet werden!

New-Methode:
Das ist der Konstruktor und leider ein bischen umständlicher. Dafür kann man hier schon eine beliebige Anzahl von Parameter genommen werden - der erste muss aber This sein! Der erste Aufruf innerhalb des Konstruktors sollte unbedingt " AllocateObject() " sein. Standardmäßig wird nicht der Konstruktor des Parent aufgerufen! Das muss man selber machen, am besten mit " SuperNew (this,parameter) " (sollte als erstes passieren, aber nur wenn es einen Parent gibt!). Als Rückgabeparameter muss man "this" zurückgeben.
Das ganze sieht dann bspw. so aus:

Code: Alles auswählen

    Procedure New(This,value)
      AllocateObject()
      This=SuperNew(This,value*2)
      ProcedureReturn This
    EndProcedure
Free-Methode:
Das hier ist deutlich einfacher. Es werden von Child nach Parent die jeweilige Free-Methode automatisch aufgerufen. Man sollte alles freigeben, was man innerhalb des Objects reservert hat. Bspw. Speicher, andere Objecte, Handles etc.

Clone-Methode:
Wenn man ein Objekt duplizieren will, wird diese Methode aufgerufen. Es wird automatisch eine 1:1-Kopie des Objects erstellt und man erhält diese neue Adresse als Parameter. Ähnlich wie bei Free wird automatisch von Parent nach Child aufgerufen und jedes Klassen-Segment sollte sich nur um seine eigene Properties kümmern. Clone darf nicht fehlschlagen! Wenn man ein Handle etc. nicht duplizieren kann, muss man hier einen Neutralen/ungültigen Wert einsetzen (bspw. 0).
Kann man bei Test3 bei den Beispielen schön ansehen.
Wie gesagt, es wurde bereist eine Kopier erstellt. Wenn aber ein pointer zu einen Speicherbereich in den Properties ist - der pointer wird kopiert und verzweigt auf den gleichen Speicherbereich wie das Original. Das muss man zwingend mit Clone entflechten.

Ein Object-Link kann man einfach mit .<modulname>::Class erstellen. Ein Objekt bekommt man mit <modulname>::New(0,parameterliste) - Den ersten Parameter muss man leider hier mit angeben - this muss hier 0 sein, also eine 0.
Freigegeben wird das Objekt mit Class::Free(Object) . Falls man einen Clone braucht, Class::Clone(Object) .

p.s.: In den Beispielen mische die verschiedenen Stiele etwas. *self.Properties ist identisch mit This. Ersteres hat halt den Vorteil, das der Editor Vorschläge machen kann, was bei THIS nicht geht.
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Benutzeravatar
Kurzer
Beiträge: 1614
Registriert: 25.04.2006 17:29
Wohnort: Nähe Hamburg

Re: AW: Modul BaseClass (Modul als Objekt programmieren)

Beitrag von Kurzer »

GPI, ich bin gerade nur per smartphone im forum und habe mir deinen code nicht in gänze ansehen können. ist das jetzt dein eigener Ansatz eines module basierten klassenkonstrukts?
Es wäre dann sicherlich weniger verwirrend, wenn du dafür einen seperaten thread erstellen würdest.

mk-soft Word hier bestimmt noch weiter zu seinem Ansatz posten wollen.
"Never run a changing system!" | "Unterhalten sich zwei Alleinunterhalter... Paradox, oder?"
PB 6.02 x64, OS: Win 7 Pro x64 & Win 11 x64, Desktopscaling: 125%, CPU: I7 6500, RAM: 16 GB, GPU: Intel Graphics HD 520
Useralter in 2023: 56 Jahre.
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul BaseClass (Modul als Objekt programmieren)

Beitrag von mk-soft »

Update v1.13
- Macro InitObject geändert. Jetzt ist für New[ObjectName]() ist nur noch ein Dreizeiler erforderlich.
- Macros AllocateObject() und InitalizeObject() für erweiterte Funktion bei New[ObjectName]() mit Parametern.

Code: Alles auswählen

...
Procedure NewMath1()
  InitObject(sMyMath1) ; Mehr kommt hier nicht rein!
EndProcedure
...  
P.S. Beispiel mit Parameter http://www.purebasic.fr/german/viewtopi ... 68#p334268

:wink:
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul BaseClass (Modul als Objekt programmieren)

Beitrag von mk-soft »

@GPI,

komme so langsam da hinter wie es bei Dir funktioniert.
Die recursive Funktion Free() ist bei mir die Funktion Dispose(). Was noch fehlt ist noch die recursive Funktion Initalize().
Das mit Clone() ist eine gute Idee. Bei mir würden man eine als zusätzliche Methode definiert werden.

Code: Alles auswählen

Procedure Clone(*this.sUser)
    Protected *Clone
    *Clone = AllocateStructure(sUser)
    If *Clone
      CopyStructure(*this, *Clone, sUser)
    EndIf
    ProcedureReturn *Clone
  EndProcedure : AsMethode(Clone)
Initialisierung darf natürlich nicht aufgerufen werden.
Im Gegensatz zu deiner Lösung gilt bei mir immer noch das die Methoden in den Modul die gleiche Reihenfolge haben müssen,
wie sie in dem Interface definiert sind.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Modul BaseClass (Modul als Objekt programmieren)

Beitrag von GPI »

mk-soft hat geschrieben:@GPI,

komme so langsam da hinter wie es bei Dir funktioniert.
Wenn dir die Macros probleme machen, damit kann man die auflösen:
https://github.com/GPIforGit/PureBasic- ... process.pb
Dann sieht man besser, wie die Macro zusammenwirken.
Die recursive Funktion Free() ist bei mir die Funktion Dispose(). Was noch fehlt ist noch die recursive Funktion Initalize().
Das ist bei mir die "New". Das ist bei mir eine Kombifunktion. Wenn der erste Parameter Null ist, wird das Object erzeugt (das macht das Macro AllocateObject), ansonsten nur initalisiert.
Da ich hier mehrere Parameter für New haben wollte, um gleich einen Startwert zu übergeben, kann ich leider nicht automatisch die vorherige New-Funktion aufrufen. Das muss man manuell mit SuperNew (*self [,parameterliste]).

Übrigens: Die Funktion __Free() ist dazu da, das eine eventuell vorhandene Function Free() (compilerif definied) aufgerufen wird und dann der Parent __Free().
Das mit Clone() ist eine gute Idee. Bei mir würden man eine als zusätzliche Methode definiert werden.
Es soll halt auch hier von Parent zum Child (in der Reihenfolge) die einzelnen Klassen eine Chance bekommen, ihre Properties zu korrigieren. Deshalb mach ich hier auch eine Kette. So muss man sich hier nicht darum kümmern, was das Eltern-Objekt gemacht hat und kann sich vollständig auf die eigene Werte konzentrieren. Zur Kettenüberprüfung ist die versteckte Function __Clone() zuständig. Wenn der zweite Parameter 0 ist, wird mit Allocate- und CopyStructure das Objekt kopiert. Anschließend werden die Parent-Class __Clone() Function mit den neuen Object und als zweiten Parameter 1! Anschließend wird die zu der Klasse gehörende Clone()-Function aufgerufen, sofern vorhanden (mit CompilerIf Definied).
Im Gegensatz zu deiner Lösung gilt bei mir immer noch das die Methoden in den Modul die gleiche Reihenfolge haben müssen,
wie sie in dem Interface definiert sind.
Wie schon in der PM gesagt, die Position kann man sehr leicht mit OffsetOf(<interfacename>\<methode>()) rausfinden. Den Methodennamen muss man eh immer übergeben. Man muss nur den Interfacenamen irgendwie herausbekommen. Ich löse das einfach damit, das sie immer gleich heißen (Class).
Das ganze führt dann auch zu den angenehmen Nebeneffekt, das man object.Test::Class schreiben muss, um eine "Objekt-Variable" zu erzeugen. Man sieht sofort beim lesen: das ist eine Klasse von Typ Test. Genauso das anschließende Test::New(). Ein UseModule darf man da dann natürlich nicht benutzen. Deshalb sind ein Teil der Macros in Modul __class_ ausgelagert.
Die Gesamtgröße (in Bytes) der *vTable kann man mit SizeOf(<interfacename>) rausbekommen und kann so die vTable sofort in der richtigen Größe per AllocateMemory anfordern.

Übrigens: Die Adressen der _Free() und __Clone() Funktionen sind unterhalb der *vTable versteckt. Sie ist deshalb bei mir eigentlich um zwei Pointer Größer. Unterhalb sind die Funktionen, damit sie nicht versehentlich mit einer Methode in Konflikt geraten und ich wollte sie auch nicht in Basis-Klasse einbinden - Der Anwender soll sie am besten gar nicht zu Gesicht bekommen (Deshalb auch zwei Unterstriche zu beginn). Ich verwalte die beiden mit der Structure SubTable.

Das Goto und Gosub sind zwei Schönheitsdinger. Da wir in Declare-Bereich der Funktion kurzzeitig in das Module/EndModule gesprungen, um die *vTable aufzubauen. Dadurch ist es möglich sofort nach der Declaration des Moduls auch die Klassen zu benutzen. Ansonsten wären sie erst nach den Module/EndModule möglich. Vorher ist die *vTable leer.

Wenn du Fragen hast, frag :)

Edit: Ein Beispiel, warum ich mehrere Parameter bei New haben möchte:

Code: Alles auswählen

DeclareModule File
    Class::Begin()
    Enumeration
      #Create
      #Open      
      #Read
    EndEnumeration
    
    Interface Class Extends Class::Class
      ReadS.s(type=#PB_UTF8,len=-1)
      ReadData.q(*buf,len.q)
      ReadA.a()
      ReadB.b()
      ReadU.u()
      ReadI.i()
      ReadW.w()
      ReadL.l()
      ReadC.c()
      ReadQ.q()
      ReadF.f()
      ReadD.d()
      
      WriteS(s.s,type=#PB_UTF8)
      WriteSN(s.s,type=#PB_UTF8)
      WriteData.q(*buf,len.q)
      WriteA(a.a)
      WriteB(b.b)
      WriteU(u.u)
      WriteI(i.i)
      WriteW(w.w)
      WriteL(l.l)
      WriteC(c.c)
      WriteQ(q.q)
      WriteF(f.f)
      WriteD(d.d)      
    EndInterface
    
    Structure Properties Extends Class::Properties
      handle.i
      access.i
    EndStructure
    
    Declare New(*self,Access.i,file.s)
    
    Class::End()
  EndDeclareModule
  
  Module File
    Class::Begin()
    
    Macro ReadX(type,function)
      Procedure.type Read#type(*self.Properties)
        ProcedureReturn Read#function(*self\handle)
      EndProcedure
      SetMethod(Read#Type)
    EndMacro    
    
    ReadX(a,AsciiCharacter)
    ReadX(b,Byte)
    Readx(u,UnicodeCharacter)
    ReadX(i,Integer)
    ReadX(w,Word)
    ReadX(l,Long)
    ReadX(c,Character)
    ReadX(q,Quad)
    ReadX(f,Float)
    ReadX(d,Double)
    
    Procedure.s ReadS(*self.Properties,type=#PB_UTF8,len=-1)
      ProcedureReturn ReadString(*self\handle,type,len)
    EndProcedure
    SetMethod(ReadS)
    
    Procedure.q ReadData_(This,*buf,len.q)
      ProcedureReturn ReadData(*self\handle,*buf,len)
    EndProcedure
    SetMethod(ReadData,ReadData_)
    
    Macro WriteX(type,function)
      Procedure.type Write#type(This,var.type)
        ProcedureReturn Write#function(This\handle,var)
      EndProcedure
      SetMethod(Write#type)
    EndMacro
    WriteX(a,AsciiCharacter)
    WriteX(b,Byte)
    WriteX(u,UnicodeCharacter)
    WriteX(i,Integer)
    WriteX(w,Word)
    WriteX(l,Long)
    WriteX(c,Character)
    WriteX(q,Quad)
    WriteX(f,Float)
    WriteX(d,Double)
    
    Procedure WriteS(This,str.s,type=#PB_UTF8)
      ProcedureReturn WriteString(This\handle,str,type)
    EndProcedure
    SetMethod(WriteS)
    Procedure WriteSN(This,str.s,type=#PB_UTF8)
      ProcedureReturn WriteStringN(This\handle,str,type)
    EndProcedure
    SetMethod(WriteSN)
    
    Procedure.q WriteData_(This,*buf,len.q)
      ProcedureReturn WriteData(This\handle,*buf,len)
    EndProcedure
    SetMethod(WriteData,WriteData_)
    
    Procedure New(This,Access.i,file.s)
      AllocateObject()
      Select Access
        Case #Create
          *self\handle=CreateFile(#PB_Any,file)
        Case #Open
          *self\handle=OpenFile(#PB_Any,file)
        Case #Read
          *self\handle=ReadFile(#PB_Any,file)
      EndSelect
      ;Handle konnte nicht erzeugt werden, object killen!
      If *self\handle=0
        FreeStructure(*self)
        *self=0
      EndIf
      ProcedureReturn *self
    EndProcedure
    
    Procedure Free(This)
      CloseFile(This\handle)
    EndProcedure
    
    Procedure Clone(This)
      Debug "[ERROR] FileClass can't be cloned"
      CallDebugger
      End
    EndProcedure
    
    Class::End()
  EndModule
  
  
  Debug "-----------"
  Out.File::Class = File::New(0, file::#Create ,"Tempfile.txt")
  If out
    Debug "write to file"
    out\WriteS("Testausgabestring")
    Class::Free(out)
  EndIf
  
  In.File::Class = File::New(0, file::#Read,"Tempfile.txt")
  If in
    Debug "read from file"
    str.s= in\ReadS()
    Debug str
    Class::Free(in)
  EndIf
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul BaseClass (Modul als Objekt programmieren)

Beitrag von mk-soft »

Dein Konzept ist mir jetzt klar. Unsere Ansätze sind allerdings im Kern und in der Syntax unterschiedlich.
Wäre schade wenn unsere Ideen untergehen würden.
Vor allem weil ohne viel Code eine sehr gut Implementierung von objektorientierte Programmierung damit möglich ist.

Meine Planung sieht aber vor das die BaseClass noch an die iUnknown Schnittstelle angepasst wird und
eine Erweiterung mit iDispatch zu ermöglichen. Daher arbeite ich mit einer Map "Class()" um alle erforderlichen Anpassungen und Erweiterungen durchführen zu können ohne das es Einfluss auf die Verwendung hat.
Die Namen der Methoden werden zum Beispiel schon ablegt. Aber das reicht natürlich noch lange nicht um eine späte Bindung an ein Objekt zu implementieren.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Modul BaseClass (Modul als Objekt programmieren)

Beitrag von GPI »

mk-soft hat geschrieben:Meine Planung sieht aber vor das die BaseClass noch an die iUnknown Schnittstelle angepasst wird und
eine Erweiterung mit iDispatch zu ermöglichen. Daher arbeite ich mit einer Map "Class()" um alle erforderlichen Anpassungen und Erweiterungen durchführen zu können ohne das es Einfluss auf die Verwendung hat.
Die Namen der Methoden werden zum Beispiel schon ablegt. Aber das reicht natürlich noch lange nicht um eine späte Bindung an ein Objekt zu implementieren.
Gibts einen besonderen Grund das zu machen?
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul BaseClass (Modul als Objekt programmieren)

Beitrag von mk-soft »

Gibts einen besonderen Grund das zu machen?
Mit den Interface Dispatch kann man zum Beispiel die Klasse als AddON für VBS verwenden oder
eine registerbare DLL erstellen und diese dann direkt in VBS (CreateObject) oder Excel verwenden.

Dauert aber noch...
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Modul BaseClass (Modul als Objekt programmieren)

Beitrag von mk-soft »

Beispiel Update

Code: Alles auswählen


IncludeFile "Modul_BaseClassSmall.pb"

; *******************************************************************************

DeclareModule User
  
  UseModule BaseClass
  
  Structure sUser Extends sBaseClass
    firstname.s
    lastname.s
  EndStructure
  
  Interface iUser Extends iBaseClass
    SetName(FirstName.s, LastName.s)
    GetName.s()
    GetFirstName.s()
    GetLastName.s()
    Clone()
  EndInterface
  
  UnuseModule BaseClass
  
  Declare.i New()
  
EndDeclareModule

Module User
  
  UseModule BaseClass
  
  NewClass(iUser)
  
  ; ---------------------------------------------------------------------------
  
  Procedure Init(*this.sUser)
    *this\firstname = "no name"
    *this\lastname = "no name"
    Debug "Initalize Object Class User " + *this
  EndProcedure : AsInitializeObject(Init)
  
  ; ---------------------------------------------------------------------------
  
  Procedure Dispose(*this.sUser)
    Debug "Dispose Object Class User " + *this
  EndProcedure : AsDisposeObject(Dispose)
  
  ; ---------------------------------------------------------------------------
  
  Procedure SetName(*this.sUser, FirstName.s, LastName.s)
    With *this
      \firstname = FirstName
      \lastname = LastName
    EndWith
  EndProcedure : AsMethode(SetName)
  
  ; ---------------------------------------------------------------------------
  
  Procedure.s GetName(*this.sUser)
    With *this
      ProcedureReturn \lastname + ";" + \firstname
    EndWith
  EndProcedure : AsMethode(GetName)
  
  ; ---------------------------------------------------------------------------
  
  Procedure.s GetFirstName(*this.sUser)
    ProcedureReturn *this\firstname
  EndProcedure : AsMethode(GetFirstName)
  
  ; ---------------------------------------------------------------------------
  
  Procedure.s GetLastName(*this.sUser)
    ProcedureReturn *this\lastname
  EndProcedure : AsMethode(GetLastName)
  
  ; ---------------------------------------------------------------------------
  
  Procedure Clone(*this.sUser)
    Protected *clone.sUser
    CloneObject(*this, *clone, sUser) 
    ProcedureReturn *clone
  EndProcedure : AsMethode(Clone)
  
  ; ---------------------------------------------------------------------------
  
  Procedure New()
    InitObject(sUser)
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  CheckInterface()
  
EndModule

; *******************************************************************************

DeclareModule Adress
  
  UseModule User
  
  Structure sAdress Extends sUser
    street.s
    postal.i
    city.s
    country.s
  EndStructure
  
  Interface iAdress Extends iUser
    SetAdress(street.s, postal.i, city.s, country.s)
    GetStreet.s()
    GetPostal.i()
    GetCity.s()
    GetCountry.s()
    GetAll.s()
  EndInterface
  
  UnuseModule User
  
  Declare New()
  
EndDeclareModule

Module Adress
  
  UseModule BaseClass
  
  NewClass(iAdress, iUser)
  
  ; ---------------------------------------------------------------------------
  
  Procedure Init(*this.sAdress)
    Debug "Initalize Object Class Adress " + *this
  EndProcedure : AsInitializeObject(Init)
  
  ; ---------------------------------------------------------------------------
  
  Procedure Dispose(*this.sAdress)
    Debug "Dispose Object Class Adress " + *this
  EndProcedure : AsDisposeObject(Dispose)
  
  ; ---------------------------------------------------------------------------
  
  Procedure SetAdress(*this.sAdress, street.s, postal.i, city.s, country.s)
    With *this
      \street = street
      \postal = postal
      \city = city
      \country = country
    EndWith
  EndProcedure : AsMethode(SetAdress)
  
  ; ---------------------------------------------------------------------------
  
  Procedure.s GetStreet(*this.sAdress)
    With *this
      ProcedureReturn \street
    EndWith
  EndProcedure : AsMethode(GetStreet)
  
  ; ---------------------------------------------------------------------------
  
  Procedure GetPostal(*this.sAdress)
    With *this
      ProcedureReturn \postal
    EndWith
  EndProcedure : AsMethode(GetPostal)
  
  ; ---------------------------------------------------------------------------
  
  Procedure.s GetCity(*this.sAdress)
    With *this
      ProcedureReturn \city
    EndWith
  EndProcedure : AsMethode(GetCity)
  
  ; ---------------------------------------------------------------------------
  
  Procedure.s GetCountry(*this.sAdress)
    With *this
      ProcedureReturn \country
    EndWith
  EndProcedure : AsMethode(GetCountry)
  
  ; ---------------------------------------------------------------------------
  
  Procedure.s GetAll(*this.sAdress)
    Protected r1.s
    With *this
      r1 = \LastName + ";"
      r1 + \FirstName + ";"
      r1 + \street + ";"
      r1 + \city + ";"
      r1 + \postal + ";"
      r1 + \country
      ProcedureReturn r1
    EndWith
  EndProcedure : AsMethode(GetAll)
  
  ; ---------------------------------------------------------------------------
  
  Procedure Clone(*this.sAdress)
    Protected *clone.sAdress
    CloneObject(*this, *clone, sAdress)
    ProcedureReturn *clone
  EndProcedure : AsNewMethode(Clone)
  
  ; ---------------------------------------------------------------------------
  
  Procedure New()
    InitObject(sAdress)
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  CheckInterface()
  
EndModule

; *******************************************************************************

;- Test

Define.Adress::iAdress *user, *user2

*user=Adress::New()
Debug *user\GetName()
*user\SetName("Toto", "Buddy")
*user\AddRef()
Debug *user\GetName()
*user2 = *user\Clone()
*user2\SetAdress("My Street", 12345, "My City", "My Country")
Debug *user2\GetAll()

Debug *user\Release()
Debug *user\Release()
Debug *user2\Release()
Zuletzt geändert von mk-soft am 04.05.2019 14:43, insgesamt 2-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
Kurzer
Beiträge: 1614
Registriert: 25.04.2006 17:29
Wohnort: Nähe Hamburg

Re: Modul BaseClass (Modul als Objekt programmieren)

Beitrag von Kurzer »

Vielen Dank, mk-soft. :allright:

Eine Frage: Du hast in diesem Beispiel erstmals im "DeclareModule User"-Block am Ende " UnuseModule BaseClass" genutzt. Auch weiter unten in der Deklaration des Moduls "Adress" hast Du "UnuseModule User" benutzt. Das ist in den älteren Beispielen nicht so.

Hat das jetzt eine bestimmte Bewandtnis oder hast Du es in den anderen Beispielen nur vergessen? Das aktuelle Beispiel lässt sich aber auch ohne das "UnuseModule" kompilieren.
"Never run a changing system!" | "Unterhalten sich zwei Alleinunterhalter... Paradox, oder?"
PB 6.02 x64, OS: Win 7 Pro x64 & Win 11 x64, Desktopscaling: 125%, CPU: I7 6500, RAM: 16 GB, GPU: Intel Graphics HD 520
Useralter in 2023: 56 Jahre.
Antworten