Code archives/3D Graphics - Misc/F-UI GUI XML Loader
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
Basically, this loads a GUI layout from an XML file. This is useful for giving users of your applications the option to modify the user interface of your application to suit your needs. An example XML file: <Root> <Window X="128" Y="128" Width="640" Height="480" Caption="Weeble"> <MenuTitle caption="File"> <MenuItem caption="New.."> <MenuItem caption="Lotus Emitter"/> <MenuItem caption="Scene"/> </MenuItem> <MenuItem caption="Save"/> <MenuItem caption="Save as.."/> <MenuBar/> <MenuItem caption="Exit" name="mnuQuit"/> </MenuTitle> <Button X="4" Y="64" Width="64" Height="24" Caption="Foobar"/> </Window> </Root> An example .BB file for loading the XML document: WINDOW_RESIZE_METHOD = 0 RENDER_MODE = 0 SKIN_ENABLED = 0 FUI_Initialise(1024,769,32,2,0,1,"XML GUI","1.8") FUI_LoadGUI("GUI.xml") Repeat FUI_Update() For e.Event = Each Event Select e\EventID Case FUI_GetGadget("mnuQuit") app\Quit = 1 Default End Select Delete e Next UpdateWorld RenderWorld Flip True Until app\Quit = 1 FUI_Destroy() | |||||
;#Region XMLGui.bb ;#Region CLASSES Type FUI_XMLGadget Field Name$ Field Gadget End Type Global LED_ColorMode=1 ;#End Region ;#Region PROCEDURES Function FUI_LoadGUI(Path$) If FileType(Path) <> 1 Then RuntimeError "Failed to load GUI '"+Path+"'" node.XMLNode = ReadXML(Path) root.XMLNode = node While(node <> Null) FUI_ParseXMLGUI(node) node = XMLNextNode(node) Wend XMLCloseNode(root) Return 1 End Function Function FUI_ParseXMLGUI(node.XMLNode,owner=0) If node = Null Then Return Local X%,Y%,Width%,Height%,Caption$,Name$ Local F1#,F2#,F3#,F4#,F5#,F6#,F7# Local I1%,I2%,I3%,I4%,I5%,I6%,I7% Local Icon$,Shortcut$,DType%=DTYPE_INTEGER,Alpha#=1 Local Flags Local a.XMLAttr = XMLGetFirstAttribute(node) While (a <> Null) Select Lower(a\name) Case "x" X = a\value Case "y" Y = a\value Case "height" Height = a\value Case "width" Width = a\value Case "caption" Caption = a\value Case "name" Name = a\value Case "id" I1 = a\value Case "checked" I1 = a\value Case "dispitems" I4 = a\value Case "checkable" I2 = a\value Case "checked" I3 = a\value Case "shortcut" Shortcut = a\value Case "image" Shortcut = a\value Case "align" I1 = ((Lower(a\value)="center")*ALIGN_CENTER Or (Lower(a\value)="left")*ALIGN_LEFT Or (Lower(a\value)="right")*ALIGN_RIGHT) Case "multisel" I1 = a\value Case "forcesel" I2 = a\value Case "min" F1 = a\value Case "max" F2 = a\value Case "value" F3 = a\value Case "dtype" DType = ((Lower(a\value)="integer")*DTYPE_INTEGER Or (Lower(a\value)="float")*DTYPE_FLOAT) Case "scrollw" I1 = a\value Case "direction" I2 = ((Lower(a\value)="horizontal")*DIR_HORIZONTAL Or (Lower(a\value)="vertical")*DIR_VERTICAL) Case "inc" F4 = a\value Case "append" Shortcut = a\value Case "maxlength" I1 = a\value Case "flags" Flags = a\value Case "buttons" I2 = a\value Case "alpha" Alpha# = a\value Case "red","r" I1 = a\value Case "green","g" I2 = a\value Case "blue","b" I3 = a\value Case "bitsperpixel" I1 = a\value Case "fullscreen" I2 = Not Int a\value + 1 Case "windowed" I2 = Int a\value + 1 Case "locked" Locked = a\value Case "colormode" LED_ColorMode=Int a\value - 1 End Select a = XMLGetNextAttribute(a) Wend Select Lower(node\tag) Case "window" If Flags=0 Then Flags=WS_TITLEBAR Or WS_ALLBUTTONS gad = FUI_Window(X,Y,Width,Height,Caption,Icon,Flags,I2) FUI_LockWindow(gad,Locked) Case "button" If Flags=0 Then Flags=CS_BORDER gad = FUI_Button(owner,X,Y,Width,Height,Caption,Icon,I1,Flags) Case "groupbox" gad = FUI_GroupBox(owner,X,Y,Width,Height,Caption) Case "listbox" gad = FUI_ListBox(owner,X,Y,Width,Height,I1,I2) Case "listboxitem" gad = FUI_ListBoxItem(owner,Caption,Icon) Case "treeview" gad = FUI_TreeView(owner,X,Y,Width,Height) Case "treeviewnode" gad = FUI_TreeViewNode(owner,Caption) Case "combobox" gad = FUI_ComboBox(owner,X,Y,Width,Height,I4) Case "comboboxitem" gad = FUI_ComboBoxItem(owner,Caption,Icon) Case "label" gad = FUI_Label(owner,X,Y,Caption,I1) Case "slider" gad = FUI_Slider(owner,X,Y,Width,Height,F1,F2,F3,I1,I2) Case "menubar" gad = FUI_MenuBar(owner) Case "menuitem" gad = FUI_MenuItem(owner,Caption,Shortcut,Icon,I2,I3,I1) Case "menutitle" gad = FUI_MenuTitle(owner,Caption,Width) Case "panel" gad = FUI_Panel(owner,X,Y,Width,Height,Caption) Case "progressbar" gad = FUI_ProgressBar(owner,X,Y,Width,Height,F1,F2,F3,DType) Case "radio" gad = FUI_Radio(owner,X,Y,Caption,I3,I1) Case "checkbox" gad = FUI_CheckBox(owner,X,Y,Caption,I3) Case "spinner" gad = FUI_Spinner(owner,X,Y,Width,Height,F1,F2,F3,F4,DType,Shortcut) Case "tab" gad = FUI_Tab(owner,X,Y,Width,Height) Case "tabpage" gad = FUI_TabPage(owner,Caption,Icon) Case "view" gad = FUI_View(owner,X,Y,Width,Height,I1,I2,I3) Case "textobx" gad = FUI_TextBox(owner,X,Y,Width,Height,I1) Case "skinpath" SKIN_PATH = node\value Case "skinenabled" SKIN_ENABLED = node\value Case "gui" If Width = 0 Or Height = 0 Then Width = 1024 Height = 768 If I1 = 0 Then I1 = 32 If I2 = 0 Then I2 = 2 FUI_Initialise(Width,Height,I1,I2,0,1,"LotusEd R2","1.8") SetupColors(LED_ColorMode) End Select If gad <> 0 Then g.FUI_XMLGadget = New FUI_XMLGadget g\Name = Name g\Gadget = gad If Alpha <> 1 Then FUI_SetGadgetAlpha(gad,Alpha,1) EndIf node = XMLGetChild(node,0) While(node <> Null) FUI_ParseXMLGUI(node,gad) node = XMLNextNode(node) Wend End Function Function FUI_GetGadget(name$) name = Lower(name) For g.FUI_XMLGadget = Each FUI_XMLGadget If Lower(g\Name) = name Then Return g\Gadget Next Return -1 End Function ;;; Add your own color schemes to this function Function SetupColors(Mode=1) If Mode=0 SC_FORM=FUI_RGBToInt(75,82,93) SC_FORM_BORDER=FUI_RGBToInt(0,0,0) SC_TITLEBAR=FUI_RGBToInt(255,155,48) SC_TITLEBAR_TEXT=FUI_RGBToInt(24,55,80) SC_MENUBAR=FUI_RGBToInt(51,55,60) SC_MENUBAR_BORDER=FUI_RGBToInt(32,32,32) SC_STATUSBAR=FUI_RGBToInt(75,82,93) SC_STATUSBAR_TEXT=FUI_RGBToInt(255,155,48) SC_STATUSBAR_BORDER=FUI_RGBToInt(32,32,32) SC_MENUTITLE=FUI_RGBToInt(75,82,93) SC_MENUTITLE_OVER=FUI_RGBToInt(66,120,164) SC_MENUTITLE_SEL=FUI_RGBToInt(66,120,164) SC_MENUTITLE_TEXT=FUI_RGBToInt(255,171,61) SC_MENUTITLE_TEXT_OVER=FUI_RGBToInt(48,46,45) SC_MENUTITLE_TEXT_SEL=FUI_RGBToInt(48,46,45) SC_MENUTITLE_BORDER=FUI_RGBToInt(0,0,0) SC_MENUTITLE_BORDER_OVER=FUI_RGBToInt(0,0,0) SC_MENUTITLE_BORDER_SEL=FUI_RGBToInt(0,0,0) SC_MENUITEM=FUI_RGBToInt(75,82,93) SC_MENUITEM_OVER=FUI_RGBToInt(66,120,164) SC_MENUITEM_SEL=FUI_RGBToInt(66,120,164) SC_MENUITEM_TEXT=FUI_RGBToInt(255,171,61) SC_MENUITEM_TEXT_OVER=FUI_RGBToInt(48,46,45) SC_MENUITEM_TEXT_SEL=FUI_RGBToInt(48,46,45) SC_MENUITEM_BORDER=FUI_RGBToInt(0,0,0) SC_MENUITEM_BORDER_OVER=FUI_RGBToInt(0,0,0) SC_MENUITEM_BORDER_SEL=FUI_RGBToInt(0,0,0) SC_MENUDROPDOWN=FUI_RGBToInt(75,82,93) SC_MENUDROPDOWN_BORDER=FUI_RGBToInt(0,0,0) SC_MENUDROPDOWN_STRIP=FUI_RGBToInt(255,171,61) SC_TOOLTIP=FUI_RGBToInt(75,82,93) SC_TOOLTIP_BORDER=FUI_RGBToInt(0,0,0) SC_TOOLTIP_TEXT=FUI_RGBToInt(255,171,61) SC_GADGET =FUI_RGBToInt(75,82,93) SC_GADGET_TEXT =FUI_RGBToInt(255,171,61) SC_GADGET_COLOR =FUI_RGBToInt(75,82,93) SC_GADGET_COLOR_TEXT =FUI_RGBToInt(255,171,61) SC_GADGET_BORDER =FUI_RGBToInt(0,0,0) SC_INPUT=FUI_RGBToInt(32,45,64) SC_INPUT_TEXT=FUI_RGBToInt(255,171,61) SC_INPUT_COLOR=FUI_RGBToInt(32,45,64) SC_INPUT_COLOR_TEXT=FUI_RGBToInt(255,171,61) SC_INPUT_BORDER=FUI_RGBToInt(0,0,0) ElseIf Mode=1 Then SC_FORM=FUI_RGBToInt(242,240,238) SC_FORM_BORDER=FUI_RGBToInt(32,32,32) SC_TITLEBAR=FUI_RGBToInt(15,128,206) SC_TITLEBAR_TEXT=FUI_RGBToInt(255,255,255) SC_MENUBAR=FUI_RGBToInt(245,244,240) SC_MENUBAR_BORDER=FUI_RGBToInt(32,32,32) SC_STATUSBAR=FUI_RGBToInt(245,244,240) SC_STATUSBAR_TEXT=FUI_RGBToInt(0,0,0) SC_STATUSBAR_BORDER=FUI_RGBToInt(64,64,64) SC_MENUTITLE=FUI_RGBToInt(255,197,128) SC_MENUTITLE_OVER=FUI_RGBToInt(255,197,128) SC_MENUTITLE_SEL=FUI_RGBToInt(255,197,128) SC_MENUTITLE_TEXT=FUI_RGBToInt(0,0,0) SC_MENUTITLE_TEXT_OVER=FUI_RGBToInt(0,0,0) SC_MENUTITLE_TEXT_SEL=FUI_RGBToInt(0,0,0) SC_MENUTITLE_BORDER=FUI_RGBToInt(0,0,0) SC_MENUTITLE_BORDER_OVER=FUI_RGBToInt(255,255,255) SC_MENUTITLE_BORDER_SEL=FUI_RGBToInt(255,255,255) SC_MENUITEM=FUI_RGBToInt(255,197,128) SC_MENUITEM_OVER=FUI_RGBToInt(255,197,128) SC_MENUITEM_SEL=FUI_RGBToInt(255,197,128) SC_MENUITEM_TEXT=FUI_RGBToInt(0,0,0) SC_MENUITEM_TEXT_OVER=FUI_RGBToInt(0,0,0) SC_MENUITEM_TEXT_SEL=FUI_RGBToInt(0,0,0) SC_MENUITEM_BORDER=FUI_RGBToInt(0,0,0) SC_MENUITEM_BORDER_OVER=FUI_RGBToInt(255,255,255) SC_MENUITEM_BORDER_SEL=FUI_RGBToInt(255,255,255) SC_MENUDROPDOWN=FUI_RGBToInt(242,240,238) SC_MENUDROPDOWN_BORDER=FUI_RGBToInt(0,0,0) SC_MENUDROPDOWN_STRIP=FUI_RGBToInt(21,119,218) SC_TOOLTIP=FUI_RGBToInt(252,242,202) SC_TOOLTIP_BORDER=FUI_RGBToInt(0,0,0) SC_TOOLTIP_TEXT=FUI_RGBToInt(0,0,0) SC_GADGET=FUI_RGBToInt(250,248,246) SC_GADGET_TEXT=FUI_RGBToInt(0,0,0) SC_GADGET_COLOR=FUI_RGBToInt(250,248,246) SC_GADGET_COLOR_TEXT=FUI_RGBToInt(0,0,0) SC_GADGET_BORDER=FUI_RGBToInt(0,0,0) SC_INPUT=FUI_RGBToInt(255,255,255) SC_INPUT_TEXT=FUI_RGBToInt(0,0,0) SC_INPUT_COLOR=FUI_RGBToInt(255,255,255) SC_INPUT_COLOR_TEXT=FUI_RGBToInt(0,0,0) SC_INPUT_BORDER=FUI_RGBToInt(0,0,0) ElseIf Mode=2 Then SC_FORM=FUI_RGBToInt(80,74,90) SC_FORM_BORDER=FUI_RGBToInt(32,32,32) SC_TITLEBAR=FUI_RGBToInt(179,247,41) SC_TITLEBAR_TEXT=FUI_RGBToInt(0,0,0) SC_MENUBAR=FUI_RGBToInt(80,74,90) SC_MENUBAR_BORDER=FUI_RGBToInt(32,32,32) SC_STATUSBAR=FUI_RGBToInt(80,74,90) SC_STATUSBAR_TEXT=FUI_RGBToInt(180,255,57) SC_STATUSBAR_BORDER=FUI_RGBToInt(64,64,64) SC_MENUTITLE=FUI_RGBToInt(96,66,173) SC_MENUTITLE_OVER=FUI_RGBToInt(96,66,173) SC_MENUTITLE_SEL=FUI_RGBToInt(96,66,173) SC_MENUTITLE_TEXT=FUI_RGBToInt(180,255,57) SC_MENUTITLE_TEXT_OVER=FUI_RGBToInt(180,255,57) SC_MENUTITLE_TEXT_SEL=FUI_RGBToInt(180,255,57) SC_MENUTITLE_BORDER=FUI_RGBToInt(0,0,0) SC_MENUTITLE_BORDER_OVER=FUI_RGBToInt(0,0,0) SC_MENUTITLE_BORDER_SEL=FUI_RGBToInt(0,0,0) SC_MENUITEM=FUI_RGBToInt(96,66,173) SC_MENUITEM_OVER=FUI_RGBToInt(96,66,173) SC_MENUITEM_SEL=FUI_RGBToInt(96,66,173) SC_MENUITEM_TEXT=FUI_RGBToInt(180,255,57) SC_MENUITEM_TEXT_OVER=FUI_RGBToInt(180,255,57) SC_MENUITEM_TEXT_SEL=FUI_RGBToInt(180,255,57) SC_MENUITEM_BORDER=FUI_RGBToInt(0,0,0) SC_MENUITEM_BORDER_OVER=FUI_RGBToInt(0,0,0) SC_MENUITEM_BORDER_SEL=FUI_RGBToInt(0,0,0) SC_MENUDROPDOWN=FUI_RGBToInt(80,74,90) SC_MENUDROPDOWN_BORDER=FUI_RGBToInt(0,0,0) SC_MENUDROPDOWN_STRIP=FUI_RGBToInt(180,255,57) SC_TOOLTIP=FUI_RGBToInt(80,74,90) SC_TOOLTIP_BORDER=FUI_RGBToInt(0,0,0) SC_TOOLTIP_TEXT=FUI_RGBToInt(180,255,57) SC_GADGET=FUI_RGBToInt(80,74,90) SC_GADGET_TEXT=FUI_RGBToInt(180,255,57) SC_GADGET_COLOR=FUI_RGBToInt(80,74,90) SC_GADGET_COLOR_TEXT=FUI_RGBToInt(180,255,57) SC_GADGET_BORDER=FUI_RGBToInt(0,0,0) SC_INPUT=FUI_RGBToInt(40,37,45) SC_INPUT_TEXT=FUI_RGBToInt(180,255,57) SC_INPUT_COLOR=FUI_RGBToInt(40,37,45) SC_INPUT_COLOR_TEXT=FUI_RGBToInt(180,255,57) SC_INPUT_BORDER=FUI_RGBToInt(0,0,0) EndIf End Function ;#End Region ;#End Region ;#Region LotusXML.bb ;#Region DESCRIPTION ; XML load / parse / save functions ; Written by Blitztastic, butchered by Noel Cower ;#End Region ;#Region CLASSES Type XMLnodelist Field node.XMLnode Field nextnode.XMLnodelist Field prevnode.XMLnodelist End Type ; for internal use, do not use in code outside of this file Type XMLworklist Field node.XMLnode End Type Type XMLnode Field tag$,value$,path$ Field firstattr.XMLattr Field lastattr.XMLattr Field attrcount,fileid Field endtag$ ; linkage functionality Field firstchild.XMLnode Field lastchild.XMLnode Field childcount Field nextnode.XMLnode Field prevnode.XMLnode Field parent.XMLnode End Type Type XMLattr Field name$,value$ Field sibattr.XMLattr Field parent.XMLnode End Type Global XMLFILEID ;#End Region ;#Region PROCEDURES Function ReadXML.XMLnode(filename$) infile = ReadFile(filename$) XMLFILEID=MilliSecs() x.XMLnode = XMLReadNode(infile,Null) CloseFile infile Return x End Function Function WriteXML(filename$,node.XMLnode,writeroot=False) outfile = WriteFile(filename$) WriteLine outfile,"<?xml version="+Chr$(34)+"1.0"+Chr$(34)+" ?>" XMLwriteNode(outfile,node) CloseFile outfile End Function Function XMLOpenNode.XMLnode(parent.XMLnode,tag$="") x.XMLnode = New XMLnode x\tag$=tag$ x\fileid = XMLFILEID; global indicator to group type entries (allows multiple XML files to be used) XMLaddNode(parent,x) Return x End Function Function XMLCloseNode.XMLnode(node.XMLnode) Return node\parent End Function ; adds node to end of list (need separate function for insert, or mod this on) Function XMLAddNode(parent.XMLnode,node.XMLnode) If parent <> Null If parent\childcount = 0 Then parent\firstchild = node Else parent\lastchild\nextnode = node End If node\prevnode = parent\lastchild parent\lastchild = node parent\childcount = parent\childcount +1 node\path$ = parent\path$+parent\tag$ End If node\parent = parent node\path$=node\path$+"/" End Function Function XMLDeleteNode(node.XMLnode) n.XMLnode = node\firstchild ; delete any children recursively While n <> Null nn.XMLnode= n\nextnode XMLdeletenode(n) n = nn Wend ; delete attributes for this node a.XMLattr = node\firstattr While a <> Null na.XMLattr = a\sibattr Delete a a = na Wend ; dec parents child count If node\parent <> Null node\parent\childcount = node\parent\childcount -1 ; heal linkages If node\prevnode <> Null Then node\prevnode\nextnode = node\nextnode If node\nextnode <> Null Then node\nextnode\prevnode = node\prevnode If node\parent\firstchild = node Then node\parent\firstchild = node\nextnode If node\parent\lastchild = node Then node\parent\lastchild = node\prevnode End If ; delete this node Delete node End Function ; node functions Function XMLfindNode.XMLnode(node.XMLnode,path$) ret.XMLnode = Null p=Instr(path$,"/") If p > 0 Then tag$=Left$(path$,p-1) a.XMLnode = node While ret=Null And a<>Null If Lower(tag$)=Lower(a\tag$) Then If p=Len(path$) Then ret = a Else If a\firstchild <> Null Then ret = XMLfindnode(a\firstchild,Mid$(path$,p+1)) End If End If End If a = a\nextnode Wend End If Return ret End Function Function XMLDeleteList(nl.XMLnodelist) While nl <> Null na.XMLnodelist = nl\nextnode Delete nl nl = na Wend End Function Function XMLSelectNodes.XMLnodelist(node.XMLnode,path$,recurse=True) root.XMLnodelist=Null XMLselectnodesi(node,path$,recurse) prev.XMLnodelist=Null c = 0 For wl.XMLworklist = Each XMLworklist c = c + 1 nl.XMLnodelist = New XMLnodelist nl\node = wl\node If prev = Null Then root = nl prev = nl Else prev\nextnode = nl nl\prevnode = prev End If prev = nl Delete wl Next ;gak debuglog "XML: "+c+" nodes selected" Return root End Function ; internal selection function, do not use outside this file Function XMLSelectNodesI(node.XMLnode,path$,recurse=True) wl.XMLworklist=Null If node = Null Then End If ret.XMLnode = Null p=Instr(path$,"/") If p > 0 Then tag$=Left$(path$,p-1) a.XMLnode = node While a<>Null If Lower(path$)=Lower(Right$(a\path$+a\tag$+"/",Len(path$))) Then wl = New XMLworklist wl\node = a End If If a\firstchild <> Null And (recurse) Then XMLSelectNodesI(a\firstchild,path$) End If a = a\nextnode Wend End If End Function Function XMLNextNode.XMLnode(node.XMLnode) Return node\nextnode End Function Function XMLPrevNode.XMLnode(node.XMLnode) Return node\prevnode End Function Function XMLAddAttr(node.XMLnode,name$,value$) ;gak debuglog "XML:adding attribute "+name$+"="+value$+" ("+Len(value$)+")" a.XMLattr = New XMLattr a\name$ = name$ a\value$ = value$ If node\attrcount = 0 Then node\firstattr = a Else node\lastattr\sibattr = a End If node\lastattr=a node\attrcount = node\attrcount + 1 a\parent = node If Upper(a\value)="TRUE" a\value=1 If Upper(a\Value)="FALSE" a\value=0 If Upper(a\Value)="GRAPHICSWIDTH" a\value=GraphicsWidth() If Upper(a\Value)="GRAPHICSHEIGHT" a\value=GraphicsHeight() End Function Function XMLReadNode.XMLnode(infile,parent.XMLnode,pushed=False) mode = 0 root.XMLnode = Null cnode.XMLnode = Null x.XMLnode = Null ispushed = False done = False While (Not done) And (Not Eof(infile)) c = ReadByte(infile) If c<32 Then c=32 ch$=Chr$(c) ; ;gak debuglog "{"+ch$+"} "+c+" mode="+mode Select mode Case 0 ; looking for the start of a tag, ignore everything else If ch$ = "<" Then mode = 1; start collecting the tag End If Case 1 ; check first byte of tag, ? special tag If ch$ = "?" Or ch$ = "!" Then mode = 0; class special nodes as garbage & consume Else If ch$ = "/" Then mode = 2 ; move to collecting end tag x\endtag$=ch$ ;gak debuglog "** found end tag" Else cnode=x x.XMLnode = XMLOpennode(cnode) If cnode=Null Then root=x x\tag$=ch$ mode = 3 ; move to collecting start tag End If End If Case 2 ; collect the tag name (close tag) If ch$=">" Then mode = 0 ; end of the close tag so jump out of loop ;done = True x = XMLclosenode(x) Else x\endtag$ = x\endtag$ + ch$ End If Case 3 ; collect the tag name If ch$=" " Then ;gak debuglog "TAG:"+x\tag$ mode = 4 ; tag name collected, move to collecting attributes Else If ch$="/" Then ;gak debuglog "TAG:"+x\tag$ x\endtag$=x\tag$ mode = 2; start/end tag combined, move to close Else If ch$=">" Then ;gak debuglog "TAG:"+x\tag$ mode = 20; tag closed, move to collecting value Else x\tag$ = x\tag$ + ch$ End If End If End If Case 4 ; start to collect attributes If Lower(ch$)>="a" And Lower(ch$)<="z" Then aname$=ch$; mode = 5; move to collect attribute name Else If ch$=">" Then x\value$="" mode = 20; tag closed, move to collecting value Else If ch$="/" Then mode = 2 ; move to collecting end tag x\endtag$=ch$ ;gak debuglog "** found end tag" End If End If End If Case 5 ; collect attribute name If ch$="=" Then ;gak debuglog "ATT:"+aname$ aval$="" mode = 6; move to collect attribute value Else aname$=aname$+ch$ End If Case 6 ; collect attribute value If c=34 Then mode = 7; move to collect string value Else If c <= 32 Then ;gak debuglog "ATV:"+aname$+"="+aval$ XMLAddAttr(x,aname$,aval$) mode = 4; start collecting a new attribute Else aval$=aval$+ch$ End If End If Case 7 ; collect string value If c=34 Then ;gak debuglog "ATV:"+aname$+"="+aval$ XMLADDattr(x,aname$,aval$) mode = 4; go and collect next attribute Else aval$=aval$+ch$ End If Case 20 ; COLLECT THE VALUE PORTION If ch$="<" Then ;gak debuglog "VAL:"+x\tag$+"="+x\value$ mode=1; go to tag checking Else x\value$=x\value$+ch$ End If End Select If Eof(infile) Then done=True Wend Return root End Function ; write out an XML node (and children) Function XMLWriteNode(outfile,node.XMLnode,tab$="") ; ;gak debuglog "Writing...."+node\tag$+".." s$="<"+node\tag$ a.XMLattr = node\firstattr While a<>Null s$ = s$+" "+Lower(a\name$)+"="+Chr$(34)+a\value$+Chr$(34) a = a\sibattr Wend If node\value$="" And node\childcount = 0 Then s$=s$+"/>" et$="" Else s$=s$+">"+node\value$ et$="</"+node\tag$+">" End If WriteLine outfile,XMLcleanStr$(tab$+s$) n.XMLnode = node\firstchild While n <> Null XMLwriteNode(outfile,n,tab$+" ") n = n\nextnode Wend If et$<> "" Then WriteLine outfile,XMLCleanStr$(tab$+et$) End Function ; remove non-visible chars from the output stream Function XMLCleanStr$(s$) a$="" For i = 1 To Len(s$) If Asc(Mid$(s$,i,1))>=32 Then a$ = a$ +Mid$(s$,i,1) Next Return a$ End Function ; attribute functions ; return an attribute of a given name Function XMLFindAttr.XMLattr(node.XMLnode,name$) ret.XMLattr = Null If node <> Null Then a.XMLattr = node\firstattr done = False While ret=Null And a<>Null If Lower(name$)=Lower(a\name$) Then ret = a End If a = a\sibattr Wend End If Return ret End Function ; return an attribute value as a string Function XMLAttrValueStr$(node.XMLnode,name$,dflt$="") ret$=dflt$ a.XMLattr = XMLfindattr(node,name$) If a <> Null Then ret$=a\value$ Return ret$ End Function ; return an attribute value as an integer Function XMLAttrValueInt(node.XMLnode,name$,dflt=0) ret=dflt a.XMLattr = XMLfindattr(node,name$) If a <> Null Then ret=a\value Return ret End Function ; return an attribute value as a float Function XMLAttrValueFloat#(node.XMLnode,name$,dflt#=0) ret#=dflt# a.XMLattr = XMLfindattr(node,name$) If a <> Null Then ret#=a\value Return ret End Function Function XMLHasChildren(node.XMLnode) Return node\firstchild <> Null End Function Function XMLHasAttributes(node.XMLnode) Return node\firstattr <> Null End Function Function XMLGetChild.XMLNode(node.XMLNode,index=0) child.XMLNode = node\FirstChild For i = 0 To index-1 child.XMLNode = child\nextnode Next Return child End Function Function XMLGetFirstAttribute.XMLAttr(node.XMLNode) Return node\firstattr End Function Function XMLGetNextAttribute.XMLAttr(attr.XMLAttr) Return attr\sibattr End Function Function XMLGetParent.XMLNode(node.XMLNode) Return node\parent End Function Function PrintXMLNode(i.XMLNode,start$="") If i = Null Then Return Write start+"<"+i\tag a.XMLAttr = XMLGetFirstAttribute(i) While a <> Null Write " "+a\name+"="+Chr(34)+a\value+Chr(34) a = XMLGetNextAttribute(a) Wend Write ">" Print "" f.XMLNode = XMLGetChild(i,0) While f.XMLNode <> Null PrintXMLNode(f,start+" ") f = XMLNextNode(f) Wend Print start+"</"+i\tag+">" End Function ;#End Region ;#End Region |
Comments
None.
Code Archives Forum