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.
mk-soft
Beiträge: 3700 Registriert: 24.11.2004 13:12
Wohnort: Germany
Beitrag
von mk-soft » 10.01.2016 22:54
Ohne UnuseModule könnte man bei Vererbung nicht die gleiche Funktion New() verwenden, da sie schon bereit in der gerbten Klasse definiert wurde, aber nicht gebraucht wird.
Man könnte auch es so schreiben
Code: Alles auswählen
DeclareModule Adress
;UseModule User
Structure sAdress Extends User::sUser
street.s
postal.i
city.s
country.s
EndStructure
Interface iAdress Extends User::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
Halte mich ja an die Syntaxregeln von PB
mk-soft
Beiträge: 3700 Registriert: 24.11.2004 13:12
Wohnort: Germany
Beitrag
von mk-soft » 24.01.2016 16:59
Update v1.16
- Code optimiert
- Debugger erweitert
Kurzer
Beiträge: 1614 Registriert: 25.04.2006 17:29
Wohnort: Nähe Hamburg
Beitrag
von Kurzer » 25.01.2016 14:36
Besten Dank fürs updaten.
"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.
Sicro
Beiträge: 955 Registriert: 11.08.2005 19:08
Kontaktdaten:
Beitrag
von Sicro » 06.05.2016 15:44
Code wird zum
CodeArchiv unter OOP/HandleModulesAsObjects.pbi hinzugefügt.
mk-soft
Beiträge: 3700 Registriert: 24.11.2004 13:12
Wohnort: Germany
Beitrag
von mk-soft » 15.08.2016 14:30
Update v1.21
-
Geändert: NewClass(Extends=BaseClass) -> NewClass(CLassInterface, ClassExtends=BaseClass)
* Erster Parameter wird jetzt der Name des Interface angegeben.
+ Vorteil: Es muss nicht mehr auf die Reihenfolge von den Methoden geachtet werden.
+ CheckInterface kann das Interface besser kontrollieren.
- Debugger Funktion ShowClasses hinzugefügt
* Zeigt alles angelegten Interfaces an
mk-soft
Beiträge: 3700 Registriert: 24.11.2004 13:12
Wohnort: Germany
Beitrag
von mk-soft » 16.08.2016 13:35
Update v1.22
- Code aufgeräumt
Ist wohl der kleinste Code um einfach OOP in Purebasic zu verwenden ohne eine neue Syntax zu entwickeln
Kurzer
Beiträge: 1614 Registriert: 25.04.2006 17:29
Wohnort: Nähe Hamburg
Beitrag
von Kurzer » 16.08.2016 20:10
Besten Dank, mk-soft.
Habe die Includes auf meiner Platte aktualisiert.
"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.
mk-soft
Beiträge: 3700 Registriert: 24.11.2004 13:12
Wohnort: Germany
Beitrag
von mk-soft » 17.08.2016 15:45
Beispiel 8 Update
Objekt im Objekt verwenden.
Kurze Beschreibung:
Verwendung des Objekt "Fields" innerhalb des Objekte "MyList" mit Rückgabe das Objekt "Fields"
Abruf der Liste als Objektliste "iRows" von Type von Objekt "Fields".
P.S. Etwas vereinfacht
Code: Alles auswählen
;-TOP
; Example 8
IncludeFile "Modul_BaseClassSmall.pb"
DeclareModule Fields
UseModule BaseClass
Structure sFields Extends sBaseClass
text.s
delimeter.s
count.i
EndStructure
Interface iFields Extends iBaseClass
Text.s()
Field.s(index)
Count()
EndInterface
UnuseModule BaseClass
Declare New(text.s, delimiter.s=";")
EndDeclareModule
Module Fields
UseModule BaseClass
NewClass(iFields)
; -----------------------------------------------------------------------------------
Procedure New(text.s, delimiter.s=";")
Protected *object.sFields
AllocateObject(*object, sFields)
With *object
\text = text
\delimeter = delimiter
\count = CountString(text, delimiter) + 1
EndWith
InitializeObject(*object)
ProcedureReturn *object
EndProcedure
; -----------------------------------------------------------------------------------
Procedure.s Text(*this.sFields)
With *this
ProcedureReturn \text
EndWith
EndProcedure : AsMethode(Text)
; -----------------------------------------------------------------------------------
Procedure.s Field(*this.sFields, index)
With *this
ProcedureReturn StringField(\text, index, \delimeter)
EndWith
EndProcedure : AsMethode(Field)
; -----------------------------------------------------------------------------------
Procedure Count(*this.sFields)
With *this
ProcedureReturn \count
EndWith
EndProcedure : AsMethode(Count)
; -----------------------------------------------------------------------------------
CheckInterface()
EndModule
; ***************************************************************************************
DeclareModule MyList
UseModule BaseClass
Structure sMyList Extends sBaseClass
List Rows.Fields::iFields()
EndStructure
Interface iMyList Extends iBaseClass
Add(text.s, delimeter.s=";")
First()
Prev()
Nxt()
Last()
Del()
GetList()
EndInterface
; Erweitere Interfaces veröffendlichen
Interface iRow Extends Fields::iFields
EndInterface
Structure iRows
List Rows.Fields::iFields()
EndStructure
UnuseModule BaseClass
Declare New()
EndDeclareModule
Module MyList
UseModule BaseClass
NewClass(iMyList)
; -----------------------------------------------------------------------------------
Procedure New()
InitObject(sMyList)
EndProcedure
; -----------------------------------------------------------------------------------
Procedure Add(*this.sMyList, text.s, delimeter.s=";") ; Result - Object of type Fields
With *this
LastElement(\Rows())
AddElement(\Rows())
\Rows() = Fields::New(text, delimeter)
ProcedureReturn \Rows()
EndWith
EndProcedure : AsMethode(Add)
; -----------------------------------------------------------------------------------
Procedure First(*this.sMyList) ; Result - Object of type Fields
With *this
FirstElement(\Rows())
ProcedureReturn \Rows()
EndWith
EndProcedure : AsMethode(First)
; -----------------------------------------------------------------------------------
Procedure Prev(*this.sMyList) ; Result - Object of type Fields
With *this
PreviousElement(\Rows())
ProcedureReturn \Rows()
EndWith
EndProcedure : AsMethode(Prev)
; -----------------------------------------------------------------------------------
Procedure Nxt(*this.sMyList) ; Result - Object of type Fields
With *this
NextElement(\Rows())
ProcedureReturn \Rows()
EndWith
EndProcedure : AsMethode(Nxt)
; -----------------------------------------------------------------------------------
Procedure Last(*this.sMyList) ; Result - Object of type Fields
With *this
LastElement(\Rows())
ProcedureReturn \Rows()
EndWith
EndProcedure : AsMethode(Last)
; -----------------------------------------------------------------------------------
Procedure Del(*this.sMyList) ; Result - Object of type Fields
With *this
\Rows()\Release()
DeleteElement(\Rows())
ProcedureReturn \Rows()
EndWith
EndProcedure : AsMethode(Del)
; -----------------------------------------------------------------------------------
Procedure GetList(*this.sMyList) ; Result - List of Object of type Rows\Fields
With *this
ProcedureReturn *this + OffsetOf(sMyList\Rows)
EndWith
EndProcedure : AsMethode(GetList)
; -----------------------------------------------------------------------------------
Procedure Dispose(*this.sMyList)
With *this
ForEach \Rows()
\Rows()\Release()
Next
EndWith
EndProcedure : AsDisposeObject(Dispose)
; -----------------------------------------------------------------------------------
CheckInterface()
EndModule
; ***************************************************************************************
;-Test
Define text.s, index
Debug "Objekte definieren"
Define *obj.MyList::iMyList
Define *row.MyList::iRow
Define *list.MyList::iRows
Debug "Daten einlesen"
*obj = MyList::New()
Restore Strings
Read.s text
*row = *obj\Add(text)
Debug *row\Text()
Read.s text
*row = *obj\Add(text)
Debug *row\Text()
Read.s text
*row = *obj\Add(text, ",")
Debug *row\Text()
Debug "Daten ausgeben"
*List = *obj\GetList()
ForEach *list\Rows()
Debug "------------------------------"
For index = 1 To *list\Rows()\Count()
Debug *List\Rows()\Field(index)
Next
Next
*obj\Release()
DataSection
Strings:
Data.s "Sonntag;Montag;Dienstag;Mitwoch;Donnerstag;Freitag;Samstag"
Data.s "Januar;Februar;März;April;Mai;Juni;Juli;August;Septemper;Oktober;November;Dezember"
Data.s "Eins,Zwei,Drei,Vier,Fünf,Sechs,Sieben"
EndDataSection
Zuletzt geändert von
mk-soft am 04.05.2019 14:45, insgesamt 1-mal geändert.
Kurzer
Beiträge: 1614 Registriert: 25.04.2006 17:29
Wohnort: Nähe Hamburg
Beitrag
von Kurzer » 14.09.2016 17:02
Hallo mk-soft,
eine kurze Frage. Für welchen realen Anwendungsfall würde man AddRef() benutzen?
Und was mir auffällt: In den Klassen/Modulen die auf der Basisklasse basieren (also in den von Dir geposteten Beispielen) fehlt jeweils das letze "UnuseModule BaseClass". Es müsste zwar theoretisch ganz ans Ende, aber evtl. ist ein "UnuseModule" auch unnötig, wenn es sich auf ein weiteres Modul bezieht, an dessen Beginn ein "UseModule BaseClass" steht. Hast Du es einfach nur vergessen oder kann man das in der Tat weglassen?
Edit: Die letzte Frage hat sich beantwortet - sie war auch etwas übereilt gestellt. Da es hier lediglich um die Bekanntmachung (UseModule) und Nicht-Bekanntmachung (UnUseModule) der Elemente eines anderen Moduls geht, kann man UnUseModule wohl gefahrlos weglassen, wenn die Bekanntmachung bis an das Ende des Quellcodes gelten soll.
"Verwirrung" und "immer wieder neues Einarbeiten" ist der Tribut den ich als zum "Multitasking verdammter" Arbeitnehmer zu zahlen habe.
Gruß Kurzer
"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.
mk-soft
Beiträge: 3700 Registriert: 24.11.2004 13:12
Wohnort: Germany
Beitrag
von mk-soft » 16.09.2016 17:14
Bin wieder Zuhause
AddRef kann man dazu verwenden wenn ein Objekt von verschiedenen Seiten (Dialoge, Threads, etc) gleichzeitig benutzt wird.
Damit erreicht man das ein Objekt erst freigeben wird, wenn keiner mehr das Objekt benötigt.
P.S. Mal ein Beispiel mit 200 Threads
Update
Code: Alles auswählen
;-TOP
; Example 9
CompilerIf #PB_Compiler_Thread = 0
CompilerError "Use compiler option theadsafe"
CompilerEndIf
IncludeFile "Modul_BaseClassSmall.pb"
DeclareModule Work
UseModule BaseClass
Structure sWork Extends sBaseClass
Value.i
EndStructure
Interface iWork Extends iBaseClass
Add(Value)
Sub(Value)
EndInterface
Declare New()
EndDeclareModule
Module Work
UseModule BaseClass
NewClass(iWork)
; ---------------------------------------------------------------------------
Procedure Init(*this.sWork)
Debug "Initialize Work"
EndProcedure : AsInitializeObject(Init)
; ---------------------------------------------------------------------------
Procedure Destroy(*this.sWork)
Debug "Dispose Work"
Debug "Result: " + *this\Value
EndProcedure : AsDisposeObject(Destroy)
; ---------------------------------------------------------------------------
Procedure Add(*this.sWork, Value)
Protected result
LockObject(*this)
*this\Value + Value
result = *this\Value
UnlockObject(*this)
ProcedureReturn result
EndProcedure : AsMethode(Add)
; ---------------------------------------------------------------------------
Procedure Sub(*this.sWork, Value = 0)
Protected result
LockObject(*this)
*this\Value - Value
result = *this\Value
UnlockObject(*this)
ProcedureReturn result
EndProcedure : AsMethode(Sub)
; ---------------------------------------------------------------------------
Procedure New()
InitObject(sWork) ; Mehr kommt hier nicht rein!
EndProcedure
; ---------------------------------------------------------------------------
CheckInterface()
EndModule
; ***************************************************************************************
;-Test AddRef
Procedure thAdd(*Object.Work::iWork)
Protected time
*Object\AddRef()
Delay(1000)
;Debug "Start"
For i = 1 To 10
time = Random(200)
*Object\Add(1)
Delay(time)
Next
;Debug "Ready."
*Object\Release()
EndProcedure
Debug "Mainscope Create Object"
Define *Object.Work::iWork
*Object = Work::New()
mutex = CreateMutex()
Debug "Start Threads"
For i = 1 To 1000
th = CreateThread(@thAdd(), *Object)
Delay(5)
If th = 0
Debug "No Thread " + i
EndIf
Next
Debug "Mainscope Wait..."
Repeat
Delay(200)
ref = *Object\AddRef()
ref = *Object\Release()
Debug ref
If ref = 0
Break
EndIf
ForEver
Debug "Mainscope Release Object"
*Object\Release()
Debug "Ready."
Zuletzt geändert von
mk-soft am 04.05.2019 14:47, insgesamt 1-mal geändert.