|
Post by Rod on May 16, 2023 2:25:16 GMT -5
I wonder if a single dummy [handler] might suffice for Preview, Write would continue to create new handlers, Export will just use the imported handlers yet to see if duplicates will cause problems.
I think I had fixed the missing text problem already.
The comma needs more work and was why ff404 was failing so much.
However I am afraid I have embarked on a rewrite to implement color change in a more systematic way and to help simplify export. I have restructured the drawit block to make color change possible, there are now color change objects which will generate TextboxColor$ etc, lines on write, preview and export.
Not sure if anyone has time but what would be a great help is if someone could marshal a list of lines known to give problems. A single testing file.
|
|
|
Post by Rod on May 16, 2023 7:30:51 GMT -5
Fix for the comma.....perhaps
'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1)
|
|
|
Post by xxgeek on May 16, 2023 8:43:39 GMT -5
Fix for the comma.....perhaps 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1)
That seems to work, but I'll be testing it more. Found another issue causing a "preview" crash. When writing to preview.bas if the type of window is "text" or any type of "text" then trapclose needs a ! in front of it. The fix - Change this section to what appears here. #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if With Rod's last fix for the missing comma, and the above fix, I am hard pressed to find any more errors that will crash the Preview now. There may be other errors in the Preview code, but at least they are not crashing the Preview, or FFUL. I will be playing with the code later and will create a list of "bad" lines I come across.
|
|
|
Post by Rod on May 16, 2023 9:39:21 GMT -5
This has as many fixes as has been mentioned I think. It has a new way of handling color more in line with how Liberty handles color change. So color and fonts seem to work. Import is working better but still cannot cope with variables. I was thinking of keeping track of where the controls are placed and so the limits of the form but I find that usually if width and height are variables then so too control placement. As I have said already it will be much better at importing its own code.
Hope to get working on export tomorrow.
ver$="1.11" 'freeform ultra lite v1.x 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1
'nomainwin dim info$(10,10) dim form$(10) form$(1)="Restore" form$(2)="New" form$(3)="Save .ffu" form$(4)="Load .ffu" form$(5)="-----------" form$(6)="Write .bas" form$(7)="Import .bas" form$(8)="Export .bas" form$(9)="File" dim tool$(14) tool$(1)="StatictText" tool$(2)="TextBox" tool$(3)="ListBox" tool$(5)="ComboBox" tool$(6)="Button" tool$(7)="BmpButton" tool$(8)="GraphicBox" tool$(9)="RadioButton" tool$(10)="CheckBox" tool$(11)="GroupBox" tool$(12)="Texteditor" tool$(13)="Menu" tool$(14)="Add New" dim hnd$(30) hnd$(1)="#1" dim grid$(20) grid$(1)="1" g=2 for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Invisible" grid$(g+1)="Visible" grid$(g+2)="Set Grid" grid=10 gridvisible=1 gridcolor$="buttonface" projectctrh=25 ctrh=25 dim color$(10) color$(1)="Control Back" color$(2)="Project Back" color$(3)="Project Fore" color$(4)="Grid Color" color$(5)="Set Color" projectback$="white" projectfore$="black" 'ctrc$="white" dim font$(10) font$(1)="Control Font" font$(2)="ResetControl" font$(3)="Project Font" font$(4)="Set Font"'default is Consolas 9" dim wind$(20)'window type names wind$(1)="window" wind$(2)="window_nf" wind$(3)="window_popup" wind$(4)="dialog" wind$(5)="dialog_modal" wind$(6)="dialog_nf" wind$(7)="dialog_nf_modal" wind$(8)="dialog_fs" wind$(9)="dialog_nf_fs" wind$(10)="dialog_popup" wind$(11)="graphics" wind$(12)="graphics_fs" wind$(13)="graphics_fs_nsb" wind$(14)="graphics_nsb" wind$(15)="graphics_nf_nsb" wind$(16)="text" wind$(17)="text_fs" wind$(18)="text_nsb" wind$(19)="text_nsb_ins"
dim v$(2000) for n= 100 to 2000 step 20 v$(n)=str$(n) next dim obj(200,6) 'x,y,width/height,type,textheight X=1 Y=2 W=3 H=4 T=5 TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline Ctr=1 Tex=2 Res=3 Fon=4 Bak=5 Bas=7
'set default starting position obj=0 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" projectctrh=25 projectgrid=10 projectw=320 projecth=360 insertx=grid inserty=grid*2
'open a small properties window and hide it WindowWidth=230 WindowHeight=260 UpperLeftX=(DisplayWidth-230)/2 UpperLeftY=(DisplayHeight-180)/2 statictext #prop.st1 "File",5,10,30,25 textbox #prop.tbfile,45,5,150,25 statictext #prop.st2 "Wind",5,32,30,25 combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25 statictext #prop.st3 "Titl",5,54,30,25 textbox #prop.tbtitl,45,49,150,25 statictext #prop.st4 "Form",5,76,30,25 textbox #prop.tbform,45,71,150,25 statictext #prop.st5 "Ctrl",5,98,30,25 textbox #prop.tbctrl,45,93,150,25 statictext #prop.st6 "Text",5,120,30,25 textbox #prop.tbtext,45,115,150,25 statictext #prop.st7 "Reso",5,142,30,25 textbox #prop.tbreso,45,137,150,25 statictext #prop.st8 "xywh",5,164,30,25 textbox #prop.tbxywh,45,159,150,25 statictext #prop.st9 "Font",5,186,30,25 textbox #prop.tbfont,45,181,150,25 statictext #prop.st10 "Colo",5,208,30,25 textbox #prop.tbcolo,45,203,150,25
open "Properties" for window_nf as #prop #prop "font Consolas 9" #prop "trapclose [show]" #prop.cbwind "select window_nf" #prop.tbfile "!disable" #prop.tbxywh "!disable" #prop.tbfont "!disable" #prop.tbcolo "!disable" gosub [propertyupdate] #prop "hide"
'open the main form window 'this window is resizable, the graphicox will resize but the 'client area, which is a drawn representation of the window 'will only change size if you change the project w/h dimensions WindowWidth=862 WindowHeight=705 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #fful.tool,tool$(,[tool],5,2,85,30 combobox #fful.form,form$(,[form],95,2,85,30 combobox #fful.hand,hnd$(,[hand],185,2,85,30 button #fful.project,"Preview",[preview],UL,275,0,60,25 combobox #fful.w,v$(,[formsize],340,2,60,30 combobox #fful.h,v$(,[formsize],405,2,60,30 combobox #fful.grid,grid$(,[grid],470,2,90,30 combobox #fful.color,color$(,[color],565,2,90,30 combobox #fful.font,font$(,[font],660,2,90,30 button #fful.help,"Help",[help],UL,755,0,80,25 graphicbox #fful.gb,5,25,830,630 open "Freeform Ultra Lite v";ver$ for window as #fful #fful "trapclose [quitfful]" #fful "font Consolas 9" #fful "resizehandler [resize]" #fful.tool "select Add New" #fful.form "select File" #fful.hand "selectindex 1" #fful.grid "select Set Grid" #fful.color "select Set Color" #fful.font "select Set Font" #fful.w "select ";projectw #fful.h "select ";projecth #fful.gb "autoresize" #fful.gb "vertscrollbar on 0 ";projectw #fful.gb "horizscrollbar on 0 ";projecth #fful.gb "font ";projectfont$ #fful.gb "down" gosub [drawgrid] gosub [drawall] #fful.gb "when rightButtonDown [show]" #fful.gb "when leftButtonDown [select]" #fful.gb "when characterInput [keys]" #fful.gb "setfocus" #prop "show" show=1 wait
[show] if show then #prop "hide" show=0 else #prop "show" show=1 end if wait
'the user clicked on the form design window 'either to chose a control or to deselect a control [select] xs=MouseX ys=MouseY
'hide property window if it is open if show then #prop "hide" show=0 end if
'before we move on update the currently selected control from properties 'get the project data and only the editable contents of controls if selected=0 then 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ end if #prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$ #prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$ #prop.tbreso "!contents? t$" : obj$(selected,Res)=t$ 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if xs>obj(cn,X) and xs<(obj(cn,X)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then if xs>obj(cn,X)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2 if obj(cn,T)=6 then action=1 selected=cn exit for end if next if selected=0 then gosub [propertyupdate] action=0 end if if selected>0 and action=1 then #fful.gb "when leftButtonMove [track]" #fful.gb "when leftButtonUp [stop]" offsetX=xs-obj(selected,X) offsetY=ys-obj(selected,Y) end if if selected>0 and obj(selected,T)<>6 and action=2 then 'dont resize bmp #fful.gb "when leftButtonMove [tracksize]" #fful.gb "when leftButtonUp [stopsize]" offsetX=xs-(obj(selected,X)+obj(selected,W)) offsetY=ys-(obj(selected,Y)+obj(selected,H)) end if if selected>0 then gosub [drawit] else insertx=int((xs+(grid/2))/grid)*grid inserty=int((ys+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #fful.gb "rule xor" gosub [drawit] xt=int((MouseX-offsetX+(grid/2))/grid)*grid if xt<0 then xt=0 if xt+obj(selected,W)>projectw then xt=projectw-obj(selected,W) obj(selected,X)=xt yt=int((MouseY-offsetY+(grid/2))/grid)*grid if yt<0 then yt=0 if yt+obj(selected,H)>projecth then yt=projecth-obj(selected,H) obj(selected,Y)=yt gosub [drawit] wait
[stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[tracksize] #fful.gb "rule xor" gosub [drawit] xs=int((MouseX-offsetX+(grid/2))/grid)*grid if xs>projectw then xs=projectw if xs<obj(selected,X) then xs=obj(selected,X)+grid ys=int((MouseY-offsetY+(grid/2))/grid)*grid if ys>projecth then ys=projecth if ys<obj(selected,Y)+ctrh then ys=obj(selected,Y)+ctrh obj(selected,W)=xs-obj(selected,X)'width obj(selected,H)=ys-obj(selected,Y)'height gosub [drawit] wait
[stopsize] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,T)=12 then menuset=0 obj(selected,T)=0 selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,X) 'x cpy(2)=obj(selected,Y) 'y cpy(3)=obj(selected,W) 'w cpy(4)=obj(selected,H) 'h cpy(5)=obj(selected,T) 'type cpy(6)=obj(selected,TH) 'textheight cpy$(1)=obj$(selected,Ctr)'name cpy$(2)=obj$(selected,Tex)'text content cpy$(3)=obj$(selected,Res)'resource array or file path cpy$(4)=obj$(selected,Fon)'ctrl specific font or "" cpy$(5)=obj$(selected,Bak)'ctrl specific backcolor end if if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty inserty=inserty+cpy(4)+grid obj(obj,W)=cpy(3) obj(obj,H)=cpy(4) obj(obj,T)=cpy(5) obj(obj,TH)=cpy(6) obj$(obj,Ctr)=left$(cpy$(1),2);obj obj$(obj,Tex)=cpy$(2) obj$(obj,Res)=cpy$(3) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) obj$(obj,Fon)=cpy$(4) obj$(obj,Bak)=cpy$(5) selected=obj gosub [drawall] end if end if #fful.gb "setfocus" wait
[tool] #fful.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh obj(obj,T)=1 obj$(obj,Ctr)="st";obj obj$(obj,Tex)="statictext?" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 2 'textbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=ctrh obj(obj,T)=2 obj$(obj,Ctr)="tb";obj obj$(obj,Tex)="Textbox" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 3 'listbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=ctrh*5 obj(obj,T)=3 obj$(obj,Ctr)="lb";obj obj$(obj,Tex)="Listbox\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectlbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 4 'combobox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="cb";obj obj$(obj,Tex)="Combobox\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectcbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 5 'button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=5 obj$(obj,Ctr)="bt";obj obj$(obj,Tex)="Button?" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)="white" inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 6 'bmp button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=50 obj(obj,H)=50 obj(obj,T)=6 obj$(obj,Ctr)="bb";obj filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Res)=file$ obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),file$ close #bmp inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid else obj(obj,T)=0 close #bmp end if else obj(obj,T)=0 end if
case 7 'graphicbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=100 obj(obj,T)=7 obj$(obj,Ctr)="gb";obj obj$(obj,Tex)="Graphicbox" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=8 obj$(obj,Ctr)="rb";obj obj$(obj,Tex)="(o) radio?" obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 9 'checkbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="ch";obj obj$(obj,Tex)="[x] check?" obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=100 obj(obj,T)=10 obj$(obj,Ctr)="gr";obj obj$(obj,Tex)="Group Box?" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=100 obj(obj,T)=11 obj$(obj,Ctr)="te";obj obj$(obj,Tex)="Texteditor" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttecl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,X)=0 obj(obj,Y)=0 obj(obj,W)=100 obj(obj,H)=10 obj(obj,T)=12 obj$(obj,Ctr)="mn";obj obj$(obj,Tex)=" Menu Added" menuset=1 end if end select selected=obj gosub [drawall] #fful.tool "select Add New" #fful.gb "setfocus" wait
[form] #fful.form "selectionindex? i" select case i case 1 'restore file$="lastsession.ffu" gosub [loadit] case 2 'new gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 6 'write gosub [write] case 7 'import gosub [import] case 8 'export gosub [export] end select #fful.form "select File" gosub [drawall] #fful.gb "setfocus" wait
[drawall] #fful.gb "discard ; redraw bak" ocn=cn projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" for cn=1 to obj gosub [drawit] next cn=ocn #fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20 #fful.gb "setfocus" return
[drawit] 'redraws control cn
'set the color for the drawn object and action taking place if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if
'set the font for the drawn object if obj$(cn,Fon)="" then #fful.gb "font ";projectfont$ ch=projectctrh if obj(cn,H)<ch then obj(cn,H)=ch else #fful.gb "font ";obj$(cn,Fon) ch=obj(cn,TH) if obj(cn,H)<ch then obj(cn,H)=ch end if
'update the properties textboxes for selected control if cn=selected then #prop.tbctrl obj$(cn,Ctr) 'ctrlname #prop.tbtext obj$(cn,Tex) 'text #prop.tbreso obj$(cn,Res) 'resource #prop.tbxywh obj(cn,X);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height #prop.tbcolo obj$(cn,Bak) end if #fful.gb "place ";obj(cn,X);" ";obj(cn,Y) if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?" select case obj(cn,T) case 1 'statictext #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 2 'textbox #fful.gb "backcolor ";projecttbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 3 'listbox #fful.gb "backcolor ";projectlbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 4 'combobox #fful.gb "backcolor ";projectcbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 5 'button #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'buttons are always black on white #fful.gb "color black" 'centre button text #fful.gb "stringwidth? ";"A";" width" xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ #fful.gb "backcolor ";projectback$ case 6 'bmpbutton if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr) #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) case 7 ' graphicbox #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "backcolor ";projectback$ case 8 'radiobutton #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'radiobutton text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 9 'checkbox #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'checkbox text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 10 'groupbox #fful.gb "backcolor ";projectback$ 'groupbox is an outline #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'group box text is always black #fful.gb "color black" 'groupbox text is offset if action=0 then #fful.gb "place ";obj(cn,X)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 11 ' texteditor #fful.gb "backcolor ";projecttecl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 12 'menu 'pin to top left obj(cn,X)=10 : obj(cn,Y)=-10 : obj(cn,W)=100 : obj(cn,H)=10 #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 21 'tecolor projecttecl$=obj$(cn,Bak) case 22 'tbcolor projecttbcl$=obj$(cn,Bak) case 23 'lbcolor projectlbcl$=obj$(cn,Bak) case 24 'cbcolor projectcbcl$=obj$(cn,Bak) case 30 'font case 31 '!font end select
return
[preview] file$="preview.bas" gosub [writeit] wait
[write] projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas" filedialog "Save .bas",projectfile$,file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit]
if file$<>"" then open file$ for output as #op 'the header #op " 'Project ";projecttitl$ #op " 'Created with Freeform Ultra Lite v";ver$;" ";date$() #op " nomainwin" #op "" if projectback$<>"white" or projectfore$<>"black" then #op " 'Set BackgroundColor$ and ForegroundColor$ of project" #op " BackgroundColor$=";chr$(34);projectback$;chr$(34) #op " ForegroundColor$=";chr$(34);projectfore$;chr$(34) #op "" end if #op " 'Create arrays needed for controls listbox,combobox" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " dim ";obj$(n,Res);"10)" #op " for n = 1 to 10" #op " ";obj$(n,Res);"n)= str$(n)" #op " next" end if next #op "" #op " 'Create controls and open window" #op " nomainwin" #op " WindowWidth = ";projectw #op " WindowHeight = ";projecth #op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"Size";chr$(34);", ";chr$(34);"Small";chr$(34);", [dummy], ";chr$(34);"Large";chr$(34);", [dummy]" end if for n=1 to obj select case obj(n,T) case 1 'statictext #op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox #op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor #op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 22 'tbcolor #op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'lbcolor #op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 24 'cbcolor #op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'tecolor #op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34) end select next #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op "" #op " 'Set any listbox or combobox to display the first item on the list" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34) end if next #op " 'apply any control specific fonts" for n= 1 to obj if obj(n,T)<>0 and obj$(n,Fon)<>"" then if obj(n,T)=1 or obj(n,T)=2 or obj(n,T)=5 or obj(n,T)=10 or obj(n,T)=11 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34) end if if obj(n,T)=3 or obj(n,T)=4 or obj(n,T)=7 or obj(n,T)=8 or obj(n,T)=9 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34) end if end if next #op " wait" #op ""
if file$<>"preview.bas" then #op " 'Create the required handlers for each control" #op " 'Radiobutton and Checkboxes are given a single handler" check=0 radio=0 for n=1 to obj select case obj(n,T) case 3 'listbox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op "" case 4 'combobox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op "" case 5 'button #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op "" case 6 'bmpbutton #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op "" case 8 'radiobutton if radio=0 then #op " [radio]" #op " 'Your handler code here, read all radiobuttons to determine which is set" #op " 'this is an example of eading the first radiobutton" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" radio=1 end if case 9 'checkbox if check=0 then #op " [check]" #op " 'Your handler code here, read all checkboxes in the group in sequence." #op " 'this is an example of eading the first checkbox" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" check=1 end if end select next else #op " [radio]" #op " wait" #op "" #op " [check]" #op " wait" #op "" end if #op " [quit]" #op " close ";projectform$ #op " end" close #op files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] end if return
[saveas] projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu" filedialog "Save As...",projectname$,file$ if file$<>"" then open file$ for output as #op projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ #op projectfile$ #op projectwind$ #op projectform$ #op projecttitl$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth for n=1 to obj if obj(n,T)<>0 then #op obj(n,X);","; #op obj(n,Y);","; #op obj(n,W);","; #op obj(n,H);","; #op obj(n,T);","; #op obj(n,TH) #op obj$(n,Ctr) #op obj$(n,Tex) #op obj$(n,Res) #op obj$(n,Fon) #op obj$(n,Bak) end if next close #op gosub [propertyupdate] redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" end if return
[load] filedialog "Open Project...","*.ffu",file$ [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #ses input #ses, projectfile$ input #ses, projectwind$ input #ses, projectform$ input #ses, projecttitl$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #fful.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ projectctrh=val(c$) projectgrid=val(g$) grid=projectgrid projectw=val(w$) projecth=val(h$) #prop.cbwind "select ";projectwind$ redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.grid "select ";grid #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,X)=val(word$(l$,1,",")) obj(obj,Y)=val(word$(l$,2,",")) obj(obj,W)=val(word$(l$,3,",")) obj(obj,H)=val(word$(l$,4,",")) obj(obj,T)=val(word$(l$,5,",")) obj(obj,TH)=val(word$(l$,6,",")) line input #ses, obj$(obj,Ctr) line input #ses, obj$(obj,Tex) line input #ses, obj$(obj,Res) line input #ses, obj$(obj,Fon) line input #ses, obj$(obj,Bak) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) if obj(obj,T)=12 then menuset=1 wend close #ses gosub [propertyupdate] #prop "hide" #prop "show" end if return
[import] filedialog "Open .bas...","*.bas",file$ if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) gosub [new] grid=1 gridvisible=0 gosub [drawgrid] 'set grid to 1 and invisible so controls stay where they import from initially 'import only those lines defining controls we are interested in wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox " wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty " wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ " wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ " dim bas$(5000,2) basln=1 ln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, wln$ 'break into multiple lines if ":" found outside quotes pos=1 ln$="" while pos<=len(wln$) c$=mid$(wln$,pos,1) if c$=chr$(34)then if quote=0 then quote=1 else quote=0 end if if c$=":" and quote=0 then gosub [line] ln$="" pos=pos+1 else ln$=ln$+c$ pos=pos+1 end if wend gosub [line] basln=basln+1 wend print "first cut" for n=1 to ln print bas$(n,1);" ";bas$(n,2) next print
'now find width height title and handle for all windows found in bas$( 'up to 30 forms in a .bas '1=handle #main etc '2=title '3=width '4=height '5=windowtype '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
redim win$(30,10) redim hnd$(30) nl=ln wh=1 for ln=1 to nl 'find width and height ,assumes width and height are defined ahead of open 'so width height and colors can be set multiple times, so store bas line number involved if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1) if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1) if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1) if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1) if instr(lower$(bas$(ln,2)),"open",1)>0 then if instr(lower$(bas$(ln,2)),"window",1)>0 or instr(lower$(bas$(ln,2)),"dialog",1)>0 or instr(lower$(bas$(ln,2)),"graphic",1)>0 then win$(wh,10)=bas$(ln,1) n$=word$(bas$(ln,2),2,chr$(34)) hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1)) 'find last "for" in command line i=1 while i oi=i i=instr(lower$(bas$(ln,2))," for ",i+1) wend wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi) wt$=word$(wt$,2) win$(wh,1)=hn$ 'handle #fful etc win$(wh,2)=n$ 'title win$(wh,3)=w$ 'width win$(wh,4)=h$ 'height win$(wh,5)=wt$ 'windowtype hnd$(wh)=hn$ 'for combobox 'print wh;" ";hnd$(wh);" ";win$(wh,2);" ";win$(wh,3);" ";win$(wh,4);" ";win$(wh,5) wh=wh+1 end if end if next #fful.hand "reload" #fful.hand "selectindex 1" close #bas wh=1 gosub [loadwindow] end if return
[line] if ln$<>"" then w$=lower$(word$(ln$,1)) if instr(w$,"=",1)>1 then w$=word$(w$,1,"=") if len(w$)>3 then w1$=" "+w$+" " w2$=" "+w$+"=" if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 then bas$(ln,1)=str$(basln) bas$(ln,2)=trim$(ln$) ln=ln+1 end if end if end if return
[hand] #fful.hand "selectionindex? wh" gosub [loadwindow] wait
[loadwindow] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=1 menuset=0 projectback$="white" TextboxColor$="white" ListboxColor$="white" ComboboxColor$="white" TexteditorColor$="white" projectfore$="black" projectw=val(win$(wh,3)) if projectw=0 then projectw=320 projecth=val(win$(wh,4)) if projecth=0 then projecth=360 projecttitl$=win$(wh,2) projectwind$=win$(wh,5) projectform$=win$(wh,1) tbc$="" lbc$="" cbc$="" tec$="" gosub [propertyupdate] #fful.w "!";str$(projectw) #fful.h "!";str$(projecth)
'find controls and create obj() for ln=1 to nl 'create hidden objects to control font and color only used in import/export, not displayed ct=0 if instr(bas$(ln,2),"TextboxColor$",1)>0 then tbc$=getcolor$(bas$(ln,2)):ct=20 if instr(bas$(ln,2),"ListboxColor$",1)>0 then lbc$=getcolor$(bas$(ln,2)):ct=21 if instr(bas$(ln,2),"ComboboxColor$",1)>0 then cbc$=getcolor$(bas$(ln,2)):ct=22 if instr(bas$(ln,2),"TexteditorColor$",1)>0 then tec$=getcolor$(bas$(ln,2)):ct=23 if ct then obj(obj,T)=ct if ct=20 then obj$(obj,Bak)=tbc$ if ct=21 then obj$(obj,Bak)=lbc$ if ct=22 then obj$(obj,Bak)=cbc$ if ct=23 then obj$(obj,Bak)=tec$ obj$(obj,Bas)=bas$(ln,1) obj=obj+1 end if for wc=1 to 12 if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for next if wc<=11 then obj$(obj,Bas)=bas$(ln,1) l$=bas$(ln,2) ll$="" 'remove spaces leaving only , separation but keep "" text untouched inString=0 for i=1 to len(l$) c$=mid$(l$,i,1) select case case c$=chr$(34) inString=1-inString case (inString=0) and c$=" " c$="" end select ll$=ll$+c$ next 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1) obj(obj,T)=wc 'type obj(obj,TH)=projectctrh 'get the .ctrl name obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1) 'for un-named controls if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj 'get the text if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc) 'get the array or bmp file name if wc=3 or wc=4 or wc=6 then obj$(obj,Res)=word$(ll$,2,",") 'get rid of "" if wc=6 and left$(obj$(obj,Res),1)=chr$(34) then obj$(obj,Res)=mid$(obj$(obj,Res),2,len(obj$(obj,Res))-2) 'array() -> array( if (wc=3 or wc=4) and right$(obj$(obj,Res),1)=")" then obj$(obj,Res)=left$(obj$(obj,Res), len(obj$(obj,Res))-1) i=1 while word$(ll$,i,",")<>"" i=i+1 wend i=i-4 if wc=6 or wc=5 then 'buttons and bmpbuttons can have xy, wh is optional and they have XX corners if i=3 then obj(obj,X)=val(word$(ll$,i+2,","))'x obj(obj,Y)=val(word$(ll$,i+3,","))'y if wc=5 then 'we need to find a way to calculate width and height if not given #fful.gb "stringwidth? ";"A";" width" obj(obj,W)=width*len(obj$(obj,Tex))+10 obj(obj,H)=projectctrh end if if wc=6 then 'we need a way to set bmp w and h on error goto [dummybmp] open obj$(obj,Res) for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Tex)="bmp" end if loadbmp obj$(obj,Ctr),obj$(obj,Res) close #bmp goto [passdummy]
[dummybmp] obj(obj,W)=25 obj(obj,H)=25 obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),"path.bmp" [passdummy] end if else obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y obj(obj,W)=val(word$(ll$,i+2,","))'w obj(obj,H)=val(word$(ll$,i+3,","))'h end if if upper$(word$(ll$,4,","))="LR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="LL" then 'obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="UR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x 'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if else 'write to .bas tweaks listbox and combobox controls to line up properly 'so we need to untweak them now obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y if wc=1 then obj(obj,Y)=obj(obj,Y)-5 if wc=10 then obj(obj,Y)=obj(obj,Y)+5 if wc=3 or wc=4 then obj(obj,X)=obj(obj,X)-1 obj(obj,W)=val(word$(ll$,i+2,","))'w if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2 obj(obj,H)=val(word$(ll$,i+3,","))'h end if
'save color if set if wc=2 then obj$(obj,Bak)=tbc$ if wc=3 then obj$(obj,Bak)=lbc$ if wc=4 then obj$(obj,Bak)=cbc$ if wc=11 then obj$(obj,Bak)=tec$ obj=obj+1 end if next 'now find font commands listed after the open statement referring to the #form '#form.ctrl !font fontname 'if so add a new font object basln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ lln$=lower$(ln$) if instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font",1)>0 or instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font",1)>0 then f$=right$(ln$,len(ln$)-instr(lln$,"font",1)-4) if instr(f$,";",1)=0 then obj$(obj,Fon)=f$ obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1) obj$(obj,Ctr)=word$(word$(ln$,1),2,".") if instr(lln$,"!font",1)>0 then obj(obj,T)=31 else obj(obj,T)=30 obj$(obj,Bas)=str$(basln)
'find the visible object and store the font change for n=1 to obj if obj$(n,Ctr)=obj$(obj,Ctr) then obj$(n,Fon)=obj$(obj,Fon) #fful.gb "font ";obj$(obj,Fon) #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" obj(n,TH)=(yp-100)/2+7 exit for end if next obj=obj+1 end if end if basln=basln+1 wend
close #bas gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[export] dim oldbas$(5000) ln=1 if file$<>"" and right$(file$,3)="bas" then open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ oldbas$(ln)=ln$ ln=ln+1 wend close #bas '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
if win$(wh,6)<>"" then oldbas$(val(win$(wh,6)))=" BackgroundColor$=";chr$(34);projectback$;chr$(34) if win$(wh,7)<>"" then oldbas$(val(win$(wh,7)))=" ForegroundColor$=";chr$(34);projectfore$;chr$(34) if win$(wh,8)<>"" then oldbas$(val(win$(wh,8)))=" WindowWidth=";projectw if win$(wh,8)=win$(wh,9) then oldbas$(val(win$(wh,8)))=oldbas$(val(win$(wh,8)))+": WindowHeight=";projecth else oldbas$(val(win$(wh,9)))=" WindowHeight=";projecth if win$(wh,10)<>"" then oldbas$(val(win$(wh,10)))=" Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ for n=1 to obj select case obj(n,T) 'handle the visible controls case 1 'statictext oldbas$(val(obj$(n,Bas)))=" statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox oldbas$(val(obj$(n,Bas)))=" textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box oldbas$(val(obj$(n,Bas)))=" listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox oldbas$(val(obj$(n,Bas)))=" combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button oldbas$(val(obj$(n,Bas)))=" button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton oldbas$(val(obj$(n,Bas)))=" bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox oldbas$(val(obj$(n,Bas)))=" graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton oldbas$(val(obj$(n,Bas)))=" radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox oldbas$(val(obj$(n,Bas)))=" checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box oldbas$(val(obj$(n,Bas)))=" groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor oldbas$(val(obj$(n,Bas)))=" texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export case 20 'textboxcolor oldbas$(val(obj$(n,Bas)))=" TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'listboxcolor oldbas$(val(obj$(n,Bas)))=" ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 22 'comboboxcolor oldbas$(val(obj$(n,Bas)))=" ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'texteditorcolor oldbas$(val(obj$(n,Bas)))=" TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
'handle font changes case 30 'font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" font ";obj$(n,Fon);chr$(34) case 32 '!font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" !font ";obj$(n,Fon);chr$(34) end select next end if open file$ for output as #bas for n= 1 to ln #bas oldbas$(n) next close #bas return
function getsize$(l$) 'what if it is a variable? v$="" pos=1 n$=mid$(l$,pos,1) while instr("1234567890",n$,1)=0 and pos<len(l$) pos=pos+1 n$=mid$(l$,pos,1) wend while n$>="0" and n$<="9" and pos<=len(l$) v$=v$+n$ pos=pos+1 n$=mid$(l$,pos,1) wend getsize$=v$ end function
function getcolor$(l$) 'what if it is a variable? cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black " for c= 1 to 15 if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for next end function
[new] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=0 menuset=0 projectw=320 projecth=360 projectback$="white" projectfore$="black" projectctrc$="white" projecttitl$="Untitled" projectform$="#1" projectfile$="Untitled.bas" projectwind$="window_nf" #prop.cbwind "select window_nf" redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.w "select ";projectw #fful.h "select ";projecth gosub [propertyupdate] gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[propertyupdate] #prop.tbfile projectfile$ #prop.cbwind "select ";projectwind$ #prop.tbtitl projecttitl$ #prop.tbform projectform$ #prop.tbctrl "" #prop.tbtext "" #prop.tbreso "" #prop.tbxywh projectw;"x";projecth #prop.tbfont projectfont$ #prop.tbcolo projectfore$;"/";projectback$ return
[resize] #fful.tool "select Add New" #fful.form "select File" if wh=0 then wh=1 #fful.hand "selectindex ";wh #fful.grid "select Set Grid" #fful.font "select Set Font" #fful.color "select Set Color" #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawall] wait
[formsize] #fful.w "contents? w$" #fful.h "contents? h$" wf=val(w$) hf=val(h$) if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait projectw=wf projecth=hf insertx=grid inserty=grid gosub [drawgrid] #fful.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid spacing according to user choice, default is 10 #fful.grid "contents? g$" select case g$ case "Invisible" gridvisible=0 case "Visible" gridvisible=1 case else grid=val(g$) end select gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" wait
[drawgrid] if grid>0 then projectgrid=grid insertx=int((insertx+(grid/2))/grid)*grid inserty=int((inserty+(grid/2))/grid)*grid #fful.gb "cls; fill buttonface" #fful.gb "place 0 0 ; color ";projectback$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth #fful.gb "color ";gridcolor$;" ; backcolor ";projectback$ if gridvisible then for xs = 0 to projectw step grid print #fful.gb, "line ";xs;" 0 ";xs;" ";projecth next for ys = 0 to projecth step grid #fful.gb, "line 0 ";ys;" ";projectw;" ";ys next end if #fful.gb "flush bak" #fful.gb "color black" end if #fful.grid "select Set Grid" return
[font] #fful.font "contents? f$" if f$="Project Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #fful.gb "font ";projectfont$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" projectctrh=(yp-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Control Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #fful.gb "font ";ctrf$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" ctrh=(yp-100)/2+7 end if if selected then obj$(selected,4)=ctrf$ 'font obj(selected,6)=ctrh 'text height end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="ResetControl" then ctrf$=projectfont$ ctrh=projectctrh if selected then obj$(selected,4)=ctrf$ obj(selected,6)=ctrh end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then #fful.gb "font ";ctrf$ obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #fful.font "select Set Font" gosub [drawall] #fful.gb "setfocus" wait
[color] #fful.color "contents? c$" select case c$ case "Control Back" gosub [colorpick] if cp$<>"" then if selected then 'insert color change event ahead of control if obj(selected,T)=2 then ct=22 : projecttbcl$=cp$ if obj(selected,T)=3 then ct=23 : projectlbcl$=cp$ if obj(selected,T)=4 then ct=24 : projectcbcl$=cp$ if obj(selected,T)=11 then ct=21 : projecttecl$=cp$ for n=obj+1 to selected+1 step -1 obj(n,X)=obj(n-1,X) obj(n,Y)=obj(n-1,Y) obj(n,W)=obj(n-1,W) obj(n,H)=obj(n-1,H) obj(n,T)=obj(n-1,T) obj(n,TH)=obj(n-1,TH) obj$(n,Ctr)=obj$(n-1,Ctr) obj$(n,Tex)=obj$(n-1,Tex) obj$(n,Res)=obj$(n-1,Res) obj$(n,Fon)=obj$(n-1,Fon) obj$(n,Bak)=obj$(n-1,Bak) obj$(n,Bas)=obj$(n-1,Bas) next obj(selected,T)=ct obj$(selected,Tex)="Color!" obj$(selected,Bak)=cp$ 'remove any previous color change statement if selected>=2 then if obj(selected-1,T)=ct then obj(selected-1,T)=0 end if obj=obj+1 end if end if case "Project Back" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Project Fore" gosub [colorpick] if cp$<>"" then projectfore$=cp$ case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] end select #fful.color "select Set Color" gosub [drawall] #fful.gb "setfocus" wait
[windowtype] #prop.cbwind "contents? projectwind$" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #pick.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #pick #pick "font Consolas 9" #pick "trapclose [quitpick]" #pick.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white " c=1 for yc=1 to 160 step 40 for xc= 1 to 160 step 40 #pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40 c=c+1 if c>15 then c=15 next next #pick.gb "when leftButtonDown [pick]" wait
[pick] xp=int(MouseX/40) yp=int(MouseY/40) c=xp+yp*4+1 cp$=word$(cl$,c)
[quitpick] close #pick return
[help] run "notepad help.txt" wait
[quitfful] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectfile$ #ses projectwind$ #ses projectform$ #ses projecttitl$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth for n=1 to obj if obj(n,T)<>0 then #ses obj(n,X);","; #ses obj(n,Y);","; #ses obj(n,W);","; #ses obj(n,H);","; #ses obj(n,T);","; #ses obj(n,TH) #ses obj$(n,Ctr) #ses obj$(n,Tex) #ses obj$(n,Res) #ses obj$(n,Fon) #ses obj$(n,Bak) end if next close #ses close #prop close #fful end
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
for n=1 to obj print n;" ";obj(n,X);" ";obj(n,Y);" ";obj(n,W);" ";obj(n,H);" ";obj(n,T);" ";obj(n,6);" "; print obj$(n,Ctr);" ";obj$(n,Tex);" ";obj$(n,Res);" ";obj$(n,Fon);" ";obj$(n,Bak);" ";obj$(n,6);" ";obj$(n,Bas);" " next
|
|
|
Post by xxgeek on May 16, 2023 11:54:55 GMT -5
I think you should move on now Rod. Implement export.
The big errors crashing the preview, and the ones leaving the preview code hanging on exit seem to be gone now. Any other errors can be dealt with as we run into them at a later date. The crashing seems to have ceased. Like you said, it's not a code writing app. We can work out more details next winter if we want a code writer built-in.
As of now we can import and preview without problems.
I have edited your most recent code to add:
1. Added the GetFilename function near bottom of code - we need to deal with users trying to preview a form when there is no form in the selected .bas file. that gets imported.
2. Added Under [writeit]
if file$<>"" then '#################################################### - new between these lines if projectwind$ = "" then WindowWidth=800 WindowHeight=150 open "No Forms" for text as #noform currentFile$ = GetFilename$(currentFile$) #noform currentFile$;" Has no Forms" #noform "!trapclose [quitnoform]" wait end if '#################################################### open file$ for output as #op
3.Under [import] added ONE line
filedialog "Open .bas...","*.bas",file$ if file$<>"" then currentFile$ = file$ 'added this line
If you re-write any of this please post the new code. I have been messing up with my code versions.
If I run into anything causing problems I'll keep a log.
The latest code now
ver$="1.11" 'freeform ultra lite v1.x 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1
'nomainwin dim info$(10,10) dim form$(10) form$(1)="Restore" form$(2)="New" form$(3)="Save .ffu" form$(4)="Load .ffu" form$(5)="-----------" form$(6)="Write .bas" form$(7)="Import .bas" form$(8)="Export .bas" form$(9)="File" dim tool$(14) tool$(1)="StatictText" tool$(2)="TextBox" tool$(3)="ListBox" tool$(5)="ComboBox" tool$(6)="Button" tool$(7)="BmpButton" tool$(8)="GraphicBox" tool$(9)="RadioButton" tool$(10)="CheckBox" tool$(11)="GroupBox" tool$(12)="Texteditor" tool$(13)="Menu" tool$(14)="Add New" dim hnd$(30) hnd$(1)="#1" dim grid$(20) grid$(1)="1" g=2 for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Invisible" grid$(g+1)="Visible" grid$(g+2)="Set Grid" grid=10 gridvisible=1 gridcolor$="buttonface" projectctrh=25 ctrh=25 dim color$(10) color$(1)="Control Back" color$(2)="Project Back" color$(3)="Project Fore" color$(4)="Grid Color" color$(5)="Set Color" projectback$="white" projectfore$="black" 'ctrc$="white" dim font$(10) font$(1)="Control Font" font$(2)="ResetControl" font$(3)="Project Font" font$(4)="Set Font"'default is Consolas 9" dim wind$(20)'window type names wind$(1)="window" wind$(2)="window_nf" wind$(3)="window_popup" wind$(4)="dialog" wind$(5)="dialog_modal" wind$(6)="dialog_nf" wind$(7)="dialog_nf_modal" wind$(8)="dialog_fs" wind$(9)="dialog_nf_fs" wind$(10)="dialog_popup" wind$(11)="graphics" wind$(12)="graphics_fs" wind$(13)="graphics_fs_nsb" wind$(14)="graphics_nsb" wind$(15)="graphics_nf_nsb" wind$(16)="text" wind$(17)="text_fs" wind$(18)="text_nsb" wind$(19)="text_nsb_ins"
dim v$(2000) for n= 100 to 2000 step 20 v$(n)=str$(n) next dim obj(200,6) 'x,y,width/height,type,textheight X=1 Y=2 W=3 H=4 T=5 TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline Ctr=1 Tex=2 Res=3 Fon=4 Bak=5 Bas=7
'set default starting position obj=0 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" projectctrh=25 projectgrid=10 projectw=320 projecth=360 insertx=grid inserty=grid*2
'open a small properties window and hide it WindowWidth=230 WindowHeight=260 UpperLeftX=(DisplayWidth-230)/2 UpperLeftY=(DisplayHeight-180)/2 statictext #prop.st1 "File",5,10,30,25 textbox #prop.tbfile,45,5,150,25 statictext #prop.st2 "Wind",5,32,30,25 combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25 statictext #prop.st3 "Titl",5,54,30,25 textbox #prop.tbtitl,45,49,150,25 statictext #prop.st4 "Form",5,76,30,25 textbox #prop.tbform,45,71,150,25 statictext #prop.st5 "Ctrl",5,98,30,25 textbox #prop.tbctrl,45,93,150,25 statictext #prop.st6 "Text",5,120,30,25 textbox #prop.tbtext,45,115,150,25 statictext #prop.st7 "Reso",5,142,30,25 textbox #prop.tbreso,45,137,150,25 statictext #prop.st8 "xywh",5,164,30,25 textbox #prop.tbxywh,45,159,150,25 statictext #prop.st9 "Font",5,186,30,25 textbox #prop.tbfont,45,181,150,25 statictext #prop.st10 "Colo",5,208,30,25 textbox #prop.tbcolo,45,203,150,25
open "Properties" for window_nf as #prop #prop "font Consolas 9" #prop "trapclose [show]" #prop.cbwind "select window_nf" #prop.tbfile "!disable" #prop.tbxywh "!disable" #prop.tbfont "!disable" #prop.tbcolo "!disable" gosub [propertyupdate] #prop "hide"
'open the main form window 'this window is resizable, the graphicox will resize but the 'client area, which is a drawn representation of the window 'will only change size if you change the project w/h dimensions WindowWidth=862 WindowHeight=705 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #fful.tool,tool$(,[tool],5,2,85,30 combobox #fful.form,form$(,[form],95,2,85,30 combobox #fful.hand,hnd$(,[hand],185,2,85,30 button #fful.project,"Preview",[preview],UL,275,0,60,25 combobox #fful.w,v$(,[formsize],340,2,60,30 combobox #fful.h,v$(,[formsize],405,2,60,30 combobox #fful.grid,grid$(,[grid],470,2,90,30 combobox #fful.color,color$(,[color],565,2,90,30 combobox #fful.font,font$(,[font],660,2,90,30 button #fful.help,"Help",[help],UL,755,0,80,25 graphicbox #fful.gb,5,25,830,630 open "Freeform Ultra Lite v";ver$ for window as #fful #fful "trapclose [quitfful]" #fful "font Consolas 9" #fful "resizehandler [resize]" #fful.tool "select Add New" #fful.form "select File" #fful.hand "selectindex 1" #fful.grid "select Set Grid" #fful.color "select Set Color" #fful.font "select Set Font" #fful.w "select ";projectw #fful.h "select ";projecth #fful.gb "autoresize" #fful.gb "vertscrollbar on 0 ";projectw #fful.gb "horizscrollbar on 0 ";projecth #fful.gb "font ";projectfont$ #fful.gb "down" gosub [drawgrid] gosub [drawall] #fful.gb "when rightButtonDown [show]" #fful.gb "when leftButtonDown [select]" #fful.gb "when characterInput [keys]" #fful.gb "setfocus" #prop "show" show=1 wait
[show] if show then #prop "hide" show=0 else #prop "show" show=1 end if wait
'the user clicked on the form design window 'either to chose a control or to deselect a control [select] xs=MouseX ys=MouseY
'hide property window if it is open if show then #prop "hide" show=0 end if
'before we move on update the currently selected control from properties 'get the project data and only the editable contents of controls if selected=0 then 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ end if #prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$ #prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$ #prop.tbreso "!contents? t$" : obj$(selected,Res)=t$ 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if xs>obj(cn,X) and xs<(obj(cn,X)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then if xs>obj(cn,X)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2 if obj(cn,T)=6 then action=1 selected=cn exit for end if next if selected=0 then gosub [propertyupdate] action=0 end if if selected>0 and action=1 then #fful.gb "when leftButtonMove [track]" #fful.gb "when leftButtonUp [stop]" offsetX=xs-obj(selected,X) offsetY=ys-obj(selected,Y) end if if selected>0 and obj(selected,T)<>6 and action=2 then 'dont resize bmp #fful.gb "when leftButtonMove [tracksize]" #fful.gb "when leftButtonUp [stopsize]" offsetX=xs-(obj(selected,X)+obj(selected,W)) offsetY=ys-(obj(selected,Y)+obj(selected,H)) end if if selected>0 then gosub [drawit] else insertx=int((xs+(grid/2))/grid)*grid inserty=int((ys+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #fful.gb "rule xor" gosub [drawit] xt=int((MouseX-offsetX+(grid/2))/grid)*grid if xt<0 then xt=0 if xt+obj(selected,W)>projectw then xt=projectw-obj(selected,W) obj(selected,X)=xt yt=int((MouseY-offsetY+(grid/2))/grid)*grid if yt<0 then yt=0 if yt+obj(selected,H)>projecth then yt=projecth-obj(selected,H) obj(selected,Y)=yt gosub [drawit] wait
[stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[tracksize] #fful.gb "rule xor" gosub [drawit] xs=int((MouseX-offsetX+(grid/2))/grid)*grid if xs>projectw then xs=projectw if xs<obj(selected,X) then xs=obj(selected,X)+grid ys=int((MouseY-offsetY+(grid/2))/grid)*grid if ys>projecth then ys=projecth if ys<obj(selected,Y)+ctrh then ys=obj(selected,Y)+ctrh obj(selected,W)=xs-obj(selected,X)'width obj(selected,H)=ys-obj(selected,Y)'height gosub [drawit] wait
[stopsize] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,T)=12 then menuset=0 obj(selected,T)=0 selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,X) 'x cpy(2)=obj(selected,Y) 'y cpy(3)=obj(selected,W) 'w cpy(4)=obj(selected,H) 'h cpy(5)=obj(selected,T) 'type cpy(6)=obj(selected,TH) 'textheight cpy$(1)=obj$(selected,Ctr)'name cpy$(2)=obj$(selected,Tex)'text content cpy$(3)=obj$(selected,Res)'resource array or file path cpy$(4)=obj$(selected,Fon)'ctrl specific font or "" cpy$(5)=obj$(selected,Bak)'ctrl specific backcolor end if if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty inserty=inserty+cpy(4)+grid obj(obj,W)=cpy(3) obj(obj,H)=cpy(4) obj(obj,T)=cpy(5) obj(obj,TH)=cpy(6) obj$(obj,Ctr)=left$(cpy$(1),2);obj obj$(obj,Tex)=cpy$(2) obj$(obj,Res)=cpy$(3) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) obj$(obj,Fon)=cpy$(4) obj$(obj,Bak)=cpy$(5) selected=obj gosub [drawall] end if end if #fful.gb "setfocus" wait
[tool] #fful.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh obj(obj,T)=1 obj$(obj,Ctr)="st";obj obj$(obj,Tex)="statictext?" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 2 'textbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=ctrh obj(obj,T)=2 obj$(obj,Ctr)="tb";obj obj$(obj,Tex)="Textbox" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 3 'listbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=ctrh*5 obj(obj,T)=3 obj$(obj,Ctr)="lb";obj obj$(obj,Tex)="Listbox\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectlbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 4 'combobox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="cb";obj obj$(obj,Tex)="Combobox\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectcbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 5 'button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=5 obj$(obj,Ctr)="bt";obj obj$(obj,Tex)="Button?" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)="white" inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 6 'bmp button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=50 obj(obj,H)=50 obj(obj,T)=6 obj$(obj,Ctr)="bb";obj filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Res)=file$ obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),file$ close #bmp inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid else obj(obj,T)=0 close #bmp end if else obj(obj,T)=0 end if
case 7 'graphicbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=100 obj(obj,T)=7 obj$(obj,Ctr)="gb";obj obj$(obj,Tex)="Graphicbox" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=8 obj$(obj,Ctr)="rb";obj obj$(obj,Tex)="(o) radio?" obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 9 'checkbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="ch";obj obj$(obj,Tex)="[x] check?" obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=100 obj(obj,T)=10 obj$(obj,Ctr)="gr";obj obj$(obj,Tex)="Group Box?" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=100 obj(obj,T)=11 obj$(obj,Ctr)="te";obj obj$(obj,Tex)="Texteditor" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttecl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,X)=0 obj(obj,Y)=0 obj(obj,W)=100 obj(obj,H)=10 obj(obj,T)=12 obj$(obj,Ctr)="mn";obj obj$(obj,Tex)=" Menu Added" menuset=1 end if end select selected=obj gosub [drawall] #fful.tool "select Add New" #fful.gb "setfocus" wait
[form] #fful.form "selectionindex? i" select case i case 1 'restore file$="lastsession.ffu" gosub [loadit] case 2 'new gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 6 'write gosub [write] case 7 'import gosub [import] case 8 'export gosub [export] end select #fful.form "select File" gosub [drawall] #fful.gb "setfocus" wait
[drawall] #fful.gb "discard ; redraw bak" ocn=cn projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" for cn=1 to obj gosub [drawit] next cn=ocn #fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20 #fful.gb "setfocus" return
[drawit] 'redraws control cn
'set the color for the drawn object and action taking place if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if
'set the font for the drawn object if obj$(cn,Fon)="" then #fful.gb "font ";projectfont$ ch=projectctrh if obj(cn,H)<ch then obj(cn,H)=ch else #fful.gb "font ";obj$(cn,Fon) ch=obj(cn,TH) if obj(cn,H)<ch then obj(cn,H)=ch end if
'update the properties textboxes for selected control if cn=selected then #prop.tbctrl obj$(cn,Ctr) 'ctrlname #prop.tbtext obj$(cn,Tex) 'text #prop.tbreso obj$(cn,Res) 'resource #prop.tbxywh obj(cn,X);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height #prop.tbcolo obj$(cn,Bak) end if #fful.gb "place ";obj(cn,X);" ";obj(cn,Y) if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?" select case obj(cn,T) case 1 'statictext #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 2 'textbox #fful.gb "backcolor ";projecttbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 3 'listbox #fful.gb "backcolor ";projectlbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 4 'combobox #fful.gb "backcolor ";projectcbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 5 'button #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'buttons are always black on white #fful.gb "color black" 'centre button text #fful.gb "stringwidth? ";"A";" width" xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ #fful.gb "backcolor ";projectback$ case 6 'bmpbutton if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr) #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) case 7 ' graphicbox #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "backcolor ";projectback$ case 8 'radiobutton #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'radiobutton text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 9 'checkbox #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'checkbox text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 10 'groupbox #fful.gb "backcolor ";projectback$ 'groupbox is an outline #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'group box text is always black #fful.gb "color black" 'groupbox text is offset if action=0 then #fful.gb "place ";obj(cn,X)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 11 ' texteditor #fful.gb "backcolor ";projecttecl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 12 'menu 'pin to top left obj(cn,X)=10 : obj(cn,Y)=-10 : obj(cn,W)=100 : obj(cn,H)=10 #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 21 'tecolor projecttecl$=obj$(cn,Bak) case 22 'tbcolor projecttbcl$=obj$(cn,Bak) case 23 'lbcolor projectlbcl$=obj$(cn,Bak) case 24 'cbcolor projectcbcl$=obj$(cn,Bak) case 30 'font case 31 '!font end select
return
[preview] file$="preview.bas" gosub [writeit] wait
[quitnoform] close #noform wait
[write] projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas" filedialog "Save .bas",projectfile$,file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit] if file$<>"" then '#################################################### if projectwind$ = "" then WindowWidth=800 WindowHeight=150 open "No Forms" for text as #noform currentFile$ = GetFilename$(currentFile$) #noform currentFile$;" Has no Forms" #noform "!trapclose [quitnoform]" wait end if '#################################################### open file$ for output as #op 'the header #op " 'Project ";projecttitl$ #op " 'Created with Freeform Ultra Lite v";ver$;" ";date$() #op " nomainwin" #op "" if projectback$<>"white" or projectfore$<>"black" then #op " 'Set BackgroundColor$ and ForegroundColor$ of project" #op " BackgroundColor$=";chr$(34);projectback$;chr$(34) #op " ForegroundColor$=";chr$(34);projectfore$;chr$(34) #op "" end if #op " 'Create arrays needed for controls listbox,combobox" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " dim ";obj$(n,Res);"10)" #op " for n = 1 to 10" #op " ";obj$(n,Res);"n)= str$(n)" #op " next" end if next #op "" #op " 'Create controls and open window" #op " nomainwin" #op " WindowWidth = ";projectw #op " WindowHeight = ";projecth #op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"Size";chr$(34);", ";chr$(34);"Small";chr$(34);", [dummy], ";chr$(34);"Large";chr$(34);", [dummy]" end if for n=1 to obj select case obj(n,T) case 1 'statictext #op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox #op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor #op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 22 'tbcolor #op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'lbcolor #op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 24 'cbcolor #op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'tecolor #op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34) end select next #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ ' if projecttitl$ ="" or projectwind$ ="" then notice "No Forms Exist in ";file$ : goto [new] if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op "" #op " 'Set any listbox or combobox to display the first item on the list" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34) end if next #op " 'apply any control specific fonts" for n= 1 to obj if obj(n,T)<>0 and obj$(n,Fon)<>"" then if obj(n,T)=1 or obj(n,T)=2 or obj(n,T)=5 or obj(n,T)=10 or obj(n,T)=11 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34) end if if obj(n,T)=3 or obj(n,T)=4 or obj(n,T)=7 or obj(n,T)=8 or obj(n,T)=9 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34) end if end if next #op " wait" #op ""
if file$<>"preview.bas" then #op " 'Create the required handlers for each control" #op " 'Radiobutton and Checkboxes are given a single handler" check=0 radio=0 for n=1 to obj select case obj(n,T) case 3 'listbox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op "" case 4 'combobox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op "" case 5 'button #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op "" case 6 'bmpbutton #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op "" case 8 'radiobutton if radio=0 then #op " [radio]" #op " 'Your handler code here, read all radiobuttons to determine which is set" #op " 'this is an example of eading the first radiobutton" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" radio=1 end if case 9 'checkbox if check=0 then #op " [check]" #op " 'Your handler code here, read all checkboxes in the group in sequence." #op " 'this is an example of eading the first checkbox" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" check=1 end if end select next else #op " [radio]" #op " wait" #op "" #op " [check]" #op " wait" #op "" end if #op " [quit]" #op " close ";projectform$ #op " end" close #op files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] end if return
[saveas] projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu" filedialog "Save As...",projectname$,file$ if file$<>"" then open file$ for output as #op projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ #op projectfile$ #op projectwind$ #op projectform$ #op projecttitl$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth for n=1 to obj if obj(n,T)<>0 then #op obj(n,X);","; #op obj(n,Y);","; #op obj(n,W);","; #op obj(n,H);","; #op obj(n,T);","; #op obj(n,TH) #op obj$(n,Ctr) #op obj$(n,Tex) #op obj$(n,Res) #op obj$(n,Fon) #op obj$(n,Bak) end if next close #op gosub [propertyupdate] redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" end if return
[load] filedialog "Open Project...","*.ffu",file$ [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #ses input #ses, projectfile$ input #ses, projectwind$ input #ses, projectform$ input #ses, projecttitl$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #fful.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ projectctrh=val(c$) projectgrid=val(g$) grid=projectgrid projectw=val(w$) projecth=val(h$) #prop.cbwind "select ";projectwind$ redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.grid "select ";grid #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,X)=val(word$(l$,1,",")) obj(obj,Y)=val(word$(l$,2,",")) obj(obj,W)=val(word$(l$,3,",")) obj(obj,H)=val(word$(l$,4,",")) obj(obj,T)=val(word$(l$,5,",")) obj(obj,TH)=val(word$(l$,6,",")) line input #ses, obj$(obj,Ctr) line input #ses, obj$(obj,Tex) line input #ses, obj$(obj,Res) line input #ses, obj$(obj,Fon) line input #ses, obj$(obj,Bak) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) if obj(obj,T)=12 then menuset=1 wend close #ses gosub [propertyupdate] #prop "hide" #prop "show" end if return
[import] filedialog "Open .bas...","*.bas",file$ if file$<>"" then currentFile$ = file$ projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) gosub [new] grid=1 gridvisible=0 gosub [drawgrid] 'set grid to 1 and invisible so controls stay where they import from initially 'import only those lines defining controls we are interested in wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox " wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty " wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ " wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ " dim bas$(5000,2) basln=1 ln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, wln$ 'break into multiple lines if ":" found outside quotes pos=1 ln$="" while pos<=len(wln$) c$=mid$(wln$,pos,1) if c$=chr$(34)then if quote=0 then quote=1 else quote=0 end if if c$=":" and quote=0 then gosub [line] ln$="" pos=pos+1 else ln$=ln$+c$ pos=pos+1 end if wend gosub [line] basln=basln+1 wend print "first cut" for n=1 to ln print bas$(n,1);" ";bas$(n,2) next print
'now find width height title and handle for all windows found in bas$( 'up to 30 forms in a .bas '1=handle #main etc '2=title '3=width '4=height '5=windowtype '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
redim win$(30,10) redim hnd$(30) nl=ln wh=1 for ln=1 to nl 'find width and height ,assumes width and height are defined ahead of open 'so width height and colors can be set multiple times, so store bas line number involved if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1) if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1) if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1) if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1) if instr(lower$(bas$(ln,2)),"open",1)>0 then if instr(lower$(bas$(ln,2)),"window",1)>0 or instr(lower$(bas$(ln,2)),"dialog",1)>0 or instr(lower$(bas$(ln,2)),"graphic",1)>0 then win$(wh,10)=bas$(ln,1) n$=word$(bas$(ln,2),2,chr$(34)) hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1)) 'find last "for" in command line i=1 while i oi=i i=instr(lower$(bas$(ln,2))," for ",i+1) wend wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi) wt$=word$(wt$,2) win$(wh,1)=hn$ 'handle #fful etc win$(wh,2)=n$ 'title win$(wh,3)=w$ 'width win$(wh,4)=h$ 'height win$(wh,5)=wt$ 'windowtype hnd$(wh)=hn$ 'for combobox 'print wh;" ";hnd$(wh);" ";win$(wh,2);" ";win$(wh,3);" ";win$(wh,4);" ";win$(wh,5) wh=wh+1 end if end if next #fful.hand "reload" #fful.hand "selectindex 1" close #bas wh=1 gosub [loadwindow] end if return
[line] if ln$<>"" then w$=lower$(word$(ln$,1)) if instr(w$,"=",1)>1 then w$=word$(w$,1,"=") if len(w$)>3 then w1$=" "+w$+" " w2$=" "+w$+"=" if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 then bas$(ln,1)=str$(basln) bas$(ln,2)=trim$(ln$) ln=ln+1 end if end if end if return
[hand] #fful.hand "selectionindex? wh" gosub [loadwindow] wait
[loadwindow] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=1 menuset=0 projectback$="white" TextboxColor$="white" ListboxColor$="white" ComboboxColor$="white" TexteditorColor$="white" projectfore$="black" projectw=val(win$(wh,3)) if projectw=0 then projectw=320 projecth=val(win$(wh,4)) if projecth=0 then projecth=360 projecttitl$=win$(wh,2) projectwind$=win$(wh,5) projectform$=win$(wh,1) tbc$="" lbc$="" cbc$="" tec$="" gosub [propertyupdate] #fful.w "!";str$(projectw) #fful.h "!";str$(projecth)
'find controls and create obj() for ln=1 to nl 'create hidden objects to control font and color only used in import/export, not displayed ct=0 if instr(bas$(ln,2),"TextboxColor$",1)>0 then tbc$=getcolor$(bas$(ln,2)):ct=20 if instr(bas$(ln,2),"ListboxColor$",1)>0 then lbc$=getcolor$(bas$(ln,2)):ct=21 if instr(bas$(ln,2),"ComboboxColor$",1)>0 then cbc$=getcolor$(bas$(ln,2)):ct=22 if instr(bas$(ln,2),"TexteditorColor$",1)>0 then tec$=getcolor$(bas$(ln,2)):ct=23 if ct then obj(obj,T)=ct if ct=20 then obj$(obj,Bak)=tbc$ if ct=21 then obj$(obj,Bak)=lbc$ if ct=22 then obj$(obj,Bak)=cbc$ if ct=23 then obj$(obj,Bak)=tec$ obj$(obj,Bas)=bas$(ln,1) obj=obj+1 end if for wc=1 to 12 if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for next if wc<=11 then obj$(obj,Bas)=bas$(ln,1) l$=bas$(ln,2) ll$="" 'remove spaces leaving only , separation but keep "" text untouched inString=0 for i=1 to len(l$) c$=mid$(l$,i,1) select case case c$=chr$(34) inString=1-inString case (inString=0) and c$=" " c$="" end select ll$=ll$+c$ next 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1) obj(obj,T)=wc 'type obj(obj,TH)=projectctrh 'get the .ctrl name obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1) 'for un-named controls if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj 'get the text if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc) 'get the array or bmp file name if wc=3 or wc=4 or wc=6 then obj$(obj,Res)=word$(ll$,2,",") 'get rid of "" if wc=6 and left$(obj$(obj,Res),1)=chr$(34) then obj$(obj,Res)=mid$(obj$(obj,Res),2,len(obj$(obj,Res))-2) 'array() -> array( if (wc=3 or wc=4) and right$(obj$(obj,Res),1)=")" then obj$(obj,Res)=left$(obj$(obj,Res), len(obj$(obj,Res))-1) i=1 while word$(ll$,i,",")<>"" i=i+1 wend i=i-4 if wc=6 or wc=5 then 'buttons and bmpbuttons can have xy, wh is optional and they have XX corners if i=3 then obj(obj,X)=val(word$(ll$,i+2,","))'x obj(obj,Y)=val(word$(ll$,i+3,","))'y if wc=5 then 'we need to find a way to calculate width and height if not given #fful.gb "stringwidth? ";"A";" width" obj(obj,W)=width*len(obj$(obj,Tex))+10 obj(obj,H)=projectctrh end if if wc=6 then 'we need a way to set bmp w and h on error goto [dummybmp] open obj$(obj,Res) for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Tex)="bmp" end if loadbmp obj$(obj,Ctr),obj$(obj,Res) close #bmp goto [passdummy]
[dummybmp] obj(obj,W)=25 obj(obj,H)=25 obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),"path.bmp" [passdummy] end if else obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y obj(obj,W)=val(word$(ll$,i+2,","))'w obj(obj,H)=val(word$(ll$,i+3,","))'h end if if upper$(word$(ll$,4,","))="LR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="LL" then 'obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="UR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x 'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if else 'write to .bas tweaks listbox and combobox controls to line up properly 'so we need to untweak them now obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y if wc=1 then obj(obj,Y)=obj(obj,Y)-5 if wc=10 then obj(obj,Y)=obj(obj,Y)+5 if wc=3 or wc=4 then obj(obj,X)=obj(obj,X)-1 obj(obj,W)=val(word$(ll$,i+2,","))'w if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2 obj(obj,H)=val(word$(ll$,i+3,","))'h end if
'save color if set if wc=2 then obj$(obj,Bak)=tbc$ if wc=3 then obj$(obj,Bak)=lbc$ if wc=4 then obj$(obj,Bak)=cbc$ if wc=11 then obj$(obj,Bak)=tec$ obj=obj+1 end if next 'now find font commands listed after the open statement referring to the #form '#form.ctrl !font fontname 'if so add a new font object basln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ lln$=lower$(ln$) if instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font",1)>0 or instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font",1)>0 then f$=right$(ln$,len(ln$)-instr(lln$,"font",1)-4) if instr(f$,";",1)=0 then obj$(obj,Fon)=f$ obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1) obj$(obj,Ctr)=word$(word$(ln$,1),2,".") if instr(lln$,"!font",1)>0 then obj(obj,T)=31 else obj(obj,T)=30 obj$(obj,Bas)=str$(basln)
'find the visible object and store the font change for n=1 to obj if obj$(n,Ctr)=obj$(obj,Ctr) then obj$(n,Fon)=obj$(obj,Fon) #fful.gb "font ";obj$(obj,Fon) #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" obj(n,TH)=(yp-100)/2+7 exit for end if next obj=obj+1 end if end if basln=basln+1 wend
close #bas gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[export] dim oldbas$(5000) ln=1 if file$<>"" and right$(file$,3)="bas" then open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ oldbas$(ln)=ln$ ln=ln+1 wend close #bas '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
if win$(wh,6)<>"" then oldbas$(val(win$(wh,6)))=" BackgroundColor$=";chr$(34);projectback$;chr$(34) if win$(wh,7)<>"" then oldbas$(val(win$(wh,7)))=" ForegroundColor$=";chr$(34);projectfore$;chr$(34) if win$(wh,8)<>"" then oldbas$(val(win$(wh,8)))=" WindowWidth=";projectw if win$(wh,8)=win$(wh,9) then oldbas$(val(win$(wh,8)))=oldbas$(val(win$(wh,8)))+": WindowHeight=";projecth else oldbas$(val(win$(wh,9)))=" WindowHeight=";projecth if win$(wh,10)<>"" then oldbas$(val(win$(wh,10)))=" Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ for n=1 to obj select case obj(n,T) 'handle the visible controls case 1 'statictext oldbas$(val(obj$(n,Bas)))=" statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox oldbas$(val(obj$(n,Bas)))=" textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box oldbas$(val(obj$(n,Bas)))=" listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox oldbas$(val(obj$(n,Bas)))=" combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button oldbas$(val(obj$(n,Bas)))=" button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton oldbas$(val(obj$(n,Bas)))=" bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox oldbas$(val(obj$(n,Bas)))=" graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton oldbas$(val(obj$(n,Bas)))=" radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox oldbas$(val(obj$(n,Bas)))=" checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box oldbas$(val(obj$(n,Bas)))=" groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor oldbas$(val(obj$(n,Bas)))=" texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export case 20 'textboxcolor oldbas$(val(obj$(n,Bas)))=" TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'listboxcolor oldbas$(val(obj$(n,Bas)))=" ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 22 'comboboxcolor oldbas$(val(obj$(n,Bas)))=" ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'texteditorcolor oldbas$(val(obj$(n,Bas)))=" TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
'handle font changes case 30 'font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" font ";obj$(n,Fon);chr$(34) case 32 '!font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" !font ";obj$(n,Fon);chr$(34) end select next end if open file$ for output as #bas for n= 1 to ln #bas oldbas$(n) next close #bas return
function getsize$(l$) 'what if it is a variable? v$="" pos=1 n$=mid$(l$,pos,1) while instr("1234567890",n$,1)=0 and pos<len(l$) pos=pos+1 n$=mid$(l$,pos,1) wend while n$>="0" and n$<="9" and pos<=len(l$) v$=v$+n$ pos=pos+1 n$=mid$(l$,pos,1) wend getsize$=v$ end function
function getcolor$(l$) 'what if it is a variable? cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black " for c= 1 to 15 if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for next end function
[new] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=0 menuset=0 projectw=320 projecth=360 projectback$="white" projectfore$="black" projectctrc$="white" projecttitl$="Untitled" projectform$="#1" projectfile$="Untitled.bas" projectwind$="window_nf" #prop.cbwind "select window_nf" redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.w "select ";projectw #fful.h "select ";projecth gosub [propertyupdate] gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[propertyupdate] #prop.tbfile projectfile$ #prop.cbwind "select ";projectwind$ #prop.tbtitl projecttitl$ #prop.tbform projectform$ #prop.tbctrl "" #prop.tbtext "" #prop.tbreso "" #prop.tbxywh projectw;"x";projecth #prop.tbfont projectfont$ #prop.tbcolo projectfore$;"/";projectback$ return
[resize] #fful.tool "select Add New" #fful.form "select File" if wh=0 then wh=1 #fful.hand "selectindex ";wh #fful.grid "select Set Grid" #fful.font "select Set Font" #fful.color "select Set Color" #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawall] wait
[formsize] #fful.w "contents? w$" #fful.h "contents? h$" wf=val(w$) hf=val(h$) if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait projectw=wf projecth=hf insertx=grid inserty=grid gosub [drawgrid] #fful.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid spacing according to user choice, default is 10 #fful.grid "contents? g$" select case g$ case "Invisible" gridvisible=0 case "Visible" gridvisible=1 case else grid=val(g$) end select gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" wait
[drawgrid] if grid>0 then projectgrid=grid insertx=int((insertx+(grid/2))/grid)*grid inserty=int((inserty+(grid/2))/grid)*grid #fful.gb "cls; fill buttonface" #fful.gb "place 0 0 ; color ";projectback$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth #fful.gb "color ";gridcolor$;" ; backcolor ";projectback$ if gridvisible then for xs = 0 to projectw step grid print #fful.gb, "line ";xs;" 0 ";xs;" ";projecth next for ys = 0 to projecth step grid #fful.gb, "line 0 ";ys;" ";projectw;" ";ys next end if #fful.gb "flush bak" #fful.gb "color black" end if #fful.grid "select Set Grid" return
[font] #fful.font "contents? f$" if f$="Project Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #fful.gb "font ";projectfont$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" projectctrh=(yp-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Control Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #fful.gb "font ";ctrf$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" ctrh=(yp-100)/2+7 end if if selected then obj$(selected,4)=ctrf$ 'font obj(selected,6)=ctrh 'text height end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="ResetControl" then ctrf$=projectfont$ ctrh=projectctrh if selected then obj$(selected,4)=ctrf$ obj(selected,6)=ctrh end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then #fful.gb "font ";ctrf$ obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #fful.font "select Set Font" gosub [drawall] #fful.gb "setfocus" wait
[color] #fful.color "contents? c$" select case c$ case "Control Back" gosub [colorpick] if cp$<>"" then if selected then 'insert color change event ahead of control if obj(selected,T)=2 then ct=22 : projecttbcl$=cp$ if obj(selected,T)=3 then ct=23 : projectlbcl$=cp$ if obj(selected,T)=4 then ct=24 : projectcbcl$=cp$ if obj(selected,T)=11 then ct=21 : projecttecl$=cp$ for n=obj+1 to selected+1 step -1 obj(n,X)=obj(n-1,X) obj(n,Y)=obj(n-1,Y) obj(n,W)=obj(n-1,W) obj(n,H)=obj(n-1,H) obj(n,T)=obj(n-1,T) obj(n,TH)=obj(n-1,TH) obj$(n,Ctr)=obj$(n-1,Ctr) obj$(n,Tex)=obj$(n-1,Tex) obj$(n,Res)=obj$(n-1,Res) obj$(n,Fon)=obj$(n-1,Fon) obj$(n,Bak)=obj$(n-1,Bak) obj$(n,Bas)=obj$(n-1,Bas) next obj(selected,T)=ct obj$(selected,Tex)="Color!" obj$(selected,Bak)=cp$ 'remove any previous color change statement if selected>=2 then if obj(selected-1,T)=ct then obj(selected-1,T)=0 end if obj=obj+1 end if end if case "Project Back" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Project Fore" gosub [colorpick] if cp$<>"" then projectfore$=cp$ case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] end select #fful.color "select Set Color" gosub [drawall] #fful.gb "setfocus" wait
[windowtype] #prop.cbwind "contents? projectwind$" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #pick.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #pick #pick "font Consolas 9" #pick "trapclose [quitpick]" #pick.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white " c=1 for yc=1 to 160 step 40 for xc= 1 to 160 step 40 #pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40 c=c+1 if c>15 then c=15 next next #pick.gb "when leftButtonDown [pick]" wait
[pick] xp=int(MouseX/40) yp=int(MouseY/40) c=xp+yp*4+1 cp$=word$(cl$,c)
[quitpick] close #pick return
[help] run "notepad help.txt" wait
[quitfful] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectfile$ #ses projectwind$ #ses projectform$ #ses projecttitl$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth for n=1 to obj if obj(n,T)<>0 then #ses obj(n,X);","; #ses obj(n,Y);","; #ses obj(n,W);","; #ses obj(n,H);","; #ses obj(n,T);","; #ses obj(n,TH) #ses obj$(n,Ctr) #ses obj$(n,Tex) #ses obj$(n,Res) #ses obj$(n,Fon) #ses obj$(n,Bak) end if next close #ses close #prop close #fful end
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
function GetFilename$(fileName$) i = len(fileName$) while mid$(fileName$, i, 1) <> "\" and mid$(fileName$, i, 1) <> "" i = i-1 wend GetFilename$ = mid$(fileName$, i+1) end function
for n=1 to obj print n;" ";obj(n,X);" ";obj(n,Y);" ";obj(n,W);" ";obj(n,H);" ";obj(n,T);" ";obj(n,6);" "; print obj$(n,Ctr);" ";obj$(n,Tex);" ";obj$(n,Res);" ";obj$(n,Fon);" ";obj$(n,Bak);" ";obj$(n,6);" ";obj$(n,Bas);" " next
|
|
|
Post by xxgeek on May 24, 2023 19:21:21 GMT -5
I've gone through the code and made quite a few changes, some were fixes, some were just new ideas. I didn't record every change. The issue of importing a .bas with no forms, fixed by writing "No Forms" to #form. Removed the old code with the dumb notice, and the getFilename function.
The best part is I believe I have the placement of controls working. If a menu or a texteditor is added to the form you will notice the grid dimensions will change to reflect the new placement change. If all texteditors are removed, and no menu exists the grid dimensions will change back.(After a grid dimension change you will need to reposition your controls so they get placed properly)
2 more options have been added to color. border color, and crosshair color 2 options have been added to "Set grid". size 1 and 3
I worked hard to fix the duplicate issue with no luck so far, so there are no control event handlers yet. One annoyance from day one was the positioning of the form$ combobox. In almost all software "File" is on the far top left, so I moved it to where it is expected and I no longer have to backtrack my mouse when I go for it.
I have not added functions to this version, but will in future.
These new options do not need to be part of your FFUL Rod, I just wanted to provide the placement code to help out. Use what you want and discard the rest.
Hope this can be of help to someone.
ver$="1.92" 'freeform ultra lite v1.x by Rod 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1 nomainwin dim info$(10,10) dim form$(10) form$(1)="Restore" form$(2)="New" form$(3)="Save .ffu" form$(4)="Load .ffu" form$(5)="-----------" form$(6)="Write .bas" form$(7)="Import .bas" form$(8)="Export .bas" form$(9)="File" dim tool$(14) tool$(1)="StatictText" tool$(2)="TextBox" tool$(3)="ListBox" tool$(5)="ComboBox" tool$(6)="Button" tool$(7)="BmpButton" tool$(8)="GraphicBox" tool$(9)="RadioButton" tool$(10)="CheckBox" tool$(11)="GroupBox" tool$(12)="Texteditor" tool$(13)="Menu" tool$(14)="Add New" dim hnd$(30) hnd$(1)="#1" dim grid$(20) grid$(1)="1" grid$(2)="3" g=3 for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Invisible" grid$(g+1)="Visible" grid$(g+2)="Set Grid" grid=10 gridvisible=1 gridcolor$="buttonface" bordercolor$=gridcolor$ crosshair$ =bordercolor$ projectctrh=25 ctrh=25 dim color$(10) color$(1)="Control Background" color$(2)="Project Background" color$(3)="Project Foreground" color$(4)="Grid Color" color$(5)="Border Color" color$(6)="CrossHair Color" color$(7)="Set Color" projectback$="white" projectfore$="black" 'ctrc$="white" dim font$(10) font$(1)="Control Font" font$(2)="ResetControl" font$(3)="Project Font" font$(4)="Set Font"'default is Consolas 9" dim wind$(20)'window type names wind$(1)="window" wind$(2)="window_nf" wind$(3)="window_popup" wind$(4)="dialog" wind$(5)="dialog_modal" wind$(6)="dialog_nf" wind$(7)="dialog_nf_modal" wind$(8)="dialog_fs" wind$(9)="dialog_nf_fs" wind$(10)="dialog_popup" wind$(11)="graphics" wind$(12)="graphics_fs" wind$(13)="graphics_fs_nsb" wind$(14)="graphics_nsb" wind$(15)="graphics_nf_nsb" wind$(16)="text" wind$(17)="text_fs" wind$(18)="text_nsb" wind$(19)="text_nsb_ins"
dim v$(2000) for n= 100 to 2000 step 20 v$(n)=str$(n) next dim obj(200,6) 'x,y,width/height,type,textheight X=1 Y=2 W=3 H=4 T=5 TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline Ctr=1 Tex=2 Res=3 Fon=4 Bak=5 Bas=7
'set default starting position obj=0 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" projectctrh=25 projectgrid=10 projectw=600 projecth=400 insertx=grid inserty=grid*2
'open a small properties window and hide it WindowWidth=230 WindowHeight=260 UpperLeftX=(DisplayWidth-230)/2 UpperLeftY=(DisplayHeight-180)/2 statictext #prop.st1 "File",5,10,30,25 textbox #prop.tbfile,45,5,150,25 statictext #prop.st2 "Wind",5,32,30,25 combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25 statictext #prop.st3 "Titl",5,54,30,25 textbox #prop.tbtitl,45,49,150,25 statictext #prop.st4 "Form",5,76,30,25 textbox #prop.tbform,45,71,150,25 statictext #prop.st5 "Ctrl",5,98,30,25 textbox #prop.tbctrl,45,93,150,25 statictext #prop.st6 "Text",5,120,30,25 textbox #prop.tbtext,45,115,150,25 statictext #prop.st7 "Reso",5,142,30,25 textbox #prop.tbreso,45,137,150,25 statictext #prop.st8 "xywh",5,164,30,25 textbox #prop.tbxywh,45,159,150,25 statictext #prop.st9 "Font",5,186,30,25 textbox #prop.tbfont,45,181,150,25 statictext #prop.st10 "Colo",5,208,30,25 textbox #prop.tbcolo,45,203,150,25
open "Properties" for window_nf as #prop #prop "font Consolas 9" #prop "trapclose [show]" #prop.cbwind "select window_nf" #prop.tbfile "!disable" #prop.tbxywh "!disable" #prop.tbfont "!disable" #prop.tbcolo "!disable" gosub [propertyupdate] #prop "hide"
'open the main form window 'this window is resizable, the graphicox will resize but the 'client area, which is a drawn representation of the window 'will only change size if you change the project w/h dimensions WindowWidth=860 WindowHeight=705 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #fful.form,form$(,[form],5,2,85,30 combobox #fful.hand,hnd$(,[hand],95,2,85,30 combobox #fful.tool,tool$(,[tool],185,2,85,30 button #fful.project,"Preview",[preview],UL,275,0,60,25 combobox #fful.w,v$(,[formsize],340,2,60,30 combobox #fful.h,v$(,[formsize],405,2,60,30 combobox #fful.grid,grid$(,[grid],470,2,90,30 combobox #fful.color,color$(,[color],565,2,130,30 combobox #fful.font,font$(,[font],700,2,90,30 button #fful.help,"Help",[help],UL,795,0,40,25 graphicbox #fful.gb,5,25,830,630 open "FFULv";ver$;" Forms Controls Form Dimensions Grid Size Colors Fonts" for window as #fful #fful "trapclose [quitfful]" #fful "font Consolas 9" #fful "resizehandler [resize]" #fful.tool "select Add New" #fful.form "select File" #fful.hand "selectindex 1" #fful.grid "select Set Grid" #fful.color "select Set Color" #fful.font "select Set Font" #fful.w "select ";projectw #fful.h "select ";projecth #fful.gb "autoresize" #fful.gb "vertscrollbar on 0 ";projectw #fful.gb "horizscrollbar on 0 ";projecth #fful.gb "font ";projectfont$ #fful.gb "down" gosub [drawgrid] gosub [drawall] #fful.gb "when rightButtonDown [show]" #fful.gb "when leftButtonDown [select]" #fful.gb "when characterInput [keys]" #fful.gb "setfocus" #prop "show" show=1 wait
[show] if show then #prop "hide" show=0 else #prop "show" show=1 end if wait
'the user clicked on the form design window 'either to chose a control or to deselect a control [select] xs=MouseX ys=MouseY 'hide property window if it is open if show then #prop "hide" show=0 end if
'before we move on update the currently selected control from properties 'get the project data and only the editable contents of controls if selected=0 then 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ end if #prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$ #prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$ #prop.tbreso "!contents? t$" : obj$(selected,Res)=t$ 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if xs>obj(cn,X) and xs<(obj(cn,X)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then if xs>obj(cn,X)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2 if obj(cn,T)=6 then action=1 selected=cn exit for end if next if selected=0 then gosub [propertyupdate] action=0 end if if selected>0 and action=1 then #fful.gb "when leftButtonMove [track]" #fful.gb "when leftButtonUp [stop]" offsetX=xs-obj(selected,X) offsetY=ys-obj(selected,Y) end if if selected>0 and obj(selected,T)<>6 and action=2 then 'dont resize bmp #fful.gb "when leftButtonMove [tracksize]" #fful.gb "when leftButtonUp [stopsize]" offsetX=xs-(obj(selected,X)+obj(selected,W)) offsetY=ys-(obj(selected,Y)+obj(selected,H)) end if if selected>0 then gosub [drawit] else insertx=int((xs+(grid/2))/grid)*grid inserty=int((ys+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #fful.gb "rule xor" gosub [drawit] xt=int((MouseX-offsetX+(grid/2))/grid)*grid if xt<0 then xt=0'11 if xt+obj(selected,W)>projectw then xt=projectw-obj(selected,W) obj(selected,X)=xt yt=int((MouseY-offsetY+(grid/2))/grid)*grid if menuset = 0 and textEd = 0 then if yt<0 then yt=0 if yt+obj(selected,H)>projecth-25 then yt=projecth-obj(selected,H)-25 obj(selected,Y)=yt end if
if menuset = 1 or textEd > 0 then if yt < 0 then yt = 0 if yt+obj(selected,H)>projecth-50 then yt=projecth-obj(selected,H)-50 obj(selected,Y)=yt end if gosub [drawit] wait
[stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[tracksize] #fful.gb "rule xor" gosub [drawit] xs=int((MouseX-offsetX+(grid/2))/grid)*grid if xs>projectw then xs=projectw if xs<obj(selected,X) then xs=obj(selected,X)+grid ys=int((MouseY-offsetY+(grid/2))/grid)*grid if ys>projecth then ys=projecth if ys<obj(selected,Y)+ctrh then ys=obj(selected,Y)+ctrh obj(selected,W)=xs-obj(selected,X)'width if menuset = 1 or textEd > 0 then obj(selected,H)=ys-obj(selected,Y)-50'height if menuset = 0 and textEd = 0 then obj(selected,H)=ys-obj(selected,Y)-25'height gosub [drawit] wait
[stopsize] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,T)=12 then menuset = 0 : gosub [drawgrid] 'menu if obj(selected,T)=11 then 'texteditor textEd = textEd-1 gosub [drawgrid] end if obj(selected,T)=0 selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,X) 'x cpy(2)=obj(selected,Y) 'y cpy(3)=obj(selected,W) 'w cpy(4)=obj(selected,H) 'h cpy(5)=obj(selected,T) 'type cpy(6)=obj(selected,TH) 'textheight cpy$(1)=obj$(selected,Ctr) 'name cpy$(2)=obj$(selected,Tex) 'text content cpy$(3)=obj$(selected,Res) 'resource array or file path cpy$(4)=obj$(selected,Fon) 'ctrl specific font or "" cpy$(5)=obj$(selected,Bak) 'ctrl specific backcolor end if
if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 if obj(obj,T)=11 then textEd = textEd+1 'texteditor obj(obj,X)=insertx obj(obj,Y)=inserty inserty=inserty+cpy(4)+grid obj(obj,W)=cpy(3) obj(obj,H)=cpy(4) obj(obj,T)=cpy(5) obj(obj,TH)=cpy(6) obj$(obj,Ctr)=left$(cpy$(1),11)';obj obj$(obj,Tex)=cpy$(2) obj$(obj,Res)=cpy$(3) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) obj$(obj,Fon)=cpy$(4) obj$(obj,Bak)=cpy$(5) selected=obj gosub [drawall] end if end if #fful.gb "setfocus" wait
[tool] #fful.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext sttx = sttx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=1 obj$(obj,Ctr)="statictext";sttx obj$(obj,Tex)="Statictext-";sttx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 2 'textbox txtbx = txtbx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=2 obj$(obj,Ctr)="textbox";txtbx obj$(obj,Tex)="Textbox-";txtbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 3 'listbox lstbx = lstbx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh*5 obj(obj,T)=3 obj$(obj,Ctr)="listbox";lstbx obj$(obj,Tex)="Listbox-";lstbx;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectlbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 4 'combobox cmbobx = cmbobx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="combobox";cmbobx obj$(obj,Tex)="Combobox-";cmbobx;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectcbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 5 'button bttn = bttn +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=5 obj$(obj,Ctr)="button";bttn obj$(obj,Tex)="button-";bttn if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)="white" inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 6 'bmp button bmpbtn = bmpbtn +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=50 obj(obj,H)=50 obj(obj,T)=6 obj$(obj,Ctr)="bmp\bmpButton";bmpbtn filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Res)=file$ obj$(obj,Tex)="BMPbutton-";bmpbtn loadbmp obj$(obj,Ctr),file$ close #bmp inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid else obj(obj,T)=0 close #bmp end if else obj(obj,T)=0 end if
case 7 'graphicbox grbx = grbx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*3 obj(obj,T)=7 obj$(obj,Ctr)="graphicbox";grbx obj$(obj,Tex)="Graphicbox-";grbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton radio = 1 rdiobtn = rdiobtn + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 obj(obj,H)=ctrh obj(obj,T)=8 obj$(obj,Ctr)="radiobutton";rdiobtn obj$(obj,Tex)="(o) radioBtn-";rdiobtn obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 9 'checkbox check = 1 chkbx = chkbx+1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="checkbox";chkbx obj$(obj,Tex)="[x] checkbox-";chkbx obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox grpbx = grpbx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*4 obj(obj,T)=10 obj$(obj,Ctr)="groupbox";grpbx obj$(obj,Tex)="Group Box-";grpbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor textEd = textEd+1 gosub [drawgrid] obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh*4 obj(obj,T)=11 obj$(obj,Ctr)="texteditor";textEd obj$(obj,Tex)="Texteditor-";textEd if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttecl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,X)=0 obj(obj,Y)=0 obj(obj,W)=100 obj(obj,H)=10 obj(obj,T)=12 obj$(obj,Ctr)="menu";obj obj$(obj,Tex)=" Menu Added" inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid gosub [drawgrid] end if end select selected=obj gosub [drawall] #fful.tool "select Add New" #fful.gb "setfocus" wait
[form] #fful.form "selectionindex? i" select case i case 1 'restore file$="lastsession.ffu" gosub [loadit] case 2 'new gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 6 'write gosub [write] case 7 'import gosub [import] case 8 'export gosub [export] end select #fful.form "select File" gosub [drawall] #fful.gb "setfocus" wait
[drawall] #fful.gb "discard ; redraw bak" ocn=cn projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" for cn=1 to obj gosub [drawit] next cn=ocn #fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20 #fful.gb "setfocus" return
[drawit] 'redraws control cn 'set the color for the drawn object and action taking place if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if
'set the font for the drawn object if obj$(cn,Fon)="" then #fful.gb "font ";projectfont$ ch=projectctrh if obj(cn,H)<ch then obj(cn,H)=ch else #fful.gb "font ";obj$(cn,Fon) ch=obj(cn,TH) if obj(cn,H)<ch then obj(cn,H)=ch end if
'update the properties textboxes for selected control if cn=selected then #prop.tbctrl obj$(cn,Ctr) 'ctrlname #prop.tbtext obj$(cn,Tex) 'text #prop.tbreso obj$(cn,Res) 'resource #prop.tbxywh obj(cn,X);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height #prop.tbcolo obj$(cn,Bak) end if #fful.gb "place ";obj(cn,X);" ";obj(cn,Y) if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?" select case obj(cn,T) case 1 'statictext #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 2 'textbox #fful.gb "backcolor ";projecttbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 3 'listbox #fful.gb "backcolor ";projectlbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 4 'combobox #fful.gb "backcolor ";projectcbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 5 'button #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'buttons are always black on white #fful.gb "color black" 'centre button text #fful.gb "stringwidth? ";"A";" width" xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ #fful.gb "backcolor ";projectback$ case 6 'bmpbutton if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr) #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) case 7 ' graphicbox #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "backcolor ";projectback$ case 8 'radiobutton #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'radiobutton text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 9 'checkbox #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'checkbox text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 10 'groupbox #fful.gb "backcolor ";projectback$ 'groupbox is an outline #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'group box text is always black #fful.gb "color black" 'groupbox text is offset if action=0 then #fful.gb "place ";obj(cn,X)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 11 ' texteditor #fful.gb "backcolor ";projecttecl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 12 'menu 'pin to top left obj(cn,X)=10 : obj(cn,Y)=-10 : obj(cn,W)=100 : obj(cn,H)=10 xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X);" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) '#fful.gb "box ";obj(cn,X)+obj(cn,H);" ";obj(cn,Y)+obj(cn,H) #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 21 'tecolor projecttecl$=obj$(cn,Bak) case 22 'tbcolor projecttbcl$=obj$(cn,Bak) case 23 'lbcolor projectlbcl$=obj$(cn,Bak) case 24 'cbcolor projectcbcl$=obj$(cn,Bak) case 30 'font case 31 '!font end select return
[preview] file$="preview.bas" gosub [writeit] wait
[quitnoform] close #noform wait
[write] projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas" filedialog "Save .bas",projectfile$,file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit] if file$<>"" then '#################################################### if projectwind$ = "" then wait '#################################################### open file$ for output as #op 'the header #op " 'Project ";projecttitl$ #op " 'Created with Freeform Ultra Lite v";ver$;" ";date$() #op "" if projectback$<>"white" or projectfore$<>"black" then #op " 'Set BackgroundColor$ and ForegroundColor$ of project" #op " BackgroundColor$=";chr$(34);projectback$;chr$(34) #op " ForegroundColor$=";chr$(34);projectfore$;chr$(34) #op "" end if #op " 'Create arrays needed for controls listbox,combobox" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " dim ";obj$(n,Ctr);"$(10)" #op " for n = 1 to 10" #op " ";obj$(n,Ctr);"$(n)= str$(n)" #op " next" end if next #op "" #op " 'Create controls and open window" #op " nomainwin" #op " WindowWidth = ";projectw #op " WindowHeight = ";projecth #op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"Size";chr$(34);", ";chr$(34);"Small";chr$(34);", [dummy], ";chr$(34);"Large";chr$(34);", [dummy]" end if for n=1 to obj select case obj(n,T) case 1 'statictext #op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox #op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ctr);"$(, [";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ctr);"$(, [";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"],[no";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"],[un";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor #op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 22 'tbcolor #op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'lbcolor #op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 24 'cbcolor #op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'tecolor #op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34) end select next #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op "" #op " 'Set any listbox or combobox to display the first item on the list" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34) end if next #op " 'apply any control specific fonts" for n= 1 to obj if obj(n,T)<>0 and obj$(n,Fon)<>"" then if obj(n,T)=1 or obj(n,T)=2 or obj(n,T)=5 or obj(n,T)=10 or obj(n,T)=11 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34) end if if obj(n,T)=3 or obj(n,T)=4 or obj(n,T)=7 or obj(n,T)=8 or obj(n,T)=9 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34) end if end if next #op " wait" #op ""
if file$<>"preview.bas" then '#op " 'Create the required handlers for each control" '#op " 'Radiobutton and Checkboxes are given a single handler" 'check=0 'radio=0 for n=1 to obj select case obj(n,T) case 3 'listbox listbx =listbx+1 #op " [listbox";listbx;"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op " " case 4 'combobox combobx =combobx+1 #op " [combobox";combobx;"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);", ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op " " case 5 'button buttn=buttn+1 #op " [button";buttn;"click]" #op " 'Your handler code here" #op " wait" #op " " case 6 'bmpbutton bmpbtn=bmpbtn+1 #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op " " case 8 'radiobutton radiobtn = radiobtn + 1 #op " [radiobutton";radiobtn;"]" #op " 'Your handler code here." #op " wait" #op " " #op " [noradiobutton";radiobtn;"]" #op " 'Your handler code here." #op " wait" #op " " case 9 'checkbox chekbx = chekbx + 1 #op " [checkbox";chekbx;"]" #op " 'Your handler code here." #op " wait" #op " " #op " [uncheckbox";chekbx;"]" #op " 'Your handler code here." #op " wait" [dontwrite2] #op " " end select next end if end if #op " " #op " [quit]" #op " close ";projectform$ #op " end" close #op
files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] return
[saveas] projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu" filedialog "Save As...",projectname$,file$ if file$<>"" then open file$ for output as #op projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ #op projectfile$ #op projectwind$ #op projectform$ #op projecttitl$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth for n=1 to obj if obj(n,T)<>0 then #op obj(n,X);","; #op obj(n,Y);","; #op obj(n,W);","; #op obj(n,H);","; #op obj(n,T);","; #op obj(n,TH) #op obj$(n,Ctr) #op obj$(n,Tex) #op obj$(n,Res) #op obj$(n,Fon) #op obj$(n,Bak) end if next close #op gosub [propertyupdate] redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" end if return
[load] obj = 0 gosub [resetVars] filedialog "Open Project...","*.ffu",file$ [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #ses input #ses, projectfile$ input #ses, projectwind$ input #ses, projectform$ input #ses, projecttitl$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #fful.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ projectctrh=val(c$) projectgrid=val(g$) grid=projectgrid projectw=val(w$) projecth=val(h$) #prop.cbwind "select ";projectwind$ redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.grid "select ";grid #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,X)=val(word$(l$,1,",")) obj(obj,Y)=val(word$(l$,2,",")) obj(obj,W)=val(word$(l$,3,",")) obj(obj,H)=val(word$(l$,4,",")) obj(obj,T)=val(word$(l$,5,",")) obj(obj,TH)=val(word$(l$,6,",")) line input #ses, obj$(obj,Ctr) line input #ses, obj$(obj,Tex) line input #ses, obj$(obj,Res) line input #ses, obj$(obj,Fon) line input #ses, obj$(obj,Bak) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) if obj(obj,T)=12 then menuset=1 if obj(obj,T)=11 then textEd= textEd+1 : gosub [drawgrid] wend close #ses gosub [propertyupdate] #prop "hide" #prop "show" end if return
[import] filedialog "Open .bas...","*.bas",file$ if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) gosub [new] grid=1 gridvisible=0 gosub [drawgrid] 'set grid to 1 and invisible so controls stay where they import from initially 'import only those lines defining controls we are interested in wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox " wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty " wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ " wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ " dim bas$(5000,2) basln=1 ln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, wln$ 'break into multiple lines if ":" found outside quotes pos=1 ln$="" while pos<=len(wln$) c$=mid$(wln$,pos,1) if c$=chr$(34)then if quote=0 then quote=1 else quote=0 end if if c$=":" and quote=0 then gosub [line] ln$="" pos=pos+1 else ln$=ln$+c$ pos=pos+1 end if wend gosub [line] basln=basln+1 wend 'print "first cut" 'for n=1 to ln 'print bas$(n,1);" ";bas$(n,2) 'next 'print
'now find width height title and handle for all windows found in bas$( 'up to 30 forms in a .bas '1=handle #main etc '2=title '3=width '4=height '5=windowtype '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
redim win$(30,10) redim hnd$(30) nl=ln wh=1 for ln=1 to nl 'find width and height ,assumes width and height are defined ahead of open 'so width height and colors can be set multiple times, so store bas line number involved if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1) if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1) if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1) if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1) if instr(lower$(bas$(ln,2)),"open",1)>0 then if instr(lower$(bas$(ln,2)),"window",1)>0 or instr(lower$(bas$(ln,2)),"dialog",1)>0 or instr(lower$(bas$(ln,2)),"graphic",1)>0 then win$(wh,10)=bas$(ln,1) n$=word$(bas$(ln,2),2,chr$(34)) hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1)) 'find last "for" in command line i=1 while i oi=i i=instr(lower$(bas$(ln,2))," for ",i+1) wend wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi) wt$=word$(wt$,2) win$(wh,1)=hn$ 'handle #fful etc win$(wh,2)=n$ 'title win$(wh,3)=w$ 'width win$(wh,4)=h$ 'height win$(wh,5)=wt$ 'windowtype hnd$(wh)=hn$ 'for combobox 'print wh;" ";hnd$(wh);" ";win$(wh,2);" ";win$(wh,3);" ";win$(wh,4);" ";win$(wh,5) wh=wh+1 end if end if next #fful.hand "reload" #fful.hand "selectindex 1" close #bas if wt$ = "" then #fful.hand "!No Forms" wh=1 gosub [loadwindow] end if return
[line] if ln$<>"" then w$=lower$(word$(ln$,1)) if instr(w$,"=",1)>1 then w$=word$(w$,1,"=") if len(w$)>3 then w1$=" "+w$+" " w2$=" "+w$+"=" if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 then bas$(ln,1)=str$(basln) bas$(ln,2)=trim$(ln$) ln=ln+1 end if end if end if return
[hand] #fful.hand "selectionindex? wh" gosub [loadwindow] wait
[loadwindow] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font gosub [resetVars] obj=1 projectback$="white" TextboxColor$="white" ListboxColor$="white" ComboboxColor$="white" TexteditorColor$="white" projectfore$="black" projectw=val(win$(wh,3)) if projectw=0 then projectw=600 projecth=val(win$(wh,4)) if projecth=0 then projecth=400 projecttitl$=win$(wh,2) projectwind$=win$(wh,5) projectform$=win$(wh,1) tbc$="" lbc$="" cbc$="" tec$="" gosub [propertyupdate] #fful.w "!";str$(projectw) #fful.h "!";str$(projecth)
'find controls and create obj() for ln=1 to nl 'create hidden objects to control font and color only used in import/export, not displayed ct=0 if instr(bas$(ln,2),"TextboxColor$",1)>0 then tbc$=getcolor$(bas$(ln,2)):ct=20 if instr(bas$(ln,2),"ListboxColor$",1)>0 then lbc$=getcolor$(bas$(ln,2)):ct=21 if instr(bas$(ln,2),"ComboboxColor$",1)>0 then cbc$=getcolor$(bas$(ln,2)):ct=22 if instr(bas$(ln,2),"TexteditorColor$",1)>0 then tec$=getcolor$(bas$(ln,2)):ct=23 if ct then obj(obj,T)=ct if ct=20 then obj$(obj,Bak)=tbc$ if ct=21 then obj$(obj,Bak)=lbc$ if ct=22 then obj$(obj,Bak)=cbc$ if ct=23 then obj$(obj,Bak)=tec$ obj$(obj,Bas)=bas$(ln,1) obj=obj+1 end if for wc=1 to 12 if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for next if wc<=11 then obj$(obj,Bas)=bas$(ln,1) l$=bas$(ln,2) ll$="" 'remove spaces leaving only , separation but keep "" text untouched inString=0 for i=1 to len(l$) c$=mid$(l$,i,1) select case case c$=chr$(34) inString=1-inString case (inString=0) and c$=" " c$="" end select ll$=ll$+c$ next 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1) obj(obj,T)=wc 'type obj(obj,TH)=projectctrh 'get the .ctrl name obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1) 'for un-named controls if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj 'get the text if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc) 'get the array or bmp file name if wc=3 or wc=4 or wc=6 then obj$(obj,Res)=word$(ll$,2,",") 'get rid of "" if wc=6 and left$(obj$(obj,Res),1)=chr$(34) then obj$(obj,Res)=mid$(obj$(obj,Res),2,len(obj$(obj,Res))-2) 'array() -> array( if (wc=3 or wc=4) and right$(obj$(obj,Res),1)=")" then obj$(obj,Res)=left$(obj$(obj,Res), len(obj$(obj,Res))-1) i=1 while word$(ll$,i,",")<>"" i=i+1 wend i=i-4 if wc=6 or wc=5 then 'buttons and bmpbuttons can have xy, wh is optional and they have XX corners if i=3 then obj(obj,X)=val(word$(ll$,i+2,","))'x obj(obj,Y)=val(word$(ll$,i+3,","))'y if wc=5 then 'we need to find a way to calculate width and height if not given #fful.gb "stringwidth? ";"A";" width" obj(obj,W)=width*len(obj$(obj,Tex))+10 obj(obj,H)=projectctrh end if if wc=6 then 'we need a way to set bmp w and h on error goto [dummybmp] open obj$(obj,Res) for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Tex)="bmp" end if loadbmp obj$(obj,Ctr),obj$(obj,Res) close #bmp goto [passdummy]
[dummybmp] obj(obj,W)=25 obj(obj,H)=25 obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),"path.bmp" [passdummy] end if else obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y obj(obj,W)=val(word$(ll$,i+2,","))'w obj(obj,H)=val(word$(ll$,i+3,","))'h end if if upper$(word$(ll$,4,","))="LR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="LL" then 'obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="UR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x 'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if else 'write to .bas tweaks listbox and combobox controls to line up properly 'so we need to untweak them now obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y if wc=1 then obj(obj,Y)=obj(obj,Y)-5 if wc=10 then obj(obj,Y)=obj(obj,Y)+5 if wc=3 or wc=4 then obj(obj,X)=obj(obj,X)-1 obj(obj,W)=val(word$(ll$,i+2,","))'w if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2 obj(obj,H)=val(word$(ll$,i+3,","))'h end if
'save color if set if wc=2 then obj$(obj,Bak)=tbc$ if wc=3 then obj$(obj,Bak)=lbc$ if wc=4 then obj$(obj,Bak)=cbc$ if wc=11 then obj$(obj,Bak)=tec$ obj=obj+1 end if next 'now find font commands listed after the open statement referring to the #form '#form.ctrl !font fontname 'if so add a new font object basln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ lln$=lower$(ln$) if instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font",1)>0 or instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font",1)>0 then f$=right$(ln$,len(ln$)-instr(lln$,"font",1)-4) if instr(f$,";",1)=0 then obj$(obj,Fon)=f$ obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1) obj$(obj,Ctr)=word$(word$(ln$,1),2,".") if instr(lln$,"!font",1)>0 then obj(obj,T)=31 else obj(obj,T)=30 obj$(obj,Bas)=str$(basln)
'find the visible object and store the font change for n=1 to obj if obj$(n,Ctr)=obj$(obj,Ctr) then obj$(n,Fon)=obj$(obj,Fon) #fful.gb "font ";obj$(obj,Fon) #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" obj(n,TH)=(yp-100)/2+7 exit for end if next obj=obj+1 end if end if basln=basln+1 wend close #bas gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[export] dim oldbas$(5000) ln=1 if file$<>"" and right$(file$,3)="bas" then open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ oldbas$(ln)=ln$ ln=ln+1 wend close #bas '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline if win$(wh,6)<>"" then oldbas$(val(win$(wh,6)))=" BackgroundColor$=";chr$(34);projectback$;chr$(34) if win$(wh,7)<>"" then oldbas$(val(win$(wh,7)))=" ForegroundColor$=";chr$(34);projectfore$;chr$(34) if win$(wh,8)<>"" then oldbas$(val(win$(wh,8)))=" WindowWidth=";projectw if win$(wh,8)=win$(wh,9) then oldbas$(val(win$(wh,8)))=oldbas$(val(win$(wh,8)))+": WindowHeight=";projecth else oldbas$(val(win$(wh,9)))=" WindowHeight=";projecth if win$(wh,10)<>"" then oldbas$(val(win$(wh,10)))=" Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ for n=1 to obj select case obj(n,T) 'handle the visible controls case 1 'statictext oldbas$(val(obj$(n,Bas)))=" statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox oldbas$(val(obj$(n,Bas)))=" textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box oldbas$(val(obj$(n,Bas)))=" listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox oldbas$(val(obj$(n,Bas)))=" combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button oldbas$(val(obj$(n,Bas)))=" button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton oldbas$(val(obj$(n,Bas)))=" bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox oldbas$(val(obj$(n,Bas)))=" graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton oldbas$(val(obj$(n,Bas)))=" radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox oldbas$(val(obj$(n,Bas)))=" checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box oldbas$(val(obj$(n,Bas)))=" groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor oldbas$(val(obj$(n,Bas)))=" texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export case 20 'textboxcolor oldbas$(val(obj$(n,Bas)))=" TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'listboxcolor oldbas$(val(obj$(n,Bas)))=" ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 22 'comboboxcolor oldbas$(val(obj$(n,Bas)))=" ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'texteditorcolor oldbas$(val(obj$(n,Bas)))=" TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
'handle font changes case 30 'font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" font ";obj$(n,Fon);chr$(34) case 32 '!font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" !font ";obj$(n,Fon);chr$(34) end select next end if open file$ for output as #bas for n= 1 to ln #bas oldbas$(n) next close #bas return
function getsize$(l$) 'what if it is a variable? v$="" pos=1 n$=mid$(l$,pos,1) while instr("1234567890",n$,1)=0 and pos<len(l$) pos=pos+1 n$=mid$(l$,pos,1) wend while n$>="0" and n$<="9" and pos<=len(l$) v$=v$+n$ pos=pos+1 n$=mid$(l$,pos,1) wend getsize$=v$ end function
function getcolor$(l$) 'what if it is a variable? cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black " for c= 1 to 15 if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for next end function
[new] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=0 gosub [resetVars] projectw=600 projecth=400 projectback$="white" projectfore$="black" projectctrc$="white" projecttitl$="Untitled" projectform$="#1" projectfile$="Untitled.bas" projectwind$="window_nf" #prop.cbwind "select window_nf" redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.w "select ";projectw #fful.h "select ";projecth gosub [propertyupdate] gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[propertyupdate] #prop.tbfile projectfile$ #prop.cbwind "select ";projectwind$ #prop.tbtitl projecttitl$ #prop.tbform projectform$ #prop.tbctrl "" #prop.tbtext "" #prop.tbreso "" #prop.tbxywh projectw;"x";projecth #prop.tbfont projectfont$ #prop.tbcolo projectfore$;"/";projectback$ return
[resetVars] obj=0:menuset=0:textEd=0:check=0:radio=0:sttx=0:txtbx=0:lstbx=0:radiobtn=0:chekbx=0 cmbobx=0:bttn=0:bmpbtn=0:grbx=0:rdiobtn=0:chkbx=0:grpbx=0:combobx=0 return
[resize] #fful.tool "select Add New" #fful.form "select File" if wh=0 then wh=1 #fful.hand "selectindex ";wh #fful.grid "select Set Grid" #fful.font "select Set Font" #fful.color "select Set Color" #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawall] wait
[formsize] #fful.w "contents? w$" #fful.h "contents? h$" wf=val(w$) hf=val(h$) if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait projectw=wf projecth=hf insertx=grid inserty=grid gosub [drawgrid] #fful.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid spacing according to user choice, default is 10 #fful.grid "contents? g$" select case g$ case "Invisible" gridvisible=0 case "Visible" gridvisible=1 case else grid=val(g$) end select gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" wait
[drawgrid] if textEd<0 then textEd=0 projectgrid=grid #fful.gb "cls; fill buttonface" if grid > 0 and gridvisible = 1 then #fful.gb "color ";gridcolor$ ' Grid - Draw vertical lines if menuset = 0 and textEd = 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25 for xs = 0 to projectw step grid ' Grid - Draw horizontal lines #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-25 next xs for ys = 0 to projecth-25 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if 'adjust grid when menu, or texeditor control is selected - revert if menu and texeditor deleted /no longer used., if menuset = 1 or textEd > 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";gridcolor$ for xs = 0 to projectw step grid #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-50 next xs for ys = 0 to projecth-50 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if end if [nogrid]
if grid = 1 or gridvisible = 0 then if textEd =0 and menuset = 0 then #fful.gb "color ";crosshair$ #fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-25 #fful.gb "line "; 0; " "; (projecth)/2; " "; projectw; " "; (projecth)/2 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25 #fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25 end if if textEd > 0 or menuset = 1 then #fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";crosshair$ #fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-50 #fful.gb "line "; 0; " "; (projecth-50)/2; " "; projectw; " "; (projecth-50)/2 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50 #fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50 end if end if #fful.gb "flush bak" #fful.grid "!Set Grid" return
[font] #fful.font "contents? f$" if f$="Project Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #fful.gb "font ";projectfont$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" projectctrh=(yp-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Control Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #fful.gb "font ";ctrf$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" ctrh=(yp-100)/2+7 end if if selected then obj$(selected,4)=ctrf$ 'font obj(selected,6)=ctrh 'text height end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="ResetControl" then ctrf$=projectfont$ ctrh=projectctrh if selected then obj$(selected,4)=ctrf$ obj(selected,6)=ctrh end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then #fful.gb "font ";ctrf$ obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #fful.font "select Set Font" gosub [drawall] #fful.gb "setfocus" wait
[color] #fful.color "contents? c$" select case c$ case "Control Background" gosub [colorpick] if cp$<>"" then if selected then 'insert color change event ahead of control if obj(selected,T)=2 then ct=22 : projecttbcl$=cp$ if obj(selected,T)=3 then ct=23 : projectlbcl$=cp$ if obj(selected,T)=4 then ct=24 : projectcbcl$=cp$ if obj(selected,T)=11 then ct=21 : projecttecl$=cp$ for n=obj+1 to selected+1 step -1 obj(n,X)=obj(n-1,X) obj(n,Y)=obj(n-1,Y) obj(n,W)=obj(n-1,W) obj(n,H)=obj(n-1,H) obj(n,T)=obj(n-1,T) obj(n,TH)=obj(n-1,TH) obj$(n,Ctr)=obj$(n-1,Ctr) obj$(n,Tex)=obj$(n-1,Tex) obj$(n,Res)=obj$(n-1,Res) obj$(n,Fon)=obj$(n-1,Fon) obj$(n,Bak)=obj$(n-1,Bak) obj$(n,Bas)=obj$(n-1,Bas) next obj(selected,T)=ct obj$(selected,Tex)="Color!" obj$(selected,Bak)=cp$ 'remove any previous color change statement if selected>=2 then if obj(selected-1,T)=ct then obj(selected-1,T)=0 end if obj=obj+1 end if end if case "Project Background" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Project Foreground" gosub [colorpick] if cp$<>"" then projectfore$=cp$ gosub [drawgrid] case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] case "Border Color" gosub [colorpick] if cp$<>"" then bordercolor$=cp$ gosub [drawgrid] case "CrossHair Color" gosub [colorpick] if cp$<>"" then crosshair$=cp$ gosub [drawgrid] end select #fful.color "select Set Color" gosub [drawall] #fful.gb "setfocus" wait
[windowtype] #prop.cbwind "contents? projectwind$" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #pick.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #pick #pick "font Consolas 9" #pick "trapclose [quitpick]" #pick.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white " c=1 for yc=1 to 160 step 40 for xc= 1 to 160 step 40 #pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40 c=c+1 if c>15 then c=15 next next #pick.gb "when leftButtonDown [pick]" wait
[pick] xp=int(MouseX/40) yp=int(MouseY/40) c=xp+yp*4+1 cp$=word$(cl$,c)
[quitpick] close #pick return
[help] run "notepad help.txt" wait
[quitfful] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectfile$ #ses projectwind$ #ses projectform$ #ses projecttitl$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth for n=1 to obj if obj(n,T)<>0 then #ses obj(n,X);","; #ses obj(n,Y);","; #ses obj(n,W);","; #ses obj(n,H);","; #ses obj(n,T);","; #ses obj(n,TH) #ses obj$(n,Ctr) #ses obj$(n,Tex) #ses obj$(n,Res) #ses obj$(n,Fon) #ses obj$(n,Bak) end if next close #ses close #prop close #fful end
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
'for n=1 to obj 'print n;" ";obj(n,X);" ";obj(n,Y);" ";obj(n,W);" ";obj(n,H);" ";obj(n,T);" ";obj(n,6);" "; 'print obj$(n,Ctr);" ";obj$(n,Tex);" ";obj$(n,Res);" ";obj$(n,Fon);" ";obj$(n,Bak);" ";obj$(n,6);" ";obj$(n,Bas);" " 'next
|
|
gaslouk
Full Member
Hi from beautiful Greece.
Posts: 131
|
Post by gaslouk on May 26, 2023 10:13:43 GMT -5
Hi.I've gone through the code and made quite a few changes, some were fixes, some were just new ideas. I didn't record every change. The issue of importing a .bas with no forms, fixed by writing "No Forms" to #form. Removed the old code with the dumb notice, and the getFilename function. The best part is I believe I have the placement of controls working. If a menu or a texteditor is added to the form you will notice the grid dimensions will change to reflect the new placement change. If all texteditors are removed, and no menu exists the grid dimensions will change back.(After a grid dimension change you will need to reposition your controls so they get placed properly) 2 more options have been added to color. border color, and crosshair color 2 options have been added to "Set grid". size 1 and 3 I worked hard to fix the duplicate issue with no luck so far, so there are no control event handlers yet. One annoyance from day one was the positioning of the form$ combobox. In almost all software "File" is on the far top left, so I moved it to where it is expected and I no longer have to backtrack my mouse when I go for it. I have not added functions to this version, but will in future. These new options do not need to be part of your FFUL Rod, I just wanted to provide the placement code to help out. Use what you want and discard the rest. Hi!
In the [drawit ] routine and in case 2 the variable projecttbcl$ does not take a value or takes an incorrect value.
case 2 'textbox projecttbcl$="White" #fful.gb "backcolor ";projecttbcl$ t code here
That's why I assign a value m at this point to the variable. And after reading all the forms contained in the file, to the original form it adds buttons contained in other forms.
Gaslouk
|
|
|
Post by xxgeek on May 26, 2023 13:19:19 GMT -5
Hi galouk Not sure I understand the problem. Probably irrelevant anyway, and most likely due to one or more of my edits.
The code for ver 1.92 posted above is a heavily edited version, it is incomplete, and has many issues. It was posted mainly to show the placement of controls.
Try the following code. It is not edited so much, and should have far less errors. It is still not a complete working version though, just testing a lot of things for now.
Thanks for the input, it is appreciated. Let me know if the same issue persists, or any other issues for that matter.
ver$="1.12" 'freeform ultra lite v1.x 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1
nomainwin dim info$(10,10) dim form$(10) form$(1)="Restore" form$(2)="New" form$(3)="Save .ffu" form$(4)="Load .ffu" form$(5)="-----------" form$(6)="Write .bas" form$(7)="Import .bas" form$(8)="Export .bas" form$(9)="File" dim tool$(14) tool$(1)="StatictText" tool$(2)="TextBox" tool$(3)="ListBox" tool$(5)="ComboBox" tool$(6)="Button" tool$(7)="BmpButton" tool$(8)="GraphicBox" tool$(9)="RadioButton" tool$(10)="CheckBox" tool$(11)="GroupBox" tool$(12)="Texteditor" tool$(13)="Menu" tool$(14)="Add New" dim hnd$(30) hnd$(1)="#1" dim grid$(20) grid$(1)="1" g=2 for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Invisible" grid$(g+1)="Visible" grid$(g+2)="Set Grid" grid=10 gridvisible=1 gridcolor$="buttonface" projectctrh=25 ctrh=25 dim color$(10) color$(1)="Control Back" color$(2)="Project Back" color$(3)="Project Fore" color$(4)="Grid Color" color$(5)="Set Color" projectback$="white" projectfore$="black" 'ctrc$="white" dim font$(10) font$(1)="Control Font" font$(2)="ResetControl" font$(3)="Project Font" font$(4)="Set Font"'default is Consolas 9" dim wind$(20)'window type names wind$(1)="window" wind$(2)="window_nf" wind$(3)="window_popup" wind$(4)="dialog" wind$(5)="dialog_modal" wind$(6)="dialog_nf" wind$(7)="dialog_nf_modal" wind$(8)="dialog_fs" wind$(9)="dialog_nf_fs" wind$(10)="dialog_popup" wind$(11)="graphics" wind$(12)="graphics_fs" wind$(13)="graphics_fs_nsb" wind$(14)="graphics_nsb" wind$(15)="graphics_nf_nsb" wind$(16)="text" wind$(17)="text_fs" wind$(18)="text_nsb" wind$(19)="text_nsb_ins"
dim v$(2000) for n= 100 to 2000 step 20 v$(n)=str$(n) next dim obj(200,6) 'x,y,width/height,type,textheight X=1 Y=2 W=3 H=4 T=5 TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline Ctr=1 Tex=2 Res=3 Fon=4 Bak=5 Bas=7
'set default starting position obj=0 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" projectctrh=25 projectgrid=10 projectw=320 projecth=360 insertx=grid inserty=grid*2
'open a small properties window and hide it WindowWidth=230 WindowHeight=260 UpperLeftX=(DisplayWidth-230)/2 UpperLeftY=(DisplayHeight-180)/2 statictext #prop.st1 "File",5,10,30,25 textbox #prop.tbfile,45,5,150,25 statictext #prop.st2 "Wind",5,32,30,25 combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25 statictext #prop.st3 "Titl",5,54,30,25 textbox #prop.tbtitl,45,49,150,25 statictext #prop.st4 "Form",5,76,30,25 textbox #prop.tbform,45,71,150,25 statictext #prop.st5 "Ctrl",5,98,30,25 textbox #prop.tbctrl,45,93,150,25 statictext #prop.st6 "Text",5,120,30,25 textbox #prop.tbtext,45,115,150,25 statictext #prop.st7 "Reso",5,142,30,25 textbox #prop.tbreso,45,137,150,25 statictext #prop.st8 "xywh",5,164,30,25 textbox #prop.tbxywh,45,159,150,25 statictext #prop.st9 "Font",5,186,30,25 textbox #prop.tbfont,45,181,150,25 statictext #prop.st10 "Colo",5,208,30,25 textbox #prop.tbcolo,45,203,150,25
open "Properties" for window_nf as #prop #prop "font Consolas 9" #prop "trapclose [show]" #prop.cbwind "select window_nf" #prop.tbfile "!disable" #prop.tbxywh "!disable" #prop.tbfont "!disable" #prop.tbcolo "!disable" gosub [propertyupdate] #prop "hide"
'open the main form window 'this window is resizable, the graphicox will resize but the 'client area, which is a drawn representation of the window 'will only change size if you change the project w/h dimensions WindowWidth=862 WindowHeight=705 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #fful.tool,tool$(,[tool],5,2,85,30 combobox #fful.form,form$(,[form],95,2,85,30 combobox #fful.hand,hnd$(,[hand],185,2,85,30 button #fful.project,"Preview",[preview],UL,275,0,60,25 combobox #fful.w,v$(,[formsize],340,2,60,30 combobox #fful.h,v$(,[formsize],405,2,60,30 combobox #fful.grid,grid$(,[grid],470,2,90,30 combobox #fful.color,color$(,[color],565,2,90,30 combobox #fful.font,font$(,[font],660,2,90,30 button #fful.help,"Help",[help],UL,755,0,80,25 graphicbox #fful.gb,5,25,830,630 open "Freeform Ultra Lite v";ver$ for window as #fful #fful "trapclose [quitfful]" #fful "font Consolas 9" #fful "resizehandler [resize]" #fful.tool "select Add New" #fful.form "select File" #fful.hand "selectindex 1" #fful.grid "select Set Grid" #fful.color "select Set Color" #fful.font "select Set Font" #fful.w "select ";projectw #fful.h "select ";projecth #fful.gb "autoresize" #fful.gb "vertscrollbar on 0 ";projectw #fful.gb "horizscrollbar on 0 ";projecth #fful.gb "font ";projectfont$ #fful.gb "down" gosub [drawgrid] gosub [drawall] #fful.gb "when rightButtonDown [show]" #fful.gb "when leftButtonDown [select]" #fful.gb "when characterInput [keys]" #fful.gb "setfocus" #prop "show" show=1 wait
[show] if show then #prop "hide" show=0 else #prop "show" show=1 end if wait
'the user clicked on the form design window 'either to chose a control or to deselect a control [select] xs=MouseX ys=MouseY
'hide property window if it is open if show then #prop "hide" show=0 end if
'before we move on update the currently selected control from properties 'get the project data and only the editable contents of controls if selected=0 then 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ end if #prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$ #prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$ #prop.tbreso "!contents? t$" : obj$(selected,Res)=t$ 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if xs>obj(cn,X) and xs<(obj(cn,X)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then if xs>obj(cn,X)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2 if obj(cn,T)=6 then action=1 selected=cn exit for end if next if selected=0 then gosub [propertyupdate] action=0 end if if selected>0 and action=1 then #fful.gb "when leftButtonMove [track]" #fful.gb "when leftButtonUp [stop]" offsetX=xs-obj(selected,X) offsetY=ys-obj(selected,Y) end if if selected>0 and obj(selected,T)<>6 and action=2 then 'dont resize bmp #fful.gb "when leftButtonMove [tracksize]" #fful.gb "when leftButtonUp [stopsize]" offsetX=xs-(obj(selected,X)+obj(selected,W)) offsetY=ys-(obj(selected,Y)+obj(selected,H)) end if if selected>0 then gosub [drawit] else insertx=int((xs+(grid/2))/grid)*grid inserty=int((ys+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #fful.gb "rule xor" gosub [drawit] xt=int((MouseX-offsetX+(grid/2))/grid)*grid if xt<0 then xt=0'11 if xt+obj(selected,W)>projectw then xt=projectw-obj(selected,W) obj(selected,X)=xt yt=int((MouseY-offsetY+(grid/2))/grid)*grid if menuset = 0 and textEd = 0 then if yt<0 then yt=0 if yt+obj(selected,H)>projecth-25 then yt=projecth-obj(selected,H)-25 obj(selected,Y)=yt end if
if menuset = 1 or textEd > 0 then if yt < 0 then yt = 0 if yt+obj(selected,H)>projecth-50 then yt=projecth-obj(selected,H)-50 obj(selected,Y)=yt end if gosub [drawit] wait
[stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[tracksize] #fful.gb "rule xor" gosub [drawit] xs=int((MouseX-offsetX+(grid/2))/grid)*grid if xs>projectw then xs=projectw if xs<obj(selected,X) then xs=obj(selected,X)+grid ys=int((MouseY-offsetY+(grid/2))/grid)*grid if ys>projecth then ys=projecth if ys<obj(selected,Y)+ctrh then ys=obj(selected,Y)+ctrh obj(selected,W)=xs-obj(selected,X)'width if menuset = 1 or textEd > 0 then obj(selected,H)=ys-obj(selected,Y)-50'height if menuset = 0 and textEd = 0 then obj(selected,H)=ys-obj(selected,Y)-25'height gosub [drawit] wait
[stopsize] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,T)=12 then menuset = 0 : gosub [drawgrid] 'menu if obj(selected,T)=11 then textEd = textEd-1 : gosub [drawgrid] 'texteditor obj(selected,T)=0 selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,X) 'x cpy(2)=obj(selected,Y) 'y cpy(3)=obj(selected,W) 'w cpy(4)=obj(selected,H) 'h cpy(5)=obj(selected,T) 'type cpy(6)=obj(selected,TH) 'textheight cpy$(1)=obj$(selected,Ctr) 'name cpy$(2)=obj$(selected,Tex) 'text content cpy$(3)=obj$(selected,Res) 'resource array or file path cpy$(4)=obj$(selected,Fon) 'ctrl specific font or "" cpy$(5)=obj$(selected,Bak) 'ctrl specific backcolor end if
if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 if obj(obj,T)=11 then textEd = textEd+1 'texteditor obj(obj,X)=insertx obj(obj,Y)=inserty inserty=inserty+cpy(4)+grid obj(obj,W)=cpy(3) obj(obj,H)=cpy(4) obj(obj,T)=cpy(5) obj(obj,TH)=cpy(6) obj$(obj,Ctr)=left$(cpy$(1),11)';obj obj$(obj,Tex)=cpy$(2) obj$(obj,Res)=cpy$(3) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) obj$(obj,Fon)=cpy$(4) obj$(obj,Bak)=cpy$(5) selected=obj gosub [drawgrid] gosub [drawall] end if end if #fful.gb "setfocus" wait
[tool] #fful.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=1 obj$(obj,Ctr)="statictext";obj obj$(obj,Tex)="Statictext ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 2 'textbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=2 obj$(obj,Ctr)="textbox";obj obj$(obj,Tex)="Textbox ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 3 'listbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*5 obj(obj,T)=3 obj$(obj,Ctr)="listbox";obj obj$(obj,Tex)="Listbox ";obj;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectlbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 4 'combobox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="combobox";obj obj$(obj,Tex)="Combobox ";obj;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectcbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 5 'button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=5 obj$(obj,Ctr)="button";obj obj$(obj,Tex)="Button ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)="white" inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 6 'bmp button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=50 obj(obj,H)=50 obj(obj,T)=6 obj$(obj,Ctr)="bmpbutton";obj filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Res)=file$ obj$(obj,Tex)="BMPbutton ";obj loadbmp obj$(obj,Ctr),file$ close #bmp inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid else obj(obj,T)=0 close #bmp end if else obj(obj,T)=0 end if
case 7 'graphicbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=100 obj(obj,T)=7 obj$(obj,Ctr)="graphicbox";obj obj$(obj,Tex)="Graphicbox ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=120 obj(obj,H)=ctrh obj(obj,T)=8 obj$(obj,Ctr)="radiobutton";obj obj$(obj,Tex)="Radiobutton ";obj obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 9 'checkbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=90 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="checkbox";obj obj$(obj,Tex)="Checkbox ";obj obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=100 obj(obj,T)=10 obj$(obj,Ctr)="groupbox";obj obj$(obj,Tex)="Group Box ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor obj=obj+1 textEd=textEd+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=100 obj(obj,T)=11 obj$(obj,Ctr)="texteditor";obj obj$(obj,Tex)="Texteditor ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttecl$ gosub [drawgrid] inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,X)=0 obj(obj,Y)=0 obj(obj,W)=100 obj(obj,H)=10 obj(obj,T)=12 obj$(obj,Ctr)="menu";obj obj$(obj,Tex)=" Menu Added" menuset=1 end if gosub [drawgrid] end select selected=obj gosub [drawgrid] gosub [drawall] #fful.tool "select Add New" #fful.gb "setfocus" wait
[form] #fful.form "selectionindex? i" select case i case 1 'restore file$="lastsession.ffu" gosub [loadit] case 2 'new gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 6 'write gosub [write] case 7 'import gosub [import] case 8 'export gosub [export] end select #fful.form "select File" gosub [drawall] #fful.gb "setfocus" wait
[drawall] #fful.gb "discard ; redraw bak" ocn=cn projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" for cn=1 to obj gosub [drawit] next cn=ocn #fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20 #fful.gb "setfocus" return
[drawit] 'redraws control cn
'set the color for the drawn object and action taking place if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if
'set the font for the drawn object if obj$(cn,Fon)="" then #fful.gb "font ";projectfont$ ch=projectctrh if obj(cn,H)<ch then obj(cn,H)=ch else #fful.gb "font ";obj$(cn,Fon) ch=obj(cn,TH) if obj(cn,H)<ch then obj(cn,H)=ch end if
'update the properties textboxes for selected control if cn=selected then #prop.tbctrl obj$(cn,Ctr) 'ctrlname #prop.tbtext obj$(cn,Tex) 'text #prop.tbreso obj$(cn,Res) 'resource #prop.tbxywh obj(cn,X);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height #prop.tbcolo obj$(cn,Bak) end if #fful.gb "place ";obj(cn,X);" ";obj(cn,Y) if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?" select case obj(cn,T) case 1 'statictext #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 2 'textbox #fful.gb "backcolor ";projecttbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 3 'listbox #fful.gb "backcolor ";projectlbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 4 'combobox #fful.gb "backcolor ";projectcbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 5 'button #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'buttons are always black on white #fful.gb "color black" 'centre button text #fful.gb "stringwidth? ";"A";" width" xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ #fful.gb "backcolor ";projectback$ case 6 'bmpbutton if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr) #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) case 7 ' graphicbox #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "backcolor ";projectback$ case 8 'radiobutton #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'radiobutton text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 9 'checkbox #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'checkbox text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 10 'groupbox #fful.gb "backcolor ";projectback$ 'groupbox is an outline #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'group box text is always black #fful.gb "color black" 'groupbox text is offset if action=0 then #fful.gb "place ";obj(cn,X)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 11 ' texteditor #fful.gb "backcolor ";projecttecl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 12 'menu 'pin to top left obj(cn,X)=10 : obj(cn,Y)=-10 : obj(cn,W)=100 : obj(cn,H)=10 #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 21 'tecolor projecttecl$=obj$(cn,Bak) case 22 'tbcolor projecttbcl$=obj$(cn,Bak) case 23 'lbcolor projectlbcl$=obj$(cn,Bak) case 24 'cbcolor projectcbcl$=obj$(cn,Bak) case 30 'font case 31 '!font end select
return
[preview] file$="preview.bas" gosub [writeit] wait
[write] projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas" filedialog "Save .bas",projectfile$,file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit]
if file$<>"" then open file$ for output as #op 'the header #op " 'Project ";projecttitl$ #op " 'Created with Freeform Ultra Lite v";ver$;" ";date$() #op " nomainwin" #op "" if projectback$<>"white" or projectfore$<>"black" then #op " 'Set BackgroundColor$ and ForegroundColor$ of project" #op " BackgroundColor$=";chr$(34);projectback$;chr$(34) #op " ForegroundColor$=";chr$(34);projectfore$;chr$(34) #op "" end if #op " 'Create arrays needed for controls listbox,combobox" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " dim ";obj$(n,Res);"10)" #op " for n = 1 to 10" #op " ";obj$(n,Res);"n)= str$(n)" #op " next" end if next #op "" #op " 'Create controls and open window" #op " nomainwin" #op " WindowWidth = ";projectw #op " WindowHeight = ";projecth #op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"Size";chr$(34);", ";chr$(34);"Small";chr$(34);", [dummy], ";chr$(34);"Large";chr$(34);", [dummy]" end if for n=1 to obj select case obj(n,T) case 1 'statictext #op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox #op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"],[no";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"],[un";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor #op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 22 'tbcolor #op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'lbcolor #op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 24 'cbcolor #op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'tecolor #op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34) end select next #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op "" #op " 'Set any listbox or combobox to display the first item on the list" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34) end if next #op " 'apply any control specific fonts" for n= 1 to obj if obj(n,T)<>0 and obj$(n,Fon)<>"" then if obj(n,T)=1 or obj(n,T)=2 or obj(n,T)=5 or obj(n,T)=10 or obj(n,T)=11 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34) end if if obj(n,T)=3 or obj(n,T)=4 or obj(n,T)=7 or obj(n,T)=8 or obj(n,T)=9 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34) end if end if next #op " wait" #op ""
if file$<>"preview.bas" then #op " 'Create the required handlers for each control" #op " 'Radiobutton and Checkboxes are given a single handler" check=0 radio=0 for n=1 to obj select case obj(n,T) case 3 'listbox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op "" case 4 'combobox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op "" case 5 'button #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op "" case 6 'bmpbutton #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op "" case 8 'radiobutton if radio=0 then #op " [radio]" #op " 'Your handler code here, read all radiobuttons to determine which is set" #op " 'this is an example of eading the first radiobutton" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" radio=1 end if case 9 'checkbox if check=0 then #op " [check]" #op " 'Your handler code here, read all checkboxes in the group in sequence." #op " 'this is an example of eading the first checkbox" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" check=1 end if end select next else '#op " [radio]" '#op " wait" #op "" '#op " [check]" '#op " wait" '#op "" end if #op " [quit]" #op " close ";projectform$ #op " end" close #op files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] end if return
[saveas] projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu" filedialog "Save As...",projectname$,file$ if file$<>"" then open file$ for output as #op projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ #op projectfile$ #op projectwind$ #op projectform$ #op projecttitl$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth for n=1 to obj if obj(n,T)<>0 then #op obj(n,X);","; #op obj(n,Y);","; #op obj(n,W);","; #op obj(n,H);","; #op obj(n,T);","; #op obj(n,TH) #op obj$(n,Ctr) #op obj$(n,Tex) #op obj$(n,Res) #op obj$(n,Fon) #op obj$(n,Bak) end if next close #op gosub [propertyupdate] redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" end if return
[load] filedialog "Open Project...","*.ffu",file$ [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #ses input #ses, projectfile$ input #ses, projectwind$ input #ses, projectform$ input #ses, projecttitl$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #fful.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ projectctrh=val(c$) projectgrid=val(g$) grid=projectgrid projectw=val(w$) projecth=val(h$) #prop.cbwind "select ";projectwind$ redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.grid "select ";grid #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,X)=val(word$(l$,1,",")) obj(obj,Y)=val(word$(l$,2,",")) obj(obj,W)=val(word$(l$,3,",")) obj(obj,H)=val(word$(l$,4,",")) obj(obj,T)=val(word$(l$,5,",")) obj(obj,TH)=val(word$(l$,6,",")) line input #ses, obj$(obj,Ctr) line input #ses, obj$(obj,Tex) line input #ses, obj$(obj,Res) line input #ses, obj$(obj,Fon) line input #ses, obj$(obj,Bak) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) if obj(obj,T)=12 then menuset=1 wend close #ses gosub [propertyupdate] #prop "hide" #prop "show" end if return
[import] filedialog "Open .bas...","*.bas",file$ if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) gosub [new] grid=1 gridvisible=0 gosub [drawgrid] 'set grid to 1 and invisible so controls stay where they import from initially 'import only those lines defining controls we are interested in wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox " wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty " wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ " wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ " dim bas$(5000,2) basln=1 ln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, wln$ 'break into multiple lines if ":" found outside quotes pos=1 ln$="" while pos<=len(wln$) c$=mid$(wln$,pos,1) if c$=chr$(34)then if quote=0 then quote=1 else quote=0 end if if c$=":" and quote=0 then gosub [line] ln$="" pos=pos+1 else ln$=ln$+c$ pos=pos+1 end if wend gosub [line] basln=basln+1 wend print "first cut" for n=1 to ln print bas$(n,1);" ";bas$(n,2) next print
'now find width height title and handle for all windows found in bas$( 'up to 30 forms in a .bas '1=handle #main etc '2=title '3=width '4=height '5=windowtype '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
redim win$(30,10) redim hnd$(30) nl=ln wh=1 for ln=1 to nl 'find width and height ,assumes width and height are defined ahead of open 'so width height and colors can be set multiple times, so store bas line number involved if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1) if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1) if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1) if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1) if instr(lower$(bas$(ln,2)),"open",1)>0 then if instr(lower$(bas$(ln,2)),"window",1)>0 or instr(lower$(bas$(ln,2)),"dialog",1)>0 or instr(lower$(bas$(ln,2)),"graphic",1)>0 then win$(wh,10)=bas$(ln,1) n$=word$(bas$(ln,2),2,chr$(34)) hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1)) 'find last "for" in command line i=1 while i oi=i i=instr(lower$(bas$(ln,2))," for ",i+1) wend wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi) wt$=word$(wt$,2) win$(wh,1)=hn$ 'handle #fful etc win$(wh,2)=n$ 'title win$(wh,3)=w$ 'width win$(wh,4)=h$ 'height win$(wh,5)=wt$ 'windowtype hnd$(wh)=hn$ 'for combobox 'print wh;" ";hnd$(wh);" ";win$(wh,2);" ";win$(wh,3);" ";win$(wh,4);" ";win$(wh,5) wh=wh+1 end if end if next #fful.hand "reload" #fful.hand "selectindex 1" close #bas wh=1 gosub [loadwindow] end if return
[line] if ln$<>"" then w$=lower$(word$(ln$,1)) if instr(w$,"=",1)>1 then w$=word$(w$,1,"=") if len(w$)>3 then w1$=" "+w$+" " w2$=" "+w$+"=" if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 then bas$(ln,1)=str$(basln) bas$(ln,2)=trim$(ln$) ln=ln+1 end if end if end if return
[hand] #fful.hand "selectionindex? wh" gosub [loadwindow] wait
[loadwindow] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=1 menuset=0 projectback$="white" TextboxColor$="white" ListboxColor$="white" ComboboxColor$="white" TexteditorColor$="white" projectfore$="black" projectw=val(win$(wh,3)) if projectw=0 then projectw=320 projecth=val(win$(wh,4)) if projecth=0 then projecth=360 projecttitl$=win$(wh,2) projectwind$=win$(wh,5) projectform$=win$(wh,1) tbc$="" lbc$="" cbc$="" tec$="" gosub [propertyupdate] #fful.w "!";str$(projectw) #fful.h "!";str$(projecth)
'find controls and create obj() for ln=1 to nl 'create hidden objects to control font and color only used in import/export, not displayed ct=0 if instr(bas$(ln,2),"TextboxColor$",1)>0 then tbc$=getcolor$(bas$(ln,2)):ct=20 if instr(bas$(ln,2),"ListboxColor$",1)>0 then lbc$=getcolor$(bas$(ln,2)):ct=21 if instr(bas$(ln,2),"ComboboxColor$",1)>0 then cbc$=getcolor$(bas$(ln,2)):ct=22 if instr(bas$(ln,2),"TexteditorColor$",1)>0 then tec$=getcolor$(bas$(ln,2)):ct=23 if ct then obj(obj,T)=ct if ct=20 then obj$(obj,Bak)=tbc$ if ct=21 then obj$(obj,Bak)=lbc$ if ct=22 then obj$(obj,Bak)=cbc$ if ct=23 then obj$(obj,Bak)=tec$ obj$(obj,Bas)=bas$(ln,1) obj=obj+1 end if for wc=1 to 12 if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for next if wc<=11 then obj$(obj,Bas)=bas$(ln,1) l$=bas$(ln,2) ll$="" 'remove spaces leaving only , separation but keep "" text untouched inString=0 for i=1 to len(l$) c$=mid$(l$,i,1) select case case c$=chr$(34) inString=1-inString case (inString=0) and c$=" " c$="" end select ll$=ll$+c$ next 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1) obj(obj,T)=wc 'type obj(obj,TH)=projectctrh 'get the .ctrl name obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1) 'for un-named controls if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj 'get the text if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc) 'get the array or bmp file name if wc=3 or wc=4 or wc=6 then obj$(obj,Res)=word$(ll$,2,",") 'get rid of "" if wc=6 and left$(obj$(obj,Res),1)=chr$(34) then obj$(obj,Res)=mid$(obj$(obj,Res),2,len(obj$(obj,Res))-2) 'array() -> array( if (wc=3 or wc=4) and right$(obj$(obj,Res),1)=")" then obj$(obj,Res)=left$(obj$(obj,Res), len(obj$(obj,Res))-1) i=1 while word$(ll$,i,",")<>"" i=i+1 wend i=i-4 if wc=6 or wc=5 then 'buttons and bmpbuttons can have xy, wh is optional and they have XX corners if i=3 then obj(obj,X)=val(word$(ll$,i+2,","))'x obj(obj,Y)=val(word$(ll$,i+3,","))'y if wc=5 then 'we need to find a way to calculate width and height if not given #fful.gb "stringwidth? ";"A";" width" obj(obj,W)=width*len(obj$(obj,Tex))+10 obj(obj,H)=projectctrh end if if wc=6 then 'we need a way to set bmp w and h on error goto [dummybmp] open obj$(obj,Res) for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Tex)="bmp" end if loadbmp obj$(obj,Ctr),obj$(obj,Res) close #bmp goto [passdummy]
[dummybmp] obj(obj,W)=25 obj(obj,H)=25 obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),"path.bmp" [passdummy] end if else obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y obj(obj,W)=val(word$(ll$,i+2,","))'w obj(obj,H)=val(word$(ll$,i+3,","))'h end if if upper$(word$(ll$,4,","))="LR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="LL" then 'obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="UR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x 'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if else 'write to .bas tweaks listbox and combobox controls to line up properly 'so we need to untweak them now obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y if wc=1 then obj(obj,Y)=obj(obj,Y)-5 if wc=10 then obj(obj,Y)=obj(obj,Y)+5 if wc=3 or wc=4 then obj(obj,X)=obj(obj,X)-1 obj(obj,W)=val(word$(ll$,i+2,","))'w if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2 obj(obj,H)=val(word$(ll$,i+3,","))'h end if
'save color if set if wc=2 then obj$(obj,Bak)=tbc$ if wc=3 then obj$(obj,Bak)=lbc$ if wc=4 then obj$(obj,Bak)=cbc$ if wc=11 then obj$(obj,Bak)=tec$ obj=obj+1 end if next 'now find font commands listed after the open statement referring to the #form '#form.ctrl !font fontname 'if so add a new font object basln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ lln$=lower$(ln$) if instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font",1)>0 or instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font",1)>0 then f$=right$(ln$,len(ln$)-instr(lln$,"font",1)-4) if instr(f$,";",1)=0 then obj$(obj,Fon)=f$ obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1) obj$(obj,Ctr)=word$(word$(ln$,1),2,".") if instr(lln$,"!font",1)>0 then obj(obj,T)=31 else obj(obj,T)=30 obj$(obj,Bas)=str$(basln)
'find the visible object and store the font change for n=1 to obj if obj$(n,Ctr)=obj$(obj,Ctr) then obj$(n,Fon)=obj$(obj,Fon) #fful.gb "font ";obj$(obj,Fon) #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" obj(n,TH)=(yp-100)/2+7 exit for end if next obj=obj+1 end if end if basln=basln+1 wend
close #bas gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[export] dim oldbas$(5000) ln=1 if file$<>"" and right$(file$,3)="bas" then open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ oldbas$(ln)=ln$ ln=ln+1 wend close #bas '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
if win$(wh,6)<>"" then oldbas$(val(win$(wh,6)))=" BackgroundColor$=";chr$(34);projectback$;chr$(34) if win$(wh,7)<>"" then oldbas$(val(win$(wh,7)))=" ForegroundColor$=";chr$(34);projectfore$;chr$(34) if win$(wh,8)<>"" then oldbas$(val(win$(wh,8)))=" WindowWidth=";projectw if win$(wh,8)=win$(wh,9) then oldbas$(val(win$(wh,8)))=oldbas$(val(win$(wh,8)))+": WindowHeight=";projecth else oldbas$(val(win$(wh,9)))=" WindowHeight=";projecth if win$(wh,10)<>"" then oldbas$(val(win$(wh,10)))=" Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ for n=1 to obj select case obj(n,T) 'handle the visible controls case 1 'statictext oldbas$(val(obj$(n,Bas)))=" statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox oldbas$(val(obj$(n,Bas)))=" textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box oldbas$(val(obj$(n,Bas)))=" listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox oldbas$(val(obj$(n,Bas)))=" combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button oldbas$(val(obj$(n,Bas)))=" button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton oldbas$(val(obj$(n,Bas)))=" bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox oldbas$(val(obj$(n,Bas)))=" graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton oldbas$(val(obj$(n,Bas)))=" radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox oldbas$(val(obj$(n,Bas)))=" checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box oldbas$(val(obj$(n,Bas)))=" groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor oldbas$(val(obj$(n,Bas)))=" texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export case 20 'textboxcolor oldbas$(val(obj$(n,Bas)))=" TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'listboxcolor oldbas$(val(obj$(n,Bas)))=" ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 22 'comboboxcolor oldbas$(val(obj$(n,Bas)))=" ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'texteditorcolor oldbas$(val(obj$(n,Bas)))=" TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
'handle font changes case 30 'font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" font ";obj$(n,Fon);chr$(34) case 32 '!font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" !font ";obj$(n,Fon);chr$(34) end select next end if open file$ for output as #bas for n= 1 to ln #bas oldbas$(n) next close #bas return
function getsize$(l$) 'what if it is a variable? v$="" pos=1 n$=mid$(l$,pos,1) while instr("1234567890",n$,1)=0 and pos<len(l$) pos=pos+1 n$=mid$(l$,pos,1) wend while n$>="0" and n$<="9" and pos<=len(l$) v$=v$+n$ pos=pos+1 n$=mid$(l$,pos,1) wend getsize$=v$ end function
function getcolor$(l$) 'what if it is a variable? cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black " for c= 1 to 15 if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for next end function
[new] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=0 menuset=0 projectw=320 projecth=360 projectback$="white" projectfore$="black" projectctrc$="white" projecttitl$="Untitled" projectform$="#1" projectfile$="Untitled.bas" projectwind$="window_nf" #prop.cbwind "select window_nf" redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.w "select ";projectw #fful.h "select ";projecth gosub [propertyupdate] gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[propertyupdate] #prop.tbfile projectfile$ #prop.cbwind "select ";projectwind$ #prop.tbtitl projecttitl$ #prop.tbform projectform$ #prop.tbctrl "" #prop.tbtext "" #prop.tbreso "" #prop.tbxywh projectw;"x";projecth #prop.tbfont projectfont$ #prop.tbcolo projectfore$;"/";projectback$ return
[resize] #fful.tool "select Add New" #fful.form "select File" if wh=0 then wh=1 #fful.hand "selectindex ";wh #fful.grid "select Set Grid" #fful.font "select Set Font" #fful.color "select Set Color" #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawall] wait
[formsize] #fful.w "contents? w$" #fful.h "contents? h$" wf=val(w$) hf=val(h$) if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait projectw=wf projecth=hf insertx=grid inserty=grid gosub [drawgrid] #fful.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid spacing according to user choice, default is 10 #fful.grid "contents? g$" select case g$ case "Invisible" gridvisible=0 case "Visible" gridvisible=1 case else grid=val(g$) end select gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" wait
[drawgrid] if grid>0 then projectgrid=grid insertx=int((insertx+(grid/2))/grid)*grid inserty=int((inserty+(grid/2))/grid)*grid #fful.gb "cls; fill buttonface" '#fful.gb "place 0 0 ; color ";projectback$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25 '#fful.gb "color ";gridcolor$;" ; backcolor ";projectback$ if gridvisible then if menuset = 0 and textEd = 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25 for xs = 0 to projectw step grid ' Grid - Draw horizontal lines #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-25 next xs for ys = 0 to projecth-25 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if 'adjust grid when menu, or texeditor control is selected - revert if menu and texeditor deleted /no longer used., if menuset = 1 or textEd > 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";gridcolor$ for xs = 0 to projectw step grid #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-50 next xs for ys = 0 to projecth-50 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if end if [nogrid]
if grid = 1 or gridvisible = 0 then if textEd =0 and menuset = 0 then #fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 '#fful.gb "color ";crosshair$ #fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-25 #fful.gb "line "; 0; " "; (projecth)/2; " "; projectw; " "; (projecth)/2 '#fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25 #fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25 end if if textEd > 0 or menuset = 1 then #fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 '#fful.gb "color ";crosshair$ #fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-50 #fful.gb "line "; 0; " "; (projecth-50)/2; " "; projectw; " "; (projecth-50)/2 '#fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50 #fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50 end if end if
#fful.gb "flush bak" #fful.gb "color black" end if #fful.grid "select Set Grid" return
[font] #fful.font "contents? f$" if f$="Project Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #fful.gb "font ";projectfont$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" projectctrh=(yp-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Control Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #fful.gb "font ";ctrf$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" ctrh=(yp-100)/2+7 end if if selected then obj$(selected,4)=ctrf$ 'font obj(selected,6)=ctrh 'text height end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="ResetControl" then ctrf$=projectfont$ ctrh=projectctrh if selected then obj$(selected,4)=ctrf$ obj(selected,6)=ctrh end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then #fful.gb "font ";ctrf$ obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #fful.font "select Set Font" gosub [drawall] #fful.gb "setfocus" wait
[color] #fful.color "contents? c$" select case c$ case "Control Back" gosub [colorpick] if cp$<>"" then if selected then 'insert color change event ahead of control if obj(selected,T)=2 then ct=22 : projecttbcl$=cp$ if obj(selected,T)=3 then ct=23 : projectlbcl$=cp$ if obj(selected,T)=4 then ct=24 : projectcbcl$=cp$ if obj(selected,T)=11 then ct=21 : projecttecl$=cp$ for n=obj+1 to selected+1 step -1 obj(n,X)=obj(n-1,X) obj(n,Y)=obj(n-1,Y) obj(n,W)=obj(n-1,W) obj(n,H)=obj(n-1,H) obj(n,T)=obj(n-1,T) obj(n,TH)=obj(n-1,TH) obj$(n,Ctr)=obj$(n-1,Ctr) obj$(n,Tex)=obj$(n-1,Tex) obj$(n,Res)=obj$(n-1,Res) obj$(n,Fon)=obj$(n-1,Fon) obj$(n,Bak)=obj$(n-1,Bak) obj$(n,Bas)=obj$(n-1,Bas) next obj(selected,T)=ct obj$(selected,Tex)="Color!" obj$(selected,Bak)=cp$ 'remove any previous color change statement if selected>=2 then if obj(selected-1,T)=ct then obj(selected-1,T)=0 end if obj=obj+1 end if end if case "Project Back" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Project Fore" gosub [colorpick] if cp$<>"" then projectfore$=cp$ case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] end select #fful.color "select Set Color" gosub [drawall] #fful.gb "setfocus" wait
[windowtype] #prop.cbwind "contents? projectwind$" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #pick.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #pick #pick "font Consolas 9" #pick "trapclose [quitpick]" #pick.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white " c=1 for yc=1 to 160 step 40 for xc= 1 to 160 step 40 #pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40 c=c+1 if c>15 then c=15 next next #pick.gb "when leftButtonDown [pick]" wait
[pick] xp=int(MouseX/40) yp=int(MouseY/40) c=xp+yp*4+1 cp$=word$(cl$,c)
[quitpick] close #pick return
[help] run "notepad help.txt" wait
[quitfful] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectfile$ #ses projectwind$ #ses projectform$ #ses projecttitl$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth for n=1 to obj if obj(n,T)<>0 then #ses obj(n,X);","; #ses obj(n,Y);","; #ses obj(n,W);","; #ses obj(n,H);","; #ses obj(n,T);","; #ses obj(n,TH) #ses obj$(n,Ctr) #ses obj$(n,Tex) #ses obj$(n,Res) #ses obj$(n,Fon) #ses obj$(n,Bak) end if next close #ses close #prop close #fful end
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
for n=1 to obj print n;" ";obj(n,X);" ";obj(n,Y);" ";obj(n,W);" ";obj(n,H);" ";obj(n,T);" ";obj(n,6);" "; print obj$(n,Ctr);" ";obj$(n,Tex);" ";obj$(n,Res);" ";obj$(n,Fon);" ";obj$(n,Bak);" ";obj$(n,6);" ";obj$(n,Bas);" " next
|
|
gaslouk
Full Member
Hi from beautiful Greece.
Posts: 131
|
Post by gaslouk on May 27, 2023 2:18:03 GMT -5
Hi From 1.6 until now, not much has changed regarding importing forms from .bas files. Specifically from the file I uploaded "logistirio" the first form contains a caption with the name of the application and 11 buttons with functions of the application, and a wider menu. However, the functions and buttons of this and secondary forms of the application can be seen in the initial form. Probably because the Tag of forms has almost the same ending "#main and a number" Gaslouk. Hi galouk Not sure I understand the problem. Probably irrelevant anyway, and most likely due to one or more of my edits. The code for ver 1.92 posted above is a heavily edited version, it is incomplete, and has many issues. It was posted mainly to show the placement of controls. Try the following code. It is not edited so much, and should have far less errors. It is still not a complete working version though, just testing a lot of things for now. Thanks for the input, it is appreciated. Let me know if the same issue persists, or any other issues for that matter.
|
|
|
Post by xxgeek on May 27, 2023 15:10:04 GMT -5
Last post I was asking if this was fixed? btw - is it fixed?
This problem is not new, it has been there since the beginning, maybe not reported. Any tag name that is part of another tag name in the same file causes this.
For example if there is a #form and a #formgen (as in fformj261006.bas- the freeform that ships with JB) then this issue shows itself.
I have been reading through the code, and thought I found the problem. Changed another "instr" line to a "word$" line with no luck. There must be more code to change, .....still hacking away at it.
I did fix another issue though. It was the last issue with import crashing on fformj261006.bas. (the line with #formgen.st1 had the word "open" in it so instr didn't work, needed word$) Every form in fformj261006.bas will preview now without crashing.
Under [import] change if instr(lower$(bas$(ln,2)),"open",1)>0 then to if word$(bas$(ln,2),1)= "open" then
gaslouk, this is a community project, so dig in, all are welcome to join the fun. It's a great way to learn too.
|
|
gaslouk
Full Member
Hi from beautiful Greece.
Posts: 131
|
Post by gaslouk on May 28, 2023 0:43:45 GMT -5
Last post I was asking if this was fixed? btw - is it fixed? This problem is not new, it has been there since the beginning, maybe not reported. Any tag name that is part of another tag name in the same file causes this. For example if there is a #form and a #formgen (as in fformj261006.bas- the freeform that ships with JB) then this issue shows itself. I have been reading through the code, and thought I found the problem. Changed another "instr" line to a "word$" line with no luck. There must be more code to change, .....still hacking away at it. I did fix another issue though. It was the last issue with import crashing on fformj261006.bas. (the line with #formgen.st1 had the word "open" in it so instr didn't work, needed word$) Every form in fformj261006.bas will preview now without crashing. Under [import] change if instr(lower$(bas$(ln,2)),"open",1)>0 then to if word$(bas$(ln,2),1)= "open" then gaslouk, this is a community project, so dig in, all are welcome to join the fun. It's a great way to learn too.
Hello. Well I patched "logistirio" and ran version 1.12 read "logistirio" and it worked pretty well. Except the variable in [drawit]. Try it. logistirioRight.bas (62.6 KB)
|
|
|
Post by xxgeek on May 28, 2023 10:22:15 GMT -5
gaslouk, I'm not experiencing any issue with case 2 under [drawit] My textboxes are colored white as expected, and if I change the color all is well. Please give a detailed description of what is going on.
I have moved to version 1.13. Preview will now add the control handlers for each control. However, an import will not yet add the control handlers. Still need to fix the "duplicate handlers" issue on files NOT created by FFUL.
ver$="1.13" 'freeform ultra lite v1.x - Author = Rod 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1
nomainwin dim info$(10,10) dim form$(10) form$(1)="Restore" form$(2)="New" form$(3)="Save .ffu" form$(4)="Load .ffu" form$(5)="-----------" form$(6)="Write .bas" form$(7)="Import .bas" form$(8)="Export .bas" form$(9)="File" dim tool$(14) tool$(1)="StatictText" tool$(2)="TextBox" tool$(3)="ListBox" tool$(5)="ComboBox" tool$(6)="Button" tool$(7)="BmpButton" tool$(8)="GraphicBox" tool$(9)="RadioButton" tool$(10)="CheckBox" tool$(11)="GroupBox" tool$(12)="Texteditor" tool$(13)="Menu" tool$(14)="Add New" dim hnd$(30) hnd$(1)="#1" dim grid$(20) grid$(1)="1" g=2 for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Invisible" grid$(g+1)="Visible" grid$(g+2)="Set Grid" grid=10 gridvisible=1 gridcolor$="buttonface" projectctrh=25 ctrh=25 dim color$(10) color$(1)="Control Back" color$(2)="Project Back" color$(3)="Project Fore" color$(4)="Grid Color" color$(5)="Set Color" projectback$="white" projectfore$="black" 'ctrc$="white" dim font$(10) font$(1)="Control Font" font$(2)="ResetControl" font$(3)="Project Font" font$(4)="Set Font"'default is Consolas 9" dim wind$(20)'window type names wind$(1)="window" wind$(2)="window_nf" wind$(3)="window_popup" wind$(4)="dialog" wind$(5)="dialog_modal" wind$(6)="dialog_nf" wind$(7)="dialog_nf_modal" wind$(8)="dialog_fs" wind$(9)="dialog_nf_fs" wind$(10)="dialog_popup" wind$(11)="graphics" wind$(12)="graphics_fs" wind$(13)="graphics_fs_nsb" wind$(14)="graphics_nsb" wind$(15)="graphics_nf_nsb" wind$(16)="text" wind$(17)="text_fs" wind$(18)="text_nsb" wind$(19)="text_nsb_ins"
dim v$(2000) for n= 100 to 2000 step 20 v$(n)=str$(n) next dim obj(200,6) 'x,y,width/height,type,textheight X=1 Y=2 W=3 H=4 T=5 TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline Ctr=1 Tex=2 Res=3 Fon=4 Bak=5 Bas=7
'set default starting position obj=0 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" projectctrh=25 projectgrid=10 projectw=320 projecth=360 insertx=grid inserty=grid*2
'open a small properties window and hide it WindowWidth=230 WindowHeight=260 UpperLeftX=(DisplayWidth-230)/2 UpperLeftY=(DisplayHeight-180)/2 statictext #prop.st1 "File",5,10,30,25 textbox #prop.tbfile,45,5,150,25 statictext #prop.st2 "Wind",5,32,30,25 combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25 statictext #prop.st3 "Titl",5,54,30,25 textbox #prop.tbtitl,45,49,150,25 statictext #prop.st4 "Form",5,76,30,25 textbox #prop.tbform,45,71,150,25 statictext #prop.st5 "Ctrl",5,98,30,25 textbox #prop.tbctrl,45,93,150,25 statictext #prop.st6 "Text",5,120,30,25 textbox #prop.tbtext,45,115,150,25 statictext #prop.st7 "Reso",5,142,30,25 textbox #prop.tbreso,45,137,150,25 statictext #prop.st8 "xywh",5,164,30,25 textbox #prop.tbxywh,45,159,150,25 statictext #prop.st9 "Font",5,186,30,25 textbox #prop.tbfont,45,181,150,25 statictext #prop.st10 "Colo",5,208,30,25 textbox #prop.tbcolo,45,203,150,25
open "Properties" for window_nf as #prop #prop "font Consolas 9" #prop "trapclose [show]" #prop.cbwind "select window_nf" #prop.tbfile "!disable" #prop.tbxywh "!disable" #prop.tbfont "!disable" #prop.tbcolo "!disable" gosub [propertyupdate] #prop "hide"
'open the main form window 'this window is resizable, the graphicox will resize but the 'client area, which is a drawn representation of the window 'will only change size if you change the project w/h dimensions WindowWidth=862 WindowHeight=705 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #fful.tool,tool$(,[tool],5,2,85,30 combobox #fful.form,form$(,[form],95,2,85,30 combobox #fful.hand,hnd$(,[hand],185,2,85,30 button #fful.project,"Preview",[preview],UL,275,0,60,25 combobox #fful.w,v$(,[formsize],340,2,60,30 combobox #fful.h,v$(,[formsize],405,2,60,30 combobox #fful.grid,grid$(,[grid],470,2,90,30 combobox #fful.color,color$(,[color],565,2,90,30 combobox #fful.font,font$(,[font],660,2,90,30 button #fful.help,"Help",[help],UL,755,0,80,25 graphicbox #fful.gb,5,25,830,630 open "Freeform Ultra Lite v";ver$ for window as #fful #fful "trapclose [quitfful]" #fful "font Consolas 9" #fful "resizehandler [resize]" #fful.tool "select Add New" #fful.form "select File" #fful.hand "selectindex 1" #fful.grid "select Set Grid" #fful.color "select Set Color" #fful.font "select Set Font" #fful.w "select ";projectw #fful.h "select ";projecth #fful.gb "autoresize" #fful.gb "vertscrollbar on 0 ";projectw #fful.gb "horizscrollbar on 0 ";projecth #fful.gb "font ";projectfont$ #fful.gb "down" gosub [drawgrid] gosub [drawall] #fful.gb "when rightButtonDown [show]" #fful.gb "when leftButtonDown [select]" #fful.gb "when characterInput [keys]" #fful.gb "setfocus" #prop "show" show=1 wait
[show] if show then #prop "hide" show=0 else #prop "show" show=1 end if wait
'the user clicked on the form design window 'either to chose a control or to deselect a control [select] xs=MouseX ys=MouseY
'hide property window if it is open if show then #prop "hide" show=0 end if
'before we move on update the currently selected control from properties 'get the project data and only the editable contents of controls if selected=0 then 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ end if #prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$ #prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$ #prop.tbreso "!contents? t$" : obj$(selected,Res)=t$ 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if xs>obj(cn,X) and xs<(obj(cn,X)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then if xs>obj(cn,X)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2 if obj(cn,T)=6 then action=1 selected=cn exit for end if next if selected=0 then gosub [propertyupdate] action=0 end if if selected>0 and action=1 then #fful.gb "when leftButtonMove [track]" #fful.gb "when leftButtonUp [stop]" offsetX=xs-obj(selected,X) offsetY=ys-obj(selected,Y) end if if selected>0 and obj(selected,T)<>6 and action=2 then 'dont resize bmp #fful.gb "when leftButtonMove [tracksize]" #fful.gb "when leftButtonUp [stopsize]" offsetX=xs-(obj(selected,X)+obj(selected,W)) offsetY=ys-(obj(selected,Y)+obj(selected,H)) end if if selected>0 then gosub [drawit] else insertx=int((xs+(grid/2))/grid)*grid inserty=int((ys+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #fful.gb "rule xor" gosub [drawit] xt=int((MouseX-offsetX+(grid/2))/grid)*grid if xt<0 then xt=0'11 if xt+obj(selected,W)>projectw then xt=projectw-obj(selected,W) obj(selected,X)=xt yt=int((MouseY-offsetY+(grid/2))/grid)*grid if menuset = 0 and textEd = 0 then if yt<0 then yt=0 if yt+obj(selected,H)>projecth-25 then yt=projecth-obj(selected,H)-25 obj(selected,Y)=yt end if
if menuset = 1 or textEd > 0 then if yt < 0 then yt = 0 if yt+obj(selected,H)>projecth-50 then yt=projecth-obj(selected,H)-50 obj(selected,Y)=yt end if gosub [drawit] wait
[stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[tracksize] #fful.gb "rule xor" gosub [drawit] xs=int((MouseX-offsetX+(grid/2))/grid)*grid if xs>projectw then xs=projectw if xs<obj(selected,X) then xs=obj(selected,X)+grid ys=int((MouseY-offsetY+(grid/2))/grid)*grid if ys>projecth then ys=projecth if ys<obj(selected,Y)+ctrh then ys=obj(selected,Y)+ctrh obj(selected,W)=xs-obj(selected,X)'width if menuset = 1 or textEd > 0 then obj(selected,H)=ys-obj(selected,Y)-50'height if menuset = 0 and textEd = 0 then obj(selected,H)=ys-obj(selected,Y)-25'height gosub [drawit] wait
[stopsize] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,T)=12 then menuset = 0 : gosub [drawgrid] 'menu if obj(selected,T)=11 then textEd = textEd-1 : gosub [drawgrid] 'texteditor obj(selected,T)=0 selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,X) 'x cpy(2)=obj(selected,Y) 'y cpy(3)=obj(selected,W) 'w cpy(4)=obj(selected,H) 'h cpy(5)=obj(selected,T) 'type cpy(6)=obj(selected,TH) 'textheight cpy$(1)=obj$(selected,Ctr) 'name cpy$(2)=obj$(selected,Tex) 'text content cpy$(3)=obj$(selected,Res) 'resource array or file path cpy$(4)=obj$(selected,Fon) 'ctrl specific font or "" cpy$(5)=obj$(selected,Bak) 'ctrl specific backcolor end if
if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 if obj(obj,T)=11 then textEd = textEd+1 'texteditor obj(obj,X)=insertx obj(obj,Y)=inserty inserty=inserty+cpy(4)+grid obj(obj,W)=cpy(3) obj(obj,H)=cpy(4) obj(obj,T)=cpy(5) obj(obj,TH)=cpy(6) obj$(obj,Ctr)=left$(cpy$(1),11)';obj obj$(obj,Tex)=cpy$(2) obj$(obj,Res)=cpy$(3) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) obj$(obj,Fon)=cpy$(4) obj$(obj,Bak)=cpy$(5) selected=obj gosub [drawgrid] gosub [drawall] end if end if #fful.gb "setfocus" wait
[tool] #fful.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=1 obj$(obj,Ctr)="statictext";obj obj$(obj,Tex)="Statictext ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 2 'textbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=2 obj$(obj,Ctr)="textbox";obj obj$(obj,Tex)="Textbox ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 3 'listbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*5 obj(obj,T)=3 obj$(obj,Ctr)="listbox";obj obj$(obj,Tex)="Listbox ";obj;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectlbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 4 'combobox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="combobox";obj obj$(obj,Tex)="Combobox ";obj;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectcbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 5 'button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=5 obj$(obj,Ctr)="button";obj obj$(obj,Tex)="Button ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)="white" inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 6 'bmp button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=50 obj(obj,H)=50 obj(obj,T)=6 obj$(obj,Ctr)="bmpbutton";obj filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Res)=file$ obj$(obj,Tex)="BMPbutton ";obj loadbmp obj$(obj,Ctr),file$ close #bmp inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid else obj(obj,T)=0 close #bmp end if else obj(obj,T)=0 end if
case 7 'graphicbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=100 obj(obj,T)=7 obj$(obj,Ctr)="graphicbox";obj obj$(obj,Tex)="Graphicbox ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=120 obj(obj,H)=ctrh obj(obj,T)=8 obj$(obj,Ctr)="radiobutton";obj obj$(obj,Tex)="Radiobutton ";obj obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 9 'checkbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=90 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="checkbox";obj obj$(obj,Tex)="Checkbox ";obj obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=100 obj(obj,T)=10 obj$(obj,Ctr)="groupbox";obj obj$(obj,Tex)="Group Box ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor obj=obj+1 textEd=textEd+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=100 obj(obj,T)=11 obj$(obj,Ctr)="texteditor";obj obj$(obj,Tex)="Texteditor ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttecl$ gosub [drawgrid] inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,X)=0 obj(obj,Y)=0 obj(obj,W)=100 obj(obj,H)=10 obj(obj,T)=12 obj$(obj,Ctr)="menu";obj obj$(obj,Tex)=" Menu Added" menuset=1 end if gosub [drawgrid] end select selected=obj gosub [drawgrid] gosub [drawall] #fful.tool "select Add New" #fful.gb "setfocus" wait
[form] #fful.form "selectionindex? i" select case i case 1 'restore file$="lastsession.ffu" gosub [loadit] case 2 'new gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 6 'write gosub [write] case 7 'import gosub [import] case 8 'export gosub [export] end select #fful.form "select File" gosub [drawall] #fful.gb "setfocus" wait
[drawall] #fful.gb "discard ; redraw bak" ocn=cn projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" for cn=1 to obj gosub [drawit] next cn=ocn #fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20 #fful.gb "setfocus" return
[drawit] 'redraws control cn
'set the color for the drawn object and action taking place if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if
'set the font for the drawn object if obj$(cn,Fon)="" then #fful.gb "font ";projectfont$ ch=projectctrh if obj(cn,H)<ch then obj(cn,H)=ch else #fful.gb "font ";obj$(cn,Fon) ch=obj(cn,TH) if obj(cn,H)<ch then obj(cn,H)=ch end if
'update the properties textboxes for selected control if cn=selected then #prop.tbctrl obj$(cn,Ctr) 'ctrlname #prop.tbtext obj$(cn,Tex) 'text #prop.tbreso obj$(cn,Res) 'resource #prop.tbxywh obj(cn,X);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height #prop.tbcolo obj$(cn,Bak) end if #fful.gb "place ";obj(cn,X);" ";obj(cn,Y) if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?" select case obj(cn,T) case 1 'statictext #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 2 'textbox #fful.gb "backcolor ";projecttbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 3 'listbox #fful.gb "backcolor ";projectlbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 4 'combobox #fful.gb "backcolor ";projectcbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 5 'button #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'buttons are always black on white #fful.gb "color black" 'centre button text #fful.gb "stringwidth? ";"A";" width" xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ #fful.gb "backcolor ";projectback$ case 6 'bmpbutton if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr) #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) case 7 ' graphicbox #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "backcolor ";projectback$ case 8 'radiobutton #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'radiobutton text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 9 'checkbox #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'checkbox text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 10 'groupbox #fful.gb "backcolor ";projectback$ 'groupbox is an outline #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'group box text is always black #fful.gb "color black" 'groupbox text is offset if action=0 then #fful.gb "place ";obj(cn,X)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 11 ' texteditor #fful.gb "backcolor ";projecttecl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 12 'menu 'pin to top left obj(cn,X)=10 : obj(cn,Y)=-10 : obj(cn,W)=100 : obj(cn,H)=10 #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 21 'tecolor projecttecl$=obj$(cn,Bak) case 22 'tbcolor projecttbcl$=obj$(cn,Bak) case 23 'lbcolor projectlbcl$=obj$(cn,Bak) case 24 'cbcolor projectcbcl$=obj$(cn,Bak) case 30 'font case 31 '!font end select
return
[preview] file$="preview.bas" gosub [writeit] wait
[write] projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas" filedialog "Save .bas",projectfile$,file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit] writingFile=1 if file$<>"" then open file$ for output as #op 'the header #op " 'Project ";projecttitl$ #op " 'Created with Freeform Ultra Lite v";ver$;" ";date$() #op " nomainwin" #op "" if projectback$<>"white" or projectfore$<>"black" then #op " 'Set BackgroundColor$ and ForegroundColor$ of project" #op " BackgroundColor$=";chr$(34);projectback$;chr$(34) #op " ForegroundColor$=";chr$(34);projectfore$;chr$(34) #op "" end if #op " 'Create arrays needed for controls listbox,combobox" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " dim ";obj$(n,Res);"10)" #op " for n = 1 to 10" #op " ";obj$(n,Res);"n)= str$(n)" #op " next" end if next #op "" #op " 'Create controls and open window" #op " nomainwin" #op " WindowWidth = ";projectw #op " WindowHeight = ";projecth #op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"Size";chr$(34);", ";chr$(34);"Small";chr$(34);", [dummy], ";chr$(34);"Large";chr$(34);", [dummy]" end if for n=1 to obj select case obj(n,T) case 1 'statictext '#op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) #op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox #op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"],[no";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"],[un";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor #op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 22 'tbcolor #op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'lbcolor #op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 24 'cbcolor #op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'tecolor #op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34) end select next #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op "" #op " 'Set any listbox or combobox to display the first item on the list" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34) end if next #op " 'apply any control specific fonts" for n= 1 to obj if obj(n,T)<>0 and obj$(n,Fon)<>"" then if obj(n,T)=1 or obj(n,T)=2 or obj(n,T)=5 or obj(n,T)=10 or obj(n,T)=11 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34) end if if obj(n,T)=3 or obj(n,T)=4 or obj(n,T)=7 or obj(n,T)=8 or obj(n,T)=9 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34) end if end if next #op " wait" #op ""
if file$="preview.bas" and writingFile = 1 then '#op " 'Create the required handlers for each control" '#op " 'Radiobutton and Checkboxes are given a single handler" check=0 radio=0 for n=1 to obj select case obj(n,T) case 3 'listbox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op "" case 4 'combobox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op "" case 5 'button #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op "" case 6 'bmpbutton #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op "" case 8 'radiobutton 'if radio=0 then #op " [";obj$(n,Ctr);"]" #op " 'Your handler code here, read all radiobuttons to determine which is set" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" #op " [no";obj$(n,Ctr);"]" #op " 'Your handler code here, read all radiobuttons to determine which is set" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" radio=1 'end if case 9 'checkbox 'if check=0 then #op " [";obj$(n,Ctr);"]" #op " 'Your handler code here, read all checkboxes in the group in sequence." #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" #op " [un";obj$(n,Ctr);"]" #op " 'Your handler code here, read all checkboxes in the group in sequence." #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" 'check=1 'end if end select next else '#op " [radio]" '#op " wait" #op "" '#op " [check]" '#op " wait" '#op "" end if #op " [quit]" #op " close ";projectform$ #op " end" close #op files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] end if writingFile=0 return
[saveas] projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu" filedialog "Save As...",projectname$,file$ if file$<>"" then open file$ for output as #op projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ #op projectfile$ #op projectwind$ #op projectform$ #op projecttitl$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth for n=1 to obj if obj(n,T)<>0 then #op obj(n,X);","; #op obj(n,Y);","; #op obj(n,W);","; #op obj(n,H);","; #op obj(n,T);","; #op obj(n,TH) #op obj$(n,Ctr) #op obj$(n,Tex) #op obj$(n,Res) #op obj$(n,Fon) #op obj$(n,Bak) end if next close #op gosub [propertyupdate] redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" end if return
[load] filedialog "Open Project...","*.ffu",file$ [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #ses input #ses, projectfile$ input #ses, projectwind$ input #ses, projectform$ input #ses, projecttitl$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #fful.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ projectctrh=val(c$) projectgrid=val(g$) grid=projectgrid projectw=val(w$) projecth=val(h$) #prop.cbwind "select ";projectwind$ redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.grid "select ";grid #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,X)=val(word$(l$,1,",")) obj(obj,Y)=val(word$(l$,2,",")) obj(obj,W)=val(word$(l$,3,",")) obj(obj,H)=val(word$(l$,4,",")) obj(obj,T)=val(word$(l$,5,",")) obj(obj,TH)=val(word$(l$,6,",")) line input #ses, obj$(obj,Ctr) line input #ses, obj$(obj,Tex) line input #ses, obj$(obj,Res) line input #ses, obj$(obj,Fon) line input #ses, obj$(obj,Bak) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) if obj(obj,T)=12 then menuset=1 wend close #ses gosub [propertyupdate] #prop "hide" #prop "show" end if return
[import] filedialog "Open .bas...","*.bas",file$ if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) gosub [new] grid=1 gridvisible=0 gosub [drawgrid] 'set grid to 1 and invisible so controls stay where they import from initially 'import only those lines defining controls we are interested in wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox " wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty " wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ " wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ " dim bas$(5000,2) basln=1 ln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, wln$ 'break into multiple lines if ":" found outside quotes pos=1 ln$="" while pos<=len(wln$) c$=mid$(wln$,pos,1) if c$=chr$(34)then if quote=0 then quote=1 else quote=0 end if if c$=":" and quote=0 then gosub [line] ln$="" pos=pos+1 else ln$=ln$+c$ pos=pos+1 end if wend gosub [line] basln=basln+1 wend 'print "first cut" 'for n=1 to ln 'print bas$(n,1);" ";bas$(n,2) 'next 'print
'now find width height title and handle for all windows found in bas$( 'up to 30 forms in a .bas '1=handle #main etc '2=title '3=width '4=height '5=windowtype '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
redim win$(30,10) redim hnd$(30) nl=ln wh=1 for ln=1 to nl 'find width and height ,assumes width and height are defined ahead of open 'so width height and colors can be set multiple times, so store bas line number involved if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1) if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1) if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1) if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1) if word$(bas$(ln,2),1)= "open" then if instr(lower$(bas$(ln,2)),"window",1)>0 or instr(lower$(bas$(ln,2)),"dialog",1)>0 or instr(lower$(bas$(ln,2)),"graphic",1)>0 or instr(lower$(bas$(ln,2)),"text",1)>0 then win$(wh,10)=bas$(ln,1) n$=word$(bas$(ln,2),2,chr$(34)) hn$ = "#";word$(bas$(ln,2), 2, "#") 'find last "for" in command line i=1 while i oi=i i=instr(lower$(bas$(ln,2))," for ",i+1) wend wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi) wt$=word$(wt$,2) win$(wh,1)=hn$ 'handle #fful etc win$(wh,2)=n$ 'title win$(wh,3)=w$ 'width win$(wh,4)=h$ 'height win$(wh,5)=wt$ 'windowtype hnd$(wh)=hn$ 'for combobox 'print wh;" ";hnd$(wh);" ";win$(wh,2);" ";win$(wh,3);" ";win$(wh,4);" ";win$(wh,5) wh=wh+1 end if end if next #fful.hand "reload" #fful.hand "selectindex 1" close #bas wh=1 gosub [loadwindow] end if return
[line] if ln$<>"" then w$=lower$(word$(ln$,1)) if instr(w$,"=",1)>1 then w$=word$(w$,1,"=") if len(w$)>3 then w1$=" "+w$+" " w2$=" "+w$+"=" if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 then bas$(ln,1)=str$(basln) bas$(ln,2)=trim$(ln$) ln=ln+1 end if end if end if return
[hand] #fful.hand "selectionindex? wh" gosub [loadwindow] wait
[loadwindow] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=1 menuset=0 projectback$="white" TextboxColor$="white" ListboxColor$="white" ComboboxColor$="white" TexteditorColor$="white" projectfore$="black" projectw=val(win$(wh,3)) if projectw=0 then projectw=320 projecth=val(win$(wh,4)) if projecth=0 then projecth=360 projecttitl$=win$(wh,2) projectwind$=win$(wh,5) projectform$=win$(wh,1) tbc$="" lbc$="" cbc$="" tec$="" gosub [propertyupdate] #fful.w "!";str$(projectw) #fful.h "!";str$(projecth)
'find controls and create obj() for ln=1 to nl 'create hidden objects to control font and color only used in import/export, not displayed ct=0 if instr(bas$(ln,2),"TextboxColor$",1)>0 then tbc$=getcolor$(bas$(ln,2)):ct=20 if instr(bas$(ln,2),"ListboxColor$",1)>0 then lbc$=getcolor$(bas$(ln,2)):ct=21 if instr(bas$(ln,2),"ComboboxColor$",1)>0 then cbc$=getcolor$(bas$(ln,2)):ct=22 if instr(bas$(ln,2),"TexteditorColor$",1)>0 then tec$=getcolor$(bas$(ln,2)):ct=23 if ct then obj(obj,T)=ct if ct=20 then obj$(obj,Bak)=tbc$ if ct=21 then obj$(obj,Bak)=lbc$ if ct=22 then obj$(obj,Bak)=cbc$ if ct=23 then obj$(obj,Bak)=tec$ obj$(obj,Bas)=bas$(ln,1) obj=obj+1 end if for wc=1 to 12 if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(bas$(ln,2),projectform$,1)>0 then exit for next if wc<=11 then obj$(obj,Bas)=bas$(ln,1) l$=bas$(ln,2) ll$="" 'remove spaces leaving only , separation but keep "" text untouched inString=0 for i=1 to len(l$) c$=mid$(l$,i,1) select case case c$=chr$(34) inString=1-inString case (inString=0) and c$=" " c$="" end select ll$=ll$+c$ next 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1) obj(obj,T)=wc 'type obj(obj,TH)=projectctrh 'get the .ctrl name obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1) 'for un-named controls if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj 'get the text if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc) 'get the array or bmp file name if wc=3 or wc=4 or wc=6 then obj$(obj,Res)=word$(ll$,2,",") 'get rid of "" if wc=6 and left$(obj$(obj,Res),1)=chr$(34) then obj$(obj,Res)=mid$(obj$(obj,Res),2,len(obj$(obj,Res))-2) 'array() -> array( if (wc=3 or wc=4) and right$(obj$(obj,Res),1)=")" then obj$(obj,Res)=left$(obj$(obj,Res), len(obj$(obj,Res))-1) i=1 while word$(ll$,i,",")<>"" i=i+1 wend i=i-4 if wc=6 or wc=5 then 'buttons and bmpbuttons can have xy, wh is optional and they have XX corners if i=3 then obj(obj,X)=val(word$(ll$,i+2,","))'x obj(obj,Y)=val(word$(ll$,i+3,","))'y if wc=5 then 'we need to find a way to calculate width and height if not given #fful.gb "stringwidth? ";"A";" width" obj(obj,W)=width*len(obj$(obj,Tex))+10 obj(obj,H)=projectctrh end if if wc=6 then 'we need a way to set bmp w and h on error goto [dummybmp] open obj$(obj,Res) for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Tex)="bmp" end if loadbmp obj$(obj,Ctr),obj$(obj,Res) close #bmp goto [passdummy]
[dummybmp] obj(obj,W)=25 obj(obj,H)=25 obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),"path.bmp" [passdummy] end if else obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y obj(obj,W)=val(word$(ll$,i+2,","))'w obj(obj,H)=val(word$(ll$,i+3,","))'h end if if upper$(word$(ll$,4,","))="LR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="LL" then 'obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="UR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x 'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if else 'write to .bas tweaks listbox and combobox controls to line up properly 'so we need to untweak them now obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y if wc=1 then obj(obj,Y)=obj(obj,Y)-5 if wc=10 then obj(obj,Y)=obj(obj,Y)+5 if wc=3 or wc=4 then obj(obj,X)=obj(obj,X)-1 obj(obj,W)=val(word$(ll$,i+2,","))'w if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2 obj(obj,H)=val(word$(ll$,i+3,","))'h end if
'save color if set if wc=2 then obj$(obj,Bak)=tbc$ if wc=3 then obj$(obj,Bak)=lbc$ if wc=4 then obj$(obj,Bak)=cbc$ if wc=11 then obj$(obj,Bak)=tec$ obj=obj+1 end if next 'now find font commands listed after the open statement referring to the #form '#form.ctrl !font fontname 'if so add a new font object basln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ lln$=lower$(ln$) if instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font",1)>0 or instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font",1)>0 then f$=right$(ln$,len(ln$)-instr(lln$,"font",1)-4) if instr(f$,";",1)=0 then obj$(obj,Fon)=f$ obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1) obj$(obj,Ctr)=word$(word$(ln$,1),2,".") if instr(lln$,"!font",1)>0 then obj(obj,T)=31 else obj(obj,T)=30 obj$(obj,Bas)=str$(basln)
'find the visible object and store the font change for n=1 to obj if obj$(n,Ctr)=obj$(obj,Ctr) then obj$(n,Fon)=obj$(obj,Fon) #fful.gb "font ";obj$(obj,Fon) #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" obj(n,TH)=(yp-100)/2+7 exit for end if next obj=obj+1 end if end if basln=basln+1 wend
close #bas gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[export] dim oldbas$(5000) ln=1 if file$<>"" and right$(file$,3)="bas" then open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ oldbas$(ln)=ln$ ln=ln+1 wend close #bas '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
if win$(wh,6)<>"" then oldbas$(val(win$(wh,6)))=" BackgroundColor$=";chr$(34);projectback$;chr$(34) if win$(wh,7)<>"" then oldbas$(val(win$(wh,7)))=" ForegroundColor$=";chr$(34);projectfore$;chr$(34) if win$(wh,8)<>"" then oldbas$(val(win$(wh,8)))=" WindowWidth=";projectw if win$(wh,8)=win$(wh,9) then oldbas$(val(win$(wh,8)))=oldbas$(val(win$(wh,8)))+": WindowHeight=";projecth else oldbas$(val(win$(wh,9)))=" WindowHeight=";projecth if win$(wh,10)<>"" then oldbas$(val(win$(wh,10)))=" Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ for n=1 to obj select case obj(n,T) 'handle the visible controls case 1 'statictext oldbas$(val(obj$(n,Bas)))=" statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox oldbas$(val(obj$(n,Bas)))=" textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box oldbas$(val(obj$(n,Bas)))=" listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox oldbas$(val(obj$(n,Bas)))=" combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button oldbas$(val(obj$(n,Bas)))=" button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton oldbas$(val(obj$(n,Bas)))=" bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox oldbas$(val(obj$(n,Bas)))=" graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton oldbas$(val(obj$(n,Bas)))=" radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox oldbas$(val(obj$(n,Bas)))=" checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box oldbas$(val(obj$(n,Bas)))=" groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor oldbas$(val(obj$(n,Bas)))=" texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export case 20 'textboxcolor oldbas$(val(obj$(n,Bas)))=" TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'listboxcolor oldbas$(val(obj$(n,Bas)))=" ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 22 'comboboxcolor oldbas$(val(obj$(n,Bas)))=" ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'texteditorcolor oldbas$(val(obj$(n,Bas)))=" TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
'handle font changes case 30 'font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" font ";obj$(n,Fon);chr$(34) case 32 '!font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" !font ";obj$(n,Fon);chr$(34) end select next end if open file$ for output as #bas for n= 1 to ln #bas oldbas$(n) next close #bas return
function getsize$(l$) 'what if it is a variable? v$="" pos=1 n$=mid$(l$,pos,1) while instr("1234567890",n$,1)=0 and pos<len(l$) pos=pos+1 n$=mid$(l$,pos,1) wend while n$>="0" and n$<="9" and pos<=len(l$) v$=v$+n$ pos=pos+1 n$=mid$(l$,pos,1) wend getsize$=v$ end function
function getcolor$(l$) 'what if it is a variable? cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black " for c= 1 to 15 if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for next end function
[new] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=0 menuset=0 projectw=320 projecth=360 projectback$="white" projectfore$="black" projectctrc$="white" projecttitl$="Untitled" projectform$="#1" projectfile$="Untitled.bas" projectwind$="window_nf" #prop.cbwind "select window_nf" redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.w "select ";projectw #fful.h "select ";projecth gosub [propertyupdate] gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[propertyupdate] #prop.tbfile projectfile$ #prop.cbwind "select ";projectwind$ #prop.tbtitl projecttitl$ #prop.tbform projectform$ #prop.tbctrl "" #prop.tbtext "" #prop.tbreso "" #prop.tbxywh projectw;"x";projecth #prop.tbfont projectfont$ #prop.tbcolo projectfore$;"/";projectback$ return
[resize] #fful.tool "select Add New" #fful.form "select File" if wh=0 then wh=1 #fful.hand "selectindex ";wh #fful.grid "select Set Grid" #fful.font "select Set Font" #fful.color "select Set Color" #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawall] wait
[formsize] #fful.w "contents? w$" #fful.h "contents? h$" wf=val(w$) hf=val(h$) if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait projectw=wf projecth=hf insertx=grid inserty=grid gosub [drawgrid] #fful.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid spacing according to user choice, default is 10 #fful.grid "contents? g$" select case g$ case "Invisible" gridvisible=0 case "Visible" gridvisible=1 case else grid=val(g$) end select gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" wait
[drawgrid] if grid>0 then projectgrid=grid insertx=int((insertx+(grid/2))/grid)*grid inserty=int((inserty+(grid/2))/grid)*grid #fful.gb "cls; fill buttonface" '#fful.gb "place 0 0 ; color ";projectback$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25 '#fful.gb "color ";gridcolor$;" ; backcolor ";projectback$ if gridvisible then if menuset = 0 and textEd = 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25 for xs = 0 to projectw step grid ' Grid - Draw horizontal lines #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-25 next xs for ys = 0 to projecth-25 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if 'adjust grid when menu, or texeditor control is selected - revert if menu and texeditor deleted /no longer used., if menuset = 1 or textEd > 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";gridcolor$ for xs = 0 to projectw step grid #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-50 next xs for ys = 0 to projecth-50 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if end if [nogrid]
if grid = 1 or gridvisible = 0 then if textEd =0 and menuset = 0 then #fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 '#fful.gb "color ";crosshair$ #fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-25 #fful.gb "line "; 0; " "; (projecth)/2; " "; projectw; " "; (projecth)/2 '#fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25 #fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25 end if if textEd > 0 or menuset = 1 then #fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 '#fful.gb "color ";crosshair$ #fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-50 #fful.gb "line "; 0; " "; (projecth-50)/2; " "; projectw; " "; (projecth-50)/2 '#fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50 #fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50 end if end if
#fful.gb "flush bak" #fful.gb "color black" end if #fful.grid "select Set Grid" return
[font] #fful.font "contents? f$" if f$="Project Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #fful.gb "font ";projectfont$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" projectctrh=(yp-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Control Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #fful.gb "font ";ctrf$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" ctrh=(yp-100)/2+7 end if if selected then obj$(selected,4)=ctrf$ 'font obj(selected,6)=ctrh 'text height end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="ResetControl" then ctrf$=projectfont$ ctrh=projectctrh if selected then obj$(selected,4)=ctrf$ obj(selected,6)=ctrh end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then #fful.gb "font ";ctrf$ obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #fful.font "select Set Font" gosub [drawall] #fful.gb "setfocus" wait
[color] #fful.color "contents? c$" select case c$ case "Control Back" gosub [colorpick] if cp$<>"" then if selected then 'insert color change event ahead of control if obj(selected,T)=2 then ct=22 : projecttbcl$=cp$ if obj(selected,T)=3 then ct=23 : projectlbcl$=cp$ if obj(selected,T)=4 then ct=24 : projectcbcl$=cp$ if obj(selected,T)=11 then ct=21 : projecttecl$=cp$ for n=obj+1 to selected+1 step -1 obj(n,X)=obj(n-1,X) obj(n,Y)=obj(n-1,Y) obj(n,W)=obj(n-1,W) obj(n,H)=obj(n-1,H) obj(n,T)=obj(n-1,T) obj(n,TH)=obj(n-1,TH) obj$(n,Ctr)=obj$(n-1,Ctr) obj$(n,Tex)=obj$(n-1,Tex) obj$(n,Res)=obj$(n-1,Res) obj$(n,Fon)=obj$(n-1,Fon) obj$(n,Bak)=obj$(n-1,Bak) obj$(n,Bas)=obj$(n-1,Bas) next obj(selected,T)=ct obj$(selected,Tex)="Color!" obj$(selected,Bak)=cp$ 'remove any previous color change statement if selected>=2 then if obj(selected-1,T)=ct then obj(selected-1,T)=0 end if obj=obj+1 end if end if case "Project Back" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Project Fore" gosub [colorpick] if cp$<>"" then projectfore$=cp$ case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] end select #fful.color "select Set Color" gosub [drawall] #fful.gb "setfocus" wait
[windowtype] #prop.cbwind "contents? projectwind$" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #pick.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #pick #pick "font Consolas 9" #pick "trapclose [quitpick]" #pick.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white " c=1 for yc=1 to 160 step 40 for xc= 1 to 160 step 40 #pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40 c=c+1 if c>15 then c=15 next next #pick.gb "when leftButtonDown [pick]" wait
[pick] xp=int(MouseX/40) yp=int(MouseY/40) c=xp+yp*4+1 cp$=word$(cl$,c)
[quitpick] close #pick return
[help] run "notepad help.txt" wait
[quitfful] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectfile$ #ses projectwind$ #ses projectform$ #ses projecttitl$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth for n=1 to obj if obj(n,T)<>0 then #ses obj(n,X);","; #ses obj(n,Y);","; #ses obj(n,W);","; #ses obj(n,H);","; #ses obj(n,T);","; #ses obj(n,TH) #ses obj$(n,Ctr) #ses obj$(n,Tex) #ses obj$(n,Res) #ses obj$(n,Fon) #ses obj$(n,Bak) end if next close #ses close #prop close #fful end
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
'for n=1 to obj ' print n;" ";obj(n,X);" ";obj(n,Y);" ";obj(n,W);" ";obj(n,H);" ";obj(n,T);" ";obj(n,6);" "; ' print obj$(n,Ctr);" ";obj$(n,Tex);" ";obj$(n,Res);" ";obj$(n,Fon);" ";obj$(n,Bak);" ";obj$(n,6);" ";obj$(n,Bas);" " 'next
|
|
|
Post by xxgeek on May 30, 2023 1:57:39 GMT -5
Another 'import' issue dealt with. It helped having the file to test with, thanks gaslouk.
Let me know how it goes. Got anymore difficult files?
I also changed to allow imported files to write the event handler labels. It will however crash the debugger when/if duplicate labels are in the imported file. A duplicate event handler label happens in our "preview.bas" because the imported file uses more than one control to point to the same event handler. This may cause FFUL to have unseen issues, and need a restart. It is worth having the event handler labels written for most other imported files.
ver$="1.12.1" 'freeform ultra lite v1.x 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1
nomainwin dim info$(10,10) dim form$(10) form$(1)="Restore" form$(2)="New" form$(3)="Save .ffu" form$(4)="Load .ffu" form$(5)="-----------" form$(6)="Write .bas" form$(7)="Import .bas" form$(8)="Export .bas" form$(9)="File" dim tool$(14) tool$(1)="StatictText" tool$(2)="TextBox" tool$(3)="ListBox" tool$(5)="ComboBox" tool$(6)="Button" tool$(7)="BmpButton" tool$(8)="GraphicBox" tool$(9)="RadioButton" tool$(10)="CheckBox" tool$(11)="GroupBox" tool$(12)="Texteditor" tool$(13)="Menu" tool$(14)="Add New" dim hnd$(30) hnd$(1)="#1" dim grid$(20) grid$(1)="1" g=2 for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Invisible" grid$(g+1)="Visible" grid$(g+2)="Set Grid" grid=10 gridvisible=1 gridcolor$="buttonface" projectctrh=25 ctrh=25 dim color$(10) color$(1)="Control Back" color$(2)="Project Back" color$(3)="Project Fore" color$(4)="Grid Color" color$(5)="Set Color" projectback$="white" projectfore$="black" 'ctrc$="white" dim font$(10) font$(1)="Control Font" font$(2)="ResetControl" font$(3)="Project Font" font$(4)="Set Font"'default is Consolas 9" dim wind$(20)'window type names wind$(1)="window" wind$(2)="window_nf" wind$(3)="window_popup" wind$(4)="dialog" wind$(5)="dialog_modal" wind$(6)="dialog_nf" wind$(7)="dialog_nf_modal" wind$(8)="dialog_fs" wind$(9)="dialog_nf_fs" wind$(10)="dialog_popup" wind$(11)="graphics" wind$(12)="graphics_fs" wind$(13)="graphics_fs_nsb" wind$(14)="graphics_nsb" wind$(15)="graphics_nf_nsb" wind$(16)="text" wind$(17)="text_fs" wind$(18)="text_nsb" wind$(19)="text_nsb_ins"
dim v$(2000) for n= 100 to 2000 step 20 v$(n)=str$(n) next dim obj(200,6) 'x,y,width/height,type,textheight X=1 Y=2 W=3 H=4 T=5 TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline Ctr=1 Tex=2 Res=3 Fon=4 Bak=5 Bas=7
'set default starting position obj=0 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" projectctrh=25 projectgrid=10 projectw=320 projecth=360 insertx=grid inserty=grid*2
'open a small properties window and hide it WindowWidth=230 WindowHeight=260 UpperLeftX=(DisplayWidth-230)/2 UpperLeftY=(DisplayHeight-180)/2 statictext #prop.st1 "File",5,10,30,25 textbox #prop.tbfile,45,5,150,25 statictext #prop.st2 "Wind",5,32,30,25 combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25 statictext #prop.st3 "Titl",5,54,30,25 textbox #prop.tbtitl,45,49,150,25 statictext #prop.st4 "Form",5,76,30,25 textbox #prop.tbform,45,71,150,25 statictext #prop.st5 "Ctrl",5,98,30,25 textbox #prop.tbctrl,45,93,150,25 statictext #prop.st6 "Text",5,120,30,25 textbox #prop.tbtext,45,115,150,25 statictext #prop.st7 "Reso",5,142,30,25 textbox #prop.tbreso,45,137,150,25 statictext #prop.st8 "xywh",5,164,30,25 textbox #prop.tbxywh,45,159,150,25 statictext #prop.st9 "Font",5,186,30,25 textbox #prop.tbfont,45,181,150,25 statictext #prop.st10 "Colo",5,208,30,25 textbox #prop.tbcolo,45,203,150,25
open "Properties" for window_nf as #prop #prop "font Consolas 9" #prop "trapclose [show]" #prop.cbwind "select window_nf" #prop.tbfile "!disable" #prop.tbxywh "!disable" #prop.tbfont "!disable" #prop.tbcolo "!disable" gosub [propertyupdate] #prop "hide"
'open the main form window 'this window is resizable, the graphicox will resize but the 'client area, which is a drawn representation of the window 'will only change size if you change the project w/h dimensions WindowWidth=862 WindowHeight=705 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #fful.tool,tool$(,[tool],5,2,85,30 combobox #fful.form,form$(,[form],95,2,85,30 combobox #fful.hand,hnd$(,[hand],185,2,85,30 button #fful.project,"Preview",[preview],UL,275,0,60,25 combobox #fful.w,v$(,[formsize],340,2,60,30 combobox #fful.h,v$(,[formsize],405,2,60,30 combobox #fful.grid,grid$(,[grid],470,2,90,30 combobox #fful.color,color$(,[color],565,2,90,30 combobox #fful.font,font$(,[font],660,2,90,30 button #fful.help,"Help",[help],UL,755,0,80,25 graphicbox #fful.gb,5,25,830,630 open "Freeform Ultra Lite v";ver$ for window as #fful #fful "trapclose [quitfful]" #fful "font Consolas 9" #fful "resizehandler [resize]" #fful.tool "select Add New" #fful.form "select File" #fful.hand "selectindex 1" #fful.grid "select Set Grid" #fful.color "select Set Color" #fful.font "select Set Font" #fful.w "select ";projectw #fful.h "select ";projecth #fful.gb "autoresize" #fful.gb "vertscrollbar on 0 ";projectw #fful.gb "horizscrollbar on 0 ";projecth #fful.gb "font ";projectfont$ #fful.gb "down" gosub [drawgrid] gosub [drawall] #fful.gb "when rightButtonDown [show]" #fful.gb "when leftButtonDown [select]" #fful.gb "when characterInput [keys]" #fful.gb "setfocus" #prop "show" show=1 wait
[show] if show then #prop "hide" show=0 else #prop "show" show=1 end if wait
'the user clicked on the form design window 'either to chose a control or to deselect a control [select] xs=MouseX ys=MouseY
'hide property window if it is open if show then #prop "hide" show=0 end if
'before we move on update the currently selected control from properties 'get the project data and only the editable contents of controls if selected=0 then 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ end if #prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$ #prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$ #prop.tbreso "!contents? t$" : obj$(selected,Res)=t$ 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if xs>obj(cn,X) and xs<(obj(cn,X)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then if xs>obj(cn,X)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2 if obj(cn,T)=6 then action=1 selected=cn exit for end if next if selected=0 then gosub [propertyupdate] action=0 end if if selected>0 and action=1 then #fful.gb "when leftButtonMove [track]" #fful.gb "when leftButtonUp [stop]" offsetX=xs-obj(selected,X) offsetY=ys-obj(selected,Y) end if if selected>0 and obj(selected,T)<>6 and action=2 then 'dont resize bmp #fful.gb "when leftButtonMove [tracksize]" #fful.gb "when leftButtonUp [stopsize]" offsetX=xs-(obj(selected,X)+obj(selected,W)) offsetY=ys-(obj(selected,Y)+obj(selected,H)) end if if selected>0 then gosub [drawit] else insertx=int((xs+(grid/2))/grid)*grid inserty=int((ys+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #fful.gb "rule xor" gosub [drawit] xt=int((MouseX-offsetX+(grid/2))/grid)*grid if xt<0 then xt=0'11 if xt+obj(selected,W)>projectw then xt=projectw-obj(selected,W) obj(selected,X)=xt yt=int((MouseY-offsetY+(grid/2))/grid)*grid if menuset = 0 and textEd = 0 then if yt<0 then yt=0 if yt+obj(selected,H)>projecth-25 then yt=projecth-obj(selected,H)-25 obj(selected,Y)=yt end if
if menuset = 1 or textEd > 0 then if yt < 0 then yt = 0 if yt+obj(selected,H)>projecth-50 then yt=projecth-obj(selected,H)-50 obj(selected,Y)=yt end if gosub [drawit] wait
[stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[tracksize] #fful.gb "rule xor" gosub [drawit] xs=int((MouseX-offsetX+(grid/2))/grid)*grid if xs>projectw then xs=projectw if xs<obj(selected,X) then xs=obj(selected,X)+grid ys=int((MouseY-offsetY+(grid/2))/grid)*grid if ys>projecth then ys=projecth if ys<obj(selected,Y)+ctrh then ys=obj(selected,Y)+ctrh obj(selected,W)=xs-obj(selected,X)'width if menuset = 1 or textEd > 0 then obj(selected,H)=ys-obj(selected,Y)-50'height if menuset = 0 and textEd = 0 then obj(selected,H)=ys-obj(selected,Y)-25'height gosub [drawit] wait
[stopsize] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,T)=12 then menuset = 0 : gosub [drawgrid] 'menu if obj(selected,T)=11 then textEd = textEd-1 : gosub [drawgrid] 'texteditor obj(selected,T)=0 selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,X) 'x cpy(2)=obj(selected,Y) 'y cpy(3)=obj(selected,W) 'w cpy(4)=obj(selected,H) 'h cpy(5)=obj(selected,T) 'type cpy(6)=obj(selected,TH) 'textheight cpy$(1)=obj$(selected,Ctr) 'name cpy$(2)=obj$(selected,Tex) 'text content cpy$(3)=obj$(selected,Res) 'resource array or file path cpy$(4)=obj$(selected,Fon) 'ctrl specific font or "" cpy$(5)=obj$(selected,Bak) 'ctrl specific backcolor end if
if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 if obj(obj,T)=11 then textEd = textEd+1 'texteditor obj(obj,X)=insertx obj(obj,Y)=inserty inserty=inserty+cpy(4)+grid obj(obj,W)=cpy(3) obj(obj,H)=cpy(4) obj(obj,T)=cpy(5) obj(obj,TH)=cpy(6) obj$(obj,Ctr)=left$(cpy$(1),11)';obj obj$(obj,Tex)=cpy$(2) obj$(obj,Res)=cpy$(3) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) obj$(obj,Fon)=cpy$(4) obj$(obj,Bak)=cpy$(5) selected=obj gosub [drawgrid] gosub [drawall] end if end if #fful.gb "setfocus" wait
[tool] #fful.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=1 obj$(obj,Ctr)="statictext";obj obj$(obj,Tex)="Statictext ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 2 'textbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=2 obj$(obj,Ctr)="textbox";obj obj$(obj,Tex)="Textbox ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 3 'listbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*5 obj(obj,T)=3 obj$(obj,Ctr)="listbox";obj obj$(obj,Tex)="Listbox ";obj;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectlbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 4 'combobox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="combobox";obj obj$(obj,Tex)="Combobox ";obj;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectcbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 5 'button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=5 obj$(obj,Ctr)="button";obj obj$(obj,Tex)="Button ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)="white" inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 6 'bmp button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=50 obj(obj,H)=50 obj(obj,T)=6 obj$(obj,Ctr)="bmpbutton";obj filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Res)=file$ obj$(obj,Tex)="BMPbutton ";obj loadbmp obj$(obj,Ctr),file$ close #bmp inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid else obj(obj,T)=0 close #bmp end if else obj(obj,T)=0 end if
case 7 'graphicbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=100 obj(obj,T)=7 obj$(obj,Ctr)="graphicbox";obj obj$(obj,Tex)="Graphicbox ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=120 obj(obj,H)=ctrh obj(obj,T)=8 obj$(obj,Ctr)="radiobutton";obj obj$(obj,Tex)="Radiobutton ";obj obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 9 'checkbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=90 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="checkbox";obj obj$(obj,Tex)="Checkbox ";obj obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=100 obj(obj,T)=10 obj$(obj,Ctr)="groupbox";obj obj$(obj,Tex)="Group Box ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor obj=obj+1 textEd=textEd+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=100 obj(obj,T)=11 obj$(obj,Ctr)="texteditor";obj obj$(obj,Tex)="Texteditor ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttecl$ gosub [drawgrid] inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,X)=0 obj(obj,Y)=0 obj(obj,W)=100 obj(obj,H)=10 obj(obj,T)=12 obj$(obj,Ctr)="menu";obj obj$(obj,Tex)=" Menu Added" menuset=1 end if gosub [drawgrid] end select selected=obj gosub [drawgrid] gosub [drawall] #fful.tool "select Add New" #fful.gb "setfocus" wait
[form] #fful.form "selectionindex? i" select case i case 1 'restore file$="lastsession.ffu" gosub [loadit] case 2 'new gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 6 'write gosub [write] case 7 'import gosub [import] case 8 'export gosub [export] end select #fful.form "select File" gosub [drawall] #fful.gb "setfocus" wait
[drawall] #fful.gb "discard ; redraw bak" ocn=cn projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" for cn=1 to obj gosub [drawit] next cn=ocn #fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20 #fful.gb "setfocus" return
[drawit] 'redraws control cn
'set the color for the drawn object and action taking place if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if
'set the font for the drawn object if obj$(cn,Fon)="" then #fful.gb "font ";projectfont$ ch=projectctrh if obj(cn,H)<ch then obj(cn,H)=ch else #fful.gb "font ";obj$(cn,Fon) ch=obj(cn,TH) if obj(cn,H)<ch then obj(cn,H)=ch end if
'update the properties textboxes for selected control if cn=selected then #prop.tbctrl obj$(cn,Ctr) 'ctrlname #prop.tbtext obj$(cn,Tex) 'text #prop.tbreso obj$(cn,Res) 'resource #prop.tbxywh obj(cn,X);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height #prop.tbcolo obj$(cn,Bak) end if #fful.gb "place ";obj(cn,X);" ";obj(cn,Y) if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?" if projecttbcl$ = "" then projecttbcl$ = "white" if projectlbcl$ = "" then projectlbcl$ = "white" if projectcbcl$ = "" then projectcbcl$ = "white" select case obj(cn,T) case 1 'statictext #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 2 'textbox #fful.gb "backcolor ";projecttbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 3 'listbox #fful.gb "backcolor ";projectlbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 4 'combobox #fful.gb "backcolor ";projectcbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 5 'button #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'buttons are always black on white #fful.gb "color black" 'centre button text #fful.gb "stringwidth? ";"A";" width" xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ #fful.gb "backcolor ";projectback$ case 6 'bmpbutton if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr) #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) case 7 ' graphicbox #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "backcolor ";projectback$ case 8 'radiobutton #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'radiobutton text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 9 'checkbox #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'checkbox text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 10 'groupbox #fful.gb "backcolor ";projectback$ 'groupbox is an outline #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'group box text is always black #fful.gb "color black" 'groupbox text is offset if action=0 then #fful.gb "place ";obj(cn,X)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 11 ' texteditor #fful.gb "backcolor ";projecttecl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 12 'menu 'pin to top left obj(cn,X)=10 : obj(cn,Y)=-10 : obj(cn,W)=100 : obj(cn,H)=10 #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 21 'tecolor projecttecl$=obj$(cn,Bak) case 22 'tbcolor projecttbcl$=obj$(cn,Bak) case 23 'lbcolor projectlbcl$=obj$(cn,Bak) case 24 'cbcolor projectcbcl$=obj$(cn,Bak) case 30 'font case 31 '!font end select
return
[preview] file$="preview.bas" gosub [writeit] wait
[write] projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas" filedialog "Save .bas",projectfile$,file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit]
if file$<>"" then open file$ for output as #op 'the header #op " 'Project ";projecttitl$ #op " 'Created with Freeform Ultra Lite v";ver$;" ";date$() #op "" if projectback$<>"white" or projectfore$<>"black" then #op " 'Set BackgroundColor$ and ForegroundColor$ of project" #op " BackgroundColor$=";chr$(34);projectback$;chr$(34) #op " ForegroundColor$=";chr$(34);projectfore$;chr$(34) #op "" end if #op " 'Create arrays needed for controls listbox,combobox" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " dim ";obj$(n,Res);"10)" #op " for n = 1 to 10" #op " ";obj$(n,Res);"n)= str$(n)" #op " next" end if next #op "" #op " 'Create controls and open window" #op " nomainwin" #op " WindowWidth = ";projectw #op " WindowHeight = ";projecth #op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"Size";chr$(34);", ";chr$(34);"Small";chr$(34);", [dummy], ";chr$(34);"Large";chr$(34);", [dummy]" end if for n=1 to obj select case obj(n,T) case 1 'statictext #op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox #op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"],[no";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"],[un";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor #op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 22 'tbcolor #op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'lbcolor #op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 24 'cbcolor #op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'tecolor #op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34) end select next #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op "" #op " 'Set any listbox or combobox to display the first item on the list" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34) end if next #op " 'apply any control specific fonts" for n= 1 to obj if obj(n,T)<>0 and obj$(n,Fon)<>"" then if obj(n,T)=1 or obj(n,T)=2 or obj(n,T)=5 or obj(n,T)=10 or obj(n,T)=11 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34) end if if obj(n,T)=3 or obj(n,T)=4 or obj(n,T)=7 or obj(n,T)=8 or obj(n,T)=9 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34) end if end if next #op " wait" #op ""
'if file$<>"preview.bas" then #op " 'Create the required handlers for each control" #op " 'Radiobutton and Checkboxes are given a single handler" check=0 radio=0 for n=1 to obj select case obj(n,T) case 3 'listbox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op "" case 4 'combobox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op "" case 5 'button #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op "" case 6 'bmpbutton #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op "" case 8 'radiobutton if radio=0 then #op " [radio]" #op " 'Your handler code here, read all radiobuttons to determine which is set" #op " 'this is an example of eading the first radiobutton" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" radio=1 end if case 9 'checkbox if check=0 then #op " [check]" #op " 'Your handler code here, read all checkboxes in the group in sequence." #op " 'this is an example of eading the first checkbox" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" check=1 end if end select next else '#op " [radio]" '#op " wait" #op "" '#op " [check]" '#op " wait" '#op "" end if #op " [quit]" #op " close ";projectform$ #op " end" close #op files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] 'end if return
[saveas] projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu" filedialog "Save As...",projectname$,file$ if file$<>"" then open file$ for output as #op projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ #op projectfile$ #op projectwind$ #op projectform$ #op projecttitl$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth for n=1 to obj if obj(n,T)<>0 then #op obj(n,X);","; #op obj(n,Y);","; #op obj(n,W);","; #op obj(n,H);","; #op obj(n,T);","; #op obj(n,TH) #op obj$(n,Ctr) #op obj$(n,Tex) #op obj$(n,Res) #op obj$(n,Fon) #op obj$(n,Bak) end if next close #op gosub [propertyupdate] redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" end if return
[load] filedialog "Open Project...","*.ffu",file$ [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #ses input #ses, projectfile$ input #ses, projectwind$ input #ses, projectform$ input #ses, projecttitl$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #fful.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ projectctrh=val(c$) projectgrid=val(g$) grid=projectgrid projectw=val(w$) projecth=val(h$) #prop.cbwind "select ";projectwind$ redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.grid "select ";grid #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,X)=val(word$(l$,1,",")) obj(obj,Y)=val(word$(l$,2,",")) obj(obj,W)=val(word$(l$,3,",")) obj(obj,H)=val(word$(l$,4,",")) obj(obj,T)=val(word$(l$,5,",")) obj(obj,TH)=val(word$(l$,6,",")) line input #ses, obj$(obj,Ctr) line input #ses, obj$(obj,Tex) line input #ses, obj$(obj,Res) line input #ses, obj$(obj,Fon) line input #ses, obj$(obj,Bak) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) if obj(obj,T)=12 then menuset=1 wend close #ses gosub [propertyupdate] #prop "hide" #prop "show" end if return
[import] filedialog "Open .bas...","*.bas",file$ if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) gosub [new] grid=1 gridvisible=0 gosub [drawgrid] 'set grid to 1 and invisible so controls stay where they import from initially 'import only those lines defining controls we are interested in wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox " wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty " wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ " wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ " dim bas$(5000,2) basln=1 ln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, wln$ 'break into multiple lines if ":" found outside quotes pos=1 ln$="" while pos<=len(wln$) c$=mid$(wln$,pos,1) if c$=chr$(34)then if quote=0 then quote=1 else quote=0 end if if c$=":" and quote=0 then gosub [line] ln$="" pos=pos+1 else ln$=ln$+c$ pos=pos+1 end if wend gosub [line] basln=basln+1 wend print "first cut" for n=1 to ln print bas$(n,1);" ";bas$(n,2) next print
'now find width height title and handle for all windows found in bas$( 'up to 30 forms in a .bas '1=handle #main etc '2=title '3=width '4=height '5=windowtype '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
redim win$(30,10) redim hnd$(30) nl=ln wh=1 for ln=1 to nl 'find width and height ,assumes width and height are defined ahead of open 'so width height and colors can be set multiple times, so store bas line number involved if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1) if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1) if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1) if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1) if word$(bas$(ln,2),1) = "open" and left$(word$(bas$(ln,2),2, " as "),1) = "#" then if instr(lower$(bas$(ln,2)),"window",1)>0 or instr(lower$(bas$(ln,2)),"dialog",1)>0 or instr(lower$(bas$(ln,2)),"graphic",1)>0 then win$(wh,10)=bas$(ln,1) n$=word$(bas$(ln,2),2,chr$(34)) hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1)) 'find last "for" in command line i=1 while i oi=i i=instr(lower$(bas$(ln,2))," for ",i+1) wend wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi) wt$=word$(wt$,2) win$(wh,1)=hn$ 'handle #fful etc win$(wh,2)=n$ 'title win$(wh,3)=w$ 'width win$(wh,4)=h$ 'height win$(wh,5)=wt$ 'windowtype hnd$(wh)=hn$ 'for combobox 'print wh;" ";hnd$(wh);" ";win$(wh,2);" ";win$(wh,3);" ";win$(wh,4);" ";win$(wh,5) wh=wh+1 end if end if next #fful.hand "reload" #fful.hand "selectindex 1" close #bas wh=1 gosub [loadwindow] end if return
[line] if ln$<>"" then w$=lower$(word$(ln$,1)) if instr(w$,"=",1)>1 then w$=word$(w$,1,"=") if len(w$)>3 then w1$=" "+w$+" " w2$=" "+w$+"=" if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 then bas$(ln,1)=str$(basln) bas$(ln,2)=trim$(ln$) ln=ln+1 end if end if end if return
[hand] #fful.hand "selectionindex? wh" gosub [loadwindow] wait
[loadwindow] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=1 menuset=0 projectback$="white" TextboxColor$="white" ListboxColor$="white" ComboboxColor$="white" TexteditorColor$="white" projectfore$="black" projectw=val(win$(wh,3)) if projectw=0 then projectw=320 projecth=val(win$(wh,4)) if projecth=0 then projecth=360 projecttitl$=win$(wh,2) projectwind$=win$(wh,5) projectform$=win$(wh,1) tbc$="" lbc$="" cbc$="" tec$="" gosub [propertyupdate] #fful.w "!";str$(projectw) #fful.h "!";str$(projecth)
'find controls and create obj() for ln=1 to nl 'create hidden objects to control font and color only used in import/export, not displayed ct=0 if instr(bas$(ln,2),"TextboxColor$",1)>0 then tbc$=getcolor$(bas$(ln,2)):ct=20 if instr(bas$(ln,2),"ListboxColor$",1)>0 then lbc$=getcolor$(bas$(ln,2)):ct=21 if instr(bas$(ln,2),"ComboboxColor$",1)>0 then cbc$=getcolor$(bas$(ln,2)):ct=22 if instr(bas$(ln,2),"TexteditorColor$",1)>0 then tec$=getcolor$(bas$(ln,2)):ct=23 if ct then obj(obj,T)=ct if ct=20 then obj$(obj,Bak)=tbc$ if ct=21 then obj$(obj,Bak)=lbc$ if ct=22 then obj$(obj,Bak)=cbc$ if ct=23 then obj$(obj,Bak)=tec$ obj$(obj,Bas)=bas$(ln,1) obj=obj+1 end if for wc=1 to 12 if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for next if wc<=11 then obj$(obj,Bas)=bas$(ln,1) l$=bas$(ln,2) ll$="" 'remove spaces leaving only , separation but keep "" text untouched inString=0 for i=1 to len(l$) c$=mid$(l$,i,1) select case case c$=chr$(34) inString=1-inString case (inString=0) and c$=" " c$="" end select ll$=ll$+c$ next 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1) obj(obj,T)=wc 'type obj(obj,TH)=projectctrh 'get the .ctrl name obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1) 'for un-named controls if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj 'get the text if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc) 'get the array or bmp file name if wc=3 or wc=4 or wc=6 then obj$(obj,Res)=word$(ll$,2,",") 'get rid of "" if wc=6 and left$(obj$(obj,Res),1)=chr$(34) then obj$(obj,Res)=mid$(obj$(obj,Res),2,len(obj$(obj,Res))-2) 'array() -> array( if (wc=3 or wc=4) and right$(obj$(obj,Res),1)=")" then obj$(obj,Res)=left$(obj$(obj,Res), len(obj$(obj,Res))-1) i=1 while word$(ll$,i,",")<>"" i=i+1 wend i=i-4 if wc=6 or wc=5 then 'buttons and bmpbuttons can have xy, wh is optional and they have XX corners if i=3 then obj(obj,X)=val(word$(ll$,i+2,","))'x obj(obj,Y)=val(word$(ll$,i+3,","))'y if wc=5 then 'we need to find a way to calculate width and height if not given #fful.gb "stringwidth? ";"A";" width" obj(obj,W)=width*len(obj$(obj,Tex))+10 obj(obj,H)=projectctrh end if if wc=6 then 'we need a way to set bmp w and h on error goto [dummybmp] open obj$(obj,Res) for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Tex)="bmp" end if loadbmp obj$(obj,Ctr),obj$(obj,Res) close #bmp goto [passdummy]
[dummybmp] obj(obj,W)=25 obj(obj,H)=25 obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),"path.bmp" [passdummy] end if else obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y obj(obj,W)=val(word$(ll$,i+2,","))'w obj(obj,H)=val(word$(ll$,i+3,","))'h end if if upper$(word$(ll$,4,","))="LR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="LL" then 'obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="UR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x 'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if else 'write to .bas tweaks listbox and combobox controls to line up properly 'so we need to untweak them now obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y if wc=1 then obj(obj,Y)=obj(obj,Y)-5 if wc=10 then obj(obj,Y)=obj(obj,Y)+5 if wc=3 or wc=4 then obj(obj,X)=obj(obj,X)-1 obj(obj,W)=val(word$(ll$,i+2,","))'w if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2 obj(obj,H)=val(word$(ll$,i+3,","))'h end if
'save color if set if wc=2 then obj$(obj,Bak)=tbc$ if wc=3 then obj$(obj,Bak)=lbc$ if wc=4 then obj$(obj,Bak)=cbc$ if wc=11 then obj$(obj,Bak)=tec$ obj=obj+1 end if next 'now find font commands listed after the open statement referring to the #form '#form.ctrl !font fontname 'if so add a new font object basln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ lln$=lower$(ln$) if instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font",1)>0 or instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font",1)>0 then f$=right$(ln$,len(ln$)-instr(lln$,"font",1)-4) if instr(f$,";",1)=0 then obj$(obj,Fon)=f$ obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1) obj$(obj,Ctr)=word$(word$(ln$,1),2,".") if instr(lln$,"!font",1)>0 then obj(obj,T)=31 else obj(obj,T)=30 obj$(obj,Bas)=str$(basln)
'find the visible object and store the font change for n=1 to obj if obj$(n,Ctr)=obj$(obj,Ctr) then obj$(n,Fon)=obj$(obj,Fon) #fful.gb "font ";obj$(obj,Fon) #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" obj(n,TH)=(yp-100)/2+7 exit for end if next obj=obj+1 end if end if basln=basln+1 wend
close #bas gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[export] dim oldbas$(5000) ln=1 if file$<>"" and right$(file$,3)="bas" then open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ oldbas$(ln)=ln$ ln=ln+1 wend close #bas '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
if win$(wh,6)<>"" then oldbas$(val(win$(wh,6)))=" BackgroundColor$=";chr$(34);projectback$;chr$(34) if win$(wh,7)<>"" then oldbas$(val(win$(wh,7)))=" ForegroundColor$=";chr$(34);projectfore$;chr$(34) if win$(wh,8)<>"" then oldbas$(val(win$(wh,8)))=" WindowWidth=";projectw if win$(wh,8)=win$(wh,9) then oldbas$(val(win$(wh,8)))=oldbas$(val(win$(wh,8)))+": WindowHeight=";projecth else oldbas$(val(win$(wh,9)))=" WindowHeight=";projecth if win$(wh,10)<>"" then oldbas$(val(win$(wh,10)))=" Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ for n=1 to obj select case obj(n,T) 'handle the visible controls case 1 'statictext oldbas$(val(obj$(n,Bas)))=" statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox oldbas$(val(obj$(n,Bas)))=" textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box oldbas$(val(obj$(n,Bas)))=" listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox oldbas$(val(obj$(n,Bas)))=" combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button oldbas$(val(obj$(n,Bas)))=" button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton oldbas$(val(obj$(n,Bas)))=" bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox oldbas$(val(obj$(n,Bas)))=" graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton oldbas$(val(obj$(n,Bas)))=" radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox oldbas$(val(obj$(n,Bas)))=" checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box oldbas$(val(obj$(n,Bas)))=" groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor oldbas$(val(obj$(n,Bas)))=" texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export case 20 'textboxcolor oldbas$(val(obj$(n,Bas)))=" TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'listboxcolor oldbas$(val(obj$(n,Bas)))=" ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 22 'comboboxcolor oldbas$(val(obj$(n,Bas)))=" ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'texteditorcolor oldbas$(val(obj$(n,Bas)))=" TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
'handle font changes case 30 'font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" font ";obj$(n,Fon);chr$(34) case 32 '!font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" !font ";obj$(n,Fon);chr$(34) end select next end if open file$ for output as #bas for n= 1 to ln #bas oldbas$(n) next close #bas return
function getsize$(l$) 'what if it is a variable? v$="" pos=1 n$=mid$(l$,pos,1) while instr("1234567890",n$,1)=0 and pos<len(l$) pos=pos+1 n$=mid$(l$,pos,1) wend while n$>="0" and n$<="9" and pos<=len(l$) v$=v$+n$ pos=pos+1 n$=mid$(l$,pos,1) wend getsize$=v$ end function
function getcolor$(l$) 'what if it is a variable? cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black " for c= 1 to 15 if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for next end function
[new] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=0 menuset=0 projectw=320 projecth=360 projectback$="white" projectfore$="black" projectctrc$="white" projecttitl$="Untitled" projectform$="#1" projectfile$="Untitled.bas" projectwind$="window_nf" #prop.cbwind "select window_nf" redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.w "select ";projectw #fful.h "select ";projecth gosub [propertyupdate] gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[propertyupdate] #prop.tbfile projectfile$ #prop.cbwind "select ";projectwind$ #prop.tbtitl projecttitl$ #prop.tbform projectform$ #prop.tbctrl "" #prop.tbtext "" #prop.tbreso "" #prop.tbxywh projectw;"x";projecth #prop.tbfont projectfont$ #prop.tbcolo projectfore$;"/";projectback$ return
[resize] #fful.tool "select Add New" #fful.form "select File" if wh=0 then wh=1 #fful.hand "selectindex ";wh #fful.grid "select Set Grid" #fful.font "select Set Font" #fful.color "select Set Color" #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawall] wait
[formsize] #fful.w "contents? w$" #fful.h "contents? h$" wf=val(w$) hf=val(h$) if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait projectw=wf projecth=hf insertx=grid inserty=grid gosub [drawgrid] #fful.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid spacing according to user choice, default is 10 #fful.grid "contents? g$" select case g$ case "Invisible" gridvisible=0 case "Visible" gridvisible=1 case else grid=val(g$) end select gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" wait
[drawgrid] if grid>0 then projectgrid=grid insertx=int((insertx+(grid/2))/grid)*grid inserty=int((inserty+(grid/2))/grid)*grid #fful.gb "cls; fill buttonface" '#fful.gb "place 0 0 ; color ";projectback$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25 '#fful.gb "color ";gridcolor$;" ; backcolor ";projectback$ if gridvisible then if menuset = 0 and textEd = 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25 for xs = 0 to projectw step grid ' Grid - Draw horizontal lines #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-25 next xs for ys = 0 to projecth-25 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if 'adjust grid when menu, or texeditor control is selected - revert if menu and texeditor deleted /no longer used., if menuset = 1 or textEd > 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";gridcolor$ for xs = 0 to projectw step grid #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-50 next xs for ys = 0 to projecth-50 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if end if [nogrid]
if grid = 1 or gridvisible = 0 then if textEd =0 and menuset = 0 then #fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 '#fful.gb "color ";crosshair$ #fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-25 #fful.gb "line "; 0; " "; (projecth)/2; " "; projectw; " "; (projecth)/2 '#fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25 #fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25 end if if textEd > 0 or menuset = 1 then #fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 '#fful.gb "color ";crosshair$ #fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-50 #fful.gb "line "; 0; " "; (projecth-50)/2; " "; projectw; " "; (projecth-50)/2 '#fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50 #fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50 end if end if
#fful.gb "flush bak" #fful.gb "color black" end if #fful.grid "select Set Grid" return
[font] #fful.font "contents? f$" if f$="Project Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #fful.gb "font ";projectfont$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" projectctrh=(yp-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Control Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #fful.gb "font ";ctrf$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" ctrh=(yp-100)/2+7 end if if selected then obj$(selected,4)=ctrf$ 'font obj(selected,6)=ctrh 'text height end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="ResetControl" then ctrf$=projectfont$ ctrh=projectctrh if selected then obj$(selected,4)=ctrf$ obj(selected,6)=ctrh end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then #fful.gb "font ";ctrf$ obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #fful.font "select Set Font" gosub [drawall] #fful.gb "setfocus" wait
[color] #fful.color "contents? c$" select case c$ case "Control Back" gosub [colorpick] if cp$<>"" then if selected then 'insert color change event ahead of control if obj(selected,T)=2 then ct=22 : projecttbcl$=cp$ if obj(selected,T)=3 then ct=23 : projectlbcl$=cp$ if obj(selected,T)=4 then ct=24 : projectcbcl$=cp$ if obj(selected,T)=11 then ct=21 : projecttecl$=cp$ for n=obj+1 to selected+1 step -1 obj(n,X)=obj(n-1,X) obj(n,Y)=obj(n-1,Y) obj(n,W)=obj(n-1,W) obj(n,H)=obj(n-1,H) obj(n,T)=obj(n-1,T) obj(n,TH)=obj(n-1,TH) obj$(n,Ctr)=obj$(n-1,Ctr) obj$(n,Tex)=obj$(n-1,Tex) obj$(n,Res)=obj$(n-1,Res) obj$(n,Fon)=obj$(n-1,Fon) obj$(n,Bak)=obj$(n-1,Bak) obj$(n,Bas)=obj$(n-1,Bas) next obj(selected,T)=ct obj$(selected,Tex)="Color!" obj$(selected,Bak)=cp$ 'remove any previous color change statement if selected>=2 then if obj(selected-1,T)=ct then obj(selected-1,T)=0 end if obj=obj+1 end if end if case "Project Back" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Project Fore" gosub [colorpick] if cp$<>"" then projectfore$=cp$ case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] end select #fful.color "select Set Color" gosub [drawall] #fful.gb "setfocus" wait
[windowtype] #prop.cbwind "contents? projectwind$" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #pick.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #pick #pick "font Consolas 9" #pick "trapclose [quitpick]" #pick.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white " c=1 for yc=1 to 160 step 40 for xc= 1 to 160 step 40 #pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40 c=c+1 if c>15 then c=15 next next #pick.gb "when leftButtonDown [pick]" wait
[pick] xp=int(MouseX/40) yp=int(MouseY/40) c=xp+yp*4+1 cp$=word$(cl$,c)
[quitpick] close #pick return
[help] run "notepad help.txt" wait
[quitfful] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectfile$ #ses projectwind$ #ses projectform$ #ses projecttitl$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth for n=1 to obj if obj(n,T)<>0 then #ses obj(n,X);","; #ses obj(n,Y);","; #ses obj(n,W);","; #ses obj(n,H);","; #ses obj(n,T);","; #ses obj(n,TH) #ses obj$(n,Ctr) #ses obj$(n,Tex) #ses obj$(n,Res) #ses obj$(n,Fon) #ses obj$(n,Bak) end if next close #ses close #prop close #fful end
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
for n=1 to obj print n;" ";obj(n,X);" ";obj(n,Y);" ";obj(n,W);" ";obj(n,H);" ";obj(n,T);" ";obj(n,6);" "; print obj$(n,Ctr);" ";obj$(n,Tex);" ";obj$(n,Res);" ";obj$(n,Fon);" ";obj$(n,Bak);" ";obj$(n,6);" ";obj$(n,Bas);" " next
|
|
|
Post by Rod on May 30, 2023 9:48:16 GMT -5
Have not had any time to look at these recent fixes. Problem is that I am going to have to implement some fundamental changes to get Export to work. I have it just about exporting existing control changes though fonts are going to require a new obj() same as color changes. The thing I am struggling with is introducing new controls and deleting old controls. I can get a list of current .bas lines and I can update their contents and but introducing new lines is problematic because the insert order is important. So too deletion because its not just the control it is also preceding color changes and post open font changes that must be deleted as well.
Summer is here, garden jobs, recreation, etc all take time and concentration away from the project.
|
|
|
Post by xxgeek on May 30, 2023 11:05:16 GMT -5
Rod, you'll have lots of time to "dream" the answers No worries. I'll keep plugging away with what you've already written and add/change things as I go, to provide an alternative FFU 'not so lite'. A little 'bit' at a time. I am getting so fed up with Windows and the issues with it that I'll be taking a lot of breaks to undo the frustration. Along with defender deleting most of the exe files I create with bas2exe, I spent hours trying to figure out what was up with gaslouks file not working, and finally got it working and posted the code last night. Today I try the code, and it no longer works. WTF? gaslouk - I hope this code works for more than a day. ver$="1.12.2" 'freeform ultra lite v1.x by rodbird@hotmail 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1
nomainwin dim info$(10,10) dim form$(10) form$(1)="Restore" form$(2)="New" form$(3)="Save .ffu" form$(4)="Load .ffu" form$(5)="-----------" form$(6)="Write .bas" form$(7)="Import .bas" form$(8)="Export .bas" form$(9)="File" dim tool$(14) tool$(1)="StatictText" tool$(2)="TextBox" tool$(3)="ListBox" tool$(5)="ComboBox" tool$(6)="Button" tool$(7)="BmpButton" tool$(8)="GraphicBox" tool$(9)="RadioButton" tool$(10)="CheckBox" tool$(11)="GroupBox" tool$(12)="Texteditor" tool$(13)="Menu" tool$(14)="Add New" dim hnd$(30) hnd$(1)="#1" dim grid$(20) grid$(1)="1" g=2 for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Invisible" grid$(g+1)="Visible" grid$(g+2)="Set Grid" grid=10 gridvisible=1 gridcolor$="buttonface" projectctrh=25 ctrh=25 dim color$(10) color$(1)="Control Back" color$(2)="Reset Back" color$(3)="Project Back" color$(4)="Project Fore" color$(5)="Grid Color" color$(6)="Set Color" projectback$="white" projectfore$="black" ctrc$="white" dim font$(10) font$(1)="Control Font" font$(2)="ResetControl" font$(3)="Project Font" font$(4)="Set Font"'default is Consolas 9" dim wind$(20)'window type names dim wind(20,2)'theme width and height for each window type wind$(1)="window" wind$(2)="window_nf" wind$(3)="window_popup" wind$(4)="dialog" wind$(5)="dialog_modal" wind$(6)="dialog_nf" wind$(7)="dialog_nf_modal" wind$(8)="dialog_fs" wind$(9)="dialog_nf_fs" wind$(10)="dialog_popup" wind$(11)="graphics" wind$(12)="graphics_fs" wind$(13)="graphics_fs_nsb" wind$(14)="graphics_nsb" wind$(15)="graphics_nf_nsb" wind$(16)="text" wind$(17)="text_fs" wind$(18)="text_nsb" wind$(19)="text_nsb_ins"
dim v$(2000) for n= 100 to 2000 step 20 v$(n)=str$(n) next dim obj(200,6) 'x,y,width/height,type,textheight X=1 Y=2 W=3 H=4 T=5 TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline Ctr=1 Tex=2 Res=3 Fon=4 Bak=5 Bas=7
'set default starting position obj=0 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projectctrc$="white" projectctrh=25 projectgrid=10 projectw=320 projecth=360 insertx=grid inserty=grid*2
'change this to get frame ans scrollbar size to show on screen
'find out what our pc's client area restrictions are 'first of find out how much space the 'windows theme takes for frame and title WindowWidth=200 WindowHeight=200 border=2 open "Measuring" for graphics as #meas 'scrollbars and frame #meas "home ; down ; posxy xp yp" clientwidth=xp*2+border clientheight=yp*2+border fsbWidth=WindowWidth-clientwidth+1 fsbHeight=WindowHeight-clientheight close #meas open "Measuring" for graphics_nsb as #meas 'no scrollbars #meas "home ; down ; posxy xp yp" clientwidth=xp*2+border clientheight=yp*2+border nsbWidth=WindowWidth-clientwidth+1 nsbHeight=WindowHeight-clientheight close #meas open "Measuring" for graphics_nf_nsb as #meas 'no scrollbars no frame #meas "home ; down ; posxy xp yp" clientwidth=xp*2+border clientheight=yp*2+border nfnsbWidth=WindowWidth-clientwidth+1 nfnsbHeight=WindowHeight-clientheight close #meas gosub [setthemewidth]
'open a small properties window and hide it WindowWidth=230 WindowHeight=260 UpperLeftX=(DisplayWidth-230)/2 UpperLeftY=(DisplayHeight-180)/2 statictext #prop.st1 "File",5,10,30,25 textbox #prop.tbfile,45,5,150,25 statictext #prop.st2 "Wind",5,32,30,25 combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25 statictext #prop.st3 "Titl",5,54,30,25 textbox #prop.tbtitl,45,49,150,25 statictext #prop.st4 "Form",5,76,30,25 textbox #prop.tbform,45,71,150,25 statictext #prop.st5 "Ctrl",5,98,30,25 textbox #prop.tbctrl,45,93,150,25 statictext #prop.st6 "Text",5,120,30,25 textbox #prop.tbtext,45,115,150,25 statictext #prop.st7 "Reso",5,142,30,25 textbox #prop.tbreso,45,137,150,25 statictext #prop.st8 "xywh",5,164,30,25 textbox #prop.tbxywh,45,159,150,25 statictext #prop.st9 "Font",5,186,30,25 textbox #prop.tbfont,45,181,150,25 statictext #prop.st10 "Colo",5,208,30,25 textbox #prop.tbcolo,45,203,150,25
open "Properties" for window_nf as #prop #prop "font Consolas 9" #prop "trapclose [show]" #prop.cbwind "select window_nf" #prop.tbfile "!disable" #prop.tbxywh "!disable" #prop.tbfont "!disable" #prop.tbcolo "!disable" gosub [propertyupdate] #prop "hide"
'open the main form window 'this window is resizable, the graphicox will resize but the 'client area, which is a drawn representation of the window 'will only change size if you change the project w/h dimensions WindowWidth=862 WindowHeight=705 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #fful.tool,tool$(,[tool],5,2,85,30 combobox #fful.form,form$(,[form],95,2,85,30 combobox #fful.hand,hnd$(,[hand],185,2,85,30 button #fful.project,"Preview",[preview],UL,275,0,60,25 combobox #fful.w,v$(,[formsize],340,2,60,30 combobox #fful.h,v$(,[formsize],405,2,60,30 combobox #fful.grid,grid$(,[grid],470,2,90,30 combobox #fful.color,color$(,[color],565,2,90,30 combobox #fful.font,font$(,[font],660,2,90,30 button #fful.help,"Help",[help],UL,755,0,80,25 graphicbox #fful.gb,5,25,830,630 open "Freeform Ultra Lite v";ver$ for window as #fful #fful "trapclose [quitfful]" #fful "font Consolas 9" #fful "resizehandler [resize]" #fful.tool "select Add New" #fful.form "select File" #fful.hand "selectindex 1" #fful.grid "select Set Grid" #fful.color "select Set Color" #fful.font "select Set Font" #fful.w "select ";projectw #fful.h "select ";projecth #fful.gb "autoresize" #fful.gb "vertscrollbar on 0 ";projectw #fful.gb "horizscrollbar on 0 ";projecth #fful.gb "font ";projectfont$ #fful.gb "down" gosub [drawgrid] gosub [drawall] #fful.gb "when rightButtonDown [show]" #fful.gb "when leftButtonDown [select]" #fful.gb "when characterInput [keys]" #fful.gb "setfocus" #prop "show" show=1 wait
[show] if show then #prop "hide" show=0 else #prop "show" show=1 end if wait
'the user clicked on the form design window 'either to chose a control or to deselect a control [select] xs=MouseX ys=MouseY
'hide property window if it is open if show then #prop "hide" show=0 end if
'before we move on update the currently selected control from properties 'get the project data and only the editable contents of controls if selected=0 then 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ end if #prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$ #prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$ #prop.tbreso "!contents? t$" : obj$(selected,Res)=t$ 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if xs>obj(cn,X) and xs<(obj(cn,X)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then if xs>obj(cn,X)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2 if obj(cn,T)=6 then action=1 selected=cn exit for end if next if selected=0 then gosub [propertyupdate] action=0 end if if selected>0 and action=1 then #fful.gb "when leftButtonMove [track]" #fful.gb "when leftButtonUp [stop]" offsetX=xs-obj(selected,X) offsetY=ys-obj(selected,Y) end if if selected>0 and obj(selected,T)<>6 and action=2 then 'dont resize bmp #fful.gb "when leftButtonMove [tracksize]" #fful.gb "when leftButtonUp [stopsize]" offsetX=xs-(obj(selected,X)+obj(selected,W)) offsetY=ys-(obj(selected,Y)+obj(selected,H)) end if if selected>0 then gosub [drawit] else insertx=int((xs+(grid/2))/grid)*grid inserty=int((ys+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #fful.gb "rule xor" gosub [drawit] xt=int((MouseX-offsetX+(grid/2))/grid)*grid if xt<0 then xt=0 if xt+obj(selected,W)>projectw then xt=projectw-obj(selected,W) obj(selected,X)=xt yt=int((MouseY-offsetY+(grid/2))/grid)*grid if yt<0 then yt=0 if yt+obj(selected,H)>projecth then yt=projecth-obj(selected,H) obj(selected,Y)=yt gosub [drawit] wait
[stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[tracksize] #fful.gb "rule xor" gosub [drawit] xs=int((MouseX-offsetX+(grid/2))/grid)*grid if xs>projectw then xs=projectw if xs<obj(selected,X) then xs=obj(selected,X)+grid ys=int((MouseY-offsetY+(grid/2))/grid)*grid if ys>projecth then ys=projecth if ys<obj(selected,Y)+ctrh then ys=obj(selected,Y)+ctrh obj(selected,W)=xs-obj(selected,X)'width obj(selected,H)=ys-obj(selected,Y)'height gosub [drawit] wait
[stopsize] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,T)=12 then menuset=0 obj(selected,T)=0 selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,X) 'x cpy(2)=obj(selected,Y) 'y cpy(3)=obj(selected,W) 'w cpy(4)=obj(selected,H) 'h cpy(5)=obj(selected,T) 'type cpy(6)=obj(selected,TH) 'textheight cpy$(1)=obj$(selected,Ctr)'name cpy$(2)=obj$(selected,Tex)'text content cpy$(3)=obj$(selected,Res)'resource array or file path cpy$(4)=obj$(selected,Fon)'ctrl specific font or "" cpy$(5)=obj$(selected,Bak)'ctrl specific backcolor or "" end if if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty inserty=inserty+cpy(4)+grid obj(obj,W)=cpy(3) obj(obj,H)=cpy(4) obj(obj,T)=cpy(5) obj(obj,TH)=cpy(6) obj$(obj,Ctr)=left$(cpy$(1),2);obj obj$(obj,Tex)=cpy$(2) obj$(obj,Res)=cpy$(3) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) obj$(obj,Fon)=cpy$(4) obj$(obj,Bak)=cpy$(5) selected=obj gosub [drawall] end if end if #fful.gb "setfocus" wait
[tool] #fful.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh obj(obj,T)=1 obj$(obj,Ctr)="st";obj obj$(obj,Tex)="statictext?" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 2 'textbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=ctrh obj(obj,T)=2 obj$(obj,Ctr)="tb";obj obj$(obj,Tex)="Textbox" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if if ctrc$<>projectback$ then obj$(obj,Bak)=ctrc$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 3 'listbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=ctrh*5 obj(obj,T)=3 obj$(obj,Ctr)="lb";obj obj$(obj,Tex)="Listbox\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if if ctrc$<>projectback$ then obj$(obj,Bak)=ctrc$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 4 'combobox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="cb";obj obj$(obj,Tex)="Combobox\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if if ctrc$<>projectback$ then obj$(obj,Bak)=ctrc$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 5 'button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=5 obj$(obj,Ctr)="bt";obj obj$(obj,Tex)="Button?" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 6 'bmp button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=50 obj(obj,H)=50 obj(obj,T)=6 obj$(obj,Ctr)="bb";obj filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Res)=file$ obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),file$ close #bmp inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid else obj(obj,T)=0 close #bmp end if else obj(obj,T)=0 end if
case 7 'graphicbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=100 obj(obj,T)=7 obj$(obj,Ctr)="gb";obj obj$(obj,Tex)="Graphicbox" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=8 obj$(obj,Ctr)="rb";obj obj$(obj,Tex)="(o) radio?" obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 9 'checkbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="ch";obj obj$(obj,Tex)="[x] check?" obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=100 obj(obj,T)=10 obj$(obj,Ctr)="gr";obj obj$(obj,Tex)="Group Box?" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=100 obj(obj,T)=11 obj$(obj,Ctr)="te";obj obj$(obj,Tex)="Texteditor" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if if ctrc$<>projectback$ then obj$(obj,Bak)=ctrc$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,X)=0 obj(obj,Y)=0 obj(obj,W)=100 obj(obj,H)=10 obj(obj,T)=12 obj$(obj,Ctr)="mn";obj obj$(obj,Tex)=" Menu Added" menuset=1 end if end select selected=obj gosub [drawall] #fful.tool "select Add New" #fful.gb "setfocus" wait
[form] #fful.form "selectionindex? i" select case i case 1 'restore file$="lastsession.ffu" gosub [loadit] case 2 'new gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 6 'write gosub [write] case 7 'import gosub [import] case 8 'export gosub [export] end select #fful.form "select File" gosub [drawall] #fful.gb "setfocus" wait
[drawall] #fful.gb "discard ; redraw bak" ocn=cn for cn=1 to obj gosub [drawit] next cn=ocn #fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20 #fful.gb "setfocus" return
[drawit] 'redraws control cn if obj(cn,T)=0 then return 'if this is a menu pin to top left to stop it being move or resized if obj(cn,T)=12 then obj(cn,X)=10 : obj(cn,Y)=-10 : obj(cn,W)=100 : obj(cn,H)=10 'if there is a special font for the object in obj$(n,Fon) change 'the font and height stored in obj(n,TH) or set to default if cn=9 then null=0
end if if obj$(cn,Fon)="" then #fful.gb "font ";projectfont$ ch=projectctrh if obj(cn,H)<ch then obj(cn,H)=ch else #fful.gb "font ";obj$(cn,Fon) ch=obj(cn,TH) if obj(cn,H)<ch then obj(cn,H)=ch end if 'update the properties textboxes for selected control if cn=selected then #prop.tbctrl obj$(cn,Ctr) 'ctrlname #prop.tbtext obj$(cn,Tex) 'text #prop.tbreso obj$(cn,Res) 'resource #prop.tbxywh obj(cn,X);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height if obj$(cn,Bak)="" then #prop.tbcolo projectback$ else #prop.tbcolo obj$(cn,Bak) end if 'set the color for the drawn object and action taking place if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if 'if it is a statictext, checkbox radiobox, groupbox or menu make background color transparent if obj(cn,T)=1 or obj(cn,T)=8 or obj(cn,T)=9 or obj(cn,T)=10 or obj(cn,T)=12 then #fful.gb "backcolor ";projectback$ if selected<>cn then #fful.gb "color 192 192 192" else if obj$(cn,Bak)<>"" then #fful.gb "backcolor ";obj$(cn,Bak) else #fful.gb "backcolor ";projectback$ end if 'now draw the object at desired location #fful.gb "place ";obj(cn,X);" ";obj(cn,Y) 'if it is a bmp draw actual bmp if it is stationary else just the outline if obj(cn,T)=6 then if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr) #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) else 'draw outline if it is a groupbox else all others filled if obj(cn,T)=10 then #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) else #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) end if 'if we are stationary draw the text in the correct color if action=0 then if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if select case obj(cn,T) case 5 'centre button text #fful.gb "stringwidth? ";"A";" width" xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 #fful.gb "place ";obj(cn,X)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 10 'groupbox text is offset #fful.gb "place ";obj(cn,X)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex) case else 'woa! normal left justified text #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) end select end if end if return
[preview] file$="preview.bas" gosub [writeit] wait
[write] projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas" filedialog "Save .bas",projectfile$,file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit] if file$<>"" then open file$ for output as #op 'the header #op " 'Project ";projecttitl$ #op " 'Created with Freeform Ultra Lite v";ver$;" ";date$() #op " nomainwin" #op "" if projectback$<>"white" or projectfore$<>"black" then #op " 'Set BackgroundColor$ and ForegroundColor$ of project" #op " BackgroundColor$=";chr$(34);projectback$;chr$(34) #op " ForegroundColor$=";chr$(34);projectfore$;chr$(34) #op "" end if #op " 'Create arrays needed for controls listbox,combobox" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " dim ";obj$(n,Res);"10)" #op " for n = 1 to 10" #op " ";obj$(n,Res);"n)= str$(n)" #op " next" end if next #op "" #op " 'Create controls and open window" #op " WindowWidth = ";projectw+ThemeW #op " WindowHeight = ";projecth+ThemeH+menuset*projectctrh #op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"Size";chr$(34);", ";chr$(34);"Small";chr$(34);", [dummy], ";chr$(34);"Large";chr$(34);", [dummy]" end if for n=1 to obj select case obj(n,T) case 1 'statictext #op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox if obj$(n,Bak)<>"" then #op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) #op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box if obj$(n,Bak)<>"" then #op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox if obj$(n,Bak)<>"" then #op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 if obj$(n,Bak)<>"" then #op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34) #op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) end select next #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op "" #op " 'Set any listbox or combobox to display the first item on the list" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34) end if next #op " 'apply any control specific fonts" for n= 1 to obj if obj(n,T)<>0 and obj$(n,Fon)<>"" then if obj(n,T)=1 or obj(n,T)=2 or obj(n,T)=5 or obj(n,T)=10 or obj(n,T)=11 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34) end if if obj(n,T)=3 or obj(n,T)=4 or obj(n,T)=7 or obj(n,T)=8 or obj(n,T)=9 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34) end if end if next #op " wait" #op "" 'if file$<>"preview.bas" then #op " 'Create the required handlers for each control" #op " 'Radiobutton and Checkboxes are given a single handler" check=0 radio=0 for n=1 to obj select case obj(n,T) case 3 'listbox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op "" case 4 'combobox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op "" case 5 'button #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op "" case 6 'bmpbutton #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op "" case 8 'radiobutton if radio=0 then #op " [radio]" #op " 'Your handler code here, read all radiobuttons to determine which is set" #op " 'this is an example of eading the first radiobutton" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" radio=1 end if case 9 'checkbox if check=0 then #op " [check]" #op " 'Your handler code here, read all checkboxes in the group in sequence." #op " 'this is an example of eading the first checkbox" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" check=1 end if end select next end if #op " [quit]" #op " close ";projectform$ #op " end" close #op files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] 'end if return
[saveas] projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu" filedialog "Save As...",projectname$,file$ if file$<>"" then open file$ for output as #op projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ #op projectfile$ #op projectwind$ #op projectform$ #op projecttitl$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth for n=1 to obj if obj(n,T)<>0 then #op obj(n,X);","; #op obj(n,Y);","; #op obj(n,W);","; #op obj(n,H);","; #op obj(n,T);","; #op obj(n,TH) #op obj$(n,Ctr) #op obj$(n,Tex) #op obj$(n,Res) #op obj$(n,Fon) #op obj$(n,Bak) end if next close #op gosub [propertyupdate] redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" end if return
[load] filedialog "Open Project...","*.ffu",file$ [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #ses input #ses, projectfile$ input #ses, projectwind$ input #ses, projectform$ input #ses, projecttitl$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #fful.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ projectctrh=val(c$) projectgrid=val(g$) grid=projectgrid projectw=val(w$) projecth=val(h$) #prop.cbwind "select ";projectwind$ redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.grid "select ";grid #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,X)=val(word$(l$,1,",")) obj(obj,Y)=val(word$(l$,2,",")) obj(obj,W)=val(word$(l$,3,",")) obj(obj,H)=val(word$(l$,4,",")) obj(obj,T)=val(word$(l$,5,",")) obj(obj,TH)=val(word$(l$,6,",")) line input #ses, obj$(obj,Ctr) line input #ses, obj$(obj,Tex) line input #ses, obj$(obj,Res) line input #ses, obj$(obj,Fon) line input #ses, obj$(obj,Bak) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) if obj(obj,T)=12 then menuset=1 wend close #ses gosub [setthemewidth] gosub [propertyupdate] #prop "hide" #prop "show" end if return
[import] filedialog "Open .bas...","*.bas",file$ if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) gosub [new] grid=1 gridvisible=0 gosub [drawgrid] 'set grid to 1 and invisible so controls stay where they import from initially 'import only those lines defining controls we are interested in wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox " wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty " wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ " wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ " dim bas$(5000,2) basln=1 ln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, wln$ 'break into multiple lines if ":" found outside quotes pos=1 ln$="" while pos<=len(wln$) c$=mid$(wln$,pos,1) if c$=chr$(34)then if quote=0 then quote=1 else quote=0 end if if c$=":" and quote=0 then gosub [line] ln$="" pos=pos+1 else ln$=ln$+c$ pos=pos+1 end if wend gosub [line] basln=basln+1 wend 'print "first cut" for n=1 to ln ' print bas$(n,2) next 'print
'now find width height title and handle for all windows found in bas$( 'up to 10 forms in a .bas '1=handle #main etc '2=title '3=width '4=height '5=windowtype '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
redim win$(30,10) redim hnd$(30) nl=ln wh=1 for ln=1 to nl 'find width and height ,assumes width and height are defined ahead of open 'so width height and colors can be set multiple times, so store bas line number involved if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1) if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1) if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1) if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1) if instr(lower$(bas$(ln,2)),"open",1)>0 then if instr(lower$(bas$(ln,2)),"window",1)>0 or instr(lower$(bas$(ln,2)),"dialog",1)>0 or instr(lower$(bas$(ln,2)),"graphic",1)>0 then win$(wh,10)=bas$(ln,1) n$=word$(bas$(ln,2),2,chr$(34)) hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1)) 'find last "for" in command line i=1 while i oi=i i=instr(lower$(bas$(ln,2))," for ",i+1) wend wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi) wt$=word$(wt$,2) win$(wh,1)=hn$ 'handle #fful etc win$(wh,2)=n$ 'title win$(wh,3)=w$ 'width win$(wh,4)=h$ 'height win$(wh,5)=wt$ 'windowtype hnd$(wh)=hn$ 'for combobox 'print wh;" ";hnd$(wh);" ";win$(wh,2);" ";win$(wh,3);" ";win$(wh,4);" ";win$(wh,5) wh=wh+1 end if end if next #fful.hand "reload" #fful.hand "selectindex 1" close #bas wh=1 gosub [loadwindow] end if return
[line] if ln$<>"" then w$=lower$(word$(ln$,1)) if instr(w$,"=",1)>1 then w$=word$(w$,1,"=") if len(w$)>3 then w1$=" "+w$+" " w2$=" "+w$+"=" if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 then bas$(ln,1)=str$(basln) bas$(ln,2)=trim$(ln$) ln=ln+1 end if end if end if return
[hand] #fful.hand "selectionindex? wh" gosub [loadwindow] wait
[loadwindow] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=1 menuset=0 projectback$="white" TextboxColor$="white" ListboxColor$="white" ComboboxColor$="white" TexteditorColor$="white" projectfore$="black" projectw=val(win$(wh,3)) if projectw=0 then projectw=320 projecth=val(win$(wh,4)) if projecth=0 then projecth=360 projecttitl$=win$(wh,2) projectwind$=win$(wh,5) projectform$=win$(wh,1) tbc$="" lbc$="" cbc$="" tec$="" gosub [setthemewidth] gosub [propertyupdate] #fful.w "!";str$(projectw) #fful.h "!";str$(projecth) for n= 1 to nl 'print bas$(n,2) next
'find controls and create obj() for ln=1 to nl 'create hidden objects to control font and color only used in import/export, not displayed ct=0 if instr(bas$(ln,2),"TextboxColor$",1)>0 then tbc$=getcolor$(bas$(ln,2)):ct=20 if instr(bas$(ln,2),"ListboxColor$",1)>0 then lbc$=getcolor$(bas$(ln,2)):ct=21 if instr(bas$(ln,2),"ComboboxColor$",1)>0 then cbc$=getcolor$(bas$(ln,2)):ct=22 if instr(bas$(ln,2),"TexteditorColor$",1)>0 then tec$=getcolor$(bas$(ln,2)):ct=23 if ct then obj(obj,T)=ct if ct=20 then obj$(obj,Bak)=tbc$ if ct=21 then obj$(obj,Bak)=lbc$ if ct=22 then obj$(obj,Bak)=cbc$ if ct=23 then obj$(obj,Bak)=tec$ obj$(obj,Bas)=bas$(ln,1) 'print bas$(ln,1),bas$(ln,2),obj$(obj,Bas) obj=obj+1 end if for wc=1 to 12 if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for next if wc<=11 then obj$(obj,Bas)=bas$(ln,1) l$=bas$(ln,2) 'print bas$(ln,1),bas$(ln,2),obj$(obj,7) ll$="" 'remove spaces leaving only , separation but keep "" text untouched inString=0 for i=1 to len(l$) c$=mid$(l$,i,1) select case case c$=chr$(34) inString=1-inString case (inString=0) and c$=" " c$="" end select ll$=ll$+c$ next 'insert missing comma if missing 'if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1)
obj(obj,T)=wc 'type obj(obj,TH)=projectctrh 'get the .ctrl name obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1) 'for un-named controls if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj 'get the text if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc) if (wc=1 or wc=5 or wc=8 or wc=9 or wc=10) and obj$(obj,Tex)=chr$(34) then obj$(obj,Tex)="" 'get the array or bmp file name if wc=3 or wc=4 or wc=6 then obj$(obj,Res)=word$(ll$,2,",") 'get rid of "" if wc=6 and left$(obj$(obj,Res),1)=chr$(34) then obj$(obj,Res)=mid$(obj$(obj,Res),2,len(obj$(obj,Res))-2) 'array() -> array( if (wc=3 or wc=4) and right$(obj$(obj,Res),1)=")" then obj$(obj,Res)=left$(obj$(obj,Res), len(obj$(obj,Res))-1) i=1 while word$(ll$,i,",")<>"" i=i+1 wend i=i-4 if wc=6 or wc=5 then 'buttons and bmpbuttons can have xy, wh is optional and they have XX corners if i=3 then obj(obj,X)=val(word$(ll$,i+2,","))'x obj(obj,Y)=val(word$(ll$,i+3,","))'y if wc=5 then 'we need to find a way to calculate width and height if not given #fful.gb "stringwidth? ";"A";" width" obj(obj,W)=width*len(obj$(obj,Tex))+10 obj(obj,H)=projectctrh end if if wc=6 then 'we need a way to set bmp w and h on error goto [dummybmp] open obj$(obj,Res) for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Tex)="bmp" end if loadbmp obj$(obj,Ctr),obj$(obj,Res) close #bmp goto [passdummy]
[dummybmp] obj(obj,W)=25 obj(obj,H)=25 obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),"path.bmp" [passdummy] end if else obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y obj(obj,W)=val(word$(ll$,i+2,","))'w obj(obj,H)=val(word$(ll$,i+3,","))'h end if if upper$(word$(ll$,4,","))="LR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="LL" then 'obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="UR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x 'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if else 'write to .bas tweaks listbox and combobox controls to line up properly 'so we need to untweak them now obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y if wc=1 then obj(obj,Y)=obj(obj,Y)-5 if wc=10 then obj(obj,Y)=obj(obj,Y)+5 if wc=3 or wc=4 then obj(obj,X)=obj(obj,X)-1 obj(obj,W)=val(word$(ll$,i+2,","))'w if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2 obj(obj,H)=val(word$(ll$,i+3,","))'h end if
'save color if set if wc=2 then obj$(obj,Bak)=tbc$ if wc=3 then obj$(obj,Bak)=lbc$ if wc=4 then obj$(obj,Bak)=cbc$ if wc=11 then obj$(obj,Bak)=tec$ obj=obj+1 end if
next 'now find font commands listed after the open statement referring to the #form '#form.ctrl !font fontname 'if so add a new font object basln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ lln$=lower$(ln$) if instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font",1)>0 or instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font",1)>0 then f$=right$(ln$,len(ln$)-instr(lln$,"font",1)-4) if instr(f$,";",1)=0 then obj$(obj,Fon)=f$ obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1) obj$(obj,Ctr)=word$(word$(ln$,1),2,".") if instr(lln$,"!font",1)>0 then obj(obj,T)=31 else obj(obj,T)=30 obj$(obj,Bas)=str$(basln)
'find the visible object and store the font change for n=1 to obj if obj$(n,Ctr)=obj$(obj,Ctr) then obj$(n,Fon)=obj$(obj,Fon) #fful.gb "font ";obj$(obj,Fon) #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" obj(n,TH)=(yp-100)/2+7 exit for end if next obj=obj+1 end if end if basln=basln+1 wend for n=1 to obj 'print n;" ";obj(n,X);" ";obj(n,Y);" ";obj(n,W);" ";obj(n,H);" ";obj(n,T);" ";obj(n,6);" "; 'print obj$(n,Ctr);" ";obj$(n,Tex);" ";obj$(n,Res);" ";obj$(n,Fon);" ";obj$(n,Bak);" ";obj$(n,6);" ";obj$(n,Bas);" " next
close #bas gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[export] dim oldbas$(5000) ln=1 if file$<>"" and right$(file$,3)="bas" then open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ oldbas$(ln)=ln$ ln=ln+1 wend close #bas '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
if win$(wh,6)<>"" then oldbas$(val(win$(wh,6)))=" BackgroundColor$=";chr$(34);projectback$;chr$(34) if win$(wh,7)<>"" then oldbas$(val(win$(wh,7)))=" ForegroundColor$=";chr$(34);projectfore$;chr$(34) if win$(wh,8)<>"" then oldbas$(val(win$(wh,8)))=" WindowWidth=";projectw if win$(wh,9)<>"" then oldbas$(val(win$(wh,9)))=" WindowHeight=";projecth if win$(wh,10)<>"" then oldbas$(val(win$(wh,10)))=" Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ for n=1 to obj select case obj(n,T) 'handle the visible controls case 1 'statictext oldbas$(val(obj$(n,Bas)))=" statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox oldbas$(val(obj$(n,Bas)))=" textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box oldbas$(val(obj$(n,Bas)))=" listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox oldbas$(val(obj$(n,Bas)))=" combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button oldbas$(val(obj$(n,Bas)))=" button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton oldbas$(val(obj$(n,Bas)))=" bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox oldbas$(val(obj$(n,Bas)))=" graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton oldbas$(val(obj$(n,Bas)))=" radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox oldbas$(val(obj$(n,Bas)))=" checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box oldbas$(val(obj$(n,Bas)))=" groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor oldbas$(val(obj$(n,Bas)))=" texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export case 20 'textboxcolor oldbas$(val(obj$(n,Bas)))=" TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'listboxcolor oldbas$(val(obj$(n,Bas)))=" ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 22 'comboboxcolor oldbas$(val(obj$(n,Bas)))=" ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'texteditorcolor oldbas$(val(obj$(n,Bas)))=" TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
'handle font changes case 30 'font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" font ";obj$(n,Fon);chr$(34) case 32 '!font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" !font ";obj$(n,Fon);chr$(34) end select next end if open file$ for output as #bas for n= 1 to ln #bas oldbas$(n) next close #bas return
function getsize$(l$) 'what if it is a variable? v$="" pos=1 n$=mid$(l$,pos,1) while instr("1234567890",n$,1)=0 and pos<len(l$) pos=pos+1 n$=mid$(l$,pos,1) wend while n$>="0" and n$<="9" and pos<=len(l$) v$=v$+n$ pos=pos+1 n$=mid$(l$,pos,1) wend getsize$=v$ end function
function getcolor$(l$) 'what if it is a variable? cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black " for c= 1 to 15 if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for next end function
[new] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=0 menuset=0 projectw=320 projecth=360 projectback$="white" projectfore$="black" projecttitl$="Untitled" projectform$="#1" projectfile$="Untitled.bas" projectwind$="window_nf" #prop.cbwind "select window_nf" ThemeW=nfnsbWidth ThemeH=nfnsbHeight redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.w "select ";projectw #fful.h "select ";projecth gosub [setthemewidth] gosub [propertyupdate] gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[propertyupdate] #prop.tbfile projectfile$ #prop.cbwind "select ";projectwind$ #prop.tbtitl projecttitl$ #prop.tbform projectform$ #prop.tbctrl "" #prop.tbtext "" #prop.tbreso "" #prop.tbxywh projectw;"x";projecth #prop.tbfont projectfont$ #prop.tbcolo projectfore$;"/";projectback$;"/";ctrc$ return
[resize] #fful.tool "select Add New" #fful.form "select File" #fful.grid "select Set Grid" #fful.font "select Set Font" #fful.color "select Set Color" #fful.w "select ";projectw #fful.h "select ";projecth #fful.hand "select ";projectform$ gosub [drawall] wait
[formsize] #fful.w "contents? w$" #fful.h "contents? h$" wf=val(w$) hf=val(h$) if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait projectw=wf projecth=hf insertx=grid inserty=grid gosub [drawgrid] #fful.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid spacing according to user choice, default is 10 #fful.grid "contents? g$" select case g$ case "Invisible" gridvisible=0 case "Visible" gridvisible=1 case else grid=val(g$) end select gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" wait
[drawgrid] if grid>0 then projectgrid=grid insertx=int((insertx+(grid/2))/grid)*grid inserty=int((inserty+(grid/2))/grid)*grid #fful.gb "cls; fill buttonface" #fful.gb "place 0 0 ; color ";projectback$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth #fful.gb "color ";gridcolor$;" ; backcolor ";projectback$ if gridvisible then for xs = 0 to projectw step grid print #fful.gb, "line ";xs;" 0 ";xs;" ";projecth next for ys = 0 to projecth step grid #fful.gb, "line 0 ";ys;" ";projectw;" ";ys next end if #fful.gb "flush bak" #fful.gb "color black" end if #fful.grid "select Set Grid" return
[font] #fful.font "contents? f$" if f$="Project Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #fful.gb "font ";projectfont$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" projectctrh=(yp-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Control Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #fful.gb "font ";ctrf$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" ctrh=(yp-100)/2+7 end if if selected then obj$(selected,4)=ctrf$ 'font obj(selected,6)=ctrh 'text height end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="ResetControl" then ctrf$=projectfont$ ctrh=projectctrh if selected then obj$(selected,4)=ctrf$ obj(selected,6)=ctrh end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then #fful.gb "font ";ctrf$ obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #fful.font "select Set Font" gosub [drawall] #fful.gb "setfocus" wait
[color] #fful.color "contents? c$" select case c$ case "Control Back" gosub [colorpick] if cp$<>"" then ctrc$=cp$ if selected then if obj(selected,T)=2 or obj(selected,T)=3 or obj(selected,T)=4 or obj(selected,T)=11 then obj$(selected,Bak)=ctrc$ end if case "Reset Back" ctrc$=projectback$ if selected then obj$(selected,Bak)="" case "Project Back" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Project Fore" gosub [colorpick] if cp$<>"" then projectfore$=cp$ case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] end select #fful.color "select Set Color" gosub [drawall] #fful.gb "setfocus" wait
[windowtype] #prop.cbwind "contents? projectwind$" gosub [setthemewidth] wait
[setthemewidth] if projectwind$="window" then ThemeW=nsbWidth : ThemeH=nsbHeight if projectwind$="window_nf" then ThemeW=nfnsbWidth : ThemeH=nfnsbHeight if projectwind$="window_popup" then ThemeW=0 : ThemeH=0 if projectwind$="dialog" then ThemeW=nsbWidth : ThemeH=nsbHeight if projectwind$="dialog_modal" then ThemeW=nsbWidth : ThemeH=nsbHeight if projectwind$="dialog_nf" then ThemeW=nfnsbWidth : ThemeH=nfnsbHeight if projectwind$="dialog_nf_modal" then ThemeW=nsbWidth : ThemeH=nsbHeight if projectwind$="dialog_fs" then ThemeW=0 : ThemeH=0 if projectwind$="dialog_nf_fs" then ThemeW=0 : ThemeH=0 if projectwind$="dialog_popup" then ThemeW=0 : ThemeH=0 if projectwind$="graphics" then ThemeW=fsbWidth : ThemeH=fsbHeight if projectwind$="graphics_fs" then ThemeW=0 : ThemeH=0 if projectwind$="graphics_nsb" then ThemeW=nsbWidth : ThemeH=nsbHeight if projectwind$="graphics_fs_nsb" then ThemeW=0 :ThemeH=0 if projectwind$="graphics_nf_nsb" then ThemeW=nfnsbWidth : ThemeH=nfnsbHeight if projectwind$="text" then ThemeW=0 :ThemeH=0 if projectwind$="text_fs" then ThemeW=0 :ThemeH=0 if projectwind$="text_nsb" then ThemeW=0 :ThemeH=0 if projectwind$="text_nsb_ins" then ThemeW=0 :ThemeH=0 return
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #pick.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #pick #pick "font Consolas 9" #pick "trapclose [quitpick]" #pick.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white" c=1 for yc=1 to 160 step 40 for xc= 1 to 160 step 40 #pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40 c=c+1 if c>15 then c=15 next next #pick.gb "when leftButtonDown [pick]" wait
[pick] xp=int(MouseX/40) yp=int(MouseY/40) c=xp+yp*4+1 cp$=word$(cl$,c)
[quitpick] close #pick return
[help] run "notepad help.txt" wait
[quitfful] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectfile$ #ses projectwind$ #ses projectform$ #ses projecttitl$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth for n=1 to obj if obj(n,T)<>0 then #ses obj(n,X);","; #ses obj(n,Y);","; #ses obj(n,W);","; #ses obj(n,H);","; #ses obj(n,T);","; #ses obj(n,TH) #ses obj$(n,Ctr) #ses obj$(n,Tex) #ses obj$(n,Res) #ses obj$(n,Fon) #ses obj$(n,Bak) end if next close #ses close #prop close #fful end
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
for n=1 to obj 'print n;" ";obj(n,X);" ";obj(n,Y);" ";obj(n,W);" ";obj(n,H);" ";obj(n,T);" ";obj(n,6);" "; 'print obj$(n,Ctr);" ";obj$(n,Tex);" ";obj$(n,Res);" ";obj$(n,Fon);" ";obj$(n,Bak);" ";obj$(n,6);" ";obj$(n,Bas);" " next
|
|