|
Post by xxgeek on Jul 31, 2023 8:44:38 GMT -5
It took a while to figure out why this happens. It seems that you coded for case 50 certain controls, and for case 51 the other controls. But didn't take into account that the 'main' font of a window is a special case. Somehow it was lumped in with case 50 controls, and the extra . was added even when there was no obj$(n,Ctr) (it's value being "" at that point)
It may affect !fonts too, I can't say, I haven't checked for it intensely yet, but haven't noticed the issue. It may not be the best of fixes either, it just worked for the file I was testing it on. Time will tell.
One thing discussed and not implemented in v2.0 is the issue of the first control getting number 2 instead of the expected number 1. Nearer top of code where declarations are made obj=1 changed to obj=0 or deleted seems to work. There is code to add 1 to obj before any control is drawn anyway.
Ok, the other issue of line chopping is something you don't want to deal with since it is an import\export thing with an old (big) .bas file. I included it in case it pointed you to something in the code I am unaware of or lack the understanding to deal with. It was affecting lines with :space and :\ and :/ in 'old' bas files.
The .bas being tested had some c:\blah\blah paths, and some http://blah/blah lines that got cut up causing syntax errors on the preview code, because I uncomment the line If file$ <> "preview.bas" then and the 'end if'
Here is my adaptation of your most recent code with the fixes mentioned. Adding of subs/functions/snippets not implemented yet. I have some work to do making/gathering subs, functions and snippets. I'm in it for the quick code output. The buttons help with speed. I know I'll still be doing some manual editing of the forms regardless. But, it beats running around my file system searching for code examples.
'uploaded 14:48 11/07/2023 by Rod = FFUltra v2.x 'version FFNSL_vxx2.0 'edited by xxgeek ver$="xx2.0" 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 hnd$(30) hnd$(1)="#1" dim grid$(20) grid$(1)="1" grid$(2)="3" g=3 for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Invisible" grid$(g+1)="Visible" grid$(g+2)="Set Grid" grid=10 gridvisible=1 gridcolor$="buttonface" projectctrh=25 ctrh=25 dim color$(10) color$(1)="Control Back" color$(2)="Project Back" color$(3)="Project Fore" color$(4)="Grid Color" color$(5)="Border Color" color$(6)="CrossHair" color$(7)="Set Color" projectback$="white" projectfore$="black" 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 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" gridcolor$="buttonface" bordercolor$ = "darkgray" '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 projectgrid=10 projectw=600 projecth=400 insertx=grid inserty=grid*2 'open a small progress bar window and hide it WindowWidth=230 WindowHeight=60 UpperLeftX=(DisplayWidth-230)/2 UpperLeftY=(DisplayHeight-350)/2 graphicbox #prog.gb1,10,0,200,25 open "Import" for window_nf as #prog #prog "font Consolas 9" #prog "hide" '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,20 combobox #fful.blocks,block$(,[block],1115,22,200,30 open ver$;" Form Preview Form Dimensions Grid - Size Colors Fonts Add Subs\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" block$(1) = " ! COMING SOON ! " #fful.blocks "reload" #fful.blocks "!Add Code Blocks/Snippets" #fful.fastfunctionsList "!Subs / Functions" gosub [drawgrid] gosub [drawall] #fful.gb "when rightButtonDown [show]" #fful.gb "when leftButtonDown [select]" #fful.gb "when characterInput [keys]" 'load subs and functions combobox fastfunctionsList$(1) = "Coming Soon" #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/window 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 by user 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 'moving controls on form [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 'when user stops moving mouse or lifts left button [stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait 'resizing controls on form [tracksize] #fful.corner "BottomRight" 'print to window #fful for x,y coordinates #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 'form workspace changes when menu, or textEditor added/removed 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 'user uses keys to copy/paste or delete controls [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 obj(selected,T)=0 selected=0 gosub [drawgrid] gosub [drawall] end if if k1=3 then 'copy control 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 control 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) if obj(selected,T)=11 then textEd = textEd + 1 : gosub [drawgrid] 'keep track of # of texteditors 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" [drawTool] cpy(5)=0 select case i case 1 'statictext obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=130 obj(obj,H)=ctrh obj(obj,T)=1 obj$(obj,Ctr)="st";obj obj$(obj,Tex)="StaticText ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 2 'textbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=140 obj(obj,H)=ctrh obj(obj,T)=2 obj$(obj,Ctr)="tb";obj obj$(obj,Tex)="TextBox ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 3 'listbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=120 obj(obj,H)=ctrh*5 obj(obj,T)=3 obj$(obj,Ctr)="lb";obj obj$(obj,Tex)="ListBox ";obj;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectlbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 4 'combobox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=120 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="cb";obj obj$(obj,Tex)="ComboBox ";obj;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectcbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 5 'button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=90 obj(obj,H)=ctrh obj(obj,T)=5 obj$(obj,Ctr)="btn";obj obj$(obj,Tex)="Button ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)="white" inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 6 'bmp button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=50 obj(obj,H)=50 obj(obj,T)=6 obj$(obj,Ctr)="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)=90 obj(obj,H)=90 obj(obj,T)=7 obj$(obj,Ctr)="gb";obj obj$(obj,Tex)="GraphicBox ";obj if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=8 obj$(obj,Ctr)="rb";obj obj$(obj,Tex)="RadioButton ";obj obj$(obj,Res)="[";obj$(obj,Ctr);"Set],[";obj$(obj,Ctr);"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 case 9 'checkbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=90 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="ch";obj obj$(obj,Tex)="CheckBox ";obj obj$(obj,Res)="[";obj$(obj,Ctr);"Checked],[";obj$(obj,Ctr);"Unchecked]" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 obj(obj,H)=110 obj(obj,T)=10 obj$(obj,Ctr)="gr";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
case 11 'texteditor obj=obj+1 textEd = textEd + 1 : gosub [drawgrid] obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=100 obj(obj,T)=11 obj$(obj,Ctr)="te";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
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 ";obj 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 #fful.path "lastsession.ffu" file$ = "lastsession.ffu" gosub [loadit] #fful.path "lastsession.ffu" case 2 'new if import <> 1 then #fful.path "Untitled.bas" gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 6 'write gosub [write] #fful.path file$ case 7 'import import = 1 gosub [import] import = 0 case 8 'export gosub [export] end select #fful.form "select File" gosub [drawall] #fful.gb "setfocus" wait
[drawall] #fful.gb "discard ; redraw bak" ocn=cn projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" for cn=1 to obj gosub [drawit] next cn=ocn #fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20 #fful.gb "setfocus" return
[drawit] 'redraws control cn 'set the color for the drawn object and action taking place if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if
'set the font for the drawn object if obj$(cn,Fon)="" then #fful.gb "font ";projectfont$ ch=projectctrh if obj(cn,H)<ch then obj(cn,H)=ch else #fful.gb "font ";obj$(cn,Fon) ch=obj(cn,TH) if obj(cn,H)<ch then obj(cn,H)=ch end if
'update the properties textboxes for selected control if cn=selected then #prop.tbctrl obj$(cn,Ctr) 'ctrlname #prop.tbtext obj$(cn,Tex) 'text #prop.tbreso obj$(cn,Res) 'resource #prop.tbxywh obj(cn,X);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height #prop.tbcolo obj$(cn,Bak) end if #fful.gb "place ";obj(cn,X);" ";obj(cn,Y) if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?" select case obj(cn,T) case 1 'statictext #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 2 'textbox #fful.gb "backcolor ";projecttbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 3 'listbox #fful.gb "backcolor ";projectlbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 4 'combobox #fful.gb "backcolor ";projectcbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 5 'button #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'buttons are always black on white #fful.gb "color black" 'centre button text #fful.gb "stringwidth? ";"A";" width" xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ #fful.gb "backcolor ";projectback$ case 6 'bmpbutton if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr) #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) case 7 ' graphicbox #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "backcolor ";projectback$ case 8 'radiobutton #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'radiobutton text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 9 'checkbox #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'checkbox text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 10 'groupbox #fful.gb "backcolor ";projectback$ 'groupbox is an outline #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'group box text is always black #fful.gb "color black" 'groupbox text is offset if action=0 then #fful.gb "place ";obj(cn,X)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 11 ' texteditor #fful.gb "backcolor ";projecttecl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 12 'menu 'pin to top left obj(cn,X)=10 : obj(cn,Y)=-8 : 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" 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 FFNotSoLite v";ver$;" ";date$();" at ";time$() #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 #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 #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"Selected],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"Selected],";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);"Clicked], 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);"Clicked], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Res);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Res);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor #op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 22 'tbcolor #op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'lbcolor #op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 24 'cbcolor #op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'tecolor #op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34) end select next #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op "" #op " 'Set any listboxes to singleclick and display the first item on the list for all listboxes and comboboxes" 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 if obj(n,T)=3 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"singleclickselect";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 [remDot] end if next #op " 'Your code here. eg: Declare variables and globals, goto/gosub/call subs and invoke functions" #op "" #op " wait" #op "" #op " 'Create the required handlers for each control" for n=1 to obj select case obj(n,T) case 3 'listbox #op " [";obj$(n,Ctr);"Selected]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? Selected$";chr$(34) #op " wait" #op "" case 4 'combobox #op " [";obj$(n,Ctr);"Selected]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? Selected$";chr$(34) #op " wait" #op "" case 5 'button #op " [";obj$(n,Ctr);"Clicked]" #op " 'Your handler code here" #op " wait" #op "" case 6 'bmpbutton #op " [";obj$(n,Ctr);"Clicked]" #op " 'Your handler code here" #op " wait" #op "" case 8 'radiobutton #op " [";obj$(n,Ctr);"Set]" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " 'Your handler code here" #op " wait" #op "" #op " [";obj$(n,Ctr);"Reset]" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " 'Your handler code here" #op " wait" #op "" case 9 'checkbox #op " [";obj$(n,Ctr);"Checked]" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " 'Your handler code here" #op " wait" #op "" #op " [";obj$(n,Ctr);"Unchecked]" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) #op " 'Your handler code here" #op " wait" #op "" end select next #op " 'Add code for any actions to take while shutting down. eg:backup settings to a file" #op " [quit]" #op " close ";projectform$ #op " end" #op " " #op " 'Subs and Functions go below this line" #op "'########################################################" #op " " close #op files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 and code=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] else run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -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 and code=0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] else run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -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 and code=0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] else run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -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 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$ end if [done] end if code = 0 return
[saveas] projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu" filedialog "Save As...",projectname$,file$ if file$<>"" then open file$ for output as #op projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) #fful.path 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] filedialog "Open Project...","*.ffu",file$ [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) #fful.path 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 obj=obj+1 line input #ses, l$ obj(obj,X)=val(word$(l$,1,",")) obj(obj,Y)=val(word$(l$,2,",")) obj(obj,W)=val(word$(l$,3,",")) obj(obj,H)=val(word$(l$,4,",")) obj(obj,T)=val(word$(l$,5,",")) obj(obj,TH)=val(word$(l$,6,",")) line input #ses, obj$(obj,Ctr) line input #ses, obj$(obj,Tex) line input #ses, obj$(obj,Res) line input #ses, obj$(obj,Fon) line input #ses, obj$(obj,Bak) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) if obj(obj,T)=12 then menuset=1 if obj(obj,T)=11 then textEd = textEd + 1 wend close #ses gosub [propertyupdate] #prop "hide" #prop "show" end if return
[import] filedialog "Open .bas...","*.bas",file$
[importit] if file$<>"" then 'check size open file$ for input as #bas maxln=0 while eof(#bas)=0 line input #bas, wln$ maxln=maxln+1 wend close #bas 'add margin for split lines dim bas$(maxln+1000,4)'an array of code lines and line numbers
'set up progress bar #prog.gb1 "down ; fill white ; backcolor cyan" #prog "show"
projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) gosub [new] 'set grid to 1 and invisible so controls stay where they import from initially 'grid=1 'gridvisible=0 gosub [drawgrid] #fful.path projectfile$ 'create objects for 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$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ " wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty " wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ font "
ln=1 bln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, wln$ 'update progress bar #prog.gb1 "cls ; place 0 0 ; boxfilled ";100/maxln*ln;" 25" 'ignore 'or rem lines if left$(lower$(trim$(wln$)),1)="'" or left$(lower$(trim$(wln$)),4)="rem " then bas$(ln,1)=str$(ln) bas$(ln,2)=trim$(wln$) ln=ln+1 else 'break into multiple lines if ":" found outside quotes pos=1 ln$="" while pos<=len(wln$) c$=mid$(wln$,pos,1) dd$ = mid$(win$,pos,2) if c$=chr$(34) then if quote=0 then quote=1 else quote=0 end if if c$=":" and quote=0 or c$=":" and right$(dd$,1) = "\" then gosub [line] ln$="" pos=pos+1 else ln$=ln$+c$ pos=pos+1 end if wend gosub [line] bln=bln+1 end if wend basln=ln-1 close #bas
redim win$(30,10)'an array of forms within .bas redim hnd$(30)'an array of form names for handle combobox wh=1 for ln=1 to basln if bas$(ln,3)="#" then 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 lower$(word$(bas$(ln,2),1)) = "open" and left$(word$(bas$(ln,2),2, " as "),1) = "#" then if instr(lower$(bas$(ln,2)),"window",1)>0 or instr(lower$(bas$(ln,2)),"dialog",1)>0 or instr(lower$(bas$(ln,2)),"graphic",1)>0 then win$(wh,10)=bas$(ln,1) n$=word$(bas$(ln,2),2,chr$(34)) hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1)) 'find last "for" in command line i=1 while i oi=i i=instr(lower$(bas$(ln,2))," for ",i+1) wend wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi) wt$=word$(wt$,2) win$(wh,1)=hn$ 'handle #fful etc win$(wh,2)=n$ 'title win$(wh,3)=w$ 'width win$(wh,4)=h$ 'height win$(wh,5)=wt$ 'windowtype hnd$(wh)=hn$ 'for combobox wh=wh+1 end if end if end if next #fful.hand "reload" #fful.hand "selectindex 1" wh=1 gosub [loadwindow] end if return
[line] bas$(ln,1)=str$(ln) bas$(ln,2)=trim$(ln$) 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 or instr(lower$(ln$),"font ",1)>0 then bas$(ln,3)="#" end if ln=ln+1 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 textEd = 0 projectback$="white" TextboxColor$="white" ListboxColor$="white" ComboboxColor$="white" TexteditorColor$="white" projectfore$="black" projectw=val(win$(wh,3)) if projectw=0 then projectw=320 projecth=val(win$(wh,4)) if projecth=0 then projecth=360 projecttitl$=win$(wh,2) projectwind$=win$(wh,5) projectform$=win$(wh,1) tbc$="" lbc$="" cbc$="" tec$="" gosub [propertyupdate] #fful.w "!";str$(projectw) #fful.h "!";str$(projecth)
'find controls and create obj() array for form we are interested in for ln=1 to basln 'update progress bar #prog.gb1 "cls ; place 0 0 ; boxfilled ";100+100/maxln*ln;" 25" if bas$(ln,3)="#" then 'reset obj pointer bas$(ln,4)="" 'create objects to control color only check lines after previous open statement up to our open statement if bas$(ln,1)>win$(wh-1,10) and bas$(ln,1)<=win$(wh,10) then if instr(bas$(ln,2),"TextboxColor$",1)>0 then obj(obj,T)=22 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bas)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1 if instr(bas$(ln,2),"ListboxColor$",1)>0 then obj(obj,T)=23 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bas)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1 if instr(bas$(ln,2),"ComboboxColor$",1)>0 then obj(obj,T)=24 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bas)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1 if instr(bas$(ln,2),"TexteditorColor$",1)>0 then obj(obj,T)=21 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bas)=bas$(ln,1):bas$(ln,4)=str$(obj):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) bas$(ln,4)=str$(obj) l$=bas$(ln,2) ll$="" 'remove spaces leaving only , separation but keep "" text untouched inString=0 for i=1 to len(l$) c$=mid$(l$,i,1) select case case c$=chr$(34) inString=1-inString case (inString=0) and c$=" " c$="" end select ll$=ll$+c$ next 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1) obj(obj,T)=wc 'type obj(obj,TH)=projectctrh 'get the .ctrl name obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1) 'for un-named controls if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj 'get the text if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc) 'get the array or bmp file name if wc=3 or wc=4 or wc=6 then obj$(obj,Res)=word$(ll$,2,",") if wc=8 or wc=9 then obj$(obj,Res)=word$(ll$,3,",")+","+word$(ll$,4,",") '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 obj=obj+1 end if 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 for ln = 1 to basln if bas$(ln,3)="#" then lln$=lower$(bas$(ln,2)) 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$(lln$,len(lln$)-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$(lln$,1),2,".") if instr(lln$,"!font",1)>0 then obj(obj,T)=51 else obj(obj,T)=50 obj$(obj,Bas)=str$(ln) bas$(ln,4)=str$(obj)
'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 end if next if win$(wh,6)<>"" then bas$(val(win$(wh,6)),4)=str$(obj) obj$(obj,Bas)=win$(wh,6) obj(obj,T)=41 obj=obj+1 'backgroundcolor end if if win$(wh,7)<>"" then bas$(val(win$(wh,7)),4)=str$(obj) obj$(obj,Bas)=win$(wh,7) obj(obj,T)=42 obj=obj+1 'foregroundcolor end if if win$(wh,8)<>"" then bas$(val(win$(wh,8)),4)=str$(obj) obj$(obj,Bas)=win$(wh,8) obj(obj,T)=43 obj=obj+1 'windowwidth end if if win$(wh,9)<>"" then bas$(val(win$(wh,9)),4)=str$(obj) obj$(obj,Bas)=win$(wh,9) obj(obj,T)=44 obj=obj+1 n=n+1 'windowheight end if if win$(wh,10)<>"" then bas$(val(win$(wh,10)),4)=str$(obj) obj$(obj,Bas)=win$(wh,10) obj(obj,T)=45 obj=obj+1 'open statement end if obj=obj-1 gosub [drawgrid] gosub [drawall] #prog "hide" #prop "hide" #prop "show" show=1 return
[export] 'all previously imported lines will be deleted and replaced by the obj( lines 'deletelist$ remembers the original imported line numbers in line number order if file$<>"" and right$(file$,3)="bas" then open file$ for output as #bas 'open "export.bas" for output as #bas for ln=1 to basln 'find any object associated with this line found=0 for l=1 to obj if bas$(ln,1)=obj$(l,Bas) then found=1 'have we got to the open command line yet if obj(l,T)=45 then 'write all new lines prior to 45 (controls) for m=1 to obj if obj$(m,Bas)="" and obj(m,T)<45 and obj(m,T)<>0 then n=m gosub [exportline] end if next 'write 45 (open line) n=l gosub [exportline] 'write all new lines after 45 (open) ie (fonts)
'apply any control specific fonts" for m= 1 to obj if obj(m,T)<>0 and obj$(m,Fon)<>"" then if obj(m,T)=1 or obj(m,T)=2 or obj(m,T)=5 or obj(m,T)=10 or obj(m,T)=11 then #bas " ";projectform$;".";obj$(m,Ctr);" ";chr$(34);"!font ";obj$(m,Fon);chr$(34) end if if obj(m,T)=3 or obj(m,T)=4 or obj(m,T)=7 or obj(m,T)=8 or obj(m,T)=9 then #bas " ";projectform$;".";obj$(m,Ctr);" ";chr$(34);"font ";obj$(m,Fon);chr$(34) end if end if next end if 'edit or erase existing line if obj(l,T)=0 then 'print ln,"'erased" else if obj(l,T)<>45 then n=l gosub [exportline] end if end if end if next if found=0 then #bas " ";bas$(ln,2) next close #bas end if 'now reload amended .bas file gosub [importit] return
[exportline] select case obj(n,T) 'handle the visible controls case 1 'statictext #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 #bas " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box #bas " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"Clicked],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox #bas " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"Clicked],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button #bas " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"Clicked], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton #bas " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"Clicked], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #bas " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton #bas " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Res);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox #bas " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Res);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #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 #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 22 'textboxcolor #bas " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'listboxcolor #bas " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 24 'comboboxcolor #bas " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'texteditorcolor #bas " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
' handle the window code case 41'backgroundcolor #bas " BackgroundColor$=";chr$(34);projectback$;chr$(34) case 42'foregroundcolor #bas " ForegroundColor$=";chr$(34);projectfore$;chr$(34) case 43'windowidth #bas " WindowWidth=";projectw case 44'windowheight #bas " WindowHeight=";projecth case 45'open #bas " Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$
'handle font changes case 50 'font if obj$(n,Ctr) = "" and projectform$ <> "" and projectfont$ <> "" then #bas " ";projectform$;" ";chr$(34);"font ";projectfont$;chr$(34) goto [delDot] end if #bas " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34) [delDot] case 51 '!font #bas " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34) end select return
[new] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=0 menuset=0 textEd = 0 projectw=600 projecth=400 projectback$="white" projectfore$="black" projectctrc$="white" projecttitl$="Untitled" projectform$="#1" 'if import <> 1 then projectfile$="Untitled.bas" projectwind$="window_nf" #prop.cbwind "select window_nf" redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.w "select ";projectw #fful.h "select ";projecth gosub [propertyupdate] gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[propertyupdate] #prop.tbfile projectfile$ #prop.cbwind "select ";projectwind$ #prop.tbtitl projecttitl$ #prop.tbform projectform$ #prop.tbctrl "" #prop.tbtext "" #prop.tbreso "" #prop.tbxywh projectw;"x";projecth #prop.tbfont projectfont$ #prop.tbcolo projectfore$;"/";projectback$ return
[resize] '#fful.tool "select Add New" #fful.form "select File" if wh=0 then wh=1 #fful.hand "selectindex ";wh #fful.grid "select Set Grid" #fful.font "select Set Font" #fful.color "select Set Color" #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawall] wait
[formsize] #fful.w "contents? w$" #fful.h "contents? h$" wf=val(w$) hf=val(h$) if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait projectw=wf projecth=hf insertx=grid inserty=grid gosub [drawgrid] #fful.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid spacing according to user choice, default is 10 #fful.grid "contents? g$" select case g$ case "Invisible" gridvisible=0 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 lightgray" 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$ 'obj$(selected,Bas)="XX" '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$ case "CrossHair" gosub [colorpick] if cp$<>"" then crosshair$=cp$ end select #fful.color "select Set Color" gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" wait
[windowtype] #prop.cbwind "contents? projectwind$" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #pick.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #pick #pick "font Consolas 9" #pick "trapclose [quitpick]" #pick.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white " c=1 for yc=1 to 160 step 40 for xc= 1 to 160 step 40 #pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40 c=c+1 if c>15 then c=15 next next #pick.gb "when leftButtonDown [pick]" wait
[pick] xp=int(MouseX/40) yp=int(MouseY/40) c=xp+yp*4+1 cp$=word$(cl$,c)
[quitpick] close #pick return
[help] run "notepad help.txt" wait
[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
[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
[block] 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 #prog close #fful end
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
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 '
|
|
|
Post by xxgeek on Aug 1, 2023 9:11:18 GMT -5
Confusing? Yes, very. Please test this for yourselves, it's very odd. Anatoly your explanation is beyond me, but you may be on to something.
That one fix fixes all the problems with the : 'colon' (in my test file) Anatoly you are correct, I did not expect it to fix all the problems with the colon. I expected it to fix the issue in the paths, but not the other issues inside quotes or the urls. However once applied ALL the issues with the colon (importing/exporting the file below) evaporated. Explain that one. (or did you already explain it, and I just didn't get it?)
Try import/export on the following file using FFUL.bas, then try it with the code I posted above, FFNSL.bas or apply the fix to FFUL and try again. Remember to uncomment before the test. if file$<>"preview.bas" then 'under [writeit] after the fonts get written(don't forget end if). After importing, preview it to see the syntax errors.
Chosen for it's multi control very busy window.
'Name = JB Help Lab and Project Organizer v1.0 Author - xxgeek a member of the _ 'Author(s) - xxgeek, cundo, Carl Gundel 'Date - Nov 2021 '_Visit the Just Basic forums @ justbasiccom.proboards.com/ for more information. '_Purpose - To help users learn to code in Just Basic v2.0_
'_This program is a collection of other programs written by other users,_ '_ and by Carl Gundel(creator of the Just Basic language)_ '_Credit goes to cundo for the jbsearch (an engine to search the jb help files) _ '_Credit also goes to cundo for the fastcode code generator that creates _ '_the shell "Window" Code _ '_Credit goes to Rod for SpriteCreator and many answers to my questions _ ' and must add, a shared enthusiasm and passion for coding and helping others '_Credit goes to Carl Gundel for his Dictionary code and his quick responses _ '_to questions regarding Just Basic's nuances and buried details _ '_Credit goes to tsh73 for his inspiration, advice, help, and most of all his _ '_code "proof of concept" which was the initial code to show that a TKN file _ '_can be created programatically that got this project moving forward. _ '_Credit goes to the following members who helped with all questions posed while _ '_learning to code in Just Basic v2.0 _ '_B+ for his many code samples and his desire to help others learn to code, ' not to mention his exceptional skills regarding math +(geomentry) and graphics coding ' enzo for his enthusiasm, his superb ideas, his willingness to help others, and the ' "OutoftheBox" kind of thinking he exibits '_code (yes "code" is a member) he writes some good code, and code helps me out ' as well, so he gets a mention here too. ' Hope I didn't forget anyone, if I did, it's cause my memory can fail me. ' Sorry, let me know if I forgot YOU.
'All are members of the Just Basic forums, and waiting to help YOU when you ' decide to code in Just Basic. Just ask for help at the Just Basic forums and 'they (and I) will help with whatever you need regarding Just Basic
'xxgeek code 'declare variables on error goto [errorReport] open "lablog.log" for append as #lablog : lablogIsOpen = 1 #lablog, "" #lablog, "" #lablog, date$();" ";time$() #lablog, "" #lablog, "Start Up >>> declaring globals ........." 'declare globals, and dim arrays for key$ and info$ global FolderDialog$, pnum, JBexe$, JBpath$, spritecreated, jbReservedWords$, dictionary$, keyCount, q$, fileToCheck$, lastKey$, helpFilePath$, resetsearch, closehtml, categorie$, upath$, selectedpath$ dim key$(1000) dim info$(500, 500)
#lablog, "declaring variables......." q$ = chr$(34) DestPathU$ = DefaultDir$;"\Projects" JBpath$ = "c:\Program Files (x86)\Just Basic v2.0" tutorialPath$ = JBpath$;"\jbtutorial\index.html" JBexe$ = "jbasic.exe" : JBruntime$ = "jbrun2.exe" openhelp$ = JBpath$;"\jb2help\JustBASIC_2_web\amber_menu.htm" helpFilePath$ = JBpath$;"\jb2help\JustBASIC_2_web" : helpFileMenu$ = "amber_menu.htm" jbReservedWords$ = "AND, APPEND, AS, BEEP, BMPBUTTON, BMPSAVE, BUTTON, BYREF, CALL, CALLFN, CASE, CHECKBOX, CLOSE, CLS, COLORDIALOG, COMBOBOX, CONFIRM, CURSOR, DATA, DIALOG, DIM, DLL, DO, DUMP, ELSE, END, ERROR, EXIT, FIELD, FILEDIALOG, FILES, FONTDIALOG, FOR, FUNCTION, GET, GETTRIM, GLOBAL, GOSUB, GOTO, GRAPHICBOX, GRAPHICS, GROUPBOX, IF, INPUT, KILL, LET, LINE, LISTBOX, LOADBMP, LOOP, LP, PRINT, MAINWIN, MAPHANDLE, MENU, NAME, NEXT, NOMAINWIN, NOTICE, ON, ONCOMERROR, OR, OPEN, OUTPUT, PASSWORD, PLAYMIDI, PLAYWAVE, POPUPMENU, PRINT, PRINTERDIALOG, PROMPT, PUT, RADIOBUTTON, RANDOM, RANDOMIZE, READ, READJOYSTICK, REDIM, REM, RESTORE, RESUME, RETURN, RUN, SCAN, SELECT, SORT, STATICTEXT, STOP, STOPMIDI, SUB, TEXT, TEXTBOX, TEXTEDITOR, THEN, TIMER, TITLEBAR, TRACE, UNLOADBMP, UNTIL, WAIT, WINDOW, WEND, WHILE, XOR, ABS(, ACS(, ASC(, ASN(, ATN(, CHR$(, COS(, DATE$(, DECHEX$(, EOF(, EXP(, HEXDEC(, INPUT$(, INPUTTO$(, INSTR(, INT(, LEFT$(, LEN(, LOF(, LOG(, LOWER$(, MAX(, MIDIPOS(, MID$(, MIN(, MKDIR(, NOT(, RIGHT$(, RMDIR(, RND(, SIN(, SPACE$(, SQR(, STR$(, TAB(, TAN(, TIME$(, TRIM$(, TXCOUNT(, UPPER$(, USING(, VAL(, WORD$(, BackgroundColor$, ComboboxColor$, CommandLine$, DefaultDir$, DisplayHeight, DisplayWidth, Drives$, Err, Err$, ForegroundColor$, Joy1x, Joy1y, Joy1z, Joy1button1, Joy1button2, Joy2x, Joy2y, Joy2z, Joy2button1, Joy2button2, ListboxColor$, Platform$, PrintCollate, PrintCopies, PrinterFont$, PrinterName$, TextboxColor$, TexteditorColor$, Version$, WindowHeight, WindowWidth, UpperLeftX, UpperLeftY" DllList$="vbas31w.sll vgui31w.sll voflr31w.sll vthk31w.dll vtk1631w.dll vtk3231w.dll vvm31w.dll vvmt31w.dll" savedProjects$ = "savedProjects" MyProjects$ = "MyProjects" programs$ = "Programs" vbs$ = "VB" ps1$ = "PS1" cmd$ = "CMD" js$ = "JS" html$ = "HTML" examples$ = "Examples" snippets$ = "Snippets" notes$ = "Notes" help$ = "Help" subroutines$ = "Subroutines" functions$ = "Functions" closehtml = 1 print "fixing date ....." #lablog, "fixing date ............" fixDate$ = Date$("yyyy/mm/dd") 'set up the date format that works with a filename(remove the /) fix1$ = word$(fixDate$, 1, "/") fix2$ = word$(fixDate$, 2 ,"/") fix3$ = word$(fixDate$, 3 ,"/") fixeddate$ = "-";fix1$;"-";fix2$;"-";fix3$
fixTime$ = Time$() 'set up the time format that works with a filename(remove the /) fix1$ = word$(fixTime$, 1, ":") fix2$ = word$(fixTime$, 2 ,":") fix3$ = word$(fixTime$, 3 ,":") fixedtime$ = "-";fix1$;"-";fix2$;"-";fix3$
'cundo's fastcode generator #lablog, "defining window types array......." dim windowTypes$(19) windowTypes$(0)= "":windowTypes$(1)= "dialog":windowTypes$(2)= "dialog_fs":windowTypes$(3)= "dialog_nf":windowTypes$(4)= "dialog_nf_fs" windowTypes$(5)= "dialog_ns_modal":windowTypes$(6)= "dialog_modal":windowTypes$(7)= "dialog_popup":windowTypes$(8)= "graphics" windowTypes$(9)= "graphics_fs":windowTypes$(10) = "graphics_nf":windowTypes$(11)= "graphics_nsb":windowTypes$(12)= "graphics_nsb_nf" windowTypes$(13)= "text":windowTypes$(14)= "text_fs":windowTypes$(15)= "text_nsb":windowTypes$(16)= "text_nsb_ins":windowTypes$(17)= "window" windowTypes$(18)= "window_nf":windowTypes$(19)= "window_popup"
#lablog, "beginning to create help lab window......." 'nomainwin WindowWidth = 1368 WindowHeight = 768 UpperLeftX= int((DisplayWidth-WindowWidth)/2) UpperLeftY= int((DisplayHeight-WindowHeight)/2) BackgroundColor$ = "lightgray" ForegroundColor$ = "black"
[resetsearch] #lablog, "setting / resetting search array......." if resetsearch = 1 then count = 0 : startAt = 0 : idx = 0 : hrefA = 0 : hrefB = 0 : a = 0 : b = 0 : c = 0 dim helpList$(500), searchList$(500) print helpFilePath$;"\";helpFileMenu$ open helpFilePath$;"\";helpFileMenu$ for input as #1 txt$ = input$(#1, lof(#1)) close #1 lowerTxt$= lower$(txt$) while 1 scan startAt = c+1 a = instr(lowerTxt$, "href",startAt) b = instr(lowerTxt$, ">",a+1) c = instr(lowerTxt$, "</a>",b+1) if a=0 or b=0 or c= 0 then exit while hrefA= instr(lowerTxt$,chr$(34),a+1) hrefB= instr(lowerTxt$,chr$(34),hrefA+1) idx = idx +1 helpList$(idx)= trim$(mid$(txt$,b+1,c-b-1));chr$(0);_ trim$(mid$(txt$,hrefA+1,hrefB-hrefA-1)) wend
if resetsearch = 1 then [reloadSearchLists]
'jbsearch code by cundo #lablog, "finishing help lab window......." 'top menu menu #main, "File" , "Open a File in Just Basic", [openFile], "Exit", [quit.main] menu #main, "edit" menu #main, "Tools" , "BAS <2> EXE", [bas2exe], "BAS <2> TKN", [makeTKN], ".bas Line Count", [numofLines] menu #main, "Options", "Preferences", [preferences] menu #main, "Browse" , "MyProjects Folder", [projectsDir], "JB Examples Folder", [jbexamplesDir], "JB BMP Folder", [bmpDir], "JB Sprites Folder", [spritesDir], "Created EXE's Folder", [exeDir], "Created TKN's Folder", [tknDir], "JB Functions Folder", [jbfunctionsDir] menu #main, "Help" , "Help", [jbHelpLabHelp], "About", [about] 'jbsearch by cundo listbox #main.listbox1, helpList$(, lbDoubleClick, 420, 80, 320, 282 statictext #main.searchtext, "Search For KeyWord(s)", 755, 40, 160, 20 statictext #main.searchheader, "Just Basic v2.0 Help and Tutorial Search", 600, 7, 360, 20 statictext #main.searchin, "Search in", 428, 39, 70, 20 statictext #main.clickTip1, "Single Click to Select", 520, 67, 170, 15 statictext #main.clickTip2, "Single Click to Select", 845, 102, 170, 15 statictext #main.or, " or", 610, 38, 20, 20 textbox #main.tb, 910, 35, 155, 25 listbox #main.listbox2, searchList$(, lbDoubleClick, 745, 115, 320, 245 button #main.search, "&Start Searching in JB Help", buttonClick, UL, 800, 70, 220, 25 button #main.contents, "&JB Help File", [helpfiles], UL, 510, 35, 90, 25 button #main.tutorial, "JB Tuto&rial", [tutorial], UL, 645, 35, 90, 25 button #main.tutorial, "Open JB Tutoria&l", [opentutorial], UL, 585, 365, 120, 20 button #main.openhelp, "Open JB HHelp", [openhelp], UL, 455, 365, 120, 20 checkbox #main.closehtml, "Close Help (htlmviewer) Windows on Exit", [setclosehtml], [resetsearchclosehtml], 760, 365, 285, 20 'fastcode code by cundo texteditor #main.ed, 8, 150, 400, 200 statictext #main.fastcode, "Create Window Code", 135, 5, 165, 20 statictext #main.st1, "< Name && Handle >", 150, 25, 128, 20 statictext #main.st1, "Window Type", 5, 126, 88, 20 textbox #main.txt1, 290, 20, 115, 20 textbox #main.txt2, 20, 20, 115, 20 button #main.button1, "&Generate Code ^ + > Copy to Clipboard", dummy, ul, 70, 355, 270, 25 combobox #main.combo, windowTypes$(, dummy, 100, 125, 140, 20 checkbox #main.r1, "Labels instead of Subs", dummy, dummy, 8, 100, 222, 20 checkbox #main.addjbsubroutine, "Add Selected Subroutine", dummy, dummy, 8, 60, 222, 20 checkbox #main.adjbfunction, "Add Selected JB Function", dummy, dummy, 8, 80, 222, 20 statictext #main.fastsubtext, "Subroutines", 290, 43, 120, 15 combobox #main.fastsubList, fastsubList$(), [fastsubList] , 245, 58, 160, 15 statictext #main.jbfunctionstext, "JB Functions", 285, 83, 120, 15 combobox #main.jbfunctionsList, jbfunctionsList$(), jbfunctionSelected , 245, 99, 160, 15 button #main.freeform, "Open &Free Form Editor", [openFreeForm], UL, 245, 127, 160, 20
'dictionary code by Carl Gundel texteditor #main.value, 293, 415, 770, 230 listbox #main.keys, keys$(), [keySelected], 5, 415, 285, 205 'category radio buttons radiobutton #main.programs, programs$, [progs], resetHandler, 400, 395, 80, 20 radiobutton #main.examples, examples$, [exams], resetHandler, 500, 395, 80, 20 radiobutton #main.snippets, snippets$, [snipps], resetHandler, 600, 395, 70, 20 radiobutton #main.savedprojects, MyProjects$, [projs], resetHandler, 290, 395, 90, 20 radiobutton #main.notes, notes$, [notes], resetHandler, 905, 395, 55, 20 radiobutton #main.subroutines, subroutines$, [subroutines], resetHandler, 695, 395, 100, 20 radiobutton #main.functions, functions$, [functions], resetHandler, 805, 395, 80, 20 radiobutton #main.VBS, vbs$, [vbs], resetHandler, 1070, 445, 45, 20 radiobutton #main.PS1, ps1$, [ps1], resetHandler, 1070, 480, 45, 20 radiobutton #main.CMD, cmd$, [cmd], resetHandler, 1070, 515, 45, 20 radiobutton #main.JS, js$, [js], resetHandler, 1070, 550, 45, 20 radiobutton #main.html, html$, [html], resetHandler, 1070, 585, 60, 20 'radiobutton #main.jbexamples, jbexamples$, [JBExamples], resetHandler, 1070, 620, 110, 20 radiobutton #main.help, help$, [help], resetHandler, 1070, 625, 60, 20 'buttons bottom left and middle button #main.addListing, "&New ";left$(categorie$, (len(categorie$) - 1)), [newKey], ul, 5, 624, 137, 20 button #main.deleteListing, " &Delete Selected ", [deleteKey], ul, 150, 624, 140, 20 button #main.makeproject, " &Make New Project", [makeproject], ul, 5, 624, 140, 20 button #main.remakeproject, "Re-Make Selected", [remakeproject], ul,5, 652, 140, 20 button #main.runListing, "&Run Selected", [runKey], ul, 150, 652, 140, 20 button #main.runjb, "Edit Selected with JB &IDE", [edit_In_JB_IDE], ul, 330, 652, 180, 20 button #main.editInNotepad, "Edit Selected with Notepad", [editInNotepad], ul, 580, 652, 180, 20 'create buttons button #main.jbProgs, "JB &Programs", [jbProgs], ul, 1085, 30, 120, 25 button #main.freeform, " JB &FreeForms ", [openFreeForm], ul, 1220, 30, 120, 25 button #main.pictures, "Pictures (&BMP)", [pictures], ul, 1085, 65, 120, 23 button #main.sprites, " Spr&ites ", [sprites], ul, 1220, 65, 120, 23 'useful tools buttons button #main.task, " Tas&k Manager ", [taskman], ul, 1085, 125, 120, 23 button #main.calc, " &Calculator ", [calc], ul, 1085, 155, 120, 23 button #main.record, " &Voice Recorder ", [record], ul, 1085, 185, 120, 23 button #main.basexe, " BAS < 2 > &EXE ", [bas2exe], ul, 1085, 215, 120, 23 button #main.bas2tkn, " BAS < 2 > &TKN ", [bas2tkn], ul, 1085, 245, 120, 23 button #main.numLines, " .BAS &Line Count ", [numofLines], ul, 1085, 275, 120, 23 button #main.notepad, " NoteP&ad ", [openNotePad], ul, 1085, 305, 120, 23 button #main.jberrorlog, "JB Error Log", [jberrorLog], ul, 1085, 340, 85, 20 button #main.helplablog, "Lab Log", [labLog], ul, 1280, 340, 60, 20 button #main.runtimelog, "Runtime Log", [runtimeLog], ul, 1177, 340, 95, 20 'browse buttons button #main.projectsDir, " Projects Folder ", [projectsDir], ul, 1220, 125, 120, 23 button #main.exeDir, " EXE Folder ", [exeDir], ul, 1220, 155, 120, 23 button #main.tknDir, " TKN Folder ", [tknDir], ul, 1220, 185, 120, 23 button #main.bmpDir, " BMP Folder ", [bmpDir], ul, 1220, 215, 120, 23 button #main.spritesDir, " Sprites Folder ", [spritesDir], ul, 1220, 245, 120, 23 button #main.functionsDir, " Functions Folder ", [jbfunctionsDir], ul, 1220, 275, 120, 23 button #main.examplesDir, " Examples Folder ", [jbexamplesDir], ul, 1220, 305, 120, 23 'ascii chart combo box and static text statictext #main.asciitext, "ASCII Codes chr$()", 1220, 375, 125, 15 combobox #main.asciiList, asciiList$(), asciiSelected , 1215, 390, 125, 40 'jb samples to reserved words comboboxes and statictext statictext #main.jbsamplestext, "JB Examples", 1140, 420, 125, 15 combobox #main.jbsamplesList, jbsamplesList$(), jbsampleSelected , 1120, 435, 120, 25 statictext #main.functionstext, "JB Functions", 1247, 420, 100, 15 combobox #main.jbfunctionsList, jbfunctionsList$(), jbfunctionSelected , 1240, 435, 100, 25 statictext #main.jbdialogstext, "JB Dialogs", 1255, 465, 100, 15 combobox #main.jbdialogsList, jbdialogsList$(), jbdialogSelected , 1245, 480, 100, 25 statictext #main.reservedwordstext, "Reserved Words", 1130, 465, 120, 15 combobox #main.jbreservedwordsList, jbreservedwordsList$(), jbreservedwordSelected , 1120, 480, 125, 25 'jb bak(up) Files combobox and statictext statictext #main.jbbaktext, "JB BAK (UP) Files", 1095, 375, 120, 15 combobox #main.jbbakfilesList, jbbakfilesList$(), jbbakfileSelected , 1090, 390, 120, 25 'right side static text statictext #main.creators, "Create", 1190, 5, 160, 20 statictext #main.useful, "Useful Tools", 1095, 102, 160, 20 statictext #main.browse, "Browse", 1250, 100, 162, 20 statictext #main.choose, "Select a Category >> >>> ", 55, 395, 200, 20 statictext #main.killtext, "Kill All JB Processes >", 1170, 660, 150, 20 statictext #main.jbforums, "Visit https://justbasiccom.proboards.com/", 05, 700, 275, 25 'kill all button button #main.killAll, " &@ ", [killAll], UL, 1320, 653, 30, 30 cursor normal #lablog, "opening help lab window......." open "Just Basic v2.0 Help Lab" for window as #main
#lablog, "defining fonts, visibility, other attributes in help lab window......." #main "trapclose [quit.main]" #main.addListing, "!hide" #main.remakeproject, "!hide" #main.makeproject, "!hide" #main.deleteListing, "!hide" #main.runListing, "!hide" #main.runjb, "!hide" #main.editInNotepad, "!hide" #main.listbox1 "singleclickselect" #main.listbox2 "singleclickselect" '#main "font arial 10 Bold" #main.asciiList, "font arial 10 bold" #main.txt1 "#main" #main.txt2 "untiltled" #main.r1 "set" #main.closehtml, "set" #main.listbox1, "font arial 12 bold" #main.listbox2, "font arial 12 bold" #main.value, "!font arial 12 bold" #main.keys, "font arial 12 bold" #main.jbProgs, "!font arial 12 bold" #main.freeform, "!font arial 12 bold" #main.ed "!font arial 12 bold" #main.clickTip1, "!font arial 8 bold" #main.clickTip2, "!font arial 8 bold" #main.combo "selectindex 17" #main.keys "singleclickselect" #main.button1, "!font arial 10 bold" #main.tutorial, "!font arial 10 bold" #main.search, "!font arial 10 bold" #main.st1, "!font arial 10 bold " #main.fastcode, "!font arial 12 bold" #main.search, "!font arial 12 bold" #main.searchheader, "!font arial 12 bold" #main.creators "!font arial 12 bold" #main.useful, "!font arial 12 bold" #main.browse, "!font arial 12 bold" #main.choose, "!font arial bold 12" #main.sprites, "!font arial 12 Bold" #main.jbforums, "!font arial 8 bold" #main.pictures, "!font arial 12 bold" #main.runListing, "!hide" #main.deleteListing, "!hide" #main.remakeproject, "!font arial 10 bold" #main.makeproject, "!font arial 10 bold" #main.tb, "!setfocus"
#lablog, "calling progressbar 0......." cursor hourglass call progressBar 'get users home dir path #lablog,"calling getUserpath......." call getUserPath pnum = 1 #lablog, "User Home dir Path = ";upath$ print "User Home dir Path = ";upath$ 'load up the list and combo boxes for dialogs, jbsamples, jbfunctions and ascii codes #lablog, "calling progressbar 1......." call progressBar #lablog, "calling getjbfunctions......." call getjbfunctions #lablog, "calling getAscii" call getAscii pnum = 2 #lablog, "calling progressbar 2......." call progressBar #lablog, "getjbreservedwords......." call getjbreservedwords pnum = 3 #lablog, "calling progressbar 3......." call progressBar #lablog, "calling getjbsamples......." call getjbsamples pnum = 4 #lablog, "calling progressbar 4......." call progressBar
#lablog, "calling getjbBakFiles......." call getjbBakFiles #lablog, "calling progressbar 5......." pnum = 5 #lablog,"calling getjbdialogs......." call getjbdialogs call progressBar
'reload search and help lists if selected path changes from Help to Tutorial [reloadSearchLists] 'wait here for input event if resetsearch = 1 then #lablog,"reloading search list boxes after reset......." cursor hourglass #main.listbox1, "reload" #main.listbox2, "reload" resetsearch = 0 #main.tb, "!setfocus" end if cursor normal wait
'Dictionary by Carl Gundel + edited by xxgeek [newKey] 'ask the user for a new listing #lablog,"creating new key......." call saveValue if len(left$(categorie$, (len(categorie$) - 1))) < 4 then goto [notPlural] end if prompt "Enter a Name for the New " + left$(categorie$,(len(categorie$)-1)); newKey$ if newKey$ = "" then notice "You must provide a name" : wait if newKey$ <> "" then [continue]
[notPlural] prompt "Enter a Name for the New "+categorie$+" Script"; newKey$ if newKey$ = "" then wait
[continue] if newKey$ <> "" then call setValueByName newKey$, "" call loadKeys #main.keys "select "; newKey$ #main.value "!cls"; #main.value "!setfocus"; #main.value "!origin 0, 0" call collectGarbage call writeDictionary if tkn = 2 or tkn = 4 then #lablog "Adding new key -> ;";fname$;" to -> ";categorie$ #main.savedprojects, "set" open fname$ for input as #1 open categorie$ for append as #2 print #2, input$(#1, lof(#1)); close #1 close #2 call saveValue call readDictionary call loadKeys tkn = 0 'call writeDictionary 'goto [projs] end if
if tkn = 3 then #lablog "Adding new key -> ";fname$;" to -> ";categorie$ #main.programs, "set" open fname$ for input as #1 open categorie$ for append as #2 print #2, input$(#1, lof(#1)); close #1 close #2 call saveValue call readDictionary call loadKeys tkn = 0 'goto [progs] end if lastKey$ = newKey$ end if wait
'xxgeek code [tutorial] #lablog,"search tutorial button pressed resetting/reloading search list boxes......." resetsearch = 1 : helpFilePath$ = JBpath$;"\jbtutorial" helpFileMenu$ = "index.html" : #main.search, "&Start Searching JB Tutorial " : goto [resetsearch]
[helpfiles] #lablog,"search jb help button pressed resetting/reloading search list boxes......." resetsearch = 1 : helpFilePath$ = JBpath$;"\jb2help\JustBASIC_2_web" helpFileMenu$ = "amber_menu.htm" #main.search, "&Start Searching in JB Help" goto [resetsearch]
[openhelp] #lablog, "opening selected help file with htmlviewer (if available) or default browser (if not)" if fileExists(DefaultDir$, "htmlviewer.exe") <> 0 then run "htmlviewer.exe ";openhelp$ else run "explorer.exe ";openhelp$ end if wait
[opentutorial] #lablog, "opening the JB Tutorial using htmlviewer if available, default browser if not" if fileExists(DefaultDir$, "htmlviewer.exe") <> 0 then run "htmlviewer.exe ";tutorialPath$ else run "explorer.exe ";tutorialPath$ end if wait
[openFreeForm] #lablog, "opening the JB FreeForm editor" freeForm$ = upath$;"\AppData\Roaming\Just BASIC v2.0\fformj261006.bas" run JBpath$;"\";JBexe$;" -R -A ";freeForm$ wait
[killAll] #lablog, "killing/closing all opened htmlviewer instances" call saveValue if fileExists(DefaultDir$, "htmlviewer.exe") <> 0 then run "taskkill /IM htmlviewer.exe /F", HIDE run "taskkill /IM jbasic.exe /F", HIDE end
'Carl Gundel's Dictionary code [keySelected] 'a key in the list was selected #lablog, "a key was selected" call saveValue #main.keys, "singleclickselect" #main.value "!origin 0, 0" #main.keys "selection? selectedKey$" #lablog, "selection made was ";selectedKey$ print "selectedKey$ = ";selectedKey$ selectedValue$ = getValue$(selectedKey$) #main.value "!contents selectedValue$"; lastKey$ = selectedKey$ #main.value "!setfocus"; #main.keys, "singleclickselect" wait
'xxgeek code [deleteKey] print "@- [deleteKey]....." #main.keys "selection? selectedKey$" #lablog, "selected key was ";selectedKey$ #lablog, "@- [deleteKey] deleting ";selectedKey$;" from ";categorie$ if pathExists(DefaultDir$;"\BAK") = 0 then res = mkdir(DefaultDir$;"\BAK") categor$ = categorie$ categor$ = left$(categor$, len(categor$)-1) answer$ = "yes" if selectedKey$ = "" then prompt "No Selection made. Try again?";answer$ if selectedKey$ = "" then wait end if prompt "Deleting Entry" + chr$(13) + selectedKey$ + " OK ?";answer$ if answer$ <> "yes" then wait cursor hourglass #main.value, "!selectall" #main.value, "!cut" deleteIt$ = selectedKey$ call saveValue #lablog, "copying ";categorie$;" to ";"BAK Dir appending date and time......." open categorie$ for input as #1 open "BAK\";categorie$;fixeddate$;fixedtime$ for output as #2 #2, input$(#1, lof(#1)); close #2 close #1 #lablog, "Opening tempfile to find line to delete from ";categorie$ open categorie$ for input as #1 tempfile$ = "tempfile" open tempfile$ for output as #2 #lablog, "tempfileOpened =";tempfile$ word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134) #lablog, "opening window for delay while deleting ";selectedKey$;" from ";categorie$ WindowWidth = 600:WindowHeight = 150 UpperLeftX= int((DisplayWidth-WindowWidth)/2) UpperLeftY= int((DisplayHeight-WindowHeight)/2)+185 BackgroundColor$ = "lightgray" ForegroundColor$ = "black" statictext #deleteKey.text, " Please wait - Deleting a listing can take some time, depending on the List and the size of each Listing's file. Approximatlely 1 minute for each 160 KB of data", 10, 40, 580, 100 open "Information Message" for dialog_popup as #deleteKey #deleteKey "trapclose [quit.deleteKey]" #deleteKey.text "!font arial 12 bold" while eof(#1) = 0 line input #1, line$ print "dontsave = ";line$ print "word1$ = ";word1$ print "line$ = ";line$ if line$ = "" then [dontSave] if line$ = word1$ then [dontSave] #2, line$ [dontSave] #lablog, "deleting line ";line$;" and any empty lines " wend close #1 close #2 #lablog, "deleting ";selectedKey$ deleteMe$ = categorie$;".bak" if fileExists(DefaultDir$, deleteMe$) = 0 then print "attempting to name categorie$ as categorie$.bak" name categorie$ as categorie$;".bak" print "Finished renaming";categorie$;" To ";categorie$;".bak" name tempfile$ as categorie$ else kill deleteMe$ print "deleted old bak file" name categorie$ as categorie$;".bak" name tempfile$ as categorie$ print "renamed temp file as";categorie$ end if selectedKey$ = "" lastKey$ = "" call readDictionary call loadKeys call saveValue #lablog, "finished deleting Listing ";selectedKey$;" in ";categorie$ [quit.deleteKey] close #deleteKey cursor normal wait
'run selected MyProjects, or Program [runKey] if selectedKey$ = "" then notice "Select from list, try again" : wait #lablog, "Running ";selectedKey$;" in ";categorie$;" List" #lablog, "selected Key = ";selectedKey$ print "selected Key = ";selectedKey$ runFile$ = savedProjects$;"\";selectedKey$;"\";selectedKey$;".exe" if fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".exe") <> 0 then #lablog, "running selectedKey = ";savedProjects$;"\";selectedKey$;"\";selectedKey$;".exe" run q$;DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".exe";q$ else Prompt "Project NOT Created.....yet?" + chr$(13) + "Make Project and Try again" ; answer$ end if wait
'open selected listing in just Basic IDE [edit_In_JB_IDE] if selectedKey$ = "" then notice "Select from list, try again" : wait #lablog, "Running ";selectedKey$;" of ";categorie$;" with JB IDE" print "selectedKey$ = ";selectedKey$ runFile$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas" print "runFile$ = ";runFile$ res = fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".bas") if res then run JBpath$;"\";JBexe$;" ";q$;runFile$;q$ else #main.value, "!contents? valueNow$"; 'print valueNow$ open "untitled.bas" for output as #1 #1, valueNow$ close #1 tempfile$ = DefaultDir$;"\untitled.bas" print JBpath$;"\";JBexe$;" ";q$;tempfile$;q$;" = ";JBpath$;"\";JBexe$;" ";q$;tempfile$;q$ run JBpath$;"\";JBexe$;" ";q$;tempfile$;q$ end if wait
[editInNotepad] #lablog, "Running ";selectedKey$;" of ";categorie$;" with Notepad" if selectedKey$ = "" then notice "Select from list, try again" : wait runFile$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas" print "runFile$ = ";runFile$ res = fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".bas") if res then run "notepad ";q$;runFile$;q$ #lablog, "Notepad opened sucessfully ";selectedKey$;" of ";categorie$;" FILE USED, not TEXT" else answer$ = "yes" notice " The file doesn't exist yet."+ chr$(13)+" No project for "+ chr$(13)+ selectedKey$ + chr$(13) + "Open notepad anyway, and edit the text in texeditor for " + chr$(13) + selectedKey$ +"?" ; answer$ if answer$ <> "yes" then wait #main.value, "!contents? forNotepad$"; open "untitledTemp.bas" for output as #1 #1, forNotepad$ close #1 run "notepad ";q$;"untitledTemp.bas";q$ #lablog, "Notepad opened sucessfully ";selectedKey$;" of ";categorie$;" TEXT used, not FILE" end if wait
'top menu "Open File in JB IDE" [openFile] #lablog "@- [openFile] opening filedialog to select a file for edit in JB IDE" filedialog "Open \ Select a Just Basic Source File (.bas) ", DefaultDir$; "\*.bas", openFilename$ if openFilename$ = "" then wait run JBpath$;"\";JBexe$;" ";openFilename$ wait
'set "close htmlviewer" checkbox [setclosehtml] closehtml = 1 : print "closehtml [setclose] = ";closehtml : wait
'reset "close htmlviewer" checkbox [resetsearchclosehtml] closehtml = 0 : print "closehtml [resetsearchclose] = ";closehtml : wait
'radio button selections from MyProjects to Help [projs] #lablog "@- [projs] ........" #main.runListing, "!show" #main.makeproject, "!show" #main.remakeproject, "!show" #main.runjb, "!show" #main.addListing, "!hide" #main.editInNotepad, "!show" #main.deleteListing, "!show" #main.value, "!cls" categorie$ = MyProjects$ call resetRadioOptions category$ = categorie$ category$= left$(category$, (len(category$) - 1)) category$ = right$(category$,7) #main.addListing, "&New ";category$ #main.choose, "Select a ";category$ wait
[progs] #lablog "@- [progs] ............" #main.runListing, "!show" #main.makeproject, "!hide" #main.remakeproject, "!show" #main.runjb, "!show" #main.addListing, "!show" #main.deleteListing, "!show" #main.editInNotepad, "!show" call saveValue #main.value, "!cls" categorie$ = programs$ call resetRadioOptions #main.addListing, "&New ";left$(categorie$, (len(categorie$) - 1)) category$ = categorie$ category$= left$(category$, (len(category$) - 1)) #main.choose, "Select a ";category$ wait
[exams] #lablog "@- [exams] ............" #main.runListing, "!hide" #main.runjb, "!show" #main.addListing, "!show" #main.deleteListing, "!show" #main.makeproject, "!hide" #main.remakeproject, "!hide" #main.editInNotepad, "!show" call saveValue #main.value, "!cls" categorie$ = examples$ call resetRadioOptions #main.addListing, "&New ";left$(categorie$, (len(categorie$) - 1)) category$ = categorie$ category$= left$(category$, (len(category$) - 1)) #main.choose, "Select an ";category$ wait
[snipps] #lablog "@- [snipps] ............" #main.makeproject, "!hide" #main.remakeproject, "!hide" #main.runjb, "!show" #main.runListing, "!hide" #main.addListing, "!show" #main.deleteListing, "!show" #main.editInNotepad, "!show" call saveValue #main.value, "!cls" categorie$ = snippets$ call resetRadioOptions #main.addListing, "&New ";left$(categorie$, (len(categorie$) - 1)) category$ = categorie$ category$= left$(category$, (len(category$) - 1)) #main.choose, "Select a ";category$ wait
[subroutines] #lablog "@- [subroutines] ............" #main.runListing, "!hide" #main.makeproject, "!hide" #main.remakeproject, "!hide" #main.runjb, "!show" #main.addListing, "!show" #main.deleteListing, "!show" #main.editInNotepad, "!show" #main.editInNotepad, "!show" call saveValue #main.value, "!cls" categorie$ = subroutines$ call resetRadioOptions category$ = categorie$ category$= left$(category$, (len(category$) - 1)) #main.addListing, "&New ";category$ #main.choose, "Select a ";category$ wait
[functions] #lablog "@- [functions] ............" #main.runListing, "!hide" #main.makeproject, "!hide" #main.remakeproject, "!hide" #main.runjb, "!show" #main.addListing, "!show" #main.deleteListing, "!show" #main.editInNotepad, "!show" #main.editInNotepad, "!show" call saveValue #main.value, "!cls" categorie$ = functions$ call resetRadioOptions #main.addListing, "&New ";left$(categorie$, (len(categorie$) - 1)) category$ = categorie$ category$= left$(category$, (len(category$) - 1)) #main.choose, "Select a ";category$ wait
[notes] #lablog "@- notes] ............" #main.runListing, "!hide" #main.runjb, "!show" #main.makeproject, "!hide" #main.remakeproject, "!hide" #main.addListing, "!show" #main.editInNotepad, "!show" #main.deleteListing, "!show" #main.editInNotepad, "!show" call saveValue #main.value, "!cls" categorie$ = notes$ call resetRadioOptions #main.addListing, "&New ";left$(categorie$, (len(categorie$) - 1)) category$ = categorie$ category$= left$(category$, (len(category$) - 1)) #main.choose, "Select a ";category$ wait
[vbs] #lablog "@- [vbs] ............" #main.runListing, "!hide" #main.makeproject, "!hide" #main.remakeproject, "!hide" #main.runjb, "!show" #main.addListing, "!show" #main.deleteListing, "!show" #main.editInNotepad, "!show" #main.editInNotepad, "!show" call saveValue #main.value, "!cls" categorie$ = vbs$ call resetRadioOptions #main.addListing, "&New ";categorie$;" Script" category$ = categorie$ #main.choose, "Select a ";category$;" Script" wait
[ps1] #lablog "@- [ps1] ............" #main.runListing, "!hide" #main.makeproject, "!hide" #main.remakeproject, "!hide" #main.runjb, "!show" #main.addListing, "!show" #main.deleteListing, "!show" #main.editInNotepad, "!show" #main.editInNotepad, "!show" call saveValue #main.value, "!cls" categorie$ = ps1$ call resetRadioOptions #main.addListing, "&New ";categorie$;" Script" category$ = categorie$ #main.choose, "Select a ";category$;" Script" wait
[cmd] #lablog "@- [cmd] ............" #main.runListing, "!hide" #main.makeproject, "!hide" #main.remakeproject, "!hide" #main.addListing, "!show" #main.deleteListing, "!show" #main.runjb, "!show" #main.editInNotepad, "!show" call saveValue #main.value, "!cls" categorie$ = cmd$ call resetRadioOptions #main.addListing, "&New ";categorie$;" Script" category$ = categorie$ #main.choose, "Select a ";category$;" Script" wait
[js] #lablog "@- [js] ............" #main.runListing, "!hide" #main.makeproject, "!hide" #main.remakeproject, "!hide" #main.runjb, "!show" #main.addListing, "!show" #main.deleteListing, "!show" #main.editInNotepad, "!show" call saveValue #main.value, "!cls" categorie$ = js$ call resetRadioOptions #main.addListing, "&New ";categorie$;" Script" category$ = categorie$ #main.choose, "Select a ";category$;" Script" wait
[html] #lablog "@- [html] ............" #main.runListing, "!hide" #main.makeproject, "!hide" #main.remakeproject, "!hide" #main.runjb, "!show" #main.addListing, "!show" #main.deleteListing, "!show" #main.editInNotepad, "!show" call saveValue #main.value, "!cls" categorie$ = html$ call resetRadioOptions #main.addListing, "&New ";categorie$;" Script" category$ = categorie$ #main.choose, "Select a ";category$;" Script" wait
[help] #lablog "@- [help] ............" #main.runListing, "!hide" #main.makeproject, "!hide" #main.remakeproject, "!hide" #main.runjb, "!show" #main.addListing, "!show" #main.deleteListing, "!show" #main.editInNotepad, "!show" call saveValue #main.value, "!cls" categorie$ = help$ call resetRadioOptions category$ = categorie$ #main.addListing, "&New ";category$ #main.choose, "Select a ";category$;" Topic" wait
'open windows taskmanager (used to kill "non responsive" code (usually caught in loops) [taskman] #lablog "@- [taskman] ............" run "taskmgr.exe" wait
'open Windows Calculator [calc] #lablog "@- [calc] ............" run "calc.exe" wait
'open Windows Notepad [openNotePad] #lablog "@- [notepad] ............" run "notepad.exe" wait
'open Windows Voice recorder [record] #lablog "@- [record] ............" run "explorer.exe shell:appsFolder\Microsoft.WindowsSoundRecorder_8wekyb3d8bbwe!App" wait
'open the following in Windows Explorer [projectsDir] #lablog "@- [projectsDir] ............" run "explorer.exe ";q$;DefaultDir$;"\";"savedProjects";q$ wait
[exeDir] #lablog "@- [exeDir] ............" run "explorer.exe ";q$;DefaultDir$;"\";"EXE";q$ wait
[spritesDir] #lablog "@- [spritesDir] ............" jbusppath$ = upath$;"\AppData\Roaming\Just Basic v2.0\SPRITES" run "explorer.exe ";q$;jbusppath$;q$ wait
[tknDir] #lablog "@- [tknDir] ............" a$ = DefaultDir$;"\TKN" run "explorer.exe ";q$;a$;q$ wait
[jbfunctionsDir] #lablog "@- [jbfunctionsDir] ............" jbufpath$ = upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions" print "jbufpath$ = ";jbufpath$ 'for testing with mainwin print "upath$ = ";upath$ 'for testing with mainwin run "explorer.exe ";q$;jbufpath$;q$ wait
[bmpDir] #lablog "@- [bmpDir] ............" jbuspath$ = upath$;"\AppData\Roaming\Just Basic v2.0\bmp" run "explorer.exe ";q$;jbuspath$;q$ wait
[jbexamplesDir] #lablog "@- [jbexamplesDir] ............" jbuepath$ = upath$+"\AppData\Roaming\Just Basic v2.0" run "explorer.exe ";q$;jbuepath$;q$ wait
[preferences] confirm "I don't need no stinkin help file. I'm too smart to need help from a file";b$ wait
[about] #lablog "@- [about] ............" message$ = chr$(13);" JB Help Lab and Project Manager v1.0";_ chr$(13);_ chr$(13);_ " Created by xxgeek";_ chr$(13);_ chr$(13);_ " Date - Oct 28 2021";_ chr$(13);_ chr$(13);_ " Purpose - To Help New Just Basic Coders with Information, Help, plus Examples";_ " and the ability to automatically manage and organize their coded, compiled, TKN,d and EXE,d projects.";_ " With Functions, Subroutines, code samples, code generators, searchable Help Files,";_ " ASCII codes, Reserved Words, MSpaint, notepad, error logs etc, at their FingerTips";_ chr$(13);_ chr$(13);_ " Just Basic Help Lab and Project Manager Is a collection of programs created by";_ " the creator of Just Basic, Carl Gundel";_ " and members of the Just Basic forums @ https://justbasiccom.proboards.com";_ " Stitched together with added programs, features and abilities to enhance and";_ " make more efficient, the Just Basic coding experience with help at the users finger tips";_ " by utuizing the built in abilities, and files of Just Basic v2.0 and Windows 10";_ chr$(13);_ chr$(13);_ " Credit goes to cundo for jbsearch(the JB help file search engine)";_ " Credit also goes to cundo for the fastcode(window code generator)";_ " Credit goes to Carl Gundel for the Dictionary code(handling the categories";_ " lists, and texteditor data saving and retrieval (not to mention Carl Gundel";_ " gives Just Basic away FREE! with runtime files so your projects are royalty FREE)";_ " Credit goes to Rod, not only for his SpriteCreator program, but for his many";_ " answers to my difficult questions, while at times going out of his way to help.";_ " Last, but not least, rather most importantly credit goes to a member - handle name";_ " tsh73 for his proof of concept code demonstrating that the TKN file can be created;";_ " using jb code (that got this project off the ground), his help whenever needed,";_ " his ideas, programming skills and his abilty to dig into posted code and fix problem issues" a$ = GetMessage$(message$) wait
[jberrorLog] jberrorlog$ = "error.log" #lablog "@- [jberrorLog]opening the jb error log ............" if fileExists(upath$;"\AppData\Roaming\Just Basic v2.0", jberrorlog$) then run "notepad ";q$;upath$;"\AppData\Roaming\Just Basic v2.0\error.log";q$ else if fileExists(upath$;"\Application Data\Just Basic v2.0", jberrorlog$) then run "notepad ";q$;upath$;"\Application Data\Just Basic v2.0\error.log";q$ else notice "Can't find the JB error log" end if end if wait
[labLog] #lablog "@- [labLog] User clicked to open error log closing error log temporarily............" close #lablog lablog$ = "lablog.log" run "notepad ";lablog$ open lablog$ for append as #lablog wait
[jbHelpLabHelp] #lablog "@- [jbHelpLabHelp] ............" message$ = "Not in this Version, please try without Help";chr$(13);"You Should be able to Figure it out" a$ = GetMessage$(message$) wait
'open Just Basic IDE [jbProgs] #lablog "@- [jbProgs] ............" run JBpath$;"\";JBexe$ wait
'open mspaint for creating pictures (bmp, jpg, icons, etc) [pictures] #lablog "@- [pictures] ............" run "mspaint.exe" wait
'download Rod's SpriteCreator [sprites] #lablog "@- [sprites] ............" spriteEXEpath$ = DefaultDir$;"\SpriteCreator v2" if fileExists(spriteEXEpath$,"SpriteCreator.exe") <> 0 then run "SpriteCreator v2\SpriteCreator.exe" : wait answer$ = "Of Course I Do" prompt "Not Implimented "+chr$(13)+"Download Rod's SpriteMaker v2.0 ?";answer$ if answer$ <> "Of Course I Do" then wait file2down$ = "https://gamebin.webs.com/SpriteCreator%20v2.zip" if fileExists(DefaultDir$ , "SpriteCreator%20v2.zip") <> 0 then [alreadyDownloaded] run "curl -O ";q$;file2down$;q$ cursor hourglass call pause 4000 cursor normal
[alreadyDownloaded] #lablog "@- [alreadyDownloaded] ............" do if fileExists(DefaultDir$, "SpriteCreator%20v2.zip") <> 0 then exit do scan loop until res
'run "PowerShell.exe Expand-Archive -Path SpriteCreator%20v2.zip -DestinationPath ";DefaultDir$',HIDE spriteCreatorPath$ = DefaultDir$;"\SpriteCreator v2" res = fileExists(DefaultDir$, "SpriteCreator v2\SpriteCreator.bas") #lablog "if SpriteCreator .bas exists heading to [makeexe]............" if res then spritecreated = 1 : goto [makeEXE]
do res = fileExists(DefaultDir$, "SpriteCreator v2\SpriteCreator.bas") if res then exit do notice "Sorry, Can't find ";"SpriteCreator.bas" : spritecreated = 0 scan loop until res #lablog "SpriteCreator .bas exists heading to [makeexe]............" spritecreated = 1 goto [makeEXE] wait
' a program to select a bas file to get it's Line count [numofLines] #lablog "@- [numofLines]............" dim line$(20000) filedialog "Open \ Select a Just Basic Source File (.bas) ", DefaultDir$; "\*.bas", file2Check$ if file2Check$ = "" then wait open file2Check$ for input as #1 while eof(#1) = 0 line input #1, line$(x) spaces$ = line$(x) if spaces$ = "" then y = y + 1 x = x +1 wend close #1 file2Check$ = GetFilename$(file2Check$) message$ = chr$(13);chr$(13);" ";file2Check$;chr$(13);chr$(13);" ";x-y;" lines of code";chr$(13);" ";y;" lines of spaces ";chr$(13);" ";x;" lines in total";chr$(13);" Approx ";x/25;" pages" message$ = GetMessage$(message$) wait
'subroutine for selections of combo boxes #lablog "entering sub asciiSelected asciiList$..........." sub asciiSelected asciiList$ #main.asciiList, "selection? asciiChoice$" end sub
sub jbsampleSelected jbsamplesList$ #lablog "entering sub jbsampleSelected jbsamplesList$..........." q$ = chr$(34) call saveValue print "jbSamplesPath = ";upath$;"\AppData\Roaming\Just Basic v2.0\";jbsamps$ #main.jbsamplesList, "selection? jbsamps$" jbsamps$ = jbsamps$;".bas" runFile$ = upath$;"\AppData\Roaming\Just Basic v2.0\";jbsamps$ print "jbSamplesPath = ";upath$;"\AppData\Roaming\Just Basic v2.0\";jbsamps$ jbRunIt$ = JBpath$;"\";JBexe$ if fileExists(upath$;"\AppData\Roaming\Just Basic v2.0", jbsamps$) <> 0 then runFile$ = upath$;"\Application Data\Just Basic v2.0\";jbsamps$ run q$;jbRunIt$;q$;" ";q$;runFile$;q$ else if fileExists(upath$;"\Application Data\Just Basic v2.0", jbsamps$) <> 0 then runFile$ = upath$;"\Application Data\Just Basic v2.0\";jbsamps$ run q$;jbRunIt$;q$;" ";q$;runFile$;q$ else notice "Can't find ";jbsamps$;".txt" end if end if end sub
sub jbfunctionSelected jbfunctionsList$ #lablog," entering sub jbfunctionSelected jbfunctionsList$" call saveValue #main.jbfunctionsList, "selection? jbfuncs$" jbfuncs$ = jbfuncs$;".txt" if fileExists(upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions", jbfuncs$) <> 0 then jbRunIt$ = JBpath$;"\";JBexe$ runFile$ = upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions\";jbfuncs$ run q$;jbRunIt$;q$;" ";q$;runFile$;q$ else if fileExists(upath$;"\Application Data\Just Basic v2.0\FFFunctions", jbfuncs$) <> 0 then runFile$ = upath$;"\Application Data\Just Basic v2.0\FFFunctions\";jbfuncs$ jbRunIt$ = JBpath$;"\";JBexe$ run q$;jbRunIt$;q$;" ";q$;runFile$;q$ else notice "can't find ";jbfuncs$ end if end if end sub
sub jbdialogSelected jbdialogsList$ #lablog," entering sub jbdialogSelected jbdialogsList$" q$ = chr$(34) call saveValue #main.jbdialogsList, "selection? jbdialog$" if jbdialog$ = " Color Dialog" then runFile$ = JBpath$;"\jb2help\JustBASIC_2_web\html\libe00mf.htm" if jbdialog$ = " Printer Dialog" then runFile$ = JBpath$;"\jb2help\JustBASIC_2_web\html\libe72sp.htm" if jbdialog$ = " File Dialog" then runFile$ = JBpath$;"\jb2help\JustBASIC_2_web\html\libe7ezo.htm" if jbdialog$ = " All JBDialogs" then runFile$ = JBpath$;"\jb2help\JustBASIC_2_web\html\libe6gmr.htm" if jbdialog$ = " Font Dialog" then runFile$ = JBpath$;"\jb2help\JustBASIC_2_web\html\libe7sc5.htm" if jbdialog$ = " Confirm Dialog" then runFile$ = JBpath$;"\jb2help\JustBASIC_2_web\html\libe4pps.htm" if jbdialog$ = " Notice Dialog" then runFile$ = JBpath$;"\jb2help\JustBASIC_2_web\html\libe1836.htm" if jbdialog$ = " Prompt Dialog" then runFile$ = JBpath$;"\jb2help\JustBASIC_2_web\html\libe2p4c.htm" print "jbDialogselected =";runFile$ 'for testing with mainwin if fileExists(DefaultDir$,"htmlviewer.exe") <> 0 then run "htmlviewer.exe ";runFile$ else run "explorer.exe ";runFile$ end if end sub
sub jbreservedwordSelected jbreservedwordList$ #lablog," entering sub jbreservedwordSelected jbreservedwordList$ " call saveValue #main.jbdialogsList, "selection? jbreserved$" end sub
sub jbbakfileSelected jbbakfilesList$ #lablog," entering sub jbbakfileSelected jbbakfilesList$ " q$ = chr$(34) call saveValue #main.jbbakfilesList, "selection? jbbakfile$" jbbakfile$ = jbbakfile$;".bak" print "jbbakfilePath = ";upath$;"\AppData\Roaming\Just Basic v2.0\bak";jbbakfile$ if fileExists(upath$;"\AppData\Roaming\Just Basic v2.0\bak", jbbakfile$) <> 0 then runFile$ = upath$;"\AppData\Roaming\Just Basic v2.0\bak\";jbbakfile$ jbRunIt$ = JBpath$;"\";JBexe$ run q$;jbRunIt$;q$;" ";q$;runFile$;q$ else if fileExists(upath$;"\Application Data\Just Basic v2.0\bak\", jbbakfile$) <> 0 then runFile$ = upath$;"\Application Data\Just Basic v2.0\bak\";jbbakfile$ jbRunIt$ = JBpath$;"\";JBexe$ run q$;jbRunIt$;q$;" ";q$;runFile$;q$ else notice "can't find ";jbbakfile$ end if end if end sub
'next few subroutines to GET the info to populate the combo boxes sub getAscii #lablog," entering sub getAscii" dim asciiList$(250) y = 7 asciiList$(0)= " Controls" asciiList$(1) = " chr$(0) = (nul) ";chr$(0) asciiList$(2) = " chr$(27) = (escape) ";chr$(27) asciiList$(3) = " chr$(32) = (space) ";chr$(32) asciiList$(4) = " chr$(13) = (enter) ";chr$(13) asciiList$(5) = " Printables" asciiList$(6) = " chr$(32)= (space) ";chr$(32) for x = 33 to 255 print "asciiList$(y) = ";"chr$(";x;") = ";chr$(x) asciiList$(y) = " chr$(";x;") = ";chr$(x) y = y + 1 next x #main.asciiList, "reload" end sub
sub getjbsamples #lablog," entering sub getjbsamples " q$ = chr$(34) dim folderInfo$(1, 1) dim jbsamplesList$(10) files upath$;"\Application Data\Just Basic v2.0\", folderInfo$() numberoFiles = val(folderInfo$(0, 0)) redim jbsamplesList$(numberoFiles) for x = 1 to numberoFiles print folderInfo$(x, 0) filename$ = folderInfo$(x, 0) if right$(filename$, 3) <> "bas" and right$(filename$, 3) <> "BAS" then [discardThisLine] jbsamplesList$(x) = left$(filename$, len(filename$) - 4) print "folderInfo$(x, 0) = ";folderInfo$(x, 0) print " jbsamplesList$(x) = ";jbsamplesList$(x) [discardThisLine] next x sort jbsamplesList$(), 0 ,numberoFiles #main.jbsamplesList, "reload" end sub
sub getjbfunctions #lablog," entering sub getjbfunctions" q$ = chr$(34) dim folderInfo$(1, 1) dim jbfunctionsList$(10) files upath$;"\Application Data\Just Basic v2.0\FFFunctions", folderInfo$() numFiles = val(folderInfo$(0, 0)) redim jbfunctionsList$(numFiles) for x = 1 to numFiles print folderInfo$(x, 0) filename$ = folderInfo$(x, 0) if right$(filename$, 3) <> "txt" then [skip] jbfunctionsList$(x) = left$(filename$, len(filename$) - 4) print "folderInfo$(x, 0) = ";folderInfo$(x, 0) print " jbfunctionsList$(x) = ";jbfunctionsList$(x) [skip] next x sort jbfunctionsList$(), 0 ,numFiles #main.jbfunctionsList, "reload" end sub
sub getjbdialogs #lablog," entering sub getjbdialogs" q$ = chr$(34) jbFontDialog$ = " All JBDialogs, Prompt Dialog, Notice Dialog, Font Dialog, Color Dialog, File Dialog, Printer Dialog, Confirm Dialog" for x = 1 to 8 print "filename$ = ";word$(jbFontDialog$, x, ",") filename$ = word$(jbFontDialog$, x, ",") jbdialogsList$(x) = filename$ print "jbdialogsList$(x) = ";jbdialogsList$(x) next x sort jbdialogsList$(), 0 ,8 #main.jbdialogsList, "reload" end sub
sub getjbreservedwords #lablog," entering sub getjbreservedwords " q$ = chr$(34) dim jbreservedwordsList$(180) for x = 1 to 180 filename$ = word$(jbReservedWords$, x ,",") print "filename$ = ";filename$ jbreservedwordsList$(x) = filename$ print "jbreservedwordsList$ = ";jbreservedwordsList$(x) next x sort jbreservedwordsList$(), 0 ,180 #main.jbreservedwordsList, "reload" end sub
sub getjbBakFiles #lablog," entering sub getjbBakFiles " q$ = chr$(34) dim folderInfo$(1, 1) dim jbbakfilesList$(500) files upath$;"\Application Data\Just Basic v2.0\bak", folderInfo$() numberOfFiles = val(folderInfo$(0, 0)) redim jbbakfilesList$(numberOfFiles) For x = 1 to numberOfFiles print folderInfo$(x, 0) filename$ = folderInfo$(x, 0) if right$(filename$, 3) <> "bak" then [skip] jbbakfilesList$(x) = left$(filename$, len(filename$) - 4) print "folderInfo$(x, 0) = ";folderInfo$(x, 0) print " jbbakfilesList(x) = ";jbbakfilesList$(x) [skip] Next x sort jbbakfilesList$(), 0 ,numFiles #main.jbbakfilesList, "reload" #lablog, "got jbBakFiles List......" end sub
sub resetRadioOptions #lablog," entering sub resetRadioOptions" 'dictionary$ = "" : keyCount = 0 : selectedKey$ = "" : lastKey$ = "" call readDictionary call loadKeys #main.value, "!origin 0, 0 " #main.value, "!setfocus" #main.keys, "singleclickselect" end sub
'subroutine to GET the current Users HomePath sub getUserPath #lablog," entering sub getUserPath" cursor hourglass run "cmd.exe /c echo %userprofile% |clip", HIDE call pause 3000 open "GetUserPath" for text as #1 #1 "!paste" #1 "!contents? upath$" upath$ = trim$(upath$) print "upath$ = ";upath$ 'print for testing with mainwin close #1 cursor normal end sub
'create a project and tkn file and add it to the MyProjects List [makeproject] #lablog," @ - [makeproject]" tkn = 2 goto [bas2exe]
[remakeproject] if selectedKey$ = "" then notice "No Listing was selected. Select an item from the list and try again " : wait #lablog," @ - [remakeproject]" tkn = 4 fname$ = savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas" goto [bas2exe]
[bas2tkn] #lablog," @ - [bas2tknt" tkn = 3 goto [bas2exe]
'BAS2EXE Version v1.8a For Linux/WINE, Windows 10 (possibly XP, Win 7, 8) 'Date = July 2021 'Title - BAS2EXE v1.8 'Author - xxgeek, a member of the justbasiccom.proboards.com/ forums a = a+ 1 print "Starting into BAS2EXE" [bas2exe] #lablog," @ - [bas2exe]" if tkn = 0 then print "@ [bas2exe] Starting - Running BAS<2>EXE full project, no new listing" if tkn = 2 then print "@ [bas2exe] Starting - Making New Project, plus creating new listing in MyProjects category" if tkn = 3 then print "@ [bas2exe] Starting - Making TKN, plus adding listing in Programs category" if tkn = 4 then print "@ [bas2exe] Starting to remake project";selectedKey$;" ReWriting MyProjects Listing" p = 0 'passworded exe defaults to false titlebar$ = "BAS2EXE v1.8"
project = 1
'check Just Basic v2.0 Default Install Dir for existence JBpath$ = "c:\Program Files (x86)\Just Basic v2.0" res=pathExists(JBpath$)
'if Just Basic v2.0 is NOT installed to it's Default Install Dir, get Path from User using folder dialog if res then [go] else notice chr$(13)+" Just Basic v2.0 was not installed to the default install folder." +chr$(13)+"Hit [ok], then Select the Folder Just Basic v2.0 is Installed"
'if folder path chosen by user for Just Basic install is wrong catch error later with check for jbrun2.exe caption$ = "Select your Just Basic v2.0 install Dir" a$ = FolderDialog$(caption$) JBpath$ = FolderDialog$
print "jb install path = ";FolderDialog$ #lablog,"Got jb install path using VBS FolderDialog Script = ";FolderDialog$
[go] #lablog," @ - [go] - Starting to make window for make tkn, bas2exe, or makeproject" print "@ [go] - Starting to make window" print " " if tkn = 3 or tkn = 4 then [spriteOnly] if spritecreated = 1 then [spriteOnly]
' setup a Window for User to Select a .bas File to Make a Project with 'nomainwin WindowWidth = 600 WindowHeight = 380 UpperLeftX=INT((DisplayWidth-WindowWidth)/2) UpperLeftY=INT((DisplayHeight-WindowHeight)/2) BackgroundColor$ = "lightgray" ForegroundColor$ = "black"
'add some text ,some buttons, and checkboxes to the Window statictext #pick.header, " BAS <2> EXE", 165, 20, 590, 45 statictext #pick.exe, "EXE FILE", 15, 70, 105, 30 statictext #pick.temp, "Temp Files", 390, 70, 105, 30 statictext #pick.datedtext, "Dated Files", 190, 70, 105, 30 statictext #pick.info, "Select a working Just Basic Source Code File (.bas)", 30, 220, 590, 30 statictext #pick.jbforums, "Visit the Just Basic Forums @ https://justbasiccom.proboards.com/", 90, 335, 590, 20
checkbox #pick.password, "Passworded", [yespass], [nopass], 20, 180, 140, 20 checkbox #pick.bit32, "32 Bit", [bit32], [nobit32], 20, 105, 80, 20 checkbox #pick.bit64, "64 Bit", [bit64], [nobit64], 20, 130, 80, 20 checkbox #pick.incbas, "Include Source", [incsource], [noincsource], 20, 155, 140, 20 checkbox #pick.sed, "Keep SED", [sed], [nosed], 400, 105, 140, 20 checkbox #pick.vbs, "Keep VBS", [keepvbs], [novbs], 400, 130, 140, 20 checkbox #pick.project, "Keep Project Dir", [project], [noproject], 400, 155, 160, 20 checkbox #pick.TKN, "Don't SaveTKN", [noTKN], [yesTKN], 200, 105, 140, 20 checkbox #pick.BAS,"Don't Save BAS", [noBAS], [yesBAS], 200, 130, 140, 20
button #pick.default, "Select File", [defaultClick],UL 140, 270, 135, 35 button #pick.32, "Cancel", [cancel],UL 320, 270, 135, 35
'open the Window, and set some Fonts for each statictext, and buttons open "BAS2EXE v1.8" for window_nf as #pick #pick, "trapclose [quit.pick]" #pick.project, "set" #pick, "font Arial 10 bold" #pick.header, "!font Arial 24 bold" #pick.exe, "!font Arial 14 bold" #pick.temp, "!font Arial 14 bold" #pick.datedtext, "!font Arial 14 bold" #pick.sed, "font Arial 12 bold" #pick.vbs, "font Arial 12 bold" #pick.project, "font Arial 12 bold" #pick.TKN, "font Arial 12 bold" #pick.BAS, "font Arial 12 bold" #pick.password, "font Arial 12 bold" #pick.info, "!font Arial 18 bold" #pick.jbforums "!font Arial 10 bold" #pick.32, "!font Arial 12 bold" #pick.bit64, "font Arial 12 bold" #pick.bit32, "font Arial 12 bold" #pick.incbas, "font Arial 12 bold" #pick.default, "!font Arial 12 bold" #pick.default, "!setfocus" print "window up and running "
if tkn = 1 then #pick.exe "!HIDE" #pick.header "Make TKN File" #pick.bit64, "HIDE" #pick.bit32, "HIDE" #pick.sed, "HIDE" #pick.vbs, "HIDE" end if
if tkn = 2 then #pick.project, "HIDE" #pick.temp, "!HIDE" #pick.datedtext, "!HIDE" #pick.incbas, "HIDE" #pick.exe "!HIDE" #pick.header "Make New project" #pick.bit64, "HIDE" #pick.bit32, "HIDE" #pick.sed, "HIDE" #pick.vbs, "HIDE" #pick.TKN, "HIDE" #pick.BAS, "HIDE" #pick.password, "HIDE" end if wait
[incsource] #lablog," @ - [incsource] - include source checkbox selected" incbas = 1 wait [noincsource] #lablog," @ - [noincsource] - include source checkbox deselected" incbas = 0 wait [sed] #lablog," @ - [sed] " sed = 1 wait [nosed] #lablog," @ - [nosed] " sed = 0 wait [keepvbs] #lablog," @ - [keepvbs] " vbs = 1 wait [novbs] #lablog," @ - [novbs] " vbs = 0 wait [project] #lablog," @ - project] " project = 1 wait [noproject] #lablog," @ - [noproject] " project = 0 wait [yesTKN] #lablog," @ - [yesTKN] " tkn = 0 wait [noTKN] #lablog," @ - [noTKN] " tkn = 1 wait [yesBAS] #lablog," @ - [yesBAS] " bas=0 wait [noBAS] #lablog," @ - [noBas] " bas = 1 wait
' passworded exe is true(user selected) [yespass] #lablog," @ - [yespass] " p=1 wait 'passworded exe is false, default [nopass] #lablog," @ - [nopass] " p=0 wait
'make 32 bit exe = true(user selected) [bit32] #lablog," @ - [bit32] " bit=32 #pick.bit64, "hide" wait
'make 64 bit exe, default [bit64] #lablog," @ - [bit64] " bit=64 #pick.bit32, "hide" wait
[nobit32] #lablog," @ - [nobit32] " bit=64 #pick.bit64, "show" wait
[nobit64] #lablog," @ - [nobit64] " bit=0 #pick.bit32, "show" wait
'close the opening window for Selecting bas file [defaultClick] #lablog, "Select File button pressed - closing Select Source File window " print "Select File button pressed - closing Select Source File window " close #pick
'check existence and JBPath$ (Just Basic default install dir) #lablog, "checking path existence for ";JBpath$ res = pathExists(JBpath$) if res then a = a + 1 else notice " Just Basic v2.0 was not was not found in ";JBpath$;" Restart BAS2EXE - Try Again":end
[spriteOnly] print "@ [spriteOnly]" #lablog," @ - [spriteOnly] " ' Just Basic 2 is installed - continue on 'define some variables 'p=0 'passworded exe = false 'JBexe$ = "jbasic.exe" 'JBruntime$ = "jbrun2.exe" DllList$="vbas31w.sll vgui31w.sll voflr31w.sll vthk31w.dll vtk1631w.dll vtk3231w.dll vvm31w.dll vvmt31w.dll" savedProjects$ = "savedProjects" #lablog, "Checking existence for JBrun$ JBexe$ JBpath$, and all the supproting dll and sll files." 'Checking all paths and file locations for existence (dll's, sll's, jbasic.exe, and jbrun2.exe) res=fileExists(JBpath$, JBexe$) if res then a = a + 1 else notice JBexe$;" Does not exist in ";JBpath$;" Closing BAS2EXE" : end res=fileExists(JBpath$,JBruntime$) if res then a = a + 1 else notice JBrun$;" Does not exist in ";JBpath$;" Closing BAS2EXE" : end res=fileExists(JBpath$,"vbas31w.sll") if res then a = a + 1 else notice " vbas31w.sll Does not exist in ";JBpath$;" Closing BAS2EXE" : end res=fileExists(JBpath$,"vgui31w.sll") if res then a = a + 1 else notice " vgui31w.sll Does not exist in ";JBpath$;" Closing BAS2EXE" : end res=fileExists(JBpath$,"voflr31w.sll") if res then a = a + 1 else notice " voflr31w.sll Does not exist in ";JBpath$;" Closing BAS2EXE" : end res=fileExists(JBpath$,"vthk31w.dll") if res then a = a + 1 else notice " vthk31w.dll Does not exist in ";JBpath$;" Closing BAS2EXE" : end res=fileExists(JBpath$,"vtk1631w.dll") if res then a = a + 1 else notice " vtk1631w.dll Does not exist in ";JBpath$;" BAS2EXE" : end res=fileExists(JBpath$,"vtk3231w.dll") if res then a = a + 1 else notice " vtk3231w.dll Does not exist in ";JBpath$;" BAS2EXE" : end res=fileExists(JBpath$,"vvm31w.dll") if res then a = a + 1 else notice " vvm31w.dll Does not exist in ";JBpath$;" BAS2EXE" : end res=fileExists(JBpath$,"vvmt31w.dll") if res then a = a + 1 else notice " vvmt31w.dll Does not exist in ";JBpath$;" Closing BAS2EXE":end #lablog," all support files dll's sll's jbrun2.exe, and jbasic.exe accounted for " ' all needed files accounted for 'prompt user for a password to start the created EXE File if p=0 then [filediag] #lablog, "Prompting user for password to add to the exe file about to be created" if p= 1 then Prompt "TYPE a PASSWORD"+chr$(13)+ "Password for EXE file is: (no spaces)";passwerd$ if passwerd$ = "" then notice "BAS2EXE will continue, without placing a password on the EXE file created" : p = 0
' Use the filedialog function to allow user to select a source file (.bas) [filediag] print "Opening FileDialog - User chooses .bas file to create TKN, EXE, or Project" if spritecreated = 1 then fname$ = DefaultDir$;"\SpriteCreator v2\SpriteCreator.bas" : goto [spriteOnly2] if tkn = 4 then [spriteOnly2] print "Opening FileDialog - User chooses .bas file to create TKN, EXE, or Project" #lablog, "Opening FileDialog - User chooses .bas file to create TKN, EXE, or Project" 'open file dialog to choose a .bas file for exe conversion filedialog "Open \ Select a Just Basic Source File (.bas) ", DefaultDir$; "\*.bas", fname$ if fname$ = "" then notice "No file selected" : wait
[spriteOnly2] 'to make sure the jb support files are in the SpriteCreator v2 folder print "file chosen = ";fname$ #lablog, "file chosen = ";fname$ print "separating name from path, and name from extension" #lablog, "separating name from path, and name from extension" 'Separate path from selected filename, and extension from selected filename for var1 = len(fname$) to 1 step -1 if mid$(fname$, var1, 1) = "\" then var2 = var1 -1 : var3 = var2 - ((len(fname$))) : exit for next var1 var3 = abs(var3) orig$ = left$(fname$, var2) fname0$ = right$(fname$, var3 -1)
'this block became unecessary, but some may find it useful code to copy for other purposes 'remove any spaces from filename 'dim s$(250) 'for x = len(fname0$) to 1 step -1 ' s$(x) = mid$(fname0$,x, 1) 's$=s$(x) ' if s$ <> " " then s2$ = s$;s2$ 's$=s2$ 'next x 'fname0$ = s$
'finish separating filename from extension for var4 = len(fname0$) to 1 step -1 if mid$(fname0$, var4, 1) = "." then var5 = var4 -1 : var6 = var5 - ((len(fname0$))) : exit for next var4 var6 = abs(var6) fnamenobas$ = left$(fname0$, var5) ' fname$ = Full Path of User Selected .bas file (including the filename.bas) ' fname0$ = Name of the Selected .bas File Only - eg ; filename.bas ' fnamenobas$ = Name of the Selected .bas File (without the .bas) - eg: filename print "finished separating........." [begin] print "@ [begin] creating folders for projects, exe'e, sed's, vbs, and tkn files" #lablog, "@ [begin] creating folders for projects, exe'e, sed's, vbs, and tkn files" 'define Destpath1$ as JB Projects\Current Project Folder DestPath$=DefaultDir$ 'Where this file is RUN from DestPathU$ = DestPath$;"\";savedProjects$ 'Projects Folder DestPath1$=DestPathU$;"\";fnamenobas$ 'Current created Project Folder
'Make Folders for Just Basic Projects, EXE files, TKN files, BAS files, SED files and Current Projects res = mkdir(DestPathU$) 'projects dir res = mkdir(DestPath1$) 'new project dir = name of selected bas file (no .bas) in Projects Dir res =mkdir(DefaultDir$;"\";"EXE") 'exe files saved here res = mkdir(DefaultDir$;"\";"TKN") 'tkn files saved here res= mkdir(DefaultDir$;"\";"BAS") 'selected bas file saved here (includes password code if exe was passworded) res= mkdir(DefaultDir$;"\";"SED") ' saves the created SED file (self extracting directive) res= mkdir(DefaultDir$;"\";"VBS") ' saves VBS file (.vbs script that auto clicks `save tkn`, and `saved as` buttons)
'make sure Folders were actually created res=pathExists(DestPathU$) if res then a=a+1 else notice "savedProjects folder was NOT Created in ";DestPath$ : end res=pathExists(DestPath1$) if res then a=a+1 else notice "New Folder ";fnamenobas$;" was NOT Created in ";DestPath1$ : end tknFolder$=DefaultDir$;"\";"TKN" res=pathExists(tknFolder$) if res then a=a+1 else notice "TKN Folder was NOT Created in ";DestPath$ : end basFolder$=DefaultDir$;"\";"BAS" res=pathExists(basFolder$) if res then a=a+1 else notice "BAS Folder was NOT Created in ";DestPath$ : end print "folders created, and verified........." #lablog, "folders created, and verified........."
if spritecreated = 1 or tkn = 4 then [noDelete]
'remove existing fname0$ from dir before creating new one print "removing existing same name file prior to copying bas file to new project dir" #lablog, "removing existing same name file prior to copying bas file to new project dir" if fileExists(DestPath1$, fname0$) <> 0 then kill DestPath1$;"\";fname0$
[noDelete] 'copy selected bas file to Projects\current project folder q$= chr$(34) if spritecreated = 1 then DestPath1$ = DefaultDir$;"\SpriteCreator v2" print "copying selected bas file to Projects\current project folder" #lablog, "removing existing same name file prior to copying bas file to new project dir" open fname$ for input as #fname fnameTemp$="tempBas.bas" open fnameTemp$ for output as #2
'add a password prompt to the begining of the temp bas file(to be added to the exe) if p=0 then [nopasswerd] ' #lablog, "Prompting user for password to temp bas file used for EXE file creation............" print "Prompting user for password to temp bas file used for EXE file creation" #2, "prompt ";q$;"Enter the Password";q$;";";"passwerd$" #2, "if passwerd$ <> ";q$;passwerd$;q$;" then end" print "password appended to temp bas file " #lablog, "password appended to temp bas file for password to temp bas file used for EXE file creation............" [nopasswerd] #2, input$(#fname, lof(#fname)); close #fname close #2 #lablog, "copying ";fnameTemp$;" to current project folder";DestPath$;" for input " print "opening fnameTemp$ for input"
'copy temp.bas file to current project folder open fnameTemp$ for input as #1 if fileExists(DestPath1$, fname0$ ) <> 0 then kill DestPath1$;"\";fname0$ open DestPath1$;"\";fname0$ for output as #2 print #2, input$(#1, lof(#1)); close #2 close #1
'check if the current project .bas file was copied to new dir res=fileExists(DestPath1$,fname0$) if res then a = a + 1 else notice fname0$; " Was not copied to ";DestPath1$;" P.O. will now close" : close #b2e : end print "finished copying and verifying bas file exists new project dir........" #lablog, "finished copying and verifying bas file exists new project dir........"
'copy selected .bas file to BAS dir and date it print "start copying bas file to BAS dir and dating it........" #lablog, "start copying bas file to BAS dir and dating it........" open DestPath1$;"\";fname0$ for input as #file open DestPath$;"\";"BAS\";fnamenobas$;fixeddate$;".bas" for output as #1 print #1, input$(#file, lof(#file)); close #file close #1
'remove any existing exe of same name as bas file selected only if created on same date print "remove any existing exe of same name as bas file selected only if created on same date." #lablog, "removeing any existing exe of same name as bas file selected only if created on same date" if fileExists(DestPath$;"\EXE", fnamenobas$;fixeddate$;".exe.BAK") then kill DestPath$;"\";"EXE";"\";fnamenobas$;fixeddate$;".exe.BAK" res = fileExists(DestPath$;"\EXE", fnamenobas$;fixeddate$;".exe") if res then name DestPath$;"\";"EXE";"\";fnamenobas$;fixeddate$;".exe" as fnamenobas;fixeddate$;".exe.BAK" print "finished checking and deleting existing bas file in BAS dir..........." print "starting copying necessary dll, and sll files to new project dir......."
'Copy the needed DLL and SLL files from Just Basic dir to projects\projectname Dir print "Copying the needed DLL and SLL files from Just Basic dir to projects\projectname Dir" #lablog, "Copying the needed DLL and SLL files from Just Basic dir to projects\projectname Dir" runtimeSupportFile$ = "" i = 0 while 1 i = i + 1 runtimeSupportFile$=word$(DllList$,i) if runtimeSupportFile$ ="" then exit while sourceFile$=JBpath$;"\";runtimeSupportFile$ destinationFile$=DestPath1$;"\";runtimeSupportFile$ if spritecreated = 1 then destinationFile$ = DefaultDir$;"\SpriteCreator v2\";runtimeSupportFile$
'remove any existing jb runtime support files from files to copy #lablog, "Copying the needed DLL and SLL files from Just Basic dir to projects\projectname Dir" print "Copying the needed DLL and SLL files from Just Basic dir to projects\projectname Dir" if fileExists(DestPath1$, runtimeSupportFile$) <> 0 then [fileExists2] open sourceFile$ for input as #file open destinationFile$ for output as #1 print #1, input$(#file, lof(#file)); close #file close #1 [fileExists2] wend
'verify dll's and sll's were copied to temp folder res=fileExists(DestPath1$,"vbas31w.sll") if res then a = a + 1 else notice " vbas31w.sll Was not created in --> ";DestPath1$;" bas2exe will now close":end res=fileExists(DestPath1$,"vgui31w.sll") if res then a = a + 1 else notice " vgui31w.sll Was not created in --> ";DestPath1$;" bas2exe will now close":end res=fileExists(DestPath1$,"voflr31w.sll") if res then a = a + 1 else notice " voflr31w.sll Was not created in --> ";DestPath1$;" bas2exe will now close":end res=fileExists(DestPath1$,"vthk31w.dll") if res then a = a + 1 else notice " vthk31w.dll Was not created in --> ";DestPath1$;" bas2exe will now close":end res=fileExists(DestPath1$,"vtk1631w.dll") if res then a = a + 1 else notice " vtk1631w.dll Was not created in --> ";DestPath1$;" bas2exe will now close":end res=fileExists(DestPath1$,"vtk3231w.dll") if res then a = a + 1 else notice " vtk3231w.dll Was not created in --> ";DestPath1$;" bas2exe will now close":end res=fileExists(DestPath1$,"vvm31w.dll") if res then a = a + 1 else notice " vvm31w.dll Was not created in --> ";DestPath1$;" bas2exe will now close":end res=fileExists(DestPath1$,"vvmt31w.dll") if res then a = a + 1 else notice " vvmt31w.dll Was not created in --> ";DestPath1$;" bas2exe will now close":end #lablog, "support files .dlls and .slls copied and verified............" print "support files copied and verified............"
'remove any left over existing jbrun2.exe (created by errors) from new project before creating new one 'Just Basic can't create\rename a file that exists, so if it does already exist - kill it (delete it) #lablog, "removing any left over existing jbrun2.exe " print "removing any left over existing jbrun2.exe " if fileExists(DestPath1$, JBruntime$) <> 0 then kill DestPath1$;"\"; JBruntime$
'copy jbrun2.exe to Current Project Folder #lablog, "coping jbrun2.exe to Current Project Folder" print "copying jbrun2.exe to Current Project Folder " open JBpath$;"\";JBruntime$ for input as #file open DestPath1$;"\";JBruntime$ for output as #1 print #1, input$(#file, lof(#file)); close #file close #1
'rename jbrun2.exe to name of User Selected .bas File - .bas +.exe #lablog, "renaming jbrun2.exe to name of User Selected .bas File - .bas +.exe" print "renaming jbrun2.exe to name of User Selected .bas File - .bas +.exe " if fileExists(DestPath1$, fnamenobas$;".exe") <> 0 then kill DestPath1$;"\";fnamenobas$;".exe" name DestPath1$;"\";JBruntime$ as DestPath1$;"\";fnamenobas$;".exe"
'check new exe (renamed jbrun2.exe) file for existence in current project Folder ) #lablog, "checking new exe (renamed jbrun2.exe) file for existence in current project Folder )" print "checking new exe (renamed jbrun2.exe) file for existence in current project Folder ) " res=fileExists(DestPath1$,fnamenobas$;".exe") if res then a=a+1 else notice "jbrun2.exe not copied or renamed - EXITING Program": end print "finished deleting, and verifying the rename of jbrun2 in new project dir" #lablog, "jbrun2.exe was renamed to ";selectedKey$;".exe"
'check for any left over tkn file existence delete if true #lablog, "checking for any left over tkn file existence due to errors on past runs, if true, deleting ";selectedKey$;".tkn" print "checking for any left over tkn file, deleting ";selectedKey$;".tkn";" if true" if fileExists(DestPath1$, selectedKey$;".tkn") <> 0 then kill DestPath1$;"\";selectedKey$;".tkn" #lablog, "left over tkn file existence verified and if true, deleted" print "left over tkn file existence verified and if true, deleted"
'####################################################################### 'Write Visual Basic Script to a .vbs file to automate TKN "save" and "information" autoSave$ = "autoSave.vbs" open autoSave$ for output as #1 print #1, "Set WshShell = WScript.CreateObject(";q$;"WScript.Shell";q$;")" #1, "WshShell.AppActivate ";q$;"Save *.TKN File As...";q$ '#1, "Wscript.Sleep(200)" - keeping for testing #1, "WshShell.SendKeys ";q$;"{ENTER}";q$ #1, "Wscript.Sleep(500)" 'this delay may need adjusting on your pc #1, "WshShell.AppActivate ";q$;"saved as";q$ #1, "WshShell.SendKeys ";q$;"{ENTER}";q$ close #1 #lablog, "script written........" print "script written........"
'loop until autoSave$ File is verified #lablog, "looping until autoSave$ File is verified.............." print "looping until autoSave$ File is verified..............." do res = fileExists(DestPath$,autoSave$) if res then exit do scan loop until res print "autosave vbs file written, saved, and existence verified............." #lablog, "autosave vbs file written, saved, and existence verified............."
'####################################################################### print "creating the tkn file..........."
'Create the TKN file in Projects\current project folder. print "creating the tkn file..........." #lablog, "creating the tkn file..........." RUN JBpath$;"\";JBexe$;" -T -A ";DestPath1$;"\";fname0$ 'give time for the save TKN window to appear call pause 1000
'####################################################################### 'run the script to close the "save" dialog, and the follow up notice of creation automatically #lablog," running autoSave vbs script to auto 'click' ENTER on 'save as' dialog and Information dialog " run "wscript ";autoSave$ '####################################################################### call pause 1000
'loop until TKN File is verified saved do res = fileExists(DestPath1$,fnamenobas$;".tkn") if res then exit do scan loop until res print "tkn verified saved to new project dir" #lablog, "tkn verified saved to new project dir"
'let JB cool off for a second just to be nice :D call pause 500
'copy TKN$ file to TKN dir, and date it print "copying tkn to TKN dir and dating it............." #lablog, "copying tkn to TKN dir and dating it............." open DestPath1$;"\";fnamenobas$;".tkn" for input as #file open DefaultDir$;"\TKN\";fnamenobas$;fixeddate$;".tkn" for output as #1 print #1, input$(#file, lof(#file)); close #file close #1 call pause 500
if fileExists (DefaultDir$;"\TKN", fnamenobas$;fixeddate$;".tkn") <> 0 then print "tkn file veried saved to ";DefaultDir$;"\TKN" #lablog, "tkn file veried saved to ";DefaultDir$;"\TKN" goto [continueOn] else notice fnamenobas$;fixeddate$;".tkn";" was NOT created in ";DefaultDir$;"\TKN" : goto [noiex] end if [continueOn] print "@ [continueOn] - tkn file verified dated and saved to TKN dir..........." #lablog, "@ [continueOn] - tkn file verified dated and saved to TKN dir..........." if tkn = 2 then print "sending to [newKey]/[continue] to add to ";categorie$;" List........" #lablog, "sending to [newKey]/[continue] to add to ";categorie$;" List........" newKey$ = fnamenobas$ categorie$ = MyProjects$ goto [continue] end if if tkn = 0 or tkn = 1 or tkn = 3 then tkn = 3 print "sending to [newKey]/[continue] to add to ";categorie$;" List........" #lablog, "sending to [newKey]/[continue] to add to ";categorie$;" List........" newKey$ = fnamenobas$ categorie$ = programs$ goto [continue] end if
if tkn = 4 then print "sending to [newKey]/[continue] to add to ";categorie$;" List........" #lablog, "sending to [newKey]/[continue] to add to ";categorie$;" List........" newKey$ = fnamenobas$ categorie$ = MyProjects$ goto [continue] end if
'bypass making the EXE file if SpriteCreator was selected (applies to first run only) if spritecreator = 1 then [noiex]
'Check if iexpress.exe is installed (a built in Windows Install Maker = Self Extracting exe File) [makeinst] print "@ [makeinstall] checking for existence of IEXPRESS to make exe" #lablog, "@ [makeinstall] checking for existence of IEXPRESS to make exe" res=fileExists("c:\windows\system32","iexpress.exe") if res then [makeexe] else notice "Cannot find file --> iexpress.exe in c:\windows\system32"+chr$(13)+"Known issue for users of WINE in Linux"+chr$(13)+"Check WINE Tricks for Adding IExpress(after each update)" wait
'make the sed file for iexpress to read and create the (Self Extracting Directorate) exe file [makeSed] print "@ [makeSed] to create SED file for use with IEXPRESS commandline" #lablog, "@ [makeSed] to create SED file for use with IEXPRESS commandline" 'can't write text to files that include quotes, so use the ascii characters so they will print without syntax errors q$=chr$(34) ' double quotes to be printed around files and paths in sed file text" sedfile$=fnamenobas$;".sed" open sedfile$ for output as #sed #sed "[Version]" #sed "Class=IEXPRESS" #sed "SEDVersion=3" #sed "[Options]" #sed "PackagePurpose=InstallApp" #sed "ShowInstallProgramWindow=1" #sed "HideExtractAnimation=1" #sed "UseLongFileName=1" #sed "InsideCompressed=0" #sed "CAB_FixedSize=0" #sed "CAB_ResvCodeSigning=0" #sed "RebootMode=N" #sed "InstallPrompt=%InstallPrompt%" #sed "DisplayLicense=%DisplayLicense%" #sed "FinishMessage=%FinishMessage%" #sed "TargetName=%TargetName%" #sed "FriendlyName=%FriendlyName%" #sed "AppLaunched=%AppLaunched%" #sed "PostInstallCmd=%PostInstallCmd%" #sed "AdminQuietInstCmd=%AdminQuietInstCmd%" #sed "UserQuietInstCmd=%UserQuietInstCmd%" #sed "SourceFiles=SourceFiles" #sed "[Strings]" #sed "InstallPrompt=" #sed "DisplayLicense=" #sed "FinishMessage=" exe$=fnamenobas$;".exe" #sed "TargetName=";q$;DefaultDir$;"\EXE\";exe$;q$ #sed "FriendlyName=";q$;fnamenobas$;q$ #sed "AppLaunched=";q$;exe$;q$ #sed "PostInstallCmd=<None>" #sed "AdminQuietInstCmd=" #sed "UserQuietInstCmd=" #sed "FILE0=";q$;exe$;q$ sedtkn$=fnamenobas$;".tkn" #sed "FILE1=";q$;sedtkn$;q$ sll1$="vbas31w.sll" sll2$="vgui31w.sll" sll3$="voflr31w.sll" dll1$="vthk31w.dll" dll2$="vtk1631w.dll" dll3$="vtk3231w.dll" dll4$="vvm31w.dll" dll5$="vvmt31w.dll" #sed "FILE2=";q$;sll1$;q$ #sed "FILE3=";q$;sll2$;q$ #sed "FILE4=";q$;sll3$;q$ #sed "FILE5=";q$;dll1$;q$ #sed "FILE6=";q$;dll2$;q$ #sed "FILE7=";q$;dll3$;q$ #sed "FILE8=";q$;dll4$;q$ #sed "FILE9=";q$;dll5$;q$ #sed "[SourceFiles]" #sed "SourceFiles0=";q$;DestPath1$;q$ #sed "[SourceFiles0]" #sed "%FILE0%=" #sed "%FILE1%=" #sed "%FILE2%=" #sed "%FILE3%=" #sed "%FILE4%=" #sed "%FILE5%=" #sed "%FILE6%=" #sed "%FILE7%=" #sed "%FILE8%=" #sed "%FILE9%=" close #sed
'verify sed file existence before proceeding do res = fileExists(DestPath$,fnamenobas$;".sed") if res then exit do scan loop until res
[makeexe] print "@ [makeexe] sed file existence veirified heading to execute IEXPRESS commandline" #lablog, "@ [makeexe] sed file existence veirified heading to execute IEXPRESS commandline"
'makes 64 bit exe if bit = 32 then [do32bit] goto [do32bit] 'run iexpress commandline using the sed (information file) created earlier print "running iexpress(64bit) commandline using the sed (information file) created earlier" #lablog, "running iexpress(64bit) commandline using the sed (information file) created earlier" express64$ = "C:\Windows\System32" res=fileExists(express64$,"iexpress.exe") if res then run "iexpress /N /q ";sedfile$ else noiex=1 : goto [noiex]
'makes 32 bit exe [do32bit] if bit = 64 or bit = 0 then [verifyEXE] print "running iexpress.exe(32bit) commandline using the sed (information file) created earlier" #lablog, "running iexpress.exe(32bit) commandline using the sed (information file) created earlier" express32$ = "C:\Windows\SysWOW64" if res=fileExists(express32$,"iexpress.exe") <> 0 then run "iexpress /N /q ";sedfile$ else noiex = 1 : goto [noiex]
'The EXE file gets created partially and fools the verification - pause to allow time 'for complete file creation - NOTE - This pause may need adjustment on YOUR PC call pause 2000
[verifyEXE] 'verify the exe file was created - loop until it exists print "@ [verifyEXE] entering verification loop" #lablog, "@ [verifyEXE] entering verification loop" do res = fileExists(DestPath$;"\EXE", exe$) if res then exit do scan loop until res cursor normal print DestPath$;"\EXE\";exe$;" was created sucessfully" #lablog, DestPath$;"\EXE\";exe$;" was created sucessfully"
[noiex] ' copy SED script file to SED dir res = fileExists(DefaultDir$, fnamenobas$;".sed") if res and sed = 1 then print "copying SED script file to SED dir" #lablog, "copying SED script file to SED dir" open fnamenobas$;".sed" for input as #file open DestPath$;"\SED\";fnamenobas$;fixeddate$;fixedtime$;".sed" for output as #1 print #1, input$(#file, lof(#file)); close #file close #1 end if
'keep autosave vbs script if user chose to res = fileExists(DefaultDir$, autoSave$) if res and sed = 1 then print "copying SED script file to SED dir" #lablog, "copying SED script file to SED dir" open autoSave$ for input as #file open DestPath$;"\";"VBS";"\";autoSave$ for output as #1 print #1, input$(#file, lof(#file)); close #file close #1 end if if spritecreator = 1 then [delete]
print "renaming EXE\";fnamenobas$;" to ";fnamenobas$;fixeddate$;".exe" #lablog, "renaming EXE\";fnamenobas$;" to ";fnamenobas$;fixeddate$;".exe" if fileExists(DestPath$;"\EXE", fnamenobas$;".exe") = 0 then notice fnamenobas$;".exe";" Does Not Exist in ";DestPath$;"\EXE" else if fileExists(DestPath$;"\EXE", fnamenobas$;".exe") <> 0 then name DestPath$;"\EXE\";fnamenobas$;".exe" as fnamenobas$;fixeddate$;".exe" end if end if
[delete] 'delete the root sed file, FolderDialog.vbs script file and the autosave script file(if user chose to) print "deleting the root sed file..............." #lablog, "deleting the root sed file..............." if fileExists(DefaultDir$,fnamenobas$;".sed") <> 0 then kill DefaultDir$;"\";fnamenobas$;".sed"
' Delete .vbs file temp .txt and temp .bas files print "Deleting temp .txt and temp .bas files" #lablog, "Deleting .vbs file temp .txt and temp .bas files" if fileExists(DefaultDir$,fnameTemp$) <> 0 then kill fnameTemp$ if fileExists(DefaultDir$,"temp.txt") <> 0 then kill "temp.txt"
'delete folderdialog vbs script print "Deleting folderdialog vbs script" #lablog, "Deleting folderdialog vbs script" if fileExists(DefaultDir$, "FolderDialog.vbs") then kill "FolderDialog.vbs"
'delete autosave.vbs print "Deleting autosave.vbs script" #lablog, "Deleting autosave.vbs script" if fileExists(DefaultDir$,autoSave$) <> 0 then kill autoSave$
'Deleting saved tkn file on user request print "Deleting saved tkn file on user request" #lablog, "Deleting saved tkn file on user request" if fileExists(DestPath$;"\TKN", fnamenobas$;fixeddate$;".tkn") <> 0 and tkn = 1 then kill DestPath$;"\TKN\";fnamenobas$;fixeddate$;".tkn" if res and tkn = 1 then kill DestPath$;"\TKN\";fnamenobas$;fixeddate$;".tkn"
'Deleting saved source code on user request print "Deleting saved tknfile on user request" #lablog, "Deleting saved tknfile on user request" if fileExists(DestPath$;"\BAS", fnamenobas$;fixeddate$;".bas") <> 0 and bas then kill DestPath$;"\BAS\"; fnamenobas$;fixeddate$;".bas"
'delete the current project dir and files(copied bas file, tkn file, sll,dll, jbrun2.exe(renamed file) 'if user chose to "not include" this project dir [remprogdir] print "deleting current project dir and files(copied bas file, tkn file, sll,dll, jbrun2.exe(renamed file) if user chose to not include this project dir" #lablog, "deleting current project dir and files(copied bas file, tkn file, sll,dll, jbrun2.exe(renamed file) if user chose to not include this project dir" if spritecreator = 1 then [done] if project = 0 and remove = 1 then kill DestPath1$;"\";"vbas31w.sll" kill DestPath1$;"\";"vgui31w.sll" kill DestPath1$;"\";"voflr31w.sll" kill DestPath1$;"\";"vthk31w.dll" kill DestPath1$;"\";"vtk1631w.dll" kill DestPath1$;"\";"vtk3231w.dll" kill DestPath1$;"\";"vvm31w.dll" kill DestPath1$;"\";"vvmt31w.dll" kill DestPath1$;"\";fnamenobas$;".exe" kill DestPath1$;"\";fnamenobas$;".tkn" kill DestPath1$;"\";fnamenobas$;".bas" 'delete the current project dir print "Deleting the current project dir" #lablog, "Deleting the current project dir" if pathExists(DestPath1$) then deldir = rmdir(DestPath1$) end if cursor normal
[done] print "@ - [done] - !SUCCESSFUL MISSION! NO ERRORS" #lablog, "copying SED script file to SED dir" yeserror = 0 if spritecreated = 1 then run DefaultDir$;"\SpriteCreator v2\SpriteCreator.exe" spritecreated = 0 wait
'close bas2exe window [quit.pick] #lablog,"@ - [quit.pick] closing #pick window " close #pick wait
'close bas2exe window [cancel] #lablog,"@ - [cancel] closing #pick window " close #pick wait
'function for checking file existence #lablog,"@ - fileExists(path$, filename$) function" function fileExists(path$, filename$) dim info$(0, 0) files path$, filename$, info$() fileExists = val(info$(0, 0)) 'non zero is true end function
'function for checking folder existence #lablog,"@ - function pathExists(path$) function" function pathExists(path$) pathExists = (mkdir(path$)=183) end function
'functions for making the folder dialog window function FolderDialog$(caption$) WindowWidth = 600 WindowHeight = 370 UpperLeftX=INT((DisplayWidth-WindowWidth)/2) UpperLeftY=INT((DisplayHeight-WindowHeight)/2) BackgroundColor$ = "lightgray" ForegroundColor$ = "black" gosub [FolderDlgGetDrives] statictext #folderdlg.S, "Note: - Only Drives and Folders Appear Below - No Files Appear", 45, 15, 550, 25 statictext #folderdlg.S, "Select a Drive or a Folder From the List", 175, 40, 300, 25 statictext #folderdlg.D, " (Double Click Drive Letters and Folders to Select or Navigate)", 85, 70, 395, 15 listbox #folderdlg.list, FolderList$(, [FolderDlgSelect], 22, 90, 550, 130 button #folderdlg.default, "Ok", [FolderDlgOk], UL, 190, 293, 85, 35 button #folderdlg.B, "Back", [FolderDlgBack], UL, 490, 45, 80, 30 button #folderdlg.C, "Cancel", [FolderDlgCancel], UL, 290, 293, 85, 35 textbox #folderdlg.text, 42, 225, 510, 30 statictext #folderdlg.path, "Selected Drive or Folder Path Appears Here", 130, 258, 400, 20 open caption$ for dialog_modal as #folderdlg #folderdlg, "trapclose [FolderDlgCancel]" #folderdlg.default, "!font Arial 8 bold" #folderdlg, "font Arial 10 bold" #folderdlg.S, "!font Arial 10 bold" #folderdlg.path, "!font Arial 10 bold" #folderdlg.list, "font Arial 10 bold" #folderdlg.C, "!font Arial 10 bold" #folderdlg.D, "!font Arial 8 bold" #folderdlg.text, "!font Arial 10 bold"
wait [FolderDlgSelect] #folderdlg.list, "selection? temp$" if temp$ <> "" then level = level+1 folder$ = folder$; temp$; "\" #folderdlg.text, folder$ gosub [FolderDlgGetDir] #folderdlg.list, "reload" end if wait [FolderDlgBack] if level > 0 then level = level-1 if level = 0 then folder$ = "" gosub [FolderDlgGetDrives] else i = len(folder$)-1 while mid$(folder$, i, 1) <> "\" and mid$(folder$, i, 1) <> "" i = i-1 wend folder$ = left$(folder$, i) gosub [FolderDlgGetDir] end if #folderdlg.text, folder$ #folderdlg.list, "reload" end if wait [FolderDlgGetDrives] c = 1 while word$(Drives$, c) <> "" c = c+1 wend redim FolderList$(c) for i = 1 to c FolderList$(i) = word$(Drives$, i) next i return [FolderDlgGetDir] files folder$, info$( s = val(info$(0,0)) t = val(info$(0,1)) redim FolderList$(t) for i = 1 to t FolderList$(i) = info$(i+s, 1) next i return [FolderDlgOk] #folderdlg.text, "!contents? FolderDialog$" If right$(FolderDialog$,1) = "\" then FolderDialog$ = left$(FolderDialog$, len(FolderDialog$) - 1) [FolderDlgCancel] close #folderdlg end function
sub quit fast$ #lablog,"@ - sub quit fast$" 'close help lab (and all open htmlviewer.exe windows if checked) call saveValue if lablogIsOpen = 1 then close #lablog print "closehtml -quit Fast$ = ";closehtml if closehtml <> 0 then run "taskkill /IM htmlviewer.exe /F",HIDE close #fast$ : end end sub
'the following are cundo's jbsearch code edited by xxgeek 'subroutine to search selection Help, and or Tutorial sub buttonClick h2$ #lablog,"@ - sub buttonClick h2$" select case word$(h2$,2,".") case "search" #main.tb "!setfocus" #main.tb "!contents? searchFor$" searchFor$=trim$(searchFor$) if len(searchFor$)>2 then cursor hourglass redim searchList$(1000) for i = 1 to 1000 ' so so if helpList$(i)="" then result$ = "yes" #main.tb "!setfocus" : exit for end if fileToOpen$= word$(helpList$(i),2,chr$(0)) print helpFilePath$; " "; fileToOpen$ if fileToOpen$ = "http://www.justbasic.com" then fileToOpen$ = "index.html" open helpFilePath$; "\"; fileToOpen$ for input as #2 contents$ = input$(#2, lof(#2)) if instr(lower$(contents$), lower$(searchFor$)) then count=count+1 searchList$(count)= helpList$(i) end if close #2 next i if count = 0 then prompt "No Entries Found for " + chr$(13) + searchFor$ + " TRY AGAIN?" ; result$ sort searchList$(), 0, count #main.listbox2 "reload" cursor normal else result$ = "yes" prompt " 3 Character Minimum"+chr$(13) +" TRY AGAIN?";result$ end if end select end sub
'subroutine to open selected search item in a browser (htmlviewer if exists\default if not) sub lbDoubleClick h2$ #lablog,"entering - sub lbDoubleClick h2$" #h2$ "selection? selection$" if selection$ = "" then exit sub fileToOpen$= word$( selection$,2,chr$(0)) if fileToOpen$ = "http://www.justbasic.com" then run "explorer.exe ";fileToOpen$ : wait fileToOpen$=replace$( fileToOpen$ , "/", "\" ) if fileExists(DefaultDir$, "htmlviewer.exe") <> 0 then print "fileToOpen$ = ";helpFilePath$;"\";fileToOpen$ 'for testing with mainwin run "htmlviewer.exe ";helpFilePath$;"\";fileToOpen$ else run "explorer.exe ";helpFilePath$;"\";fileToOpen$ end if end sub
function replace$( text$ , this$, tothis$ ) #lablog,"entering function replace$( text$ , this$, tothis$ )" while 1 if instr(text$, this$) then f = instr(text$, this$) lenght=len(this$) text$ = mid$(text$,1,f-1);_ tothis$;mid$(text$,f+lenght) else exit while end if wend replace$=text$ end function
sub combosub #lablog,"entering sub combosub" end sub
'sub to generate the window code and copy to clipboard, and texeditor sub dummy fast$ #lablog,"entering sub dummy fast$" select case case fast$ = "#main.button1" #main.txt1 "!contents? txt$" #main.txt2 "!contents? theName$" #main.r1 "value? result$" if result$="set" then itag$="[" otag$="]" closingCode$= "[quit]";chr$(13);_ " close ";txt$;chr$(13);_ " end" else closingCode$ = "Sub quit fast$";chr$(13);_ " close #fast$" ;chr$(13);_ " end";chr$(13);_ "End Sub" end if #main.combo "selection? sel$" if instr(sel$,"popup") then includeButton$= "button ";txt$;".button1 ";chr$(34);_ "&Exit";chr$(34);", "; itag$;"quit";otag$;", ul, 1, 1, 100, 30" end if toPrint$ = "WindowWidth = 640 : WindowHeight = 480";chr$(13);_ "UpperLeftX=int((DisplayWidth-WindowWidth)/2)";chr$(13);_ "UpperLeftY=int((DisplayHeight-WindowHeight)/2)";chr$(13);chr$(13);_ includeButton$;chr$(13);chr$(13);_ "Open ";chr$(34);theName$;chr$(34);" for ";sel$; " as ";txt$;chr$(13);_ " ";txt$;" "; chr$(34); "trapclose ";itag$;"quit";otag$; chr$(34);chr$(13);_ "wait";chr$(13);chr$(13);_ closingCode$ #main.ed "!cls" #main.ed toPrint$ #main.ed "!selectall" #main.ed "!copy" #main.ed "!paste" #main.ed "!origin 0 0" end select End sub
'quit program, save the current selected List first, and kill all htmlviewer 'windows if User chose to as well [quit.main] #lablog,"@ - [quit.main] calling saveValue, closing htmlviewers(if user chose to), closing program" call saveValue if lablogIsOpen = 1 then close #lablog print "closehtml -quit.main = ";closehtml if closehtml <> 0 then run "taskkill /IM htmlviewer.exe /F", HIDE Close #main END
'sub to create pauses in program
sub pause mil #lablog,"entering sub pause mil" t=time$("ms")+mil while time$("ms")<t scan wend end sub
'sub to save current Dictionary Listings and text in texeditor sub saveValue 'if the value is changed, save it #lablog,"entering sub savevalue" if lastKey$ <> "" then #main.value "!modified? modified$"; if modified$ = "true" then #main.value "!contents? saveThisValue$"; call setValueByName lastKey$, saveThisValue$ call collectGarbage call writeDictionary end if end if end sub
'function to get selected Listing function getKeys$(delimiter$) #lablog,"entering function getKeys$" global keyCount pointer = 1 while pointer <> 0 'get the next key pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), pointer) if pointer then keyPointer = pointer + 9 pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), pointer) key$ = mid$(dictionary$, keyPointer, pointer - keyPointer) if instr(keyList$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)) = 0 then getKeys$ = getKeys$ + key$ + delimiter$ keyList$ = keyList$ + chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ keyCount = keyCount + 1 end if end if wend end function
'sub to write each Listing to corresponding file #lablog,"entering sub writeDictionary" sub writeDictionary print categorie$ open categorie$ for output as #writeDict #writeDict, dictionary$ close #writeDict end sub
'sub to read each Listing from corresponding file sub readDictionary #lablog,"entering sub readDictionary" [tryAgain] print DefaultDir$;"\";categorie$ if fileExists(DefaultDir$, categorie$) <> 0 then open categorie$ for input as #readDict length = lof(#readDict) dictionary$ = input$(#readDict, length) close #readDict else open categorie$ for output as #1 : close #1 : goto [tryAgain] end if end sub
'sub to cleanup any mess in the dictionary text
sub collectGarbage #lablog,"entering sub collectGarbage" pointer = 1 while pointer > 0 'get the next key pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), pointer) if pointer then keyPointer = pointer + 9 pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), pointer) key$ = mid$(dictionary$, keyPointer, pointer - keyPointer) if instr(keyList$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)) = 0 then value$ = getValue$(key$) newDictionary$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134) + value$ + newDictionary$ keyList$ = keyList$ + chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134) end if end if wend dictionary$ = newDictionary$ end sub
#lablog,"entering sub collectGarbage" sub setValueByName key$, value$ dictionary$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134);key$;chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)+value$+dictionary$ end sub
'function to get info from selected Listing function getValue$(key$) getValue$ = chr$(0) keyPosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134)+key$+chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)) if keyPosition > 0 then keyPosition = keyPosition + 9 'skip over key tag valuePosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), keyPosition) if valuePosition > 0 then valuePosition = valuePosition + 11 'skip over value tag endPosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), valuePosition) if endPosition > 0 then getValue$ = mid$(dictionary$, valuePosition, endPosition - valuePosition) else getValue$ = mid$(dictionary$, valuePosition) end if end if end if end function
'sub to load selected categorie List sub loadKeys keyList$ = getKeys$(chr$(134);chr$(165);chr$(134)) redim keys$(keyCount) for item = 1 to keyCount keys$(item-1) = word$(keyList$, item, chr$(134);chr$(165);chr$(134)) next item sort keys$(), 0 ,keyCount #main.keys "reload" end sub
'function to make custom messages function GetMessage$(message$) WindowWidth = 520 : WindowHeight = 740 UpperLeftX=INT((DisplayWidth-WindowWidth)/2) UpperLeftY=INT((DisplayHeight-WindowHeight)/2) BackgroundColor$ = "lightgray" : ForegroundColor$ = "black" statictext #textmessage.text, "", 0, 0, 490, 600 button #textmessage.button, "OK", [quit], UL, 230, 625, 35, 35 open "Information" for window as #textmessage #textmessage.button, "!setfocus" print #textmessage, "trapclose [close]" #textmessage, "font Arial bold 10" #textmessage.text, message$ #textmessage.button, "!font Arial bold 12" wait [close] close #textmessage : exit function scan wait [quit] scan close #textmessage : exit function end function
'function to separate filename from full path to file function GetFilename$(fileName$) i = len(fileName$) while mid$(fileName$, i, 1) <> "\" and mid$(fileName$, i, 1) <> "" i = i-1 wend GetFilename$ = mid$(fileName$, i+1) end function
'JB function for making of popup menus (JB code from functions examples) function PopupMenu$(options$, width, bgColor$, textColor$, selBackColor$, selTextColor$) 'arguments: 'options$ - comma-separated list of menu options 'width - window-width, default = 100 'bgColor$ - background color of the dialog 'textColor$ - color of inactive text 'selBackColor$ - backcolor of active, selected text 'selTextColor$ - color of active, selected text 'NOTE: colors are either a string of rgb values, one of the windows colours or 'empty string (use default colour scheme) while word$(options$, count+1, ",") <> "" count = count+1 wend height = count*20+38 width = int(width) : if width < 100 then width = 100 if bgColor$ = "" then bgColor$ = "white" if textColor$ = "" then textColor$ = "black" if selBackColor$ = "" then selBackColor$ = "darkblue" if selTextColor$ = "" then selTextColor$ = "white" WindowHeight = height WindowWidth = width UpperLeftX = MouseX UpperLeftY = MouseY graphicbox #popup.graph, 0, 0, width, height open title$ for dialog_modal_nf as #popup #popup, "trapclose [popupDlgCancel]" #popup, "font ms_sans_serif 16 9" #popup.graph, "down; fill "; bgColor$ #popup.graph, "color "; textColor$; "; backcolor "; bgColor$ for i = 1 to count #popup.graph, "place 4 "; i*20 - 2 #popup.graph, "\"; word$(options$, i, ",") next i #popup.graph, "flush" #popup.graph, "when mouseMove [popupDlgMove]" #popup.graph, "when leftButtonDown [popupDlgSelect]" wait
[popupDlgMove] this = (MouseY-3)/20 : if this >= 0 then this = this + 1 this = int(this) if this <> selection then #popup.graph, "backcolor "; bgColor$; "; color "; bgColor$ #popup.graph, "place 2 "; selection*20 - 16; "; boxfilled "; width-12; " "; selection*20+2 #popup.graph, "color "; textColor$ #popup.graph, "place 4 "; selection*20 - 2 #popup.graph, "\"; word$(options$, selection, ",") if this > 0 and this <= count then #popup.graph, "backcolor "; selBackColor$; "; color "; selBackColor$ #popup.graph, "place 2 "; this*20 - 16; "; boxfilled "; width-12; " "; this*20+2 #popup.graph, "color "; selTextColor$ #popup.graph, "place 4 "; this*20 - 2 #popup.graph, "\"; word$(options$, this, ",") end if selection = this end if wait [popupDlgSelect] this = (MouseY-3)/20 : if this >= 0 then this = this + 1 this = int(this) if this > count or this < 1 then wait PopupMenu$ = word$(options$, this, ",") [popupDlgCancel] close #popup end function 'JB progress bar - Edited by xxgeek to suit this app sub progressBar [launch] WindowWidth = 500 WindowHeight = 80 UpperLeftX = INT((DisplayWidth-WindowWidth)/2) UpperLeftY = INT((DisplayHeight-WindowHeight)/2)+175 graphicbox #progress.bar, 20, 15, 450, 10 statictext #progress.text, "", 30, 25, 450, 25 open "ProgressBar" for dialog_popup as #progress #progress, "trapclose [endprogress]" #progress.bar, "backcolor 100 100 250" #progress.bar, "down" #progress, "font arial 12 bold" #progress.bar, "setfocus" #progress.bar, "cls" while bar < 450 #progress.bar, "boxfilled "; bar ;" 20" progress = bar/450 progress =int(progress * 100) if pnum = 0 then #progress.text, "Getting User Path ";progress; " % done" if pnum = 1 then #progress.text, "Loading Dialogs List ";progress; " % done" if pnum = 2 then #progress.text, "Loading Reserved Words List ";progress; "% done" if pnum = 3 then #progress.text, "Loading Samples List ";progress; "% done" if pnum = 4 then #progress.text, "Loading Functions List ";progress; "% done" if pnum = 5 then #progress.text, "Loading ASCII List ";progress;" % done" for break = 1 to 200 next break bar = bar + 2.5 wend bar = 0 close #progress if pnum = 0 then WindowWidth = 120 WindowHeight = 90 UpperLeftX = INT((DisplayWidth-WindowWidth)/2) UpperLeftY = INT((DisplayHeight-WindowHeight)/2)+255 statictext #ready.text, " Please Wait", 10, 20, 90, 20 open "Ready" for dialog_popup as #ready #ready, "trapclose [endprogress]" #ready.text, "!font arial 10 bold" exit sub end if if pnum = 5 then #ready.text, " Ready" for readymessage = 1 to 1000000 next readymessage close #ready end if [endprogress] end sub
'get any errors that occur and let user know what's up and create a log file [errorReport] yeserror = 1 print chr$(13);"Date ";date$();" ";Time$();" Error # ";Err;" ";Err$;chr$(13) print "Error # ";Err;" ";Err$;chr$(13);chr$(13);" ! MISION INTERUPTED ! ";chr$(13);" ! ABORT ! ";chr$(13);" >>> Aborting Mission ";chr$(13);" >>> Attempting Recovery" ;chr$(13);" Recovery Failed >>> Cleaning up Temp Files";chr$(13);chr$(13);" See jbHelpLabError.log " open "jbHelpLabError.log" for append as #1 #1, chr$(13);date$();" ";Time$();" Error # ";Err;" ";Err$;chr$(13) close #1 notice "Error # ";Err;" ";Err$;chr$(13);chr$(13);" ! MISION INTERUPTED ! ";chr$(13);" ! ABORT ! ";chr$(13);" >>> Aborting Mission ";chr$(13);" >>> Attempting Recovery" ;chr$(13);" Recovery Failed >>> Cleaning up Temp Files";chr$(13);chr$(13);" See jbHelpLabError.log " : goto [delete]
|
|