- generate load/save structure data
- convert structure field to label text (if label attribute isn't defined) : MyStructureField => "My Structure Field"
- supported decorator attributes : hidden, nolabel, label, mask, min, max
- supported layout attributes : x, y, w, h, lw, dy
Code: Select all
;-TOP
; Comment :Generate code to bind structure data to form gadgets
; Author : eddy
; Web : http://www.purebasic.fr/english/viewtopic.php?f=12&t=411336
; File: : StructToForm.pb
; Version : v0.9
EnableExplicit
Declare GenerateCode()
; ********************
; main form
; ********************
Global winTool=OpenWindow(#PB_Any, 0, 0, 650, 540, "Struct-To-Form Generator",
#PB_Window_MaximizeGadget|
#PB_Window_MinimizeGadget|
#PB_Window_ScreenCentered)
Global editCode=EditorGadget(#PB_Any, 5, 5, 640, 500)
Global btGenerate=ButtonGadget(#PB_Any, 545, 510, 100, 25, "Generate")
; ********************
; load default file
; ********************
If FileSize("struct.txt")>0
ReadFile(0, "struct.txt")
SetGadgetText(editCode, ReadString(0, #PB_File_IgnoreEOL))
CloseFile(0)
EndIf
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case btGenerate
;convert structure-to-form code
GenerateCode()
EndSelect
Case #PB_Event_CloseWindow : Break
EndSelect
ForEver
Procedure.b StringEndWith(string$, find$)
If string$ And find$
ProcedureReturn FindString(string$, find$, Len(string$)-Len(find$), #PB_String_NoCase)
EndIf
EndProcedure
Procedure.b StringStartWith(string$, find$)
If string$ And find$
ProcedureReturn FindString(Mid(string$, 1, Len(find$)), find$, 1, #PB_String_NoCase)
EndIf
EndProcedure
Procedure.s MakeLabelString(label$, Map attribute.s())
Static regexInsertSpace, regexUnderscores
If regexInsertSpace=0
regexInsertSpace=CreateRegularExpression(#PB_Any, "[a-z][A-Z]")
regexUnderscores=CreateRegularExpression(#PB_Any, "_+")
EndIf
If FindMapElement(attribute(), "label")
label$=attribute("label")
DeleteMapElement(attribute(), "label")
Else
Protected Dim find$(0), replace$, i
label$=ReplaceRegularExpression(regexUnderscores, label$, " ")
If ExtractRegularExpression(regexInsertSpace, label$, find$())
For i=0 To ArraySize(find$())
replace$=Mid(find$(i), 1, 1)+" "+Mid(find$(i), 2, 1)
label$=ReplaceString(label$, find$(i), replace$)
Next
EndIf
EndIf
attribute("newlabel")=label$
ProcedureReturn #DQUOTE$+label$+#DQUOTE$
EndProcedure
Procedure.s ExtractAttributes(line$, Map attribute.s())
line$=Mid(line$, 3, Len(line$)-3)
Protected i, attr$, key$, value$, attrLine$
For i=1 To CountString(line$, ",")+1
attr$=StringField(line$, i, ",")
key$=LCase(Trim(StringField(attr$, 1, ":")))
value$=Mid(attr$, FindString(attr$, ":")+1)
attribute(key$)=value$
Select key$
Case "x", "y", "w", "h", "lw", "dy"
If attrLine$ : attrLine$+" : " : EndIf
attrLine$+key$+"="+value$
EndSelect
Next
If attrLine$
ProcedureReturn #LF$+attrLine$
EndIf
EndProcedure
Procedure.s ExtractPropertyType(line$, Map attribute.s())
Protected propertyType$=LCase(Trim(StringField(line$, 2, ".")))
If FindString(line$, "$")
propertyType$="s"
ElseIf StringStartWith(propertyType$, "s{") And StringEndWith(propertyType$, "}")
attribute("max")=Trim(Mid(propertyType$, 3, Len(propertyType$)-3))
propertyType$="s"
EndIf
ProcedureReturn propertyType$
EndProcedure
Procedure AddLabel(Map property.s(), Map attribute.s())
If attribute("nolabel")
attribute("nolabel")=#NULL$
Else
If attribute("newlabel")
property("var")+", lblPropertyName"
property("label")=#LF$+"lblPropertyName=TextGadget(#PB_Any, x, y, lw, h, PropertyLabel$)"
EndIf
property("gadget")=ReplaceString(property("gadget"), ", x,", ", x+lw,")
property("gadget")=ReplaceString(property("gadget"), ", w,", ", w-lw,")
EndIf
EndProcedure
Procedure GenerateCode()
Protected NewMap view.s()
Protected NewMap property.s()
Protected NewMap attribute.s()
Protected text$=ReplaceString(GetGadgetText(editCode), #CR$, #LF$)
Protected lineCount=CountString(text$, #LF$)
Protected lineNumber
Protected line$
For lineNumber=1 To lineCount
line$=StringField(text$, lineNumber, #LF$)
line$=Trim(ReplaceString(line$, #TAB$, " "))
If line$="" : Continue : EndIf
If attribute("hidden")
attribute("hidden")=#NULL$
ElseIf StringStartWith(line$, ";[") And StringEndWith(line$, "]")
view("create")+ExtractAttributes(line$, attribute())
ElseIf StringStartWith(line$, "structure")
Else
Protected propertyName$=Trim(StringField(line$, 1, "."))
Protected propertyVar$=ReplaceString(propertyName$, "$", "")
Protected propertyType$=ExtractPropertyType(line$, attribute())
Protected propertyLabel$=MakeLabelString(propertyVar$, attribute())
ClearMap(property())
Select propertyType$
Case "b"
property("var")="checkPropertyName"
property("gadget")=#LF$+"checkPropertyName=CheckBoxGadget(#PB_Any, x, y, w, h, PropertyLabel$)"+
":y+dy+h"
property("load")=#LF$+"SetGadgetState(checkPropertyName,#PB_Checkbox_Checked * Bool(\PropertyName))"
property("save")=#LF$+"\PropertyName=Bool(GetGadgetState(checkPropertyName)=#PB_CheckBox_Checked)"
Case "s"
property("var")="strPropertyName"
property("gadget")=#LF$+"strPropertyName=StringGadget(#PB_Any, x, y, w, h, #NULL$)"+
":y+dy+h"
AddLabel(property(), attribute())
property("max")+#LF$+"SetGadgetAttribute(strPropertyName,#PB_String_MaximumLength,"+attribute("max")+")"
property("load")=#LF$+"SetGadgetText(strPropertyName,\PropertyName)"
property("save")=#LF$+"\PropertyName=GetGadgetText(strPropertyName)"
Case "f", "d"
property("var")="strPropertyName"
property("gadget")=#LF$+"strPropertyName=StringGadget(#PB_Any, x, y, w, h, #NULL$,#PB_String_Numeric)"+
":y+dy+h"
AddLabel(property(), attribute())
property("load")=#LF$+"SetGadgetText(strPropertyName,Str(\PropertyName))"
property("save")=#LF$+"\PropertyName=Val(GetGadgetText(strPropertyName))"
Case "c", "u", "w"
;TODO
Case "l", "i", "q"
If StringEndWith(propertyName$, "Date")
property("var")="spnPropertyName"
property("gadget")=#LF$+"dtPropertyName=DateGadget(#PB_Any, x, y, w, h)"+
":y+dy+h"
AddLabel(property(), attribute())
property("min")+#LF$+"SetGadgetAttribute(dtPropertyName,#PB_Date_Minimum,"+ParseDate(attribute("mask"),attribute("min"))+")"
property("max")+#LF$+"SetGadgetAttribute(dtPropertyName,#PB_Date_Maximum,"+ParseDate(attribute("mask"),attribute("max"))+")"
property("load")=#LF$+"SetGadgetState(dtPropertyName,\PropertyName)"
property("save")=#LF$+"\PropertyName=GetGadgetState(dtPropertyName)"
ElseIf StringEndWith(propertyName$, "Color")
;TODO
Else
property("var")="spnPropertyName"
property("gadget")=#LF$+"spnPropertyName=SpinGadget(#PB_Any, x, y, w, h, #MINLONG, #MAXLONG,#PB_Spin_Numeric)"+
":y+dy+h"
AddLabel(property(), attribute())
property("min")+#LF$+"SetGadgetAttribute(spnPropertyName,#PB_Spin_Minimum,"+attribute("min")+")"
property("max")+#LF$+"SetGadgetAttribute(spnPropertyName,#PB_Spin_Maximum,"+attribute("max")+")"
property("load")=#LF$+"SetGadgetState(spnPropertyName,\PropertyName)"
property("save")=#LF$+"\PropertyName=GetGadgetState(spnPropertyName)"
EndIf
Default
Continue
EndSelect
ForEach property()
property()=ReplaceString(property(), "PropertyLabel$", propertyLabel$)
property()=ReplaceString(property(), "\PropertyName", "\"+propertyName$)
property()=ReplaceString(property(), "PropertyName", propertyVar$)
Next
If property("var")
If view("var") : view("var")+", " : EndIf
view("var")+property("var")
EndIf
view("create")+property("label")+property("gadget")
If attribute("min") : view("create")+property("min") : attribute("min")=#NULL$ : EndIf
If attribute("max") : view("create")+property("max") : attribute("max")=#NULL$ : EndIf
view("load")+property("load")
view("save")+property("save")
EndIf
Next
view("var")=#LF$+"Define.i "+view("var")+
#LF$+"Define.i x,y,w,h,lw,dy"
SetGadgetText(editCode, view("var")+
#LF$+#LF$+";======== GADGETS "+
view("create")+
#LF$+#LF$+";======== LOADING DATA "+
view("load")+#LF$+
#LF$+#LF$+";======== SAVE DATA "+
view("save"))
EndProcedure