I had long term a problem searching for somewhat like classes. The approach by TS-soft in
procedures inside structures
suited me well. So I thought, why not generalise it? Here is some kind of an object-maker:
Code: Select all
; ;baut objectdefinitions dateien auf
; LN 15.02.2013
;
EnableExplicit
Enumeration 1
#integer
#long
#word
#quad
#string
#float
#double
#byte
#ascii
#character
#unicode
EndEnumeration
Enumeration 20
#usual
#get
#set
EndEnumeration
Global Dim typen.s(20)
typen(1)="i"
typen(2)="l"
typen(3)="w"
typen(4)="q"
typen(5)="s"
typen(6)="f"
typen(7)="d"
typen(8)="b"
typen(9)="a"
typen(10)="c"
typen(11)="u"
Structure memb
name.s
type.w
get_soll.w
set_soll.w
EndStructure
Structure meth
name.s
art.w
type.w
EndStructure
Global NewList methods.meth()
Global NewList members.memb()
Global classname.s
Global objectname.s
Procedure ausgeben(weg.s)
WriteStringN(20,weg.s, #PB_Ascii)
EndProcedure
Procedure lesbarausgeben()
ausgeben("")
EndProcedure
Procedure expend_get_methods_from_members()
Protected nome.s
ForEach members()
If members()\get_soll = #True
nome = "Get_"+members()\name
AddElement(methods())
methods()\name = nome
methods()\art = #get
methods()\type = members()\type
EndIf
Next
EndProcedure
Procedure expend_set_methods_from_members()
Protected name.s
ForEach members()
If members()\set_soll = #True
name = "Set_"+members()\name
AddElement(methods())
methods()\name = name
methods()\art = #set
methods()\type = members()\type
EndIf
Next
EndProcedure
Procedure build_prototypesection()
Protected ausgabe.s
ForEach methods()
ausgabe = "Prototype "+methods()\name+"()"
ausgeben(ausgabe)
Next
EndProcedure
Procedure build_structure()
Protected ausgabe.s
ausgabe = "Structure "+classname
ausgeben(ausgabe)
ausgeben("; -----members-------- ")
ForEach members()
ausgabe = members()\name+"."+typen(members()\type)
ausgeben(ausgabe)
Next
ausgeben("; ----- methods----------")
ForEach methods()
ausgabe = methods()\name+"."+methods()\name
ausgeben(ausgabe)
Next
ausgabe = "EndStructure "
ausgeben(ausgabe)
EndProcedure
Procedure build_structure_definition()
Protected ausgabe.s
ausgabe = "Global Dim "+objectname+"."+classname+"(1)"
ausgeben(ausgabe)
EndProcedure
Procedure build_procedure_stubs()
Protected ausgabe.s
ausgeben("; -----Procedures definition-------- ")
ForEach methods()
If methods()\art = #set
ausgabe = "procedure "+methods()\name+"(value."+typen(methods()\type)+")"
ElseIf methods()\art = #get And methods()\type = #string
ausgabe = "procedure.s "+methods()\name+"()"
Else
ausgabe = "procedure "+methods()\name+"()"
EndIf
ausgeben(ausgabe)
If methods()\art = #set
ausgabe = objectname+"(0)\"+Right(methods()\name,Len(methods()\name)-4)+" = value"
ElseIf methods()\art = #get
ausgabe = "procedurereturn "+objectname+"(0)\"+Right(methods()\name,Len(methods()\name)-4)
Else
ausgabe=""
EndIf
ausgeben(ausgabe)
ausgabe="Endprocedure"
ausgeben(ausgabe)
lesbarausgeben()
Next
lesbarausgeben()
EndProcedure
Procedure build_object_init_procedure()
Protected ausgabe.s
ausgeben("; -----InitProcedure-------- ")
ausgabe = "procedure new_"+objectname+"()"
ausgeben(ausgabe)
ForEach methods()
ausgabe = objectname+"(0)\"+methods()\name+" = @"+methods()\name+"()"
ausgeben(ausgabe)
Next
ausgabe="Endprocedure"
ausgeben(ausgabe)
EndProcedure
Procedure build_object()
Protected ausgabe.s
ausgabe = "mod_"+objectname+".pbi"
If CreateFile(20,ausgabe)
ausgeben("enableexplicit")
expend_get_methods_from_members()
lesbarausgeben()
expend_set_methods_from_members()
lesbarausgeben()
build_prototypesection()
lesbarausgeben()
build_structure()
lesbarausgeben()
build_structure_definition()
lesbarausgeben()
build_procedure_stubs()
lesbarausgeben()
build_object_init_procedure()
Else
MessageRequester("Mist gebaut", "Datei konnte nicht erstellt werden")
EndIf
EndProcedure
Code: Select all
; test_objectmaker_run
IncludeFile"object_maker.pb"
classname = "balken"
objectname = "einbalken"
;-members definition
AddElement(members())
members()\name = "hoehe"
members()\type = #word
members()\get_soll = #False
members()\set_soll = #True
AddElement(members())
members()\name = "breite"
members()\type = #word
members()\get_soll = #False
members()\set_soll = #True
AddElement(members())
members()\name = "beginn"
members()\type = #word
members()\get_soll = #False
members()\set_soll = #True
AddElement(members())
members()\name = "ende"
members()\type = #word
members()\get_soll = #False
members()\set_soll = #True
AddElement(members())
members()\name = "farbe"
members()\type = #long
members()\get_soll = #True
members()\set_soll = #True
AddElement(members())
members()\name = "art"
members()\type = #word
members()\get_soll = #True
members()\set_soll = #True
AddElement(members())
members()\name = "beschriftung"
members()\type = #string
members()\get_soll = #True
members()\set_soll = #True
;--methoden definition-------
AddElement(methods())
methods()\name = "balken_darstellen"
methods()\type = 0
methods()\art = #usual
AddElement(methods())
methods()\name = "balken_beschriften"
methods()\type = #word
methods()\art = #False
;---auf gehts---
build_object()