A class replacement for enumerations in RealBasic
purpose enumerations are useful, but in RB some abilities are lacking, namely access to its items as a list. This prevents automatically filling menus with your enums (have to manually add each row) or getting the name of a particular one (have to select case). Using a dictionary for mapping name to value loses one of the main features of enumerations: autocomplete.
design intents 1) items autocomplete 2) easy to specify/edit the enums 3) preserves list order 4) works as much like an RB enum with the extra ability to access a list of the enums.
dense design overview The psuedo-enumerations are made as singleton class instances. Each enumeration is represented by a Shared function that returns it's same instance when called. Each instance stores it's name and value, plus their accessor methods. The constuctor is protected so enums can't be made willy nilly outside the enum class.
A super class EnumSuper defines the instance items (mName, mValue, name(), value(), Constructor()) and any utility methods (so far only buildPopupMenu). A subclass of EnumSuper acts like an RB enum. Shared Functions are added in a specific but easy and concise way that defines the enumerations.
usage overview To create an enum type named "BlendTypes" make a subclass of EnumSuper and name the class "BlendTypes". Then add this method (return type and array type set to the class name).
Shared Function buildEnumList() As BlendTypes() dim ea() As BlendTypes //...append return ea End Function
Now adding an enumeration like "feather = 4" is a 2 step process...
1) Add a method following this template. This is what autocompletes as you type "BlendTypes.feat...". The use of static instead of dim means only a single instance is ever made with the name and value specified.
Shared Function feather() As BlendTypes static e As new BlendTypes("feather", 4) return e End Function
2) in buildEnumList add this line where the append comment is.
That's it. Now you can write...
dim e As BlendTypes = BlendTypes.feather //get enum if e = BlendTypes.feather then beep //compare enum MsgBox e.name + " : " + Str(e.value) //show name and value //fill PopupMenu, name as row text, enum itself in RowTag EnumSuper.buildPopupMenu(BlendTypes.buildEnumList, PopupMenu1) e = PopupMenu1.RowTag(PopupMenu1.ListIndex) //get enum from Popup
Class EnumSuper Protected mName As String Protected mValue As Integer Protected Sub Constructor(newName As String, newValue As integer) mName = newName mValue = newValue End Sub Function name() As String return mName End Function Function value() As integer return mValue End Function Shared Sub buildPopupMenu(enums() As EnumSuper, pm As PopupMenu) pm.DeleteAllRows for i As integer = 0 to enums.Ubound pm.AddRow enums(i).mName pm.RowTag(i) = enums(i) next End Sub End Class
Definition of a template subclass
Class TemplateEnumName Inherits EnumSuper Shared Function buildEnumList() As TemplateEnumName() dim ea() As TemplateEnumName 'ea.Append 'ea.Append 'ea.Append 'ea.Append return ea End Function Shared Function enumerationName() As TemplateEnumName static e As new TemplateEnumName("enumerationName", enumerationValue) return e End Function End Class
Experimental In addition I've made 3 methods that can be added to EnumSuper that will auto-generate a class file given a definition in this format
enum BlendTypes feather = 4 crisp = 7 granular = 2 end enum
Two of the methods are smallish utitlies and the other is a massive process that is early alpha quality. Here's the experimental code followed with some notes.
makeNode wraps common XML appending
Protected Shared Function makeNode(doc As XmlDocument, parentNode As XmlNode, nodeName As String, innerText As String = "") As XmlNode dim n As XmlNode = parentNode.AppendChild(doc.CreateElement(nodeName)) if innerText <> "" then n.AppendChild(doc.CreateTextNode(innerText)) end return n End Function
makeMethod wraps commonalities of writing a method node
Protected Shared Sub makeMethod(doc As XmlDocument, block As XmlNode, methName As String, methParams As String, methResult As String, sourceLines() As String) dim funOrSub As String = "Sub" dim asRes As String = "" if methResult <> "" then funOrSub = "Function" asRes = " As " end dim meth, src As XmlNode meth = makeNode(doc, block, "Method") call makeNode(doc, meth, "ItemName", methName) src = makeNode(doc, meth, "ItemSource") call makeNode(doc, src, "SourceLine", _ "Shared " + funOrSub + " " + methName + "(" + methParams + ")" + asRes + methResult) for i As integer = 0 to sourceLines.Ubound call makeNode(doc, src, "SourceLine", sourceLines(i)) next call makeNode(doc, src, "SourceLine", "End " + funOrSub) call makeNode(doc, meth, "Shared", "1") call makeNode(doc, meth, "ItemParams", methParams) call makeNode(doc, meth, "ItemResult", methResult) End Sub
createEnumClassFile. little error testing and unsure about encodings. pass in text to turn into a class file, or pass in nothing and Clipboard text is used. A file with the extracted enum name + ".xml" is written to the desktop. Drag the file into your project pane to import the class.
Shared Sub createEnumClassFile(inputText As String = "") //=================================================== get input dim formattedEnumText As String = inputText.Trim if formattedEnumText = "" then 'get from Clipboard dim c As new Clipboard formattedEnumText = c.Text.Trim c.Close end //==============================================first test if formattedEnumText = "" then MsgBox "no input" return end //=============================================fix encoding? formattedEnumText = DefineEncoding(formattedEnumText, Encodings.UTF16LE) formattedEnumText = ConvertEncoding(formattedEnumText, Encodings.UTF8) //=================================== parse input to enum parts dim enumClassName, enumNames(), enumValues() As String //<< building these formattedEnumText = formattedEnumText.ReplaceAll("'", "") dim ta() As String = formattedEnumText.Split(EndOfLine) dim nextAutoGen As integer = 0 dim usedAutoValues() As integer for i As integer = 0 to ta.Ubound if ta(i).Trim.Left(5) = "enum " then //the enums class name enumClassName = ta(i).Right(ta(i).Len - ta(i).InStr("enum") - 4).Trim //crazy extract elseif ta(i).Trim.Left(8) = "end enum" then //end exit for i elseif ta(i).Trim = "" then //empty continue for i else 'seems we have a line dim sa() As String = ta(i).Split("=") //split to name|value if sa.Ubound = 1 then //have both enumNames.Append sa(0).Trim enumValues.Append sa(1).Trim if IsNumeric(sa(1).Trim) then usedAutoValues.Append Val(sa(1).Trim) elseif sa.Ubound = 0 then //only name enumNames.Append sa(0).Trim while usedAutoValues.IndexOf(nextAutoGen) >= 0 nextAutoGen = nextAutoGen + 1 wend enumValues.Append Str(nextAutoGen) usedAutoValues.Append nextAutoGen else //have 0 or 3 or more ? end end next //can test if any spaces in name or value then bad format //========================================= test parse if enumClassName = "" then MsgBox "bad parse, no name" return end //==================================================== get file dim f As FolderItem = SpecialFolder.Desktop.Child(enumClassName + ".xml") if f.Exists then MsgBox """" + f.name + """ already exists, not overwriting" return end //=============================================== create xml //setup class root block dim doc As new XmlDocument dim RBProj As XmlNode = makeNode(doc, doc, "RBProject") dim block As XmlNode = makeNode(doc, RBProj, "block") block.SetAttribute("type", "Module") //add class info call makeNode(doc, block, "ObjName", enumClassName) call makeNode(doc, block, "IsClass", "1") call makeNode(doc, block, "SuperClass", "EnumSuper") call makeNode(doc, block, "IsInterface", "0") //add pseudo enum functions dim sa() As String for i As integer = 0 to enumNames.Ubound redim sa(-1) sa.Append "static e As new " + enumClassName + "(""" + enumNames(i) + """, " + enumValues(i) + ")" sa.Append "return e" makeMethod(doc, block, enumNames(i), "", enumClassName, sa) next //add buildPopupMenu redim sa(-1) sa.Append "dim ea() As EnumSuper" for i As integer = 0 to enumNames.Ubound sa.Append "ea.Append " + enumNames(i) next sa.Append "Super.buildPopupMenu(pm, ea)" makeMethod(doc, block, "buildPopupMenu", "pm As PopupMenu", "", sa) //================================================ write file doc.SaveXml(f) beep //========================= drag file into project End Sub
Having a real moment of deja-vu. I think someone else did this and I forget and now the code has percolated back.
