|
Post by xxgeek on Jul 26, 2023 21:21:52 GMT
A version written for JB only (Initially what I was wishing for) Includes adding JB functions to output code
Add as many functions as you wish, but only one of each. Use "Clear Functions Que" under [Add JB Functions] when needed.
To add controls use the buttons, or alt+ b = Button c = Combobox e = TextEditor g = GraphicBox k = CheckBox l = ListBox m = Menu p = BMPButton r = RadioButton s = StaticText t = TextBox x = GroupBox Copy\paste, and delete work on highlighted control.
Biggie size the window for other features.
Designed only for creating forms quickly, adding some functions\subs, and outputting the code. There is no import or export of bas files.
Users can add functions or subs to the list by following the directions in the readme.txt file in "%appdata%\Just Basic v2.0\FFFunctions"
You can -load .ffu files you create, edit them and save them. -write the .bas file that will display the form. -
' This version for Just Basic v2.0 only - Includes adding jbfunctions if Version$ <> "2.0" then notice "Install Just Basic v2.0 and Try Again" : end ver$="ff-xx1.2" 'Author - Rod 'Edits - xxgeek 'freeform ultra lite v1.x to freeform NotSo Lite vxx1.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)="Last .ffu" form$(2)="New .ffu" form$(3)="Save .ffu" form$(4)="Load .ffu" form$(5)=" " form$(6)=" BAS Files" form$(7)="Write .bas" form$(8)=" " 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" dim color$(10) color$(1)="Control Back" color$(2)="Project Back" color$(3)="Project Fore" color$(4)="Grid Color" color$(5)="Border Color" color$(6)="CrossHair" color$(7)="Set Color" 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=1 grid=10 gridvisible=1 gridcolor$="white" bordercolor$ = "darkred" 'border of grid dimension limits of x,y crosshair$ = gridcolor$ 'crosshair available in grid = 0 or grid = 1 barrier = 1 'barrier - form dimension limit - when tracking / resizing controls negbar = 1 'negative barrier - less than zero - when tracking / resizing controls projectctrh=25 ctrh=25 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="lightgray" 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)/2 + 420 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=600 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #fful.fastfunctionsList,fastfunctionsList$(),fastfunctionSelected,680,2,140,25 combobox #fful.form,form$(,[form],5,2,85,30 combobox #fful.hand,hnd$(,[hand],91,2,85,30 button #fful.code,"Code",[code],UL,177,0,43,25 button #fful.gui,"GUI",[preview],UL,222,0,40,25 combobox #fful.w,v$(,[formsize],265,2,55,30 combobox #fful.h,v$(,[formsize],321,2,55,30 combobox #fful.grid,grid$(,[grid],375,2,90,30 statictext #fful.gridsize "10",470,7,15,15 combobox #fful.color,color$(,[color],490,2,90,30 combobox #fful.font,font$(,[font],585,2,90,30 button #fful.barrier,"No Barrier &+",[barrier],UL,850,0,100,20 button #fful.help,"?",[help],UL,820,0,25,25 button #fful.negbarrier,"No Barrier &-",[negbarrier],UL,850,22,100,20 statictext #fful.corner, "UpperLeft",960,12,75,15 statictext #fful.cornertext, " Corner >",960,25,85,15 statictext #fful.Xco, "x 0" ,1045,2,65,20 statictext #fful.Yco, "y 0",1045,24,65,20 button #fful.mnu,"&Menu",[bttnMNU],UL,5,25,45,20 button #fful.button,"&Button",[bttnBTTN],UL,50,25,55,20 button #fful.textbox,"&Textbox",[bttnTXBX],UL,105,25,65,20 button #fful.lstbx,"&Listbox",[bttnLSTBX],UL,170,25,65,20 button #fful.cmbobx,"&Combobox",[bttnCMBOBX],UL,235,25,65,20 button #fful.statictext,"&Statictext",[bttnSTTX],UL,300,25,80,20 button #fful.bmpbttn,"BM&Pbutton",[bttnBMPBTTN],UL,380,25,75,20 button #fful.grphcbx,"&Graphicbox",[bttnGRPHCBX],UL,455,25,80,20 button #fful.rdiobttn,"&Radiobutton",[bttnRDBTTN],UL,535,25,85,20 button #fful.chckbx,"Chec&kbox",[bttnCHKBX],UL,620,25,70,20 button #fful.grpbx,"Groupbo&x",[bttnGRPBX],UL,690,25,70,20 button #fful.txtedtr,"Text&editor",[bttnTXTEDTR],UL,760,25,85,20 graphicbox #fful.gb,5,45,830,510 textbox #fful.path,1115,0,200,25 open ver$;" Form Preview Form Dimensions Grid - Size Colors Fonts Functions Help Form Limits (X,Y) Coordinates" for window as #fful #fful "trapclose [quitfful]" #fful "font Consolas 9 " #fful.Xco "!font Consolas 11 " #fful.Yco "!font Consolas 11 " #fful "resizehandler [resize]" #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" #fful.path "File - untitled.ffu" #fful.form "!File" #fful.fastfunctionsList "!Add JB Functions" 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 call getUserPath gosub [getfastfunctions] 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.corner "UpperLeft" #fful.gb "rule xor" gosub [drawit] xt=int((MouseX-offsetX+(grid/2))/grid)*grid if negbar then if xt<0 then xt=0 end if if xt+obj(selected,W)>projectw and barrier 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 negbar then if yt<0 then yt=0 end if if yt+obj(selected,H)>projecth-25 and barrier then yt=projecth-obj(selected,H)-25 obj(selected,Y)=yt end if if menuset = 1 or textEd > 0 then if negbar then if yt < 0 then yt = 0 end if if yt+obj(selected,H)>projecth-50 and barrier then yt=projecth-obj(selected,H)-50 obj(selected,Y)=yt end if #fful.Xco "x ";str$(xt) #fful.Yco "y ";str$(yt) gosub [drawit] wait
[stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[tracksize] #fful.corner "BottomRight" #fful.gb "rule xor" gosub [drawit] xs=int((MouseX-offsetX+(grid/2))/grid)*grid if xs>projectw and barrier 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 and barrier then ys=projecth if ys<obj(selected,Y)+ctrh and barrier 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 #fful.Xco "x ";xs : #fful.Yco "y ";ys 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 if obj(selected,T)=11 then textEd = textEd-1 'keep track of # of texteditors removed obj(selected,T)=0 selected=0 gosub [drawgrid] 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,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) if obj(obj,T)=11 then textEd = textEd + 1 'keep track of # of texteditors added obj$(obj,Fon)=cpy$(4) obj$(obj,Bak)=cpy$(5) selected=obj obj=obj+1 gosub [drawall] end if end if #fful.gb "setfocus" wait
[drawTool] cpy(5)=0 select case i case 1 'statictext obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=130 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 obj=obj+1 case 2 'textbox obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 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 obj=obj+1 case 3 'listbox obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*4 obj(obj,T)=3 obj$(obj,Ctr)="listbox";obj obj$(obj,Tex)="Listbox ";obj;" \Title 1\Title 2\Title 3\Title 4\Title 5" 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 obj=obj+1 case 4 'combobox obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="combobox";obj obj$(obj,Tex)="Combobox ";obj;" \Item 1\Item 2\Item 3" 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 obj = obj + 1 case 5 'button obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=90 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 obj=obj+1 case 6 'bmp button 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)="bmp ";obj loadbmp obj$(obj,Ctr),file$ close #bmp inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid obj=obj+1 else obj(obj,T)=0 close #bmp end if else obj(obj,T)=0 end if case 7 'graphicbox 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 obj=obj+1 case 8 'radiobutton 'radio = radio + 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)="[rb";obj;"Set],[rb";obj;"Reset]" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid obj=obj+1 case 9 'checkbox obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=120 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="checkbox";obj obj$(obj,Tex)=" CheckBox ";obj obj$(obj,Res)="[ch";obj;"Set],[ch";obj;"Reset]" 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 obj=obj+1 case 10 'groupbox 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)="GroupBox ";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 obj=obj+1 case 11 'texteditor textEd = textEd + 1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=75 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$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid obj=obj+1 case 12 'menu if menuset=0 then 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,Tex)=" Menu Added" menuset=1 obj=obj+1 end if end select selected=obj-1 gosub [drawgrid]
gosub [drawall] #fful.gb "setfocus" wait
[form] #fful.form "selectionindex? i" select case i case 1 'restore file$="lastsession.ffu" #fful.form "!File" gosub [loadit] case 2 'new gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 7 'write gosub [write] end select gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" #fful.form "select 0" #fful.form "!File" 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 darkred" 'action 1 or 2 if action=2 then #fful.gb "color darkgreen" 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)="" then obj$(cn,Tex)="Missing Text?" 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)=0 : 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) '41,42,43,44,45 and 50 51 ignored ie back/fore w/h open and font objects end select return
[preview] file$="preview.bas" #fful.path "File - preview.bas" gosub [writeit] wait
[write] #fful.form "select 0" #fful.form "!File" projectfile$ = left$(projectfile$, len(projectfile$)-3)+"bas" filedialog "Save As...",projectfile$,file$ if file$="" then return file$=right$(file$,len(file$)-len(DefaultDir$)-1) file$=left$(file$, len(file$)-3)+"bas" projecttitl$=file$
[writeit] #fful.form "select 0" #fful.form "!File" if file$<>"" then open file$ for output as #op op=1 #fful.path "File - ";file$ 'the header #op " 'Project ";projecttitl$ #op " 'Created with Freeform NOT SO Lite v";ver$;" ";date$();" ";time$() #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 'if selected function used info$() then dim for it. if fileExists(DefaultDir$, "jbfunctions.bas") then open "jbfunctions.bas" for input as #jb jb$=input$(#jb,lof(#jb)) close #jb if instr(lower$(jb$), lower$("info$(")) then #op " 'A JB function was added that needs info$() dimmensioned" #op " dim info$(10,10)" #op "" end if 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)=";chr$(34);"Title ";chr$(34);";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);"&Open";chr$(34);", [dummy], ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Save As";chr$(34);", [dummy],";chr$(34);"&Load";chr$(34);", [dummy], ";chr$(34);"&Exit";chr$(34);", [dummy]" if textEd > 0 then #op " menu ";projectform$;", ";chr$(34);"Edit";chr$(34) end if #op " menu ";projectform$;", ";chr$(34);"&Tools";chr$(34);", ";chr$(34);"Preferences";chr$(34);", [dummy] " #op " menu ";projectform$;", ";chr$(34);"&Options";chr$(34);", ";chr$(34);"Fonts";chr$(34);", [dummy], ";chr$(34);"Colors";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"&Help";chr$(34);", ";chr$(34);"About";chr$(34);", [dummy]";", ";chr$(34);"Help";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 lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Selected]") if left$(lbl$,1) <> "[" then goto [goRound1] #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);","; nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Selected]");",";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) [goRound1] if left$(lbl$,1) <> "[" then fix1$ = "[";obj$(n,Ctr);"Selected]" #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);","; fix1$;",";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) end if case 4 'combobox lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Selected]") if left$(lbl$,1) <> "[" then goto [goRound2] #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);","; nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Selected]");",";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) [goRound2] if left$(lbl$,1) <> "[" then #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);","; fix1$;",";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) end if case 5 'button lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Clicked]") if left$(lbl$,1) <> "[" then goto [goRound3] #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);","; nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Clicked]");", UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) [goRound3] if left$(lbl$,1) <> "[" then fix2$ = "[";obj$(n,Ctr);"Clicked], UL" #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);","; fix2$;",";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) end if case 6 'bmpbutton lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Clicked]") if left$(lbl$,1) <> "[" then goto [goRound4] #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);","; nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Clicked]");", UL, ";obj(n,X);",";obj(n,Y) [goRound4] if left$(lbl$,1) <> "[" then #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);","; fix2$;",";obj(n,X)+1;",";obj(n,Y) ';",";obj(n,W)-2;",";obj(n,H) end if case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Set],[";obj$(n,Ctr);"Reset]") if left$(lbl$,1) <> "[" then lbl$ = "[";lbl$;"Set],[";lbl$;"Reset]" end if #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";lbl$;",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Checked],[";obj$(n,Ctr);"Unchecked]") if left$(lbl$,1) <> "[" then lbl$ = "[";lbl$;"Checked],[";lbl$;"Unchecked]" end if #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";lbl$;",";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$, lower$("text"),1) then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op " ";projectform$;" ";chr$(34);"font ";projectfont$;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 "" 'an imaginary line beteen pre-window code and post window code '######################################################################################## #op " 'Create the required handlers for each control" for n=1 to obj select case obj(n,T) case 3,4 'listbox, combobox lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Selected]") if instr(labelList$, lbl$)=0 then 'label NOT already written if left$(lbl$,1) <> "[" then lbl$ = "[";lbl$;"Selected]" 'write label #op " ";lbl$ #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? Selected$";chr$(34) #op " wait" #op "" 'and remember it labelList$= labelList$+" "+ lbl$ end if case 5, 6 'button, bmpbutton lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Clicked]") if left$(lbl$,1) <> "[" then lbl$ = "[";lbl$;"Clicked]" if instr(labelList$, lbl$)=0 then 'label NOT already written 'write label #op " ";lbl$ #op " 'Your handler code here" #op " wait" #op "" 'and remember it labelList$= labelList$+" "+ lbl$ end if case 8 'radiobutton for i = 1 to 2 'set,reset labels lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Set],[";obj$(n,Ctr);"Reset]") lbl$=word$(lbl$,i,",") if instr(labelList$, lbl$)=0 and left$(lbl$,1) = "[" then 'label NOT already written #op " ";lbl$ #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) 'write label if left$(lbl$,1) <> "[" and lbl$ <> "" then #op "[";lbl$;"Set]" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" end if if left$(lbl$,1) <> "[" and lbl$ <> "" then #op "[";lbl$;"Reset]" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" end if #op " wait" #op "" 'and remember it labelList$= labelList$+" "+ lbl$ end if next case 9 'checkbox for i = 1 to 2 'check.uncheck labels lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Checked],[";obj$(n,Ctr);"Unchecked]") lbl$=word$(lbl$,i,",") if instr(labelList$, lbl$)=0 and left$(lbl$,1) = "[" then 'label NOT already written #op " ";lbl$ #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) 'write label if left$(lbl$,1) <> "[" and lbl$ <> "" then #op "[";lbl$;"Checked]" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" end if if left$(lbl$,1) <> "[" and lbl$ <> "" then #op "[";lbl$;"Unchecked]" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " wait" #op "" end if #op " wait" #op "" 'and remember it labelList$= labelList$+" "+ lbl$ end if next end select next if menuset <> 0 then #op " [dummy]" #op " 'Your Handler code here" #op " wait" #op "" end if #op " [quit]" #op " close ";projectform$ #op " end" #op " " #op " 'Add Subs and Functions below this line" #op " " if fileExists(DefaultDir$, "jbfunctions.bas") then open "jbfunctions.bas" for input as #jb jb$=input$(#jb,lof(#jb)) close #jb #op jb$ #op " " end if close #op open file$ for input as #allcode allcode$=input$(#allcode,lof(#allcode)) close #allcode texteditor #copy.te,0,0,0,0 open "text" for text as #copy #copy.te allcode$ #copy.te jb$ #copy.te "!selectall" #copy.te "!copy" close #copy lbl$ = "" labelList$ = ""
files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 and code=0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] else run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -A ";DefaultDir$;"\";file$ code = 0 goto [done] end if files "c:\program files\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 and code =0 then run chr$(34);"c:\program files\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] else run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -A ";DefaultDir$;"\";file$ code = 0 goto [done] end if notice "jbasic.exe is missing";chr$(13);"jbasic.exe is not in the Default install folder ";chr$(13);chr$(13);"Rewrite this code using the actual install folder path" [done] end if #fful.form "!File" wait return
[saveas] #fful.form "select 0" #fful.form "!File" 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) #fful.path "File - ";projectfile$ '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] #fful.form "select 0" #fful.form "!File" filedialog "Open Project...","*.ffu",file$ if file$ = "" then return [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) end if #fful.path "File - ";projectfile$ 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 if obj = 0 then obj=obj+1 end if 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)=11 then textEd = textEd + 1 : gosub [drawgrid] if obj(obj,T)=12 then menuset=1 obj=obj+1 wend close #ses gosub [propertyupdate] #prop "hide" #prop "show" 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$) if l$="palegray" then l$="lightgray" '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 if getcolor$="" then getcolor$="white" end function
[new] #fful.form "select 0" #fful.form "!File" redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font if fileExists(DefaultDir$, "jbfunctions.bas") then kill DefaultDir$;"\jbfunctions.bas" obj=1 menuset=0 textEd=0 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 #fful.path "File - untitled.ffu" 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.fastfunctionsList "!Add JB Functions" #fful.form "!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 grid=1 case "Visible" gridvisible=1 case else grid=val(g$) if grid = 1 then gridvisible = 0 if grid > 2 then gridvisible = 1 end select gosub [drawgrid] gosub [drawall] #fful.gridsize grid #fful.gb "setfocus" wait
[drawgrid] projectgrid=grid #fful.gb "cls; fill darkgray" 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 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25 #fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25 #fful.gb "line "; 0; " "; 0; " "; projectw; " "; 0 #fful.gb "line ";0;" "; 0;" "; 0; " ";projecth-25 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 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50 #fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50 #fful.gb "line "; 0; " "; 0; " "; 0; " "; projecth-50 #fful.gb "line ";0;" "; 0;" "; projectw; " ";0 end if end if [nogrid] if grid < 2 or gridvisible = 0 then if textEd =0 and menuset = 0 then #fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25 #fful.gb "color ";crosshair$ #fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-25 #fful.gb "line "; 0; " "; ((projecth)/2)-12; " "; projectw; " "; ((projecth)/2)-12 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25 #fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25 #fful.gb "line "; 0; " "; 0; " "; projectw; " "; 0 #fful.gb "line ";0;" "; 0;" "; 0; " ";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 #fful.gb "line "; 0; " "; 0; " "; 0; " "; projecth-50 #fful.gb "line ";0;" "; 0;" "; projectw; " ";0 end if end if #fful.gb "flush bak" #fful.grid "select 0" #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 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] case "Border Color" gosub [colorpick] if cp$<>"" then bordercolor$=cp$ gosub [drawgrid] case "CrossHair" 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
[code] code=1 goto [preview]
'control buttons [bttnSTTX] i=1 : gosub [drawTool] : wait [bttnTXBX] i=2 : gosub [drawTool] : wait : wait [bttnLSTBX] i=3 : gosub [drawTool] : wait [bttnCMBOBX] i=4 : gosub [drawTool] : wait [bttnBTTN] i=5 : gosub [drawTool] : wait [bttnBMPBTTN] i=6 : gosub [drawTool] : wait [bttnGRPHCBX] i=7 : gosub [drawTool] : wait [bttnRDBTTN] i=8 : gosub [drawTool] : wait [bttnCHKBX] i=9 : gosub [drawTool] : wait [bttnGRPBX] i=10 : gosub [drawTool] : wait [bttnTXTEDTR] i=11 : gosub [drawTool] : wait [bttnMNU] i=12 : gosub [drawTool] : wait
[help] 'run "notepad help.txt" notice "Visit the Just Basic Forums";chr$(13);"For Help Visit the Just Basic Forms ";chr$(13);Chr$(13);"@ - https://justbasiccom.proboards.com/";chr$(13);chr$(13);"Become a member and post your questions" 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 if fileExists(DefaultDir$, "jbfunctions.bas") then kill DefaultDir$;"\jbfunctions.bas" end
[negbarrier] if negbar = 1 then negbar = 0 #fful.negbarrier "Barrier -" else negbar = 1 #fful.negbarrier "No Barrier -" end if wait
[barrier] if barrier = 1 then barrier = 0 #fful.barrier "Barrier +" else barrier = 1 #fful.barrier "No Barrier +" end if wait
function nvl$(a$,b$) 'if a$ empty return b$, else a$ if a$<>"" then nvl$=a$ else nvl$=b$ end function
sub copyFunction count = 0 dim codeLine$(500) if fileExists(upath$;"\Application Data\Roaming\Just Basic v2.0\FFFunctions", fastfuncs$) then open upath$;"\Application Data\Roaming\Just Basic v2.0\FFFunctions\";fastfuncs$ for input as #fastfunc open DefaultDir$;"\test.bas" for append as #copyfunction #copyfunction "" while eof(#fastfunc) = 0 line input #fastfunc, codeLine$(count) line$ = codeLine$(count) if count < 6 then [skipme] #copyfunction line$ [skipme] count = count + 1 wend close #fastfunc close #copyfunction end if end sub
[getfastfunctions] q$ = chr$(34) dim folderInfo$(1, 1) dim fastfunctionsList$(10) files upath$;"\Application Data\Just Basic v2.0\FFFunctions", folderInfo$() numFiles = val(folderInfo$(0, 0)) redim fastfunctionsList$(numFiles+4) for count = 1 to numFiles filename$ = folderInfo$(count, 0) if right$(filename$, 3) <> "txt" then [skip] if filename$ = "readme.txt" then [skip] fastfunctionsList$(count+4) = left$(filename$, len(filename$) - 4) [skip] next count fastfunctionsList$(0) = "Clear Functions Que" fastfunctionsList$(1) = " " fastfunctionsList$(2) = "Add Upto 1 of Each" fastfunctionsList$(3) = " " sort fastfunctionsList$(), 4,numFiles #fful.fastfunctionsList, "reload" return
sub fastfunctionSelected fastfunctionsList$ #fful.fastfunctionsList "!Add JB Functions" global fastfuncs$, upath$ #fful.fastfunctionsList, "selection? fastfuncs$" if fastfuncs$ = "Clear Functions Que" then if fileExists(DefaultDir$, "jbfunctions.bas") then kill DefaultDir$;"\jbfunctions.bas" goto [endsub] end if fastfuncs$ = fastfuncs$;".txt" '################################################################################## count = 0 dim codeLine$(1500) if fileExists(upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions", fastfuncs$) then open upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions\";fastfuncs$ for input as #fastfunc else if fileExists(upath$;"\Application Data\Just Basic v2.0\FFFunctions", fastfuncs$) then open upath$;"\Application Data\Just Basic v2.0\FFFunctions\";fastfuncs$ for input as #fastfunc end if end if open DefaultDir$;"\jbfunctions.bas" for append as #copyfunction while eof(#fastfunc) = 0 line input #fastfunc, line$ if count < 6 then [skipme] #copyfunction line$ [skipme] count = count + 1 wend #copyfunction " " close #fastfunc close #copyfunction '################################################################################# [endsub] end sub
'get users homepath = aka %userprofile% = "c:\users\xxxxx" (5 characters long normally Win 10) sub getUserPath global upath$ run "cmd.exe /c echo %userprofile% >UserHomePath.txt", HIDE do scan loop until fileExists(DefaultDir$, "UserHomePath.txt") open "UserHomePath.txt" for input as #1 upath$ = input$(#1, lof(#1)) upath$=trim$(upath$) close #1 if upath$ = "" then notice "Sorry, can't find user path " : end kill DefaultDir$;"\UserHomePath.txt" end sub
'Verify file existence function function fileExists(path$, filename$) dim fileExistsInfo$(0,0) files path$, filename$, fileExistsInfo$() fileExists = val(fileExistsInfo$(0, 0)) 'non zero is true end function
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 '
btw - Thanks Rod, your code is beyond my understanding, without it this would still be a distant dream.
|
|