This version also includes the creation of the processUI() function.
1. Only includes button clicks
2. Uses IF statements, 'cos I'm not sure how stable SELECT/CASE is in DB Pro. For example, it doesn't like variables.
`Produces DarkBASIC Professional-compatible GUI code
function exportCodeDB(fileName as string)
local fileNum=1
local readStr as string
local parent as string
local lastParent as string
local gtext as string
` SV01 DELETE CODING
dim DelGadget() as STRING
` SV01 DELETE CODING
`Open file
if file exist(fileName) then delete file fileName
open to write fileNum,fileName
`Write Header
write string fileNum,"`User Interface Setup Code"
write string fileNum,"`Generated by Rainbow version " + RAINBOW_VERSION
write string fileNum,"`==========================================="
write string fileNum,"`Call createUI() to setup the user interface"
write string fileNum,"`-------------------------------------------"
`Write Declarations
write string fileNum,""
write string fileNum,"`Global Variable Declarations for Gadgets"
write string fileNum,"`----------------------------------------"
for i=1 to MAX_GADGETS
if gadgets(i).handle <> 0
write string fileNum,"global " + gadgets(i).name
endif
next i
exportWriteMenuGlobalsDB(fileNum)
`Write Function Header
write string fileNum,""
write string fileNum,"`Create User Interface"
write string fileNum,"`---------------------"
write string fileNum,"function createUI()"
write string fileNum,SPACETAB+"If Not GUI_CONSTANTS Then errorMessage "+QUOTE_CHAR+"GUI Constants not defined. Please include gui.dba when you compile"+QUOTE_CHAR+" : end"
write string fileNum,SPACETAB+""
`Write Creation Code
`BUGBUG Export writing will fail if a child gadget has an earlier index than the parent gadget
`we must make sure that this is not possible
for i=1 to MAX_GADGETS
if gadgets(i).handle <> 0
`Get basic gadget properties
handle=gadgets(i).handle
x=gadgetX(handle)
y=gadgetY(handle)
width=gadgetWidth(handle)
height=gadgetHeight(handle)
gtext=getGadgetText(handle)
parent=gadgets(getGadgetData(gadgets(i).parent)).name
if len(parent)=0 then parent = "0"
if parent <> lastParent
`Add an empty line for readability
write string fileNum,SPACETAB
endif
` message parent
`Write the line out to the file
exportWriteLineDB(fileNum,i,str$(x),str$(y),str$(width),str$(height),parent,gtext)
`Write out additional options
exportWriteBorderStyleDB(fileNum,i)
exportWriteEnableDB(fileNum,i)
exportWriteVisibleDB(fileNum,i)
exportWriteAlignDB(fileNum,i)
lastParent=parent
` SV01 DELETE CODING
` Add gadget to delete order...
array insert at top DelGadget()
DelGadget() = gadgets(i).name
` SV01 DELETE CODING
endif
next i
`Write Function Tail
write string fileNum,SPACETAB+""
write string fileNum,"endfunction"
` SV01 DELETE CODING
write string fileNum,SPACETAB+""
write string fileNum,"function DeleteGadgets()"
for n = 0 to array count(delGadget())
write string filenum,SPACETAB + "DELETEGADGET " + delgadget(n)
next n
write string fileNum,"endfunction"
write string fileNum,SPACETAB+""
` SV01 DELETE CODING
write string fileNum,""
write string fileNum,"`Create Main Menu"
write string fileNum,"`----------------"
write string fileNum,"function createMainMenu()"
exportWriteMenuDB(fileNum)
write string fileNum,"endfunction"
` SV01 Button Clicked framework
write string fileNum,""
write string fileNum,"`Process UI Skeleton"
write string fileNum,"`----------------"
write string fileNum,"function processUI()"
for i=1 to MAX_GADGETS
message "Type : " + str$(gadgets(i).gType) + " Name : " + gadgets(i).name
if gadgets(i).gType = GADGET_BUTTON and gadgets(i).name <> ""
message "writing " + gadgets(i).name
write string fileNum,""
write string fileNum,SPACETAB + "` Process Button Click - " + gadgets(i).name
write string fileNum, SPACETAB + "if eventsource() = " + gadgets(i).name + " and eventType() = MOUSE_CLICK"
write string fileNum, SPACETAB + SPACETAB + "` Do something"
write string fileNum, SPACETAB + "endif"
endif
next i
write string fileNum,""
write string fileNum,"endfunction"
write string fileNum,"` End of processUI Skeleton"
`Close file
close file fileNum
if (questionMessage("Code Export Complete. Do you wish to copy the exported code to the clipboard?","Export Complete"))
open to read fileNum,fileName
repeat
read string fileNum,temp$
readStr=readStr+chr$(13)+chr$(10)+temp$
until file end(fileNum)
close file fileNum
`message readStr
write to clipboard readStr
`execute file "notepad.exe",fileName,"C:\"
endif
endfunction
BatVink
