Aktuelle Zeit: 14.12.2019 01:46

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 54 Beiträge ]  Gehe zu Seite Vorherige  1, 2, 3, 4, 5, 6  Nächste
Autor Nachricht
 Betreff des Beitrags: Re: Modul BaseClass (Modul als Objekt programmieren)
BeitragVerfasst: 31.12.2015 16:53 
Offline

Registriert: 29.08.2004 13:18
Mir war wieder mal etwas langweilig :)
Code:
;-
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:
    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!


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: AW: Modul BaseClass (Modul als Objekt programmieren)
BeitragVerfasst: 01.01.2016 14:36 
Offline
Benutzeravatar

Registriert: 25.04.2006 17:29
Wohnort: Nähe Hamburg
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!"
PB 5.71 x64, OS: Windows 7 Pro x64, Desktopscaling: 125%, CPU: I7 6500, RAM: 16 GB, GPU: Intel Graphics HD 520
Ich bin Baujahr 1968, also aktuell 51.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul BaseClass (Modul als Objekt programmieren)
BeitragVerfasst: 01.01.2016 16:24 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
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:
...
Procedure NewMath1()
  InitObject(sMyMath1) ; Mehr kommt hier nicht rein!
EndProcedure
... 


P.S. Beispiel mit Parameter viewtopic.php?f=8&t=29343&p=334268#p334268

:wink:

_________________
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul BaseClass (Modul als Objekt programmieren)
BeitragVerfasst: 02.01.2016 13:08 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
@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:
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 / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul BaseClass (Modul als Objekt programmieren)
BeitragVerfasst: 02.01.2016 23:31 
Offline

Registriert: 29.08.2004 13:18
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.
Zitat:
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().

Zitat:
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).

Zitat:
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:
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!


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul BaseClass (Modul als Objekt programmieren)
BeitragVerfasst: 03.01.2016 02:16 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
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 / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul BaseClass (Modul als Objekt programmieren)
BeitragVerfasst: 04.01.2016 20:23 
Offline

Registriert: 29.08.2004 13:18
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!


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul BaseClass (Modul als Objekt programmieren)
BeitragVerfasst: 10.01.2016 16:00 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
Zitat:
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 / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf Webspace


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul BaseClass (Modul als Objekt programmieren)
BeitragVerfasst: 10.01.2016 16:05 
Offline
Benutzeravatar

Registriert: 24.11.2004 13:12
Wohnort: Germany
Beispiel Update
Code:

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()

_________________
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul / OPC-Helper DLL
PB v3.30 / v5.4x - OS Mac Mini OSX 10.xx / Window 10 Pro. (X64) /Window 7 Pro. (X64) / Window XP Pro. (X86) / Ubuntu 14.04
Downloads auf Webspace


Zuletzt geändert von mk-soft am 04.05.2019 14:43, insgesamt 2-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Modul BaseClass (Modul als Objekt programmieren)
BeitragVerfasst: 10.01.2016 21:50 
Offline
Benutzeravatar

Registriert: 25.04.2006 17:29
Wohnort: Nähe Hamburg
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!"
PB 5.71 x64, OS: Windows 7 Pro x64, Desktopscaling: 125%, CPU: I7 6500, RAM: 16 GB, GPU: Intel Graphics HD 520
Ich bin Baujahr 1968, also aktuell 51.


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 54 Beiträge ]  Gehe zu Seite Vorherige  1, 2, 3, 4, 5, 6  Nächste

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 2 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  
cron

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye