|
Post by xxgeek on May 15, 2023 16:46:50 GMT -5
Here is the code I am working with. It has all the current fixes including the last fix posted by Anatoly, (except the "missing comma fix" is commented out.
It is the 'least' error prone code so far. And if the "missing comma fix" is fanagled to work with the rest of the code, we are very close with import.
Are we all on the same page?
ver$="1.9" '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$ #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) #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)
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
|
|