|
Post by tsh73 on May 30, 2023 14:48:10 GMT -5
Rod, on
>>but introducing new lines is problematic because the insert order is important. Nice thing to have would be text list of controls (may be real BASIC source strings) in program order, with ability to move up/down (may be even allow delete things like apparent doubles or off-screen controls)
>>So too deletion because its not just the control it is also preceding color changes and post open font changes that must be deleted as well Just ignore it. I pretty sure it will not make much harm if left. Let user sort it out (delete manually if needed)
|
|
|
Post by xxgeek on May 31, 2023 10:04:39 GMT -5
The following code is the latest, best working version so far. It is a separate FFUL with a couple other features The version number of this FFUL will be preceded by xx to distinguish between the 2 different FFUL's
ver$="xx_1.1.4" - Writing, importing, loading(.ffu) and previewing code 'created by FFUL' seems to be working well. - Previewing code of any selected .bas file seems to be working well, except for the written event handlers. (next priority) Posting here to have a backup since versions are piling up and causing confusion here.
ver$="xx_1.1.4" 'freeform ultra lite v1.x by Rod 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1 nomainwin dim info$(10,10) dim form$(10) form$(1)="Restore" form$(2)="New" form$(3)="Save .ffu" form$(4)="Load .ffu" form$(5)="-----------" form$(6)="Write .bas" form$(7)="Import .bas" form$(8)="Export .bas" form$(9)="File" dim tool$(14) tool$(1)="StatictText" tool$(2)="TextBox" tool$(3)="ListBox" tool$(5)="ComboBox" tool$(6)="Button" tool$(7)="BmpButton" tool$(8)="GraphicBox" tool$(9)="RadioButton" tool$(10)="CheckBox" tool$(11)="GroupBox" tool$(12)="Texteditor" tool$(13)="Menu" tool$(14)="Add New" dim hnd$(30) hnd$(1)="#1" dim grid$(20) grid$(1)="1" grid$(2)="3" g=3 for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Invisible" grid$(g+1)="Visible" grid$(g+2)="Set Grid" grid=10 gridvisible=1 gridcolor$="buttonface" bordercolor$=gridcolor$ crosshair$ =bordercolor$ projectctrh=25 ctrh=25 dim color$(10) color$(1)="Control Background" color$(2)="Project Background" color$(3)="Project Foreground" color$(4)="Grid Color" color$(5)="Border Color" color$(6)="CrossHair Color" color$(7)="Set Color" projectback$="white" projectfore$="black" 'ctrc$="white" dim font$(10) font$(1)="Control Font" font$(2)="ResetControl" font$(3)="Project Font" font$(4)="Set Font"'default is Consolas 9" dim wind$(20)'window type names wind$(1)="window" wind$(2)="window_nf" wind$(3)="window_popup" wind$(4)="dialog" wind$(5)="dialog_modal" wind$(6)="dialog_nf" wind$(7)="dialog_nf_modal" wind$(8)="dialog_fs" wind$(9)="dialog_nf_fs" wind$(10)="dialog_popup" wind$(11)="graphics" wind$(12)="graphics_fs" wind$(13)="graphics_fs_nsb" wind$(14)="graphics_nsb" wind$(15)="graphics_nf_nsb" wind$(16)="text" wind$(17)="text_fs" wind$(18)="text_nsb" wind$(19)="text_nsb_ins"
dim v$(2000) for n= 100 to 2000 step 20 v$(n)=str$(n) next dim obj(200,6) 'x,y,width/height,type,textheight X=1 Y=2 W=3 H=4 T=5 TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline Ctr=1 Tex=2 Res=3 Fon=4 Bak=5 Bas=7
'set default starting position obj=0 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" projectctrh=25 projectgrid=10 projectw=600 projecth=400 insertx=grid inserty=grid*2
'open a small properties window and hide it WindowWidth=230 WindowHeight=260 UpperLeftX=(DisplayWidth-230)/2 UpperLeftY=(DisplayHeight-180)/2 statictext #prop.st1 "File",5,10,30,25 textbox #prop.tbfile,45,5,150,25 statictext #prop.st2 "Wind",5,32,30,25 combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25 statictext #prop.st3 "Titl",5,54,30,25 textbox #prop.tbtitl,45,49,150,25 statictext #prop.st4 "Form",5,76,30,25 textbox #prop.tbform,45,71,150,25 statictext #prop.st5 "Ctrl",5,98,30,25 textbox #prop.tbctrl,45,93,150,25 statictext #prop.st6 "Text",5,120,30,25 textbox #prop.tbtext,45,115,150,25 statictext #prop.st7 "Reso",5,142,30,25 textbox #prop.tbreso,45,137,150,25 statictext #prop.st8 "xywh",5,164,30,25 textbox #prop.tbxywh,45,159,150,25 statictext #prop.st9 "Font",5,186,30,25 textbox #prop.tbfont,45,181,150,25 statictext #prop.st10 "Colo",5,208,30,25 textbox #prop.tbcolo,45,203,150,25
open "Properties" for window_nf as #prop #prop "font Consolas 9" #prop "trapclose [show]" #prop.cbwind "select window_nf" #prop.tbfile "!disable" #prop.tbxywh "!disable" #prop.tbfont "!disable" #prop.tbcolo "!disable" gosub [propertyupdate] #prop "hide"
'open the main form window 'this window is resizable, the graphicox will resize but the 'client area, which is a drawn representation of the window 'will only change size if you change the project w/h dimensions WindowWidth=860 WindowHeight=705 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #fful.form,form$(,[form],5,2,85,30 combobox #fful.hand,hnd$(,[hand],95,2,85,30 combobox #fful.tool,tool$(,[tool],185,2,85,30 button #fful.project,"Preview",[preview],UL,275,0,60,25 combobox #fful.w,v$(,[formsize],340,2,60,30 combobox #fful.h,v$(,[formsize],405,2,60,30 combobox #fful.grid,grid$(,[grid],470,2,90,30 combobox #fful.color,color$(,[color],565,2,130,30 combobox #fful.font,font$(,[font],700,2,90,30 button #fful.help,"Help",[help],UL,795,0,40,25 textbox #fful.filePath, 5,18,1600,20 'statictext #fful.filePath, "",5,25,1600,15 graphicbox #fful.gb,5,35,830,630 open "FFULv";ver$;" Forms Controls Form Dimensions Grid Size Colors Fonts" for window as #fful #fful "trapclose [quitfful]" #fful "font Consolas 9" #fful "resizehandler [resize]" #fful.tool "select Add New" #fful.form "select File" #fful.hand "selectindex 1" #fful.grid "select Set Grid" #fful.color "select Set Color" #fful.font "select Set Font" #fful.w "select ";projectw #fful.h "select ";projecth #fful.gb "autoresize" #fful.gb "vertscrollbar on 0 ";projectw #fful.gb "horizscrollbar on 0 ";projecth #fful.gb "font ";projectfont$ #fful.gb "down" gosub [drawgrid] gosub [drawall] #fful.gb "when rightButtonDown [show]" #fful.gb "when leftButtonDown [select]" #fful.gb "when characterInput [keys]" #fful.gb "setfocus" #prop "show" show=1 #fful.filePath, "File - untitled.ffu" #fful.filePath, "!disable" wait
[show] if show then #prop "hide" show=0 else #prop "show" show=1 end if wait
'the user clicked on the form design window 'either to chose a control or to deselect a control [select] xs=MouseX ys=MouseY 'hide property window if it is open if show then #prop "hide" show=0 end if
'before we move on update the currently selected control from properties 'get the project data and only the editable contents of controls if selected=0 then 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ end if #prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$ #prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$ #prop.tbreso "!contents? t$" : obj$(selected,Res)=t$ 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if xs>obj(cn,X) and xs<(obj(cn,X)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then if xs>obj(cn,X)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2 if obj(cn,T)=6 then action=1 selected=cn exit for end if next if selected=0 then gosub [propertyupdate] action=0 end if if selected>0 and action=1 then #fful.gb "when leftButtonMove [track]" #fful.gb "when leftButtonUp [stop]" offsetX=xs-obj(selected,X) offsetY=ys-obj(selected,Y) end if if selected>0 and obj(selected,T)<>6 and action=2 then 'dont resize bmp #fful.gb "when leftButtonMove [tracksize]" #fful.gb "when leftButtonUp [stopsize]" offsetX=xs-(obj(selected,X)+obj(selected,W)) offsetY=ys-(obj(selected,Y)+obj(selected,H)) end if if selected>0 then gosub [drawit] else insertx=int((xs+(grid/2))/grid)*grid inserty=int((ys+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #fful.gb "rule xor" gosub [drawit] xt=int((MouseX-offsetX+(grid/2))/grid)*grid if xt<0 then xt=0'11 if xt+obj(selected,W)>projectw then xt=projectw-obj(selected,W) obj(selected,X)=xt yt=int((MouseY-offsetY+(grid/2))/grid)*grid if menuset = 0 and textEd = 0 then if yt<0 then yt=0 if yt+obj(selected,H)>projecth-25 then yt=projecth-obj(selected,H)-25 obj(selected,Y)=yt end if
if menuset = 1 or textEd > 0 then if yt < 0 then yt = 0 if yt+obj(selected,H)>projecth-50 then yt=projecth-obj(selected,H)-50 obj(selected,Y)=yt end if gosub [drawit] wait
[stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[tracksize] #fful.gb "rule xor" gosub [drawit] xs=int((MouseX-offsetX+(grid/2))/grid)*grid if xs>projectw then xs=projectw if xs<obj(selected,X) then xs=obj(selected,X)+grid ys=int((MouseY-offsetY+(grid/2))/grid)*grid if ys>projecth then ys=projecth if ys<obj(selected,Y)+ctrh then ys=obj(selected,Y)+ctrh obj(selected,W)=xs-obj(selected,X)'width if menuset = 1 or textEd > 0 then obj(selected,H)=ys-obj(selected,Y)-50'height if menuset = 0 and textEd = 0 then obj(selected,H)=ys-obj(selected,Y)-25'height gosub [drawit] wait
[stopsize] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,T)=12 then menuset = 0 : gosub [drawgrid] 'menu if obj(selected,T)=11 then textEd = textEd-1 : gosub [drawgrid] 'texteditor obj(selected,T)=0 selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,X) 'x cpy(2)=obj(selected,Y) 'y cpy(3)=obj(selected,W) 'w cpy(4)=obj(selected,H) 'h cpy(5)=obj(selected,T) 'type cpy(6)=obj(selected,TH) 'textheight cpy$(1)=obj$(selected,Ctr) 'name cpy$(2)=obj$(selected,Tex) 'text content cpy$(3)=obj$(selected,Res) 'resource array or file path cpy$(4)=obj$(selected,Fon) 'ctrl specific font or "" cpy$(5)=obj$(selected,Bak) 'ctrl specific backcolor end if
if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 if obj(obj,T)=11 then textEd = textEd+1 'texteditor obj(obj,X)=insertx obj(obj,Y)=inserty inserty=inserty+cpy(4)+grid obj(obj,W)=cpy(3) obj(obj,H)=cpy(4) obj(obj,T)=cpy(5) obj(obj,TH)=cpy(6) obj$(obj,Ctr)=left$(cpy$(1),11)';obj obj$(obj,Tex)=cpy$(2) obj$(obj,Res)=cpy$(3) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) obj$(obj,Fon)=cpy$(4) obj$(obj,Bak)=cpy$(5) selected=obj gosub [drawall] end if end if #fful.gb "setfocus" wait
[tool] #fful.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext sttx = sttx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=1 obj$(obj,Ctr)="statictext";sttx obj$(obj,Tex)="Statictext-";sttx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 2 'textbox txtbx = txtbx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=2 obj$(obj,Ctr)="textbox";txtbx obj$(obj,Tex)="Textbox-";txtbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 3 'listbox lstbx = lstbx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh*5 obj(obj,T)=3 obj$(obj,Ctr)="listbox";lstbx obj$(obj,Tex)="Listbox-";lstbx;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectlbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 4 'combobox cmbobx = cmbobx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="combobox";cmbobx obj$(obj,Tex)="Combobox-";cmbobx;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectcbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 5 'button bttn = bttn +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=5 obj$(obj,Ctr)="button";bttn obj$(obj,Tex)="button-";bttn if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)="white" inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 6 'bmp button bmpbtn = bmpbtn +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=50 obj(obj,H)=50 obj(obj,T)=6 obj$(obj,Ctr)="bmp\bmpButton";bmpbtn filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Res)=file$ obj$(obj,Tex)="BMPbutton-";bmpbtn loadbmp obj$(obj,Ctr),file$ close #bmp inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid else obj(obj,T)=0 close #bmp end if else obj(obj,T)=0 end if
case 7 'graphicbox grbx = grbx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*3 obj(obj,T)=7 obj$(obj,Ctr)="graphicbox";grbx obj$(obj,Tex)="Graphicbox-";grbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton radio = 1 rdiobtn = rdiobtn + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 obj(obj,H)=ctrh obj(obj,T)=8 obj$(obj,Ctr)="radiobutton";rdiobtn obj$(obj,Tex)="(o) radioBtn-";rdiobtn obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 9 'checkbox check = 1 chkbx = chkbx+1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="checkbox";chkbx obj$(obj,Tex)="[x] checkbox-";chkbx obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox grpbx = grpbx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*4 obj(obj,T)=10 obj$(obj,Ctr)="groupbox";grpbx obj$(obj,Tex)="Group Box-";grpbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor textEd = textEd+1 gosub [drawgrid] obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh*4 obj(obj,T)=11 obj$(obj,Ctr)="texteditor";textEd obj$(obj,Tex)="Texteditor-";textEd if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttecl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,X)=0 obj(obj,Y)=0 obj(obj,W)=100 obj(obj,H)=10 obj(obj,T)=12 obj$(obj,Ctr)="menu";obj obj$(obj,Tex)=" Menu Added" inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid gosub [drawgrid] end if end select selected=obj gosub [drawall] #fful.tool "select Add New" #fful.gb "setfocus" wait
[form] #fful.form "selectionindex? i" select case i case 1 'restore file$="lastsession.ffu" #fful.filePath, "lastsession.ffu" gosub [loadit] case 2 'new gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 6 'write gosub [write] case 7 'import gosub [import] case 8 'export gosub [export] end select #fful.form "select File" gosub [drawall] #fful.gb "setfocus" wait
[drawall] #fful.gb "discard ; redraw bak" ocn=cn projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" for cn=1 to obj gosub [drawit] next cn=ocn #fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20 #fful.gb "setfocus" return
[drawit] 'redraws control cn 'set the color for the drawn object and action taking place if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if
'set the font for the drawn object if obj$(cn,Fon)="" then #fful.gb "font ";projectfont$ ch=projectctrh if obj(cn,H)<ch then obj(cn,H)=ch else #fful.gb "font ";obj$(cn,Fon) ch=obj(cn,TH) if obj(cn,H)<ch then obj(cn,H)=ch end if
'update the properties textboxes for selected control if cn=selected then #prop.tbctrl obj$(cn,Ctr) 'ctrlname #prop.tbtext obj$(cn,Tex) 'text #prop.tbreso obj$(cn,Res) 'resource #prop.tbxywh obj(cn,X);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height #prop.tbcolo obj$(cn,Bak) end if if projecttbcl$ = "" then projecttbcl$ = "white" if projectlbcl$ = "" then projectlbcl$ = "white" if projectcbcl$ = "" then projectcbcl$ = "white" if projecttecl$ = "" then projecttecl$ = "white" #fful.gb "place ";obj(cn,X);" ";obj(cn,Y) if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?" select case obj(cn,T) case 1 'statictext #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 2 'textbox #fful.gb "backcolor ";projecttbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 3 'listbox #fful.gb "backcolor ";projectlbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 4 'combobox #fful.gb "backcolor ";projectcbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 5 'button #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'buttons are always black on white #fful.gb "color black" 'centre button text #fful.gb "stringwidth? ";"A";" width" xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ #fful.gb "backcolor ";projectback$ case 6 'bmpbutton if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr) #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) case 7 ' graphicbox #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "backcolor ";projectback$ case 8 'radiobutton #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'radiobutton text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 9 'checkbox #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'checkbox text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 10 'groupbox #fful.gb "backcolor ";projectback$ 'groupbox is an outline #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'group box text is always black #fful.gb "color black" 'groupbox text is offset if action=0 then #fful.gb "place ";obj(cn,X)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 11 ' texteditor #fful.gb "backcolor ";projecttecl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 12 'menu 'pin to top left obj(cn,X)=10 : obj(cn,Y)=-10 : obj(cn,W)=100 : obj(cn,H)=10 xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X);" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) '#fful.gb "box ";obj(cn,X)+obj(cn,H);" ";obj(cn,Y)+obj(cn,H) #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 21 'tecolor projecttecl$=obj$(cn,Bak) case 22 'tbcolor projecttbcl$=obj$(cn,Bak) case 23 'lbcolor projectlbcl$=obj$(cn,Bak) case 24 'cbcolor projectcbcl$=obj$(cn,Bak) case 30 'font case 31 '!font end select return
[preview] file$="preview.bas" gosub [writeit] wait
[quitnoform] close #noform wait
[write] projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas" filedialog "Save .bas",projectfile$,file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit] if file$<>"" then '#################################################### if projectwind$ = "" then wait '#################################################### open file$ for output as #op 'the header #op " 'Project ";projecttitl$ #op " 'Created with Freeform Ultra Lite v";ver$;" ";date$() #op "" if projectback$<>"white" or projectfore$<>"black" then #op " 'Set BackgroundColor$ and ForegroundColor$ of project" #op " BackgroundColor$=";chr$(34);projectback$;chr$(34) #op " ForegroundColor$=";chr$(34);projectfore$;chr$(34) #op "" end if #op " 'Create arrays needed for controls listbox,combobox" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " dim ";obj$(n,Ctr);"$(10)" #op " for n = 1 to 10" #op " ";obj$(n,Ctr);"$(n)= str$(n)" #op " next" end if next #op "" #op " 'Create controls and open window" #op " nomainwin" #op " WindowWidth = ";projectw #op " WindowHeight = ";projecth #op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"Size";chr$(34);", ";chr$(34);"Small";chr$(34);", [dummy], ";chr$(34);"Large";chr$(34);", [dummy]" end if for n=1 to obj select case obj(n,T) case 1 'statictext #op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox #op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ctr);"$(, [";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ctr);"$(, [";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"],[no";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"],[un";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor #op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 22 'tbcolor #op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'lbcolor #op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 24 'cbcolor #op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'tecolor #op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34) end select next #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op "" #op " 'Set any listbox or combobox to display the first item on the list" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34) end if next #op " 'apply any control specific fonts" for n= 1 to obj if obj(n,T)<>0 and obj$(n,Fon)<>"" then if obj(n,T)=1 or obj(n,T)=2 or obj(n,T)=5 or obj(n,T)=10 or obj(n,T)=11 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34) end if if obj(n,T)=3 or obj(n,T)=4 or obj(n,T)=7 or obj(n,T)=8 or obj(n,T)=9 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34) end if end if next #op " wait" #op ""
'if file$<>"preview.bas" then '#op " 'Create the required handlers for each control" '#op " 'Radiobutton and Checkboxes are given a single handler" 'check=0 'radio=0 for n=1 to obj select case obj(n,T) case 3 'listbox listbx =listbx+1 #op " [listbox";listbx;"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op " " case 4 'combobox combobx =combobx+1 #op " [combobox";combobx;"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);", ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op " " case 5 'button buttn=buttn+1 #op " [button";buttn;"click]" #op " 'Your handler code here" #op " wait" #op " " case 6 'bmpbutton bmpbtn=bmpbtn+1 #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op " " case 8 'radiobutton radiobtn = radiobtn + 1 #op " [radiobutton";radiobtn;"]" #op " 'Your handler code here." #op " wait" #op " " #op " [noradiobutton";radiobtn;"]" #op " 'Your handler code here." #op " wait" #op " " case 9 'checkbox chekbx = chekbx + 1 #op " [checkbox";chekbx;"]" #op " 'Your handler code here." #op " wait" #op " " #op " [uncheckbox";chekbx;"]" #op " 'Your handler code here." #op " wait" [dontwrite2] #op " " end select next 'end if end if #op " " #op " [quit]" #op " close ";projectform$ #op " end" close #op
files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] return
[saveas] projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu" filedialog "Save As...",projectname$,file$ if file$<>"" then #fful.filePath "File - ";file$ open file$ for output as #op projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ #op projectfile$ #op projectwind$ #op projectform$ #op projecttitl$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth for n=1 to obj if obj(n,T)<>0 then #op obj(n,X);","; #op obj(n,Y);","; #op obj(n,W);","; #op obj(n,H);","; #op obj(n,T);","; #op obj(n,TH) #op obj$(n,Ctr) #op obj$(n,Tex) #op obj$(n,Res) #op obj$(n,Fon) #op obj$(n,Bak) end if next close #op gosub [propertyupdate] redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" end if return
[load] obj = 0 gosub [resetVars] filedialog "Open Project...","*.ffu",file$ #fful.filePath "File - ";file$ [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #ses input #ses, projectfile$ input #ses, projectwind$ input #ses, projectform$ input #ses, projecttitl$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #fful.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ projectctrh=val(c$) projectgrid=val(g$) grid=projectgrid projectw=val(w$) projecth=val(h$) #prop.cbwind "select ";projectwind$ redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.grid "select ";grid #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,X)=val(word$(l$,1,",")) obj(obj,Y)=val(word$(l$,2,",")) obj(obj,W)=val(word$(l$,3,",")) obj(obj,H)=val(word$(l$,4,",")) obj(obj,T)=val(word$(l$,5,",")) obj(obj,TH)=val(word$(l$,6,",")) line input #ses, obj$(obj,Ctr) line input #ses, obj$(obj,Tex) line input #ses, obj$(obj,Res) line input #ses, obj$(obj,Fon) line input #ses, obj$(obj,Bak) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) if obj(obj,T)=12 then menuset=1 if obj(obj,T)=11 then textEd= textEd+1 : gosub [drawgrid] wend close #ses gosub [propertyupdate] #prop "hide" #prop "show" end if return
[import] filedialog "Open .bas...","*.bas",file$ if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) gosub [new] #fful.filePath "File - ";file$ 'grid=1 'gridvisible=0 gosub [drawgrid] 'set grid to 1 and invisible so controls stay where they import from initially 'import only those lines defining controls we are interested in wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox " wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty " wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ " wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ " dim bas$(5000,2) basln=1 ln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, wln$ 'break into multiple lines if ":" found outside quotes pos=1 ln$="" while pos<=len(wln$) c$=mid$(wln$,pos,1) if c$=chr$(34)then if quote=0 then quote=1 else quote=0 end if if c$=":" and quote=0 then gosub [line] ln$="" pos=pos+1 else ln$=ln$+c$ pos=pos+1 end if wend gosub [line] basln=basln+1 wend 'print "first cut" 'for n=1 to ln 'print bas$(n,1);" ";bas$(n,2) 'next 'print
'now find width height title and handle for all windows found in bas$( 'up to 30 forms in a .bas '1=handle #main etc '2=title '3=width '4=height '5=windowtype '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
redim win$(30,10) redim hnd$(30) nl=ln wh=1 for ln=1 to nl 'find width and height ,assumes width and height are defined ahead of open 'so width height and colors can be set multiple times, so store bas line number involved if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1) if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1) if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1) if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1) if instr(lower$(bas$(ln,2)),"open",1)>0 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 or instr(lower$(bas$(ln,2)),"text",1)>0 then win$(wh,10)=bas$(ln,1) n$=word$(bas$(ln,2),2,chr$(34)) hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1)) 'find last "for" in command line i=1 while i oi=i i=instr(lower$(bas$(ln,2))," for ",i+1) wend wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi) wt$=word$(wt$,2) win$(wh,1)=hn$ 'handle #fful etc win$(wh,2)=n$ 'title win$(wh,3)=w$ 'width win$(wh,4)=h$ 'height win$(wh,5)=wt$ 'windowtype hnd$(wh)=hn$ 'for combobox 'print wh;" ";hnd$(wh);" ";win$(wh,2);" ";win$(wh,3);" ";win$(wh,4);" ";win$(wh,5) wh=wh+1 end if end if next #fful.hand "reload" #fful.hand "selectindex 1" close #bas if wt$ = "" then #fful.hand "!No Forms" wh=1 gosub [loadwindow] end if return
[line] if ln$<>"" then w$=lower$(word$(ln$,1)) if instr(w$,"=",1)>1 then w$=word$(w$,1,"=") if len(w$)>3 then w1$=" "+w$+" " w2$=" "+w$+"=" if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 then bas$(ln,1)=str$(basln) bas$(ln,2)=trim$(ln$) ln=ln+1 end if end if end if return
[hand] gosub [resetVars] #fful.hand "selectionindex? wh" gosub [loadwindow] wait
[loadwindow] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font gosub [resetVars] obj=1 projectback$="white" TextboxColor$="white" ListboxColor$="white" ComboboxColor$="white" TexteditorColor$="white" projectfore$="black" projectw=val(win$(wh,3)) if projectw=0 then projectw=600 projecth=val(win$(wh,4)) if projecth=0 then projecth=400 projecttitl$=win$(wh,2) projectwind$=win$(wh,5) projectform$=win$(wh,1) tbc$="" lbc$="" cbc$="" tec$="" gosub [propertyupdate] #fful.w "!";str$(projectw) #fful.h "!";str$(projecth)
'find controls and create obj() for ln=1 to nl 'create hidden objects to control font and color only used in import/export, not displayed ct=0 if instr(bas$(ln,2),"TextboxColor$",1)>0 then tbc$=getcolor$(bas$(ln,2)):ct=20 if instr(bas$(ln,2),"ListboxColor$",1)>0 then lbc$=getcolor$(bas$(ln,2)):ct=21 if instr(bas$(ln,2),"ComboboxColor$",1)>0 then cbc$=getcolor$(bas$(ln,2)):ct=22 if instr(bas$(ln,2),"TexteditorColor$",1)>0 then tec$=getcolor$(bas$(ln,2)):ct=23 if ct then obj(obj,T)=ct if ct=20 then obj$(obj,Bak)=tbc$ if ct=21 then obj$(obj,Bak)=lbc$ if ct=22 then obj$(obj,Bak)=cbc$ if ct=23 then obj$(obj,Bak)=tec$ obj$(obj,Bas)=bas$(ln,1) obj=obj+1 end if for wc=1 to 12 if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for next if wc<=11 then obj$(obj,Bas)=bas$(ln,1) l$=bas$(ln,2) ll$="" 'remove spaces leaving only , separation but keep "" text untouched inString=0 for i=1 to len(l$) c$=mid$(l$,i,1) select case case c$=chr$(34) inString=1-inString case (inString=0) and c$=" " c$="" end select ll$=ll$+c$ next 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1) obj(obj,T)=wc 'type obj(obj,TH)=projectctrh 'get the .ctrl name obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1) 'for un-named controls if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj 'get the text if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc) 'get the array or bmp file name if wc=3 or wc=4 or wc=6 then obj$(obj,Res)=word$(ll$,2,",") 'get rid of "" if wc=6 and left$(obj$(obj,Res),1)=chr$(34) then obj$(obj,Res)=mid$(obj$(obj,Res),2,len(obj$(obj,Res))-2) 'array() -> array( if (wc=3 or wc=4) and right$(obj$(obj,Res),1)=")" then obj$(obj,Res)=left$(obj$(obj,Res), len(obj$(obj,Res))-1) i=1 while word$(ll$,i,",")<>"" i=i+1 wend i=i-4 if wc=6 or wc=5 then 'buttons and bmpbuttons can have xy, wh is optional and they have XX corners if i=3 then obj(obj,X)=val(word$(ll$,i+2,","))'x obj(obj,Y)=val(word$(ll$,i+3,","))'y if wc=5 then 'we need to find a way to calculate width and height if not given #fful.gb "stringwidth? ";"A";" width" obj(obj,W)=width*len(obj$(obj,Tex))+10 obj(obj,H)=projectctrh end if if wc=6 then 'we need a way to set bmp w and h on error goto [dummybmp] open obj$(obj,Res) for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Tex)="bmp" end if loadbmp obj$(obj,Ctr),obj$(obj,Res) close #bmp goto [passdummy]
[dummybmp] obj(obj,W)=25 obj(obj,H)=25 obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),"path.bmp" [passdummy] end if else obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y obj(obj,W)=val(word$(ll$,i+2,","))'w obj(obj,H)=val(word$(ll$,i+3,","))'h end if if upper$(word$(ll$,4,","))="LR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="LL" then 'obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="UR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x 'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if else 'write to .bas tweaks listbox and combobox controls to line up properly 'so we need to untweak them now obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y if wc=1 then obj(obj,Y)=obj(obj,Y)-5 if wc=10 then obj(obj,Y)=obj(obj,Y)+5 if wc=3 or wc=4 then obj(obj,X)=obj(obj,X)-1 obj(obj,W)=val(word$(ll$,i+2,","))'w if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2 obj(obj,H)=val(word$(ll$,i+3,","))'h end if
'save color if set if wc=2 then obj$(obj,Bak)=tbc$ if wc=3 then obj$(obj,Bak)=lbc$ if wc=4 then obj$(obj,Bak)=cbc$ if wc=11 then obj$(obj,Bak)=tec$ obj=obj+1 end if next 'now find font commands listed after the open statement referring to the #form '#form.ctrl !font fontname 'if so add a new font object basln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ lln$=lower$(ln$) if instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font",1)>0 or instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font",1)>0 then f$=right$(ln$,len(ln$)-instr(lln$,"font",1)-4) if instr(f$,";",1)=0 then obj$(obj,Fon)=f$ obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1) obj$(obj,Ctr)=word$(word$(ln$,1),2,".") if instr(lln$,"!font",1)>0 then obj(obj,T)=31 else obj(obj,T)=30 obj$(obj,Bas)=str$(basln)
'find the visible object and store the font change for n=1 to obj if obj$(n,Ctr)=obj$(obj,Ctr) then obj$(n,Fon)=obj$(obj,Fon) #fful.gb "font ";obj$(obj,Fon) #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" obj(n,TH)=(yp-100)/2+7 exit for end if next obj=obj+1 end if end if basln=basln+1 wend close #bas gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[export] dim oldbas$(5000) ln=1 if file$<>"" and right$(file$,3)="bas" then open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ oldbas$(ln)=ln$ ln=ln+1 wend close #bas '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline if win$(wh,6)<>"" then oldbas$(val(win$(wh,6)))=" BackgroundColor$=";chr$(34);projectback$;chr$(34) if win$(wh,7)<>"" then oldbas$(val(win$(wh,7)))=" ForegroundColor$=";chr$(34);projectfore$;chr$(34) if win$(wh,8)<>"" then oldbas$(val(win$(wh,8)))=" WindowWidth=";projectw if win$(wh,8)=win$(wh,9) then oldbas$(val(win$(wh,8)))=oldbas$(val(win$(wh,8)))+": WindowHeight=";projecth else oldbas$(val(win$(wh,9)))=" WindowHeight=";projecth if win$(wh,10)<>"" then oldbas$(val(win$(wh,10)))=" Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ for n=1 to obj select case obj(n,T) 'handle the visible controls case 1 'statictext oldbas$(val(obj$(n,Bas)))=" statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox oldbas$(val(obj$(n,Bas)))=" textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box oldbas$(val(obj$(n,Bas)))=" listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox oldbas$(val(obj$(n,Bas)))=" combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button oldbas$(val(obj$(n,Bas)))=" button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton oldbas$(val(obj$(n,Bas)))=" bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox oldbas$(val(obj$(n,Bas)))=" graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton oldbas$(val(obj$(n,Bas)))=" radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox oldbas$(val(obj$(n,Bas)))=" checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box oldbas$(val(obj$(n,Bas)))=" groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor oldbas$(val(obj$(n,Bas)))=" texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export case 20 'textboxcolor oldbas$(val(obj$(n,Bas)))=" TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'listboxcolor oldbas$(val(obj$(n,Bas)))=" ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 22 'comboboxcolor oldbas$(val(obj$(n,Bas)))=" ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'texteditorcolor oldbas$(val(obj$(n,Bas)))=" TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
'handle font changes case 30 'font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" font ";obj$(n,Fon);chr$(34) case 32 '!font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" !font ";obj$(n,Fon);chr$(34) end select next end if open file$ for output as #bas for n= 1 to ln #bas oldbas$(n) next close #bas return
function getsize$(l$) 'what if it is a variable? v$="" pos=1 n$=mid$(l$,pos,1) while instr("1234567890",n$,1)=0 and pos<len(l$) pos=pos+1 n$=mid$(l$,pos,1) wend while n$>="0" and n$<="9" and pos<=len(l$) v$=v$+n$ pos=pos+1 n$=mid$(l$,pos,1) wend getsize$=v$ end function
function getcolor$(l$) 'what if it is a variable? cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black " for c= 1 to 15 if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for next end function
[new] #fful.filePath "File - untitled.ffu" redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=0 gosub [resetVars] projectw=600 projecth=400 projectback$="white" projectfore$="black" projectctrc$="white" projecttitl$="Untitled" projectform$="#1" projectfile$="Untitled.bas" projectwind$="window_nf" #prop.cbwind "select window_nf" redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.w "select ";projectw #fful.h "select ";projecth gosub [propertyupdate] gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[propertyupdate] #prop.tbfile projectfile$ #prop.cbwind "select ";projectwind$ #prop.tbtitl projecttitl$ #prop.tbform projectform$ #prop.tbctrl "" #prop.tbtext "" #prop.tbreso "" #prop.tbxywh projectw;"x";projecth #prop.tbfont projectfont$ #prop.tbcolo projectfore$;"/";projectback$ return
[resetVars] obj=0:menuset=0:textEd=0:check=0:radio=0:sttx=0:txtbx=0:lstbx=0:radiobtn=0:chekbx=0 cmbobx=0:bttn=0:buttn = 0:bmpbtn=0:grbx=0:rdiobtn=0:chkbx=0:grpbx=0:combobx=0 : import = 0 return
[resize] #fful.tool "select Add New" #fful.form "select File" if wh=0 then wh=1 #fful.hand "selectindex ";wh #fful.grid "select Set Grid" #fful.font "select Set Font" #fful.color "select Set Color" #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawall] wait
[formsize] #fful.w "contents? w$" #fful.h "contents? h$" wf=val(w$) hf=val(h$) if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait projectw=wf projecth=hf insertx=grid inserty=grid gosub [drawgrid] #fful.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid spacing according to user choice, default is 10 #fful.grid "contents? g$" select case g$ case "Invisible" gridvisible=0 case "Visible" gridvisible=1 case else grid=val(g$) end select gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" wait
[drawgrid] if textEd<0 then textEd=0 projectgrid=grid #fful.gb "cls; fill buttonface" if grid > 0 and gridvisible = 1 then #fful.gb "color ";gridcolor$ ' Grid - Draw vertical lines if menuset = 0 and textEd = 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25 for xs = 0 to projectw step grid ' Grid - Draw horizontal lines #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-25 next xs for ys = 0 to projecth-25 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if 'adjust grid when menu, or texeditor control is selected - revert if menu and texeditor deleted /no longer used., if menuset = 1 or textEd > 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";gridcolor$ for xs = 0 to projectw step grid #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-50 next xs for ys = 0 to projecth-50 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if end if [nogrid]
if grid = 1 or gridvisible = 0 then if textEd =0 and menuset = 0 then #fful.gb "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; " "; projectw; " "; (projecth)/2 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25 #fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25 end if if textEd > 0 or menuset = 1 then #fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";crosshair$ #fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-50 #fful.gb "line "; 0; " "; (projecth-50)/2; " "; projectw; " "; (projecth-50)/2 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50 #fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50 end if end if #fful.gb "flush bak" #fful.grid "!Set Grid" return
[font] #fful.font "contents? f$" if f$="Project Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #fful.gb "font ";projectfont$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" projectctrh=(yp-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Control Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #fful.gb "font ";ctrf$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" ctrh=(yp-100)/2+7 end if if selected then obj$(selected,4)=ctrf$ 'font obj(selected,6)=ctrh 'text height end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="ResetControl" then ctrf$=projectfont$ ctrh=projectctrh if selected then obj$(selected,4)=ctrf$ obj(selected,6)=ctrh end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then #fful.gb "font ";ctrf$ obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #fful.font "select Set Font" gosub [drawall] #fful.gb "setfocus" wait
[color] #fful.color "contents? c$" select case c$ case "Control Background" gosub [colorpick] if cp$<>"" then if selected then 'insert color change event ahead of control if obj(selected,T)=2 then ct=22 : projecttbcl$=cp$ if obj(selected,T)=3 then ct=23 : projectlbcl$=cp$ if obj(selected,T)=4 then ct=24 : projectcbcl$=cp$ if obj(selected,T)=11 then ct=21 : projecttecl$=cp$ for n=obj+1 to selected+1 step -1 obj(n,X)=obj(n-1,X) obj(n,Y)=obj(n-1,Y) obj(n,W)=obj(n-1,W) obj(n,H)=obj(n-1,H) obj(n,T)=obj(n-1,T) obj(n,TH)=obj(n-1,TH) obj$(n,Ctr)=obj$(n-1,Ctr) obj$(n,Tex)=obj$(n-1,Tex) obj$(n,Res)=obj$(n-1,Res) obj$(n,Fon)=obj$(n-1,Fon) obj$(n,Bak)=obj$(n-1,Bak) obj$(n,Bas)=obj$(n-1,Bas) next obj(selected,T)=ct obj$(selected,Tex)="Color!" obj$(selected,Bak)=cp$ 'remove any previous color change statement if selected>=2 then if obj(selected-1,T)=ct then obj(selected-1,T)=0 end if obj=obj+1 end if end if case "Project Background" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Project Foreground" gosub [colorpick] if cp$<>"" then projectfore$=cp$ gosub [drawgrid] case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] case "Border Color" gosub [colorpick] if cp$<>"" then bordercolor$=cp$ gosub [drawgrid] case "CrossHair Color" gosub [colorpick] if cp$<>"" then crosshair$=cp$ gosub [drawgrid] end select #fful.color "select Set Color" gosub [drawall] #fful.gb "setfocus" wait
[windowtype] #prop.cbwind "contents? projectwind$" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #pick.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #pick #pick "font Consolas 9" #pick "trapclose [quitpick]" #pick.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white " c=1 for yc=1 to 160 step 40 for xc= 1 to 160 step 40 #pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40 c=c+1 if c>15 then c=15 next next #pick.gb "when leftButtonDown [pick]" wait
[pick] xp=int(MouseX/40) yp=int(MouseY/40) c=xp+yp*4+1 cp$=word$(cl$,c)
[quitpick] close #pick return
[help] run "notepad help.txt" wait
[quitfful] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectfile$ #ses projectwind$ #ses projectform$ #ses projecttitl$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth for n=1 to obj if obj(n,T)<>0 then #ses obj(n,X);","; #ses obj(n,Y);","; #ses obj(n,W);","; #ses obj(n,H);","; #ses obj(n,T);","; #ses obj(n,TH) #ses obj$(n,Ctr) #ses obj$(n,Tex) #ses obj$(n,Res) #ses obj$(n,Fon) #ses obj$(n,Bak) end if next close #ses close #prop close #fful end
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
'for n=1 to obj 'print n;" ";obj(n,X);" ";obj(n,Y);" ";obj(n,W);" ";obj(n,H);" ";obj(n,T);" ";obj(n,6);" "; 'print obj$(n,Ctr);" ";obj$(n,Tex);" ";obj$(n,Res);" ";obj$(n,Fon);" ";obj$(n,Bak);" ";obj$(n,6);" ";obj$(n,Bas);" " 'next
|
|
|
Post by Rod on May 31, 2023 11:35:12 GMT -5
@anatoly, I would like to keep it “visual” highlight the control, click delete, gone. Anything else leaves the ultra lite tag hanging.
|
|
gaslouk
Full Member
Hi from beautiful Greece.
Posts: 131
|
Post by gaslouk on May 31, 2023 12:35:26 GMT -5
The following code is the latest, best working version so far. It is a separate FFUL with a couple other features The version number of this FFUL will be preceded by xx to distinguish between the 2 different FFUL's ver$="xx_1.1.4" - Writing, importing, loading(.ffu) and previewing code 'created by FFUL' seems to be working well. - Previewing code of any selected .bas file seems to be working well, except for the written event handlers. (next priority) Posting here to have a backup since versions are piling up and causing confusion here. ver$="xx_1.1.4" 'freeform ultra lite v1.x by Rod 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1 nomainwin dim info$(10,10) dim form$(10) form$(1)="Restore" form$(2)="New" form$(3)="Save .ffu" form$(4)="Load .ffu" form$(5)="-----------" form$(6)="Write .bas" form$(7)="Import .bas" form$(8)="Export .bas" form$(9)="File" dim tool$(14) tool$(1)="StatictText" tool$(2)="TextBox" tool$(3)="ListBox" tool$(5)="ComboBox" tool$(6)="Button" tool$(7)="BmpButton" tool$(8)="GraphicBox" tool$(9)="RadioButton" tool$(10)="CheckBox" tool$(11)="GroupBox" tool$(12)="Texteditor" tool$(13)="Menu" tool$(14)="Add New" dim hnd$(30) hnd$(1)="#1" dim grid$(20) grid$(1)="1" grid$(2)="3" g=3 for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Invisible" grid$(g+1)="Visible" grid$(g+2)="Set Grid" grid=10 gridvisible=1 gridcolor$="buttonface" bordercolor$=gridcolor$ crosshair$ =bordercolor$ projectctrh=25 ctrh=25 dim color$(10) color$(1)="Control Background" color$(2)="Project Background" color$(3)="Project Foreground" color$(4)="Grid Color" color$(5)="Border Color" color$(6)="CrossHair Color" color$(7)="Set Color" projectback$="white" projectfore$="black" 'ctrc$="white" dim font$(10) font$(1)="Control Font" font$(2)="ResetControl" font$(3)="Project Font" font$(4)="Set Font"'default is Consolas 9" dim wind$(20)'window type names wind$(1)="window" wind$(2)="window_nf" wind$(3)="window_popup" wind$(4)="dialog" wind$(5)="dialog_modal" wind$(6)="dialog_nf" wind$(7)="dialog_nf_modal" wind$(8)="dialog_fs" wind$(9)="dialog_nf_fs" wind$(10)="dialog_popup" wind$(11)="graphics" wind$(12)="graphics_fs" wind$(13)="graphics_fs_nsb" wind$(14)="graphics_nsb" wind$(15)="graphics_nf_nsb" wind$(16)="text" wind$(17)="text_fs" wind$(18)="text_nsb" wind$(19)="text_nsb_ins"
dim v$(2000) for n= 100 to 2000 step 20 v$(n)=str$(n) next dim obj(200,6) 'x,y,width/height,type,textheight X=1 Y=2 W=3 H=4 T=5 TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline Ctr=1 Tex=2 Res=3 Fon=4 Bak=5 Bas=7
'set default starting position obj=0 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" projectctrh=25 projectgrid=10 projectw=600 projecth=400 insertx=grid inserty=grid*2
'open a small properties window and hide it WindowWidth=230 WindowHeight=260 UpperLeftX=(DisplayWidth-230)/2 UpperLeftY=(DisplayHeight-180)/2 statictext #prop.st1 "File",5,10,30,25 textbox #prop.tbfile,45,5,150,25 statictext #prop.st2 "Wind",5,32,30,25 combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25 statictext #prop.st3 "Titl",5,54,30,25 textbox #prop.tbtitl,45,49,150,25 statictext #prop.st4 "Form",5,76,30,25 textbox #prop.tbform,45,71,150,25 statictext #prop.st5 "Ctrl",5,98,30,25 textbox #prop.tbctrl,45,93,150,25 statictext #prop.st6 "Text",5,120,30,25 textbox #prop.tbtext,45,115,150,25 statictext #prop.st7 "Reso",5,142,30,25 textbox #prop.tbreso,45,137,150,25 statictext #prop.st8 "xywh",5,164,30,25 textbox #prop.tbxywh,45,159,150,25 statictext #prop.st9 "Font",5,186,30,25 textbox #prop.tbfont,45,181,150,25 statictext #prop.st10 "Colo",5,208,30,25 textbox #prop.tbcolo,45,203,150,25
open "Properties" for window_nf as #prop #prop "font Consolas 9" #prop "trapclose [show]" #prop.cbwind "select window_nf" #prop.tbfile "!disable" #prop.tbxywh "!disable" #prop.tbfont "!disable" #prop.tbcolo "!disable" gosub [propertyupdate] #prop "hide"
'open the main form window 'this window is resizable, the graphicox will resize but the 'client area, which is a drawn representation of the window 'will only change size if you change the project w/h dimensions WindowWidth=860 WindowHeight=705 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #fful.form,form$(,[form],5,2,85,30 combobox #fful.hand,hnd$(,[hand],95,2,85,30 combobox #fful.tool,tool$(,[tool],185,2,85,30 button #fful.project,"Preview",[preview],UL,275,0,60,25 combobox #fful.w,v$(,[formsize],340,2,60,30 combobox #fful.h,v$(,[formsize],405,2,60,30 combobox #fful.grid,grid$(,[grid],470,2,90,30 combobox #fful.color,color$(,[color],565,2,130,30 combobox #fful.font,font$(,[font],700,2,90,30 button #fful.help,"Help",[help],UL,795,0,40,25 textbox #fful.filePath, 5,18,1600,20 'statictext #fful.filePath, "",5,25,1600,15 graphicbox #fful.gb,5,35,830,630 open "FFULv";ver$;" Forms Controls Form Dimensions Grid Size Colors Fonts" for window as #fful #fful "trapclose [quitfful]" #fful "font Consolas 9" #fful "resizehandler [resize]" #fful.tool "select Add New" #fful.form "select File" #fful.hand "selectindex 1" #fful.grid "select Set Grid" #fful.color "select Set Color" #fful.font "select Set Font" #fful.w "select ";projectw #fful.h "select ";projecth #fful.gb "autoresize" #fful.gb "vertscrollbar on 0 ";projectw #fful.gb "horizscrollbar on 0 ";projecth #fful.gb "font ";projectfont$ #fful.gb "down" gosub [drawgrid] gosub [drawall] #fful.gb "when rightButtonDown [show]" #fful.gb "when leftButtonDown [select]" #fful.gb "when characterInput [keys]" #fful.gb "setfocus" #prop "show" show=1 #fful.filePath, "File - untitled.ffu" #fful.filePath, "!disable" wait
[show] if show then #prop "hide" show=0 else #prop "show" show=1 end if wait
'the user clicked on the form design window 'either to chose a control or to deselect a control [select] xs=MouseX ys=MouseY 'hide property window if it is open if show then #prop "hide" show=0 end if
'before we move on update the currently selected control from properties 'get the project data and only the editable contents of controls if selected=0 then 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ end if #prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$ #prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$ #prop.tbreso "!contents? t$" : obj$(selected,Res)=t$ 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if xs>obj(cn,X) and xs<(obj(cn,X)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then if xs>obj(cn,X)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2 if obj(cn,T)=6 then action=1 selected=cn exit for end if next if selected=0 then gosub [propertyupdate] action=0 end if if selected>0 and action=1 then #fful.gb "when leftButtonMove [track]" #fful.gb "when leftButtonUp [stop]" offsetX=xs-obj(selected,X) offsetY=ys-obj(selected,Y) end if if selected>0 and obj(selected,T)<>6 and action=2 then 'dont resize bmp #fful.gb "when leftButtonMove [tracksize]" #fful.gb "when leftButtonUp [stopsize]" offsetX=xs-(obj(selected,X)+obj(selected,W)) offsetY=ys-(obj(selected,Y)+obj(selected,H)) end if if selected>0 then gosub [drawit] else insertx=int((xs+(grid/2))/grid)*grid inserty=int((ys+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #fful.gb "rule xor" gosub [drawit] xt=int((MouseX-offsetX+(grid/2))/grid)*grid if xt<0 then xt=0'11 if xt+obj(selected,W)>projectw then xt=projectw-obj(selected,W) obj(selected,X)=xt yt=int((MouseY-offsetY+(grid/2))/grid)*grid if menuset = 0 and textEd = 0 then if yt<0 then yt=0 if yt+obj(selected,H)>projecth-25 then yt=projecth-obj(selected,H)-25 obj(selected,Y)=yt end if
if menuset = 1 or textEd > 0 then if yt < 0 then yt = 0 if yt+obj(selected,H)>projecth-50 then yt=projecth-obj(selected,H)-50 obj(selected,Y)=yt end if gosub [drawit] wait
[stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[tracksize] #fful.gb "rule xor" gosub [drawit] xs=int((MouseX-offsetX+(grid/2))/grid)*grid if xs>projectw then xs=projectw if xs<obj(selected,X) then xs=obj(selected,X)+grid ys=int((MouseY-offsetY+(grid/2))/grid)*grid if ys>projecth then ys=projecth if ys<obj(selected,Y)+ctrh then ys=obj(selected,Y)+ctrh obj(selected,W)=xs-obj(selected,X)'width if menuset = 1 or textEd > 0 then obj(selected,H)=ys-obj(selected,Y)-50'height if menuset = 0 and textEd = 0 then obj(selected,H)=ys-obj(selected,Y)-25'height gosub [drawit] wait
[stopsize] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,T)=12 then menuset = 0 : gosub [drawgrid] 'menu if obj(selected,T)=11 then textEd = textEd-1 : gosub [drawgrid] 'texteditor obj(selected,T)=0 selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,X) 'x cpy(2)=obj(selected,Y) 'y cpy(3)=obj(selected,W) 'w cpy(4)=obj(selected,H) 'h cpy(5)=obj(selected,T) 'type cpy(6)=obj(selected,TH) 'textheight cpy$(1)=obj$(selected,Ctr) 'name cpy$(2)=obj$(selected,Tex) 'text content cpy$(3)=obj$(selected,Res) 'resource array or file path cpy$(4)=obj$(selected,Fon) 'ctrl specific font or "" cpy$(5)=obj$(selected,Bak) 'ctrl specific backcolor end if
if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 if obj(obj,T)=11 then textEd = textEd+1 'texteditor obj(obj,X)=insertx obj(obj,Y)=inserty inserty=inserty+cpy(4)+grid obj(obj,W)=cpy(3) obj(obj,H)=cpy(4) obj(obj,T)=cpy(5) obj(obj,TH)=cpy(6) obj$(obj,Ctr)=left$(cpy$(1),11)';obj obj$(obj,Tex)=cpy$(2) obj$(obj,Res)=cpy$(3) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) obj$(obj,Fon)=cpy$(4) obj$(obj,Bak)=cpy$(5) selected=obj gosub [drawall] end if end if #fful.gb "setfocus" wait
[tool] #fful.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext sttx = sttx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=1 obj$(obj,Ctr)="statictext";sttx obj$(obj,Tex)="Statictext-";sttx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 2 'textbox txtbx = txtbx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=2 obj$(obj,Ctr)="textbox";txtbx obj$(obj,Tex)="Textbox-";txtbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 3 'listbox lstbx = lstbx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh*5 obj(obj,T)=3 obj$(obj,Ctr)="listbox";lstbx obj$(obj,Tex)="Listbox-";lstbx;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectlbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 4 'combobox cmbobx = cmbobx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="combobox";cmbobx obj$(obj,Tex)="Combobox-";cmbobx;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectcbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 5 'button bttn = bttn +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=5 obj$(obj,Ctr)="button";bttn obj$(obj,Tex)="button-";bttn if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)="white" inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 6 'bmp button bmpbtn = bmpbtn +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=50 obj(obj,H)=50 obj(obj,T)=6 obj$(obj,Ctr)="bmp\bmpButton";bmpbtn filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Res)=file$ obj$(obj,Tex)="BMPbutton-";bmpbtn loadbmp obj$(obj,Ctr),file$ close #bmp inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid else obj(obj,T)=0 close #bmp end if else obj(obj,T)=0 end if
case 7 'graphicbox grbx = grbx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*3 obj(obj,T)=7 obj$(obj,Ctr)="graphicbox";grbx obj$(obj,Tex)="Graphicbox-";grbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton radio = 1 rdiobtn = rdiobtn + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 obj(obj,H)=ctrh obj(obj,T)=8 obj$(obj,Ctr)="radiobutton";rdiobtn obj$(obj,Tex)="(o) radioBtn-";rdiobtn obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 9 'checkbox check = 1 chkbx = chkbx+1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="checkbox";chkbx obj$(obj,Tex)="[x] checkbox-";chkbx obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox grpbx = grpbx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*4 obj(obj,T)=10 obj$(obj,Ctr)="groupbox";grpbx obj$(obj,Tex)="Group Box-";grpbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor textEd = textEd+1 gosub [drawgrid] obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh*4 obj(obj,T)=11 obj$(obj,Ctr)="texteditor";textEd obj$(obj,Tex)="Texteditor-";textEd if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttecl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,X)=0 obj(obj,Y)=0 obj(obj,W)=100 obj(obj,H)=10 obj(obj,T)=12 obj$(obj,Ctr)="menu";obj obj$(obj,Tex)=" Menu Added" inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid gosub [drawgrid] end if end select selected=obj gosub [drawall] #fful.tool "select Add New" #fful.gb "setfocus" wait
[form] #fful.form "selectionindex? i" select case i case 1 'restore file$="lastsession.ffu" #fful.filePath, "lastsession.ffu" gosub [loadit] case 2 'new gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 6 'write gosub [write] case 7 'import gosub [import] case 8 'export gosub [export] end select #fful.form "select File" gosub [drawall] #fful.gb "setfocus" wait
[drawall] #fful.gb "discard ; redraw bak" ocn=cn projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" for cn=1 to obj gosub [drawit] next cn=ocn #fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20 #fful.gb "setfocus" return
[drawit] 'redraws control cn 'set the color for the drawn object and action taking place if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if
'set the font for the drawn object if obj$(cn,Fon)="" then #fful.gb "font ";projectfont$ ch=projectctrh if obj(cn,H)<ch then obj(cn,H)=ch else #fful.gb "font ";obj$(cn,Fon) ch=obj(cn,TH) if obj(cn,H)<ch then obj(cn,H)=ch end if
'update the properties textboxes for selected control if cn=selected then #prop.tbctrl obj$(cn,Ctr) 'ctrlname #prop.tbtext obj$(cn,Tex) 'text #prop.tbreso obj$(cn,Res) 'resource #prop.tbxywh obj(cn,X);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height #prop.tbcolo obj$(cn,Bak) end if if projecttbcl$ = "" then projecttbcl$ = "white" if projectlbcl$ = "" then projectlbcl$ = "white" if projectcbcl$ = "" then projectcbcl$ = "white" if projecttecl$ = "" then projecttecl$ = "white" #fful.gb "place ";obj(cn,X);" ";obj(cn,Y) if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?" select case obj(cn,T) case 1 'statictext #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 2 'textbox #fful.gb "backcolor ";projecttbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 3 'listbox #fful.gb "backcolor ";projectlbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 4 'combobox #fful.gb "backcolor ";projectcbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 5 'button #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'buttons are always black on white #fful.gb "color black" 'centre button text #fful.gb "stringwidth? ";"A";" width" xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ #fful.gb "backcolor ";projectback$ case 6 'bmpbutton if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr) #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) case 7 ' graphicbox #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "backcolor ";projectback$ case 8 'radiobutton #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'radiobutton text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 9 'checkbox #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'checkbox text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 10 'groupbox #fful.gb "backcolor ";projectback$ 'groupbox is an outline #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'group box text is always black #fful.gb "color black" 'groupbox text is offset if action=0 then #fful.gb "place ";obj(cn,X)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 11 ' texteditor #fful.gb "backcolor ";projecttecl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 12 'menu 'pin to top left obj(cn,X)=10 : obj(cn,Y)=-10 : obj(cn,W)=100 : obj(cn,H)=10 xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X);" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) '#fful.gb "box ";obj(cn,X)+obj(cn,H);" ";obj(cn,Y)+obj(cn,H) #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 21 'tecolor projecttecl$=obj$(cn,Bak) case 22 'tbcolor projecttbcl$=obj$(cn,Bak) case 23 'lbcolor projectlbcl$=obj$(cn,Bak) case 24 'cbcolor projectcbcl$=obj$(cn,Bak) case 30 'font case 31 '!font end select return
[preview] file$="preview.bas" gosub [writeit] wait
[quitnoform] close #noform wait
[write] projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas" filedialog "Save .bas",projectfile$,file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit] if file$<>"" then '#################################################### if projectwind$ = "" then wait '#################################################### open file$ for output as #op 'the header #op " 'Project ";projecttitl$ #op " 'Created with Freeform Ultra Lite v";ver$;" ";date$() #op "" if projectback$<>"white" or projectfore$<>"black" then #op " 'Set BackgroundColor$ and ForegroundColor$ of project" #op " BackgroundColor$=";chr$(34);projectback$;chr$(34) #op " ForegroundColor$=";chr$(34);projectfore$;chr$(34) #op "" end if #op " 'Create arrays needed for controls listbox,combobox" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " dim ";obj$(n,Ctr);"$(10)" #op " for n = 1 to 10" #op " ";obj$(n,Ctr);"$(n)= str$(n)" #op " next" end if next #op "" #op " 'Create controls and open window" #op " nomainwin" #op " WindowWidth = ";projectw #op " WindowHeight = ";projecth #op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"Size";chr$(34);", ";chr$(34);"Small";chr$(34);", [dummy], ";chr$(34);"Large";chr$(34);", [dummy]" end if for n=1 to obj select case obj(n,T) case 1 'statictext #op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox #op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ctr);"$(, [";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ctr);"$(, [";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"],[no";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"],[un";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor #op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 22 'tbcolor #op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'lbcolor #op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 24 'cbcolor #op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'tecolor #op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34) end select next #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op "" #op " 'Set any listbox or combobox to display the first item on the list" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34) end if next #op " 'apply any control specific fonts" for n= 1 to obj if obj(n,T)<>0 and obj$(n,Fon)<>"" then if obj(n,T)=1 or obj(n,T)=2 or obj(n,T)=5 or obj(n,T)=10 or obj(n,T)=11 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34) end if if obj(n,T)=3 or obj(n,T)=4 or obj(n,T)=7 or obj(n,T)=8 or obj(n,T)=9 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34) end if end if next #op " wait" #op ""
'if file$<>"preview.bas" then '#op " 'Create the required handlers for each control" '#op " 'Radiobutton and Checkboxes are given a single handler" 'check=0 'radio=0 for n=1 to obj select case obj(n,T) case 3 'listbox listbx =listbx+1 #op " [listbox";listbx;"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op " " case 4 'combobox combobx =combobx+1 #op " [combobox";combobx;"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);", ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op " " case 5 'button buttn=buttn+1 #op " [button";buttn;"click]" #op " 'Your handler code here" #op " wait" #op " " case 6 'bmpbutton bmpbtn=bmpbtn+1 #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op " " case 8 'radiobutton radiobtn = radiobtn + 1 #op " [radiobutton";radiobtn;"]" #op " 'Your handler code here." #op " wait" #op " " #op " [noradiobutton";radiobtn;"]" #op " 'Your handler code here." #op " wait" #op " " case 9 'checkbox chekbx = chekbx + 1 #op " [checkbox";chekbx;"]" #op " 'Your handler code here." #op " wait" #op " " #op " [uncheckbox";chekbx;"]" #op " 'Your handler code here." #op " wait" [dontwrite2] #op " " end select next 'end if end if #op " " #op " [quit]" #op " close ";projectform$ #op " end" close #op
files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] return
[saveas] projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu" filedialog "Save As...",projectname$,file$ if file$<>"" then #fful.filePath "File - ";file$ open file$ for output as #op projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ #op projectfile$ #op projectwind$ #op projectform$ #op projecttitl$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth for n=1 to obj if obj(n,T)<>0 then #op obj(n,X);","; #op obj(n,Y);","; #op obj(n,W);","; #op obj(n,H);","; #op obj(n,T);","; #op obj(n,TH) #op obj$(n,Ctr) #op obj$(n,Tex) #op obj$(n,Res) #op obj$(n,Fon) #op obj$(n,Bak) end if next close #op gosub [propertyupdate] redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" end if return
[load] obj = 0 gosub [resetVars] filedialog "Open Project...","*.ffu",file$ #fful.filePath "File - ";file$ [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #ses input #ses, projectfile$ input #ses, projectwind$ input #ses, projectform$ input #ses, projecttitl$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #fful.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ projectctrh=val(c$) projectgrid=val(g$) grid=projectgrid projectw=val(w$) projecth=val(h$) #prop.cbwind "select ";projectwind$ redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.grid "select ";grid #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,X)=val(word$(l$,1,",")) obj(obj,Y)=val(word$(l$,2,",")) obj(obj,W)=val(word$(l$,3,",")) obj(obj,H)=val(word$(l$,4,",")) obj(obj,T)=val(word$(l$,5,",")) obj(obj,TH)=val(word$(l$,6,",")) line input #ses, obj$(obj,Ctr) line input #ses, obj$(obj,Tex) line input #ses, obj$(obj,Res) line input #ses, obj$(obj,Fon) line input #ses, obj$(obj,Bak) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) if obj(obj,T)=12 then menuset=1 if obj(obj,T)=11 then textEd= textEd+1 : gosub [drawgrid] wend close #ses gosub [propertyupdate] #prop "hide" #prop "show" end if return
[import] filedialog "Open .bas...","*.bas",file$ if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) gosub [new] #fful.filePath "File - ";file$ 'grid=1 'gridvisible=0 gosub [drawgrid] 'set grid to 1 and invisible so controls stay where they import from initially 'import only those lines defining controls we are interested in wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox " wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty " wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ " wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ " dim bas$(5000,2) basln=1 ln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, wln$ 'break into multiple lines if ":" found outside quotes pos=1 ln$="" while pos<=len(wln$) c$=mid$(wln$,pos,1) if c$=chr$(34)then if quote=0 then quote=1 else quote=0 end if if c$=":" and quote=0 then gosub [line] ln$="" pos=pos+1 else ln$=ln$+c$ pos=pos+1 end if wend gosub [line] basln=basln+1 wend 'print "first cut" 'for n=1 to ln 'print bas$(n,1);" ";bas$(n,2) 'next 'print
'now find width height title and handle for all windows found in bas$( 'up to 30 forms in a .bas '1=handle #main etc '2=title '3=width '4=height '5=windowtype '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
redim win$(30,10) redim hnd$(30) nl=ln wh=1 for ln=1 to nl 'find width and height ,assumes width and height are defined ahead of open 'so width height and colors can be set multiple times, so store bas line number involved if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1) if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1) if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1) if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1) if instr(lower$(bas$(ln,2)),"open",1)>0 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 or instr(lower$(bas$(ln,2)),"text",1)>0 then win$(wh,10)=bas$(ln,1) n$=word$(bas$(ln,2),2,chr$(34)) hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1)) 'find last "for" in command line i=1 while i oi=i i=instr(lower$(bas$(ln,2))," for ",i+1) wend wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi) wt$=word$(wt$,2) win$(wh,1)=hn$ 'handle #fful etc win$(wh,2)=n$ 'title win$(wh,3)=w$ 'width win$(wh,4)=h$ 'height win$(wh,5)=wt$ 'windowtype hnd$(wh)=hn$ 'for combobox 'print wh;" ";hnd$(wh);" ";win$(wh,2);" ";win$(wh,3);" ";win$(wh,4);" ";win$(wh,5) wh=wh+1 end if end if next #fful.hand "reload" #fful.hand "selectindex 1" close #bas if wt$ = "" then #fful.hand "!No Forms" wh=1 gosub [loadwindow] end if return
[line] if ln$<>"" then w$=lower$(word$(ln$,1)) if instr(w$,"=",1)>1 then w$=word$(w$,1,"=") if len(w$)>3 then w1$=" "+w$+" " w2$=" "+w$+"=" if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 then bas$(ln,1)=str$(basln) bas$(ln,2)=trim$(ln$) ln=ln+1 end if end if end if return
[hand] gosub [resetVars] #fful.hand "selectionindex? wh" gosub [loadwindow] wait
[loadwindow] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font gosub [resetVars] obj=1 projectback$="white" TextboxColor$="white" ListboxColor$="white" ComboboxColor$="white" TexteditorColor$="white" projectfore$="black" projectw=val(win$(wh,3)) if projectw=0 then projectw=600 projecth=val(win$(wh,4)) if projecth=0 then projecth=400 projecttitl$=win$(wh,2) projectwind$=win$(wh,5) projectform$=win$(wh,1) tbc$="" lbc$="" cbc$="" tec$="" gosub [propertyupdate] #fful.w "!";str$(projectw) #fful.h "!";str$(projecth)
'find controls and create obj() for ln=1 to nl 'create hidden objects to control font and color only used in import/export, not displayed ct=0 if instr(bas$(ln,2),"TextboxColor$",1)>0 then tbc$=getcolor$(bas$(ln,2)):ct=20 if instr(bas$(ln,2),"ListboxColor$",1)>0 then lbc$=getcolor$(bas$(ln,2)):ct=21 if instr(bas$(ln,2),"ComboboxColor$",1)>0 then cbc$=getcolor$(bas$(ln,2)):ct=22 if instr(bas$(ln,2),"TexteditorColor$",1)>0 then tec$=getcolor$(bas$(ln,2)):ct=23 if ct then obj(obj,T)=ct if ct=20 then obj$(obj,Bak)=tbc$ if ct=21 then obj$(obj,Bak)=lbc$ if ct=22 then obj$(obj,Bak)=cbc$ if ct=23 then obj$(obj,Bak)=tec$ obj$(obj,Bas)=bas$(ln,1) obj=obj+1 end if for wc=1 to 12 if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for next if wc<=11 then obj$(obj,Bas)=bas$(ln,1) l$=bas$(ln,2) ll$="" 'remove spaces leaving only , separation but keep "" text untouched inString=0 for i=1 to len(l$) c$=mid$(l$,i,1) select case case c$=chr$(34) inString=1-inString case (inString=0) and c$=" " c$="" end select ll$=ll$+c$ next 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1) obj(obj,T)=wc 'type obj(obj,TH)=projectctrh 'get the .ctrl name obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1) 'for un-named controls if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj 'get the text if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc) 'get the array or bmp file name if wc=3 or wc=4 or wc=6 then obj$(obj,Res)=word$(ll$,2,",") 'get rid of "" if wc=6 and left$(obj$(obj,Res),1)=chr$(34) then obj$(obj,Res)=mid$(obj$(obj,Res),2,len(obj$(obj,Res))-2) 'array() -> array( if (wc=3 or wc=4) and right$(obj$(obj,Res),1)=")" then obj$(obj,Res)=left$(obj$(obj,Res), len(obj$(obj,Res))-1) i=1 while word$(ll$,i,",")<>"" i=i+1 wend i=i-4 if wc=6 or wc=5 then 'buttons and bmpbuttons can have xy, wh is optional and they have XX corners if i=3 then obj(obj,X)=val(word$(ll$,i+2,","))'x obj(obj,Y)=val(word$(ll$,i+3,","))'y if wc=5 then 'we need to find a way to calculate width and height if not given #fful.gb "stringwidth? ";"A";" width" obj(obj,W)=width*len(obj$(obj,Tex))+10 obj(obj,H)=projectctrh end if if wc=6 then 'we need a way to set bmp w and h on error goto [dummybmp] open obj$(obj,Res) for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Tex)="bmp" end if loadbmp obj$(obj,Ctr),obj$(obj,Res) close #bmp goto [passdummy]
[dummybmp] obj(obj,W)=25 obj(obj,H)=25 obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),"path.bmp" [passdummy] end if else obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y obj(obj,W)=val(word$(ll$,i+2,","))'w obj(obj,H)=val(word$(ll$,i+3,","))'h end if if upper$(word$(ll$,4,","))="LR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="LL" then 'obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="UR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x 'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if else 'write to .bas tweaks listbox and combobox controls to line up properly 'so we need to untweak them now obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y if wc=1 then obj(obj,Y)=obj(obj,Y)-5 if wc=10 then obj(obj,Y)=obj(obj,Y)+5 if wc=3 or wc=4 then obj(obj,X)=obj(obj,X)-1 obj(obj,W)=val(word$(ll$,i+2,","))'w if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2 obj(obj,H)=val(word$(ll$,i+3,","))'h end if
'save color if set if wc=2 then obj$(obj,Bak)=tbc$ if wc=3 then obj$(obj,Bak)=lbc$ if wc=4 then obj$(obj,Bak)=cbc$ if wc=11 then obj$(obj,Bak)=tec$ obj=obj+1 end if next 'now find font commands listed after the open statement referring to the #form '#form.ctrl !font fontname 'if so add a new font object basln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ lln$=lower$(ln$) if instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font",1)>0 or instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font",1)>0 then f$=right$(ln$,len(ln$)-instr(lln$,"font",1)-4) if instr(f$,";",1)=0 then obj$(obj,Fon)=f$ obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1) obj$(obj,Ctr)=word$(word$(ln$,1),2,".") if instr(lln$,"!font",1)>0 then obj(obj,T)=31 else obj(obj,T)=30 obj$(obj,Bas)=str$(basln)
'find the visible object and store the font change for n=1 to obj if obj$(n,Ctr)=obj$(obj,Ctr) then obj$(n,Fon)=obj$(obj,Fon) #fful.gb "font ";obj$(obj,Fon) #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" obj(n,TH)=(yp-100)/2+7 exit for end if next obj=obj+1 end if end if basln=basln+1 wend close #bas gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[export] dim oldbas$(5000) ln=1 if file$<>"" and right$(file$,3)="bas" then open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ oldbas$(ln)=ln$ ln=ln+1 wend close #bas '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline if win$(wh,6)<>"" then oldbas$(val(win$(wh,6)))=" BackgroundColor$=";chr$(34);projectback$;chr$(34) if win$(wh,7)<>"" then oldbas$(val(win$(wh,7)))=" ForegroundColor$=";chr$(34);projectfore$;chr$(34) if win$(wh,8)<>"" then oldbas$(val(win$(wh,8)))=" WindowWidth=";projectw if win$(wh,8)=win$(wh,9) then oldbas$(val(win$(wh,8)))=oldbas$(val(win$(wh,8)))+": WindowHeight=";projecth else oldbas$(val(win$(wh,9)))=" WindowHeight=";projecth if win$(wh,10)<>"" then oldbas$(val(win$(wh,10)))=" Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ for n=1 to obj select case obj(n,T) 'handle the visible controls case 1 'statictext oldbas$(val(obj$(n,Bas)))=" statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox oldbas$(val(obj$(n,Bas)))=" textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box oldbas$(val(obj$(n,Bas)))=" listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox oldbas$(val(obj$(n,Bas)))=" combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button oldbas$(val(obj$(n,Bas)))=" button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton oldbas$(val(obj$(n,Bas)))=" bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox oldbas$(val(obj$(n,Bas)))=" graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton oldbas$(val(obj$(n,Bas)))=" radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox oldbas$(val(obj$(n,Bas)))=" checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box oldbas$(val(obj$(n,Bas)))=" groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor oldbas$(val(obj$(n,Bas)))=" texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export case 20 'textboxcolor oldbas$(val(obj$(n,Bas)))=" TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'listboxcolor oldbas$(val(obj$(n,Bas)))=" ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 22 'comboboxcolor oldbas$(val(obj$(n,Bas)))=" ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'texteditorcolor oldbas$(val(obj$(n,Bas)))=" TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
'handle font changes case 30 'font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" font ";obj$(n,Fon);chr$(34) case 32 '!font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" !font ";obj$(n,Fon);chr$(34) end select next end if open file$ for output as #bas for n= 1 to ln #bas oldbas$(n) next close #bas return
function getsize$(l$) 'what if it is a variable? v$="" pos=1 n$=mid$(l$,pos,1) while instr("1234567890",n$,1)=0 and pos<len(l$) pos=pos+1 n$=mid$(l$,pos,1) wend while n$>="0" and n$<="9" and pos<=len(l$) v$=v$+n$ pos=pos+1 n$=mid$(l$,pos,1) wend getsize$=v$ end function
function getcolor$(l$) 'what if it is a variable? cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black " for c= 1 to 15 if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for next end function
[new] #fful.filePath "File - untitled.ffu" redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=0 gosub [resetVars] projectw=600 projecth=400 projectback$="white" projectfore$="black" projectctrc$="white" projecttitl$="Untitled" projectform$="#1" projectfile$="Untitled.bas" projectwind$="window_nf" #prop.cbwind "select window_nf" redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.w "select ";projectw #fful.h "select ";projecth gosub [propertyupdate] gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[propertyupdate] #prop.tbfile projectfile$ #prop.cbwind "select ";projectwind$ #prop.tbtitl projecttitl$ #prop.tbform projectform$ #prop.tbctrl "" #prop.tbtext "" #prop.tbreso "" #prop.tbxywh projectw;"x";projecth #prop.tbfont projectfont$ #prop.tbcolo projectfore$;"/";projectback$ return
[resetVars] obj=0:menuset=0:textEd=0:check=0:radio=0:sttx=0:txtbx=0:lstbx=0:radiobtn=0:chekbx=0 cmbobx=0:bttn=0:buttn = 0:bmpbtn=0:grbx=0:rdiobtn=0:chkbx=0:grpbx=0:combobx=0 : import = 0 return
[resize] #fful.tool "select Add New" #fful.form "select File" if wh=0 then wh=1 #fful.hand "selectindex ";wh #fful.grid "select Set Grid" #fful.font "select Set Font" #fful.color "select Set Color" #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawall] wait
[formsize] #fful.w "contents? w$" #fful.h "contents? h$" wf=val(w$) hf=val(h$) if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait projectw=wf projecth=hf insertx=grid inserty=grid gosub [drawgrid] #fful.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid spacing according to user choice, default is 10 #fful.grid "contents? g$" select case g$ case "Invisible" gridvisible=0 case "Visible" gridvisible=1 case else grid=val(g$) end select gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" wait
[drawgrid] if textEd<0 then textEd=0 projectgrid=grid #fful.gb "cls; fill buttonface" if grid > 0 and gridvisible = 1 then #fful.gb "color ";gridcolor$ ' Grid - Draw vertical lines if menuset = 0 and textEd = 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25 for xs = 0 to projectw step grid ' Grid - Draw horizontal lines #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-25 next xs for ys = 0 to projecth-25 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if 'adjust grid when menu, or texeditor control is selected - revert if menu and texeditor deleted /no longer used., if menuset = 1 or textEd > 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";gridcolor$ for xs = 0 to projectw step grid #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-50 next xs for ys = 0 to projecth-50 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if end if [nogrid]
if grid = 1 or gridvisible = 0 then if textEd =0 and menuset = 0 then #fful.gb "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; " "; projectw; " "; (projecth)/2 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25 #fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25 end if if textEd > 0 or menuset = 1 then #fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";crosshair$ #fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-50 #fful.gb "line "; 0; " "; (projecth-50)/2; " "; projectw; " "; (projecth-50)/2 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50 #fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50 end if end if #fful.gb "flush bak" #fful.grid "!Set Grid" return
[font] #fful.font "contents? f$" if f$="Project Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #fful.gb "font ";projectfont$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" projectctrh=(yp-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Control Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #fful.gb "font ";ctrf$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" ctrh=(yp-100)/2+7 end if if selected then obj$(selected,4)=ctrf$ 'font obj(selected,6)=ctrh 'text height end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="ResetControl" then ctrf$=projectfont$ ctrh=projectctrh if selected then obj$(selected,4)=ctrf$ obj(selected,6)=ctrh end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then #fful.gb "font ";ctrf$ obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #fful.font "select Set Font" gosub [drawall] #fful.gb "setfocus" wait
[color] #fful.color "contents? c$" select case c$ case "Control Background" gosub [colorpick] if cp$<>"" then if selected then 'insert color change event ahead of control if obj(selected,T)=2 then ct=22 : projecttbcl$=cp$ if obj(selected,T)=3 then ct=23 : projectlbcl$=cp$ if obj(selected,T)=4 then ct=24 : projectcbcl$=cp$ if obj(selected,T)=11 then ct=21 : projecttecl$=cp$ for n=obj+1 to selected+1 step -1 obj(n,X)=obj(n-1,X) obj(n,Y)=obj(n-1,Y) obj(n,W)=obj(n-1,W) obj(n,H)=obj(n-1,H) obj(n,T)=obj(n-1,T) obj(n,TH)=obj(n-1,TH) obj$(n,Ctr)=obj$(n-1,Ctr) obj$(n,Tex)=obj$(n-1,Tex) obj$(n,Res)=obj$(n-1,Res) obj$(n,Fon)=obj$(n-1,Fon) obj$(n,Bak)=obj$(n-1,Bak) obj$(n,Bas)=obj$(n-1,Bas) next obj(selected,T)=ct obj$(selected,Tex)="Color!" obj$(selected,Bak)=cp$ 'remove any previous color change statement if selected>=2 then if obj(selected-1,T)=ct then obj(selected-1,T)=0 end if obj=obj+1 end if end if case "Project Background" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Project Foreground" gosub [colorpick] if cp$<>"" then projectfore$=cp$ gosub [drawgrid] case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] case "Border Color" gosub [colorpick] if cp$<>"" then bordercolor$=cp$ gosub [drawgrid] case "CrossHair Color" gosub [colorpick] if cp$<>"" then crosshair$=cp$ gosub [drawgrid] end select #fful.color "select Set Color" gosub [drawall] #fful.gb "setfocus" wait
[windowtype] #prop.cbwind "contents? projectwind$" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #pick.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #pick #pick "font Consolas 9" #pick "trapclose [quitpick]" #pick.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white " c=1 for yc=1 to 160 step 40 for xc= 1 to 160 step 40 #pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40 c=c+1 if c>15 then c=15 next next #pick.gb "when leftButtonDown [pick]" wait
[pick] xp=int(MouseX/40) yp=int(MouseY/40) c=xp+yp*4+1 cp$=word$(cl$,c)
[quitpick] close #pick return
[help] run "notepad help.txt" wait
[quitfful] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectfile$ #ses projectwind$ #ses projectform$ #ses projecttitl$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth for n=1 to obj if obj(n,T)<>0 then #ses obj(n,X);","; #ses obj(n,Y);","; #ses obj(n,W);","; #ses obj(n,H);","; #ses obj(n,T);","; #ses obj(n,TH) #ses obj$(n,Ctr) #ses obj$(n,Tex) #ses obj$(n,Res) #ses obj$(n,Fon) #ses obj$(n,Bak) end if next close #ses close #prop close #fful end
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
'for n=1 to obj 'print n;" ";obj(n,X);" ";obj(n,Y);" ";obj(n,W);" ";obj(n,H);" ";obj(n,T);" ";obj(n,6);" "; 'print obj$(n,Ctr);" ";obj$(n,Tex);" ";obj$(n,Res);" ";obj$(n,Fon);" ";obj$(n,Bak);" ";obj$(n,6);" ";obj$(n,Bas);" " 'next
Hello
I tried version xx.1.1.4 and in oklogistirio form loading when I read the first form "startPage" And I ask for preview everything is ok. the second time I will request a preview then while the button was getting a tag [batton1click] the tag that the code for the button will be written gets a different value the second time and another the third time. That is, the variable does not reset to zero even if it starts from the beginning. This only happens in the tag where the code for the button will be written and not in the tag that each button takes. I am attaching photos. It doesn't leave me more than one photo.
|
|
gaslouk
Full Member
Hi from beautiful Greece.
Posts: 131
|
Post by gaslouk on May 31, 2023 12:37:14 GMT -5
The following code is the latest, best working version so far. It is a separate FFUL with a couple other features The version number of this FFUL will be preceded by xx to distinguish between the 2 different FFUL's ver$="xx_1.1.4" - Writing, importing, loading(.ffu) and previewing code 'created by FFUL' seems to be working well. - Previewing code of any selected .bas file seems to be working well, except for the written event handlers. (next priority) Posting here to have a backup since versions are piling up and causing confusion here. ver$="xx_1.1.4" 'freeform ultra lite v1.x by Rod 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1 nomainwin dim info$(10,10) dim form$(10) form$(1)="Restore" form$(2)="New" form$(3)="Save .ffu" form$(4)="Load .ffu" form$(5)="-----------" form$(6)="Write .bas" form$(7)="Import .bas" form$(8)="Export .bas" form$(9)="File" dim tool$(14) tool$(1)="StatictText" tool$(2)="TextBox" tool$(3)="ListBox" tool$(5)="ComboBox" tool$(6)="Button" tool$(7)="BmpButton" tool$(8)="GraphicBox" tool$(9)="RadioButton" tool$(10)="CheckBox" tool$(11)="GroupBox" tool$(12)="Texteditor" tool$(13)="Menu" tool$(14)="Add New" dim hnd$(30) hnd$(1)="#1" dim grid$(20) grid$(1)="1" grid$(2)="3" g=3 for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Invisible" grid$(g+1)="Visible" grid$(g+2)="Set Grid" grid=10 gridvisible=1 gridcolor$="buttonface" bordercolor$=gridcolor$ crosshair$ =bordercolor$ projectctrh=25 ctrh=25 dim color$(10) color$(1)="Control Background" color$(2)="Project Background" color$(3)="Project Foreground" color$(4)="Grid Color" color$(5)="Border Color" color$(6)="CrossHair Color" color$(7)="Set Color" projectback$="white" projectfore$="black" 'ctrc$="white" dim font$(10) font$(1)="Control Font" font$(2)="ResetControl" font$(3)="Project Font" font$(4)="Set Font"'default is Consolas 9" dim wind$(20)'window type names wind$(1)="window" wind$(2)="window_nf" wind$(3)="window_popup" wind$(4)="dialog" wind$(5)="dialog_modal" wind$(6)="dialog_nf" wind$(7)="dialog_nf_modal" wind$(8)="dialog_fs" wind$(9)="dialog_nf_fs" wind$(10)="dialog_popup" wind$(11)="graphics" wind$(12)="graphics_fs" wind$(13)="graphics_fs_nsb" wind$(14)="graphics_nsb" wind$(15)="graphics_nf_nsb" wind$(16)="text" wind$(17)="text_fs" wind$(18)="text_nsb" wind$(19)="text_nsb_ins"
dim v$(2000) for n= 100 to 2000 step 20 v$(n)=str$(n) next dim obj(200,6) 'x,y,width/height,type,textheight X=1 Y=2 W=3 H=4 T=5 TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline Ctr=1 Tex=2 Res=3 Fon=4 Bak=5 Bas=7
'set default starting position obj=0 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" projectctrh=25 projectgrid=10 projectw=600 projecth=400 insertx=grid inserty=grid*2
'open a small properties window and hide it WindowWidth=230 WindowHeight=260 UpperLeftX=(DisplayWidth-230)/2 UpperLeftY=(DisplayHeight-180)/2 statictext #prop.st1 "File",5,10,30,25 textbox #prop.tbfile,45,5,150,25 statictext #prop.st2 "Wind",5,32,30,25 combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25 statictext #prop.st3 "Titl",5,54,30,25 textbox #prop.tbtitl,45,49,150,25 statictext #prop.st4 "Form",5,76,30,25 textbox #prop.tbform,45,71,150,25 statictext #prop.st5 "Ctrl",5,98,30,25 textbox #prop.tbctrl,45,93,150,25 statictext #prop.st6 "Text",5,120,30,25 textbox #prop.tbtext,45,115,150,25 statictext #prop.st7 "Reso",5,142,30,25 textbox #prop.tbreso,45,137,150,25 statictext #prop.st8 "xywh",5,164,30,25 textbox #prop.tbxywh,45,159,150,25 statictext #prop.st9 "Font",5,186,30,25 textbox #prop.tbfont,45,181,150,25 statictext #prop.st10 "Colo",5,208,30,25 textbox #prop.tbcolo,45,203,150,25
open "Properties" for window_nf as #prop #prop "font Consolas 9" #prop "trapclose [show]" #prop.cbwind "select window_nf" #prop.tbfile "!disable" #prop.tbxywh "!disable" #prop.tbfont "!disable" #prop.tbcolo "!disable" gosub [propertyupdate] #prop "hide"
'open the main form window 'this window is resizable, the graphicox will resize but the 'client area, which is a drawn representation of the window 'will only change size if you change the project w/h dimensions WindowWidth=860 WindowHeight=705 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #fful.form,form$(,[form],5,2,85,30 combobox #fful.hand,hnd$(,[hand],95,2,85,30 combobox #fful.tool,tool$(,[tool],185,2,85,30 button #fful.project,"Preview",[preview],UL,275,0,60,25 combobox #fful.w,v$(,[formsize],340,2,60,30 combobox #fful.h,v$(,[formsize],405,2,60,30 combobox #fful.grid,grid$(,[grid],470,2,90,30 combobox #fful.color,color$(,[color],565,2,130,30 combobox #fful.font,font$(,[font],700,2,90,30 button #fful.help,"Help",[help],UL,795,0,40,25 textbox #fful.filePath, 5,18,1600,20 'statictext #fful.filePath, "",5,25,1600,15 graphicbox #fful.gb,5,35,830,630 open "FFULv";ver$;" Forms Controls Form Dimensions Grid Size Colors Fonts" for window as #fful #fful "trapclose [quitfful]" #fful "font Consolas 9" #fful "resizehandler [resize]" #fful.tool "select Add New" #fful.form "select File" #fful.hand "selectindex 1" #fful.grid "select Set Grid" #fful.color "select Set Color" #fful.font "select Set Font" #fful.w "select ";projectw #fful.h "select ";projecth #fful.gb "autoresize" #fful.gb "vertscrollbar on 0 ";projectw #fful.gb "horizscrollbar on 0 ";projecth #fful.gb "font ";projectfont$ #fful.gb "down" gosub [drawgrid] gosub [drawall] #fful.gb "when rightButtonDown [show]" #fful.gb "when leftButtonDown [select]" #fful.gb "when characterInput [keys]" #fful.gb "setfocus" #prop "show" show=1 #fful.filePath, "File - untitled.ffu" #fful.filePath, "!disable" wait
[show] if show then #prop "hide" show=0 else #prop "show" show=1 end if wait
'the user clicked on the form design window 'either to chose a control or to deselect a control [select] xs=MouseX ys=MouseY 'hide property window if it is open if show then #prop "hide" show=0 end if
'before we move on update the currently selected control from properties 'get the project data and only the editable contents of controls if selected=0 then 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ end if #prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$ #prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$ #prop.tbreso "!contents? t$" : obj$(selected,Res)=t$ 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if xs>obj(cn,X) and xs<(obj(cn,X)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then if xs>obj(cn,X)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2 if obj(cn,T)=6 then action=1 selected=cn exit for end if next if selected=0 then gosub [propertyupdate] action=0 end if if selected>0 and action=1 then #fful.gb "when leftButtonMove [track]" #fful.gb "when leftButtonUp [stop]" offsetX=xs-obj(selected,X) offsetY=ys-obj(selected,Y) end if if selected>0 and obj(selected,T)<>6 and action=2 then 'dont resize bmp #fful.gb "when leftButtonMove [tracksize]" #fful.gb "when leftButtonUp [stopsize]" offsetX=xs-(obj(selected,X)+obj(selected,W)) offsetY=ys-(obj(selected,Y)+obj(selected,H)) end if if selected>0 then gosub [drawit] else insertx=int((xs+(grid/2))/grid)*grid inserty=int((ys+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #fful.gb "rule xor" gosub [drawit] xt=int((MouseX-offsetX+(grid/2))/grid)*grid if xt<0 then xt=0'11 if xt+obj(selected,W)>projectw then xt=projectw-obj(selected,W) obj(selected,X)=xt yt=int((MouseY-offsetY+(grid/2))/grid)*grid if menuset = 0 and textEd = 0 then if yt<0 then yt=0 if yt+obj(selected,H)>projecth-25 then yt=projecth-obj(selected,H)-25 obj(selected,Y)=yt end if
if menuset = 1 or textEd > 0 then if yt < 0 then yt = 0 if yt+obj(selected,H)>projecth-50 then yt=projecth-obj(selected,H)-50 obj(selected,Y)=yt end if gosub [drawit] wait
[stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[tracksize] #fful.gb "rule xor" gosub [drawit] xs=int((MouseX-offsetX+(grid/2))/grid)*grid if xs>projectw then xs=projectw if xs<obj(selected,X) then xs=obj(selected,X)+grid ys=int((MouseY-offsetY+(grid/2))/grid)*grid if ys>projecth then ys=projecth if ys<obj(selected,Y)+ctrh then ys=obj(selected,Y)+ctrh obj(selected,W)=xs-obj(selected,X)'width if menuset = 1 or textEd > 0 then obj(selected,H)=ys-obj(selected,Y)-50'height if menuset = 0 and textEd = 0 then obj(selected,H)=ys-obj(selected,Y)-25'height gosub [drawit] wait
[stopsize] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,T)=12 then menuset = 0 : gosub [drawgrid] 'menu if obj(selected,T)=11 then textEd = textEd-1 : gosub [drawgrid] 'texteditor obj(selected,T)=0 selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,X) 'x cpy(2)=obj(selected,Y) 'y cpy(3)=obj(selected,W) 'w cpy(4)=obj(selected,H) 'h cpy(5)=obj(selected,T) 'type cpy(6)=obj(selected,TH) 'textheight cpy$(1)=obj$(selected,Ctr) 'name cpy$(2)=obj$(selected,Tex) 'text content cpy$(3)=obj$(selected,Res) 'resource array or file path cpy$(4)=obj$(selected,Fon) 'ctrl specific font or "" cpy$(5)=obj$(selected,Bak) 'ctrl specific backcolor end if
if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 if obj(obj,T)=11 then textEd = textEd+1 'texteditor obj(obj,X)=insertx obj(obj,Y)=inserty inserty=inserty+cpy(4)+grid obj(obj,W)=cpy(3) obj(obj,H)=cpy(4) obj(obj,T)=cpy(5) obj(obj,TH)=cpy(6) obj$(obj,Ctr)=left$(cpy$(1),11)';obj obj$(obj,Tex)=cpy$(2) obj$(obj,Res)=cpy$(3) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) obj$(obj,Fon)=cpy$(4) obj$(obj,Bak)=cpy$(5) selected=obj gosub [drawall] end if end if #fful.gb "setfocus" wait
[tool] #fful.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext sttx = sttx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=1 obj$(obj,Ctr)="statictext";sttx obj$(obj,Tex)="Statictext-";sttx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 2 'textbox txtbx = txtbx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=2 obj$(obj,Ctr)="textbox";txtbx obj$(obj,Tex)="Textbox-";txtbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 3 'listbox lstbx = lstbx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh*5 obj(obj,T)=3 obj$(obj,Ctr)="listbox";lstbx obj$(obj,Tex)="Listbox-";lstbx;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectlbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 4 'combobox cmbobx = cmbobx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="combobox";cmbobx obj$(obj,Tex)="Combobox-";cmbobx;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectcbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 5 'button bttn = bttn +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=5 obj$(obj,Ctr)="button";bttn obj$(obj,Tex)="button-";bttn if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)="white" inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 6 'bmp button bmpbtn = bmpbtn +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=50 obj(obj,H)=50 obj(obj,T)=6 obj$(obj,Ctr)="bmp\bmpButton";bmpbtn filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Res)=file$ obj$(obj,Tex)="BMPbutton-";bmpbtn loadbmp obj$(obj,Ctr),file$ close #bmp inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid else obj(obj,T)=0 close #bmp end if else obj(obj,T)=0 end if
case 7 'graphicbox grbx = grbx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*3 obj(obj,T)=7 obj$(obj,Ctr)="graphicbox";grbx obj$(obj,Tex)="Graphicbox-";grbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton radio = 1 rdiobtn = rdiobtn + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 obj(obj,H)=ctrh obj(obj,T)=8 obj$(obj,Ctr)="radiobutton";rdiobtn obj$(obj,Tex)="(o) radioBtn-";rdiobtn obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 9 'checkbox check = 1 chkbx = chkbx+1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="checkbox";chkbx obj$(obj,Tex)="[x] checkbox-";chkbx obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox grpbx = grpbx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*4 obj(obj,T)=10 obj$(obj,Ctr)="groupbox";grpbx obj$(obj,Tex)="Group Box-";grpbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor textEd = textEd+1 gosub [drawgrid] obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh*4 obj(obj,T)=11 obj$(obj,Ctr)="texteditor";textEd obj$(obj,Tex)="Texteditor-";textEd if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttecl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,X)=0 obj(obj,Y)=0 obj(obj,W)=100 obj(obj,H)=10 obj(obj,T)=12 obj$(obj,Ctr)="menu";obj obj$(obj,Tex)=" Menu Added" inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid gosub [drawgrid] end if end select selected=obj gosub [drawall] #fful.tool "select Add New" #fful.gb "setfocus" wait
[form] #fful.form "selectionindex? i" select case i case 1 'restore file$="lastsession.ffu" #fful.filePath, "lastsession.ffu" gosub [loadit] case 2 'new gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 6 'write gosub [write] case 7 'import gosub [import] case 8 'export gosub [export] end select #fful.form "select File" gosub [drawall] #fful.gb "setfocus" wait
[drawall] #fful.gb "discard ; redraw bak" ocn=cn projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" for cn=1 to obj gosub [drawit] next cn=ocn #fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20 #fful.gb "setfocus" return
[drawit] 'redraws control cn 'set the color for the drawn object and action taking place if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if
'set the font for the drawn object if obj$(cn,Fon)="" then #fful.gb "font ";projectfont$ ch=projectctrh if obj(cn,H)<ch then obj(cn,H)=ch else #fful.gb "font ";obj$(cn,Fon) ch=obj(cn,TH) if obj(cn,H)<ch then obj(cn,H)=ch end if
'update the properties textboxes for selected control if cn=selected then #prop.tbctrl obj$(cn,Ctr) 'ctrlname #prop.tbtext obj$(cn,Tex) 'text #prop.tbreso obj$(cn,Res) 'resource #prop.tbxywh obj(cn,X);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height #prop.tbcolo obj$(cn,Bak) end if if projecttbcl$ = "" then projecttbcl$ = "white" if projectlbcl$ = "" then projectlbcl$ = "white" if projectcbcl$ = "" then projectcbcl$ = "white" if projecttecl$ = "" then projecttecl$ = "white" #fful.gb "place ";obj(cn,X);" ";obj(cn,Y) if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?" select case obj(cn,T) case 1 'statictext #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 2 'textbox #fful.gb "backcolor ";projecttbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 3 'listbox #fful.gb "backcolor ";projectlbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 4 'combobox #fful.gb "backcolor ";projectcbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 5 'button #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'buttons are always black on white #fful.gb "color black" 'centre button text #fful.gb "stringwidth? ";"A";" width" xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ #fful.gb "backcolor ";projectback$ case 6 'bmpbutton if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr) #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) case 7 ' graphicbox #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "backcolor ";projectback$ case 8 'radiobutton #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'radiobutton text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 9 'checkbox #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'checkbox text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 10 'groupbox #fful.gb "backcolor ";projectback$ 'groupbox is an outline #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'group box text is always black #fful.gb "color black" 'groupbox text is offset if action=0 then #fful.gb "place ";obj(cn,X)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 11 ' texteditor #fful.gb "backcolor ";projecttecl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 12 'menu 'pin to top left obj(cn,X)=10 : obj(cn,Y)=-10 : obj(cn,W)=100 : obj(cn,H)=10 xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X);" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) '#fful.gb "box ";obj(cn,X)+obj(cn,H);" ";obj(cn,Y)+obj(cn,H) #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 21 'tecolor projecttecl$=obj$(cn,Bak) case 22 'tbcolor projecttbcl$=obj$(cn,Bak) case 23 'lbcolor projectlbcl$=obj$(cn,Bak) case 24 'cbcolor projectcbcl$=obj$(cn,Bak) case 30 'font case 31 '!font end select return
[preview] file$="preview.bas" gosub [writeit] wait
[quitnoform] close #noform wait
[write] projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas" filedialog "Save .bas",projectfile$,file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit] if file$<>"" then '#################################################### if projectwind$ = "" then wait '#################################################### open file$ for output as #op 'the header #op " 'Project ";projecttitl$ #op " 'Created with Freeform Ultra Lite v";ver$;" ";date$() #op "" if projectback$<>"white" or projectfore$<>"black" then #op " 'Set BackgroundColor$ and ForegroundColor$ of project" #op " BackgroundColor$=";chr$(34);projectback$;chr$(34) #op " ForegroundColor$=";chr$(34);projectfore$;chr$(34) #op "" end if #op " 'Create arrays needed for controls listbox,combobox" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " dim ";obj$(n,Ctr);"$(10)" #op " for n = 1 to 10" #op " ";obj$(n,Ctr);"$(n)= str$(n)" #op " next" end if next #op "" #op " 'Create controls and open window" #op " nomainwin" #op " WindowWidth = ";projectw #op " WindowHeight = ";projecth #op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"Size";chr$(34);", ";chr$(34);"Small";chr$(34);", [dummy], ";chr$(34);"Large";chr$(34);", [dummy]" end if for n=1 to obj select case obj(n,T) case 1 'statictext #op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox #op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ctr);"$(, [";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ctr);"$(, [";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"],[no";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"],[un";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor #op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 22 'tbcolor #op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'lbcolor #op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 24 'cbcolor #op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'tecolor #op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34) end select next #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op "" #op " 'Set any listbox or combobox to display the first item on the list" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34) end if next #op " 'apply any control specific fonts" for n= 1 to obj if obj(n,T)<>0 and obj$(n,Fon)<>"" then if obj(n,T)=1 or obj(n,T)=2 or obj(n,T)=5 or obj(n,T)=10 or obj(n,T)=11 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34) end if if obj(n,T)=3 or obj(n,T)=4 or obj(n,T)=7 or obj(n,T)=8 or obj(n,T)=9 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34) end if end if next #op " wait" #op ""
'if file$<>"preview.bas" then '#op " 'Create the required handlers for each control" '#op " 'Radiobutton and Checkboxes are given a single handler" 'check=0 'radio=0 for n=1 to obj select case obj(n,T) case 3 'listbox listbx =listbx+1 #op " [listbox";listbx;"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op " " case 4 'combobox combobx =combobx+1 #op " [combobox";combobx;"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);", ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op " " case 5 'button buttn=buttn+1 #op " [button";buttn;"click]" #op " 'Your handler code here" #op " wait" #op " " case 6 'bmpbutton bmpbtn=bmpbtn+1 #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op " " case 8 'radiobutton radiobtn = radiobtn + 1 #op " [radiobutton";radiobtn;"]" #op " 'Your handler code here." #op " wait" #op " " #op " [noradiobutton";radiobtn;"]" #op " 'Your handler code here." #op " wait" #op " " case 9 'checkbox chekbx = chekbx + 1 #op " [checkbox";chekbx;"]" #op " 'Your handler code here." #op " wait" #op " " #op " [uncheckbox";chekbx;"]" #op " 'Your handler code here." #op " wait" [dontwrite2] #op " " end select next 'end if end if #op " " #op " [quit]" #op " close ";projectform$ #op " end" close #op
files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] return
[saveas] projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu" filedialog "Save As...",projectname$,file$ if file$<>"" then #fful.filePath "File - ";file$ open file$ for output as #op projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ #op projectfile$ #op projectwind$ #op projectform$ #op projecttitl$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth for n=1 to obj if obj(n,T)<>0 then #op obj(n,X);","; #op obj(n,Y);","; #op obj(n,W);","; #op obj(n,H);","; #op obj(n,T);","; #op obj(n,TH) #op obj$(n,Ctr) #op obj$(n,Tex) #op obj$(n,Res) #op obj$(n,Fon) #op obj$(n,Bak) end if next close #op gosub [propertyupdate] redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" end if return
[load] obj = 0 gosub [resetVars] filedialog "Open Project...","*.ffu",file$ #fful.filePath "File - ";file$ [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #ses input #ses, projectfile$ input #ses, projectwind$ input #ses, projectform$ input #ses, projecttitl$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #fful.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ projectctrh=val(c$) projectgrid=val(g$) grid=projectgrid projectw=val(w$) projecth=val(h$) #prop.cbwind "select ";projectwind$ redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.grid "select ";grid #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,X)=val(word$(l$,1,",")) obj(obj,Y)=val(word$(l$,2,",")) obj(obj,W)=val(word$(l$,3,",")) obj(obj,H)=val(word$(l$,4,",")) obj(obj,T)=val(word$(l$,5,",")) obj(obj,TH)=val(word$(l$,6,",")) line input #ses, obj$(obj,Ctr) line input #ses, obj$(obj,Tex) line input #ses, obj$(obj,Res) line input #ses, obj$(obj,Fon) line input #ses, obj$(obj,Bak) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) if obj(obj,T)=12 then menuset=1 if obj(obj,T)=11 then textEd= textEd+1 : gosub [drawgrid] wend close #ses gosub [propertyupdate] #prop "hide" #prop "show" end if return
[import] filedialog "Open .bas...","*.bas",file$ if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) gosub [new] #fful.filePath "File - ";file$ 'grid=1 'gridvisible=0 gosub [drawgrid] 'set grid to 1 and invisible so controls stay where they import from initially 'import only those lines defining controls we are interested in wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox " wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty " wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ " wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ " dim bas$(5000,2) basln=1 ln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, wln$ 'break into multiple lines if ":" found outside quotes pos=1 ln$="" while pos<=len(wln$) c$=mid$(wln$,pos,1) if c$=chr$(34)then if quote=0 then quote=1 else quote=0 end if if c$=":" and quote=0 then gosub [line] ln$="" pos=pos+1 else ln$=ln$+c$ pos=pos+1 end if wend gosub [line] basln=basln+1 wend 'print "first cut" 'for n=1 to ln 'print bas$(n,1);" ";bas$(n,2) 'next 'print
'now find width height title and handle for all windows found in bas$( 'up to 30 forms in a .bas '1=handle #main etc '2=title '3=width '4=height '5=windowtype '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
redim win$(30,10) redim hnd$(30) nl=ln wh=1 for ln=1 to nl 'find width and height ,assumes width and height are defined ahead of open 'so width height and colors can be set multiple times, so store bas line number involved if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1) if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1) if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1) if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1) if instr(lower$(bas$(ln,2)),"open",1)>0 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 or instr(lower$(bas$(ln,2)),"text",1)>0 then win$(wh,10)=bas$(ln,1) n$=word$(bas$(ln,2),2,chr$(34)) hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1)) 'find last "for" in command line i=1 while i oi=i i=instr(lower$(bas$(ln,2))," for ",i+1) wend wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi) wt$=word$(wt$,2) win$(wh,1)=hn$ 'handle #fful etc win$(wh,2)=n$ 'title win$(wh,3)=w$ 'width win$(wh,4)=h$ 'height win$(wh,5)=wt$ 'windowtype hnd$(wh)=hn$ 'for combobox 'print wh;" ";hnd$(wh);" ";win$(wh,2);" ";win$(wh,3);" ";win$(wh,4);" ";win$(wh,5) wh=wh+1 end if end if next #fful.hand "reload" #fful.hand "selectindex 1" close #bas if wt$ = "" then #fful.hand "!No Forms" wh=1 gosub [loadwindow] end if return
[line] if ln$<>"" then w$=lower$(word$(ln$,1)) if instr(w$,"=",1)>1 then w$=word$(w$,1,"=") if len(w$)>3 then w1$=" "+w$+" " w2$=" "+w$+"=" if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 then bas$(ln,1)=str$(basln) bas$(ln,2)=trim$(ln$) ln=ln+1 end if end if end if return
[hand] gosub [resetVars] #fful.hand "selectionindex? wh" gosub [loadwindow] wait
[loadwindow] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font gosub [resetVars] obj=1 projectback$="white" TextboxColor$="white" ListboxColor$="white" ComboboxColor$="white" TexteditorColor$="white" projectfore$="black" projectw=val(win$(wh,3)) if projectw=0 then projectw=600 projecth=val(win$(wh,4)) if projecth=0 then projecth=400 projecttitl$=win$(wh,2) projectwind$=win$(wh,5) projectform$=win$(wh,1) tbc$="" lbc$="" cbc$="" tec$="" gosub [propertyupdate] #fful.w "!";str$(projectw) #fful.h "!";str$(projecth)
'find controls and create obj() for ln=1 to nl 'create hidden objects to control font and color only used in import/export, not displayed ct=0 if instr(bas$(ln,2),"TextboxColor$",1)>0 then tbc$=getcolor$(bas$(ln,2)):ct=20 if instr(bas$(ln,2),"ListboxColor$",1)>0 then lbc$=getcolor$(bas$(ln,2)):ct=21 if instr(bas$(ln,2),"ComboboxColor$",1)>0 then cbc$=getcolor$(bas$(ln,2)):ct=22 if instr(bas$(ln,2),"TexteditorColor$",1)>0 then tec$=getcolor$(bas$(ln,2)):ct=23 if ct then obj(obj,T)=ct if ct=20 then obj$(obj,Bak)=tbc$ if ct=21 then obj$(obj,Bak)=lbc$ if ct=22 then obj$(obj,Bak)=cbc$ if ct=23 then obj$(obj,Bak)=tec$ obj$(obj,Bas)=bas$(ln,1) obj=obj+1 end if for wc=1 to 12 if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for next if wc<=11 then obj$(obj,Bas)=bas$(ln,1) l$=bas$(ln,2) ll$="" 'remove spaces leaving only , separation but keep "" text untouched inString=0 for i=1 to len(l$) c$=mid$(l$,i,1) select case case c$=chr$(34) inString=1-inString case (inString=0) and c$=" " c$="" end select ll$=ll$+c$ next 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1) obj(obj,T)=wc 'type obj(obj,TH)=projectctrh 'get the .ctrl name obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1) 'for un-named controls if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj 'get the text if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc) 'get the array or bmp file name if wc=3 or wc=4 or wc=6 then obj$(obj,Res)=word$(ll$,2,",") 'get rid of "" if wc=6 and left$(obj$(obj,Res),1)=chr$(34) then obj$(obj,Res)=mid$(obj$(obj,Res),2,len(obj$(obj,Res))-2) 'array() -> array( if (wc=3 or wc=4) and right$(obj$(obj,Res),1)=")" then obj$(obj,Res)=left$(obj$(obj,Res), len(obj$(obj,Res))-1) i=1 while word$(ll$,i,",")<>"" i=i+1 wend i=i-4 if wc=6 or wc=5 then 'buttons and bmpbuttons can have xy, wh is optional and they have XX corners if i=3 then obj(obj,X)=val(word$(ll$,i+2,","))'x obj(obj,Y)=val(word$(ll$,i+3,","))'y if wc=5 then 'we need to find a way to calculate width and height if not given #fful.gb "stringwidth? ";"A";" width" obj(obj,W)=width*len(obj$(obj,Tex))+10 obj(obj,H)=projectctrh end if if wc=6 then 'we need a way to set bmp w and h on error goto [dummybmp] open obj$(obj,Res) for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Tex)="bmp" end if loadbmp obj$(obj,Ctr),obj$(obj,Res) close #bmp goto [passdummy]
[dummybmp] obj(obj,W)=25 obj(obj,H)=25 obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),"path.bmp" [passdummy] end if else obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y obj(obj,W)=val(word$(ll$,i+2,","))'w obj(obj,H)=val(word$(ll$,i+3,","))'h end if if upper$(word$(ll$,4,","))="LR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="LL" then 'obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="UR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x 'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if else 'write to .bas tweaks listbox and combobox controls to line up properly 'so we need to untweak them now obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y if wc=1 then obj(obj,Y)=obj(obj,Y)-5 if wc=10 then obj(obj,Y)=obj(obj,Y)+5 if wc=3 or wc=4 then obj(obj,X)=obj(obj,X)-1 obj(obj,W)=val(word$(ll$,i+2,","))'w if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2 obj(obj,H)=val(word$(ll$,i+3,","))'h end if
'save color if set if wc=2 then obj$(obj,Bak)=tbc$ if wc=3 then obj$(obj,Bak)=lbc$ if wc=4 then obj$(obj,Bak)=cbc$ if wc=11 then obj$(obj,Bak)=tec$ obj=obj+1 end if next 'now find font commands listed after the open statement referring to the #form '#form.ctrl !font fontname 'if so add a new font object basln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ lln$=lower$(ln$) if instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font",1)>0 or instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font",1)>0 then f$=right$(ln$,len(ln$)-instr(lln$,"font",1)-4) if instr(f$,";",1)=0 then obj$(obj,Fon)=f$ obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1) obj$(obj,Ctr)=word$(word$(ln$,1),2,".") if instr(lln$,"!font",1)>0 then obj(obj,T)=31 else obj(obj,T)=30 obj$(obj,Bas)=str$(basln)
'find the visible object and store the font change for n=1 to obj if obj$(n,Ctr)=obj$(obj,Ctr) then obj$(n,Fon)=obj$(obj,Fon) #fful.gb "font ";obj$(obj,Fon) #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" obj(n,TH)=(yp-100)/2+7 exit for end if next obj=obj+1 end if end if basln=basln+1 wend close #bas gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[export] dim oldbas$(5000) ln=1 if file$<>"" and right$(file$,3)="bas" then open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ oldbas$(ln)=ln$ ln=ln+1 wend close #bas '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline if win$(wh,6)<>"" then oldbas$(val(win$(wh,6)))=" BackgroundColor$=";chr$(34);projectback$;chr$(34) if win$(wh,7)<>"" then oldbas$(val(win$(wh,7)))=" ForegroundColor$=";chr$(34);projectfore$;chr$(34) if win$(wh,8)<>"" then oldbas$(val(win$(wh,8)))=" WindowWidth=";projectw if win$(wh,8)=win$(wh,9) then oldbas$(val(win$(wh,8)))=oldbas$(val(win$(wh,8)))+": WindowHeight=";projecth else oldbas$(val(win$(wh,9)))=" WindowHeight=";projecth if win$(wh,10)<>"" then oldbas$(val(win$(wh,10)))=" Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ for n=1 to obj select case obj(n,T) 'handle the visible controls case 1 'statictext oldbas$(val(obj$(n,Bas)))=" statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox oldbas$(val(obj$(n,Bas)))=" textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box oldbas$(val(obj$(n,Bas)))=" listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox oldbas$(val(obj$(n,Bas)))=" combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button oldbas$(val(obj$(n,Bas)))=" button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton oldbas$(val(obj$(n,Bas)))=" bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox oldbas$(val(obj$(n,Bas)))=" graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton oldbas$(val(obj$(n,Bas)))=" radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox oldbas$(val(obj$(n,Bas)))=" checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box oldbas$(val(obj$(n,Bas)))=" groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor oldbas$(val(obj$(n,Bas)))=" texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export case 20 'textboxcolor oldbas$(val(obj$(n,Bas)))=" TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'listboxcolor oldbas$(val(obj$(n,Bas)))=" ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 22 'comboboxcolor oldbas$(val(obj$(n,Bas)))=" ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'texteditorcolor oldbas$(val(obj$(n,Bas)))=" TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
'handle font changes case 30 'font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" font ";obj$(n,Fon);chr$(34) case 32 '!font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" !font ";obj$(n,Fon);chr$(34) end select next end if open file$ for output as #bas for n= 1 to ln #bas oldbas$(n) next close #bas return
function getsize$(l$) 'what if it is a variable? v$="" pos=1 n$=mid$(l$,pos,1) while instr("1234567890",n$,1)=0 and pos<len(l$) pos=pos+1 n$=mid$(l$,pos,1) wend while n$>="0" and n$<="9" and pos<=len(l$) v$=v$+n$ pos=pos+1 n$=mid$(l$,pos,1) wend getsize$=v$ end function
function getcolor$(l$) 'what if it is a variable? cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black " for c= 1 to 15 if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for next end function
[new] #fful.filePath "File - untitled.ffu" redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=0 gosub [resetVars] projectw=600 projecth=400 projectback$="white" projectfore$="black" projectctrc$="white" projecttitl$="Untitled" projectform$="#1" projectfile$="Untitled.bas" projectwind$="window_nf" #prop.cbwind "select window_nf" redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.w "select ";projectw #fful.h "select ";projecth gosub [propertyupdate] gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[propertyupdate] #prop.tbfile projectfile$ #prop.cbwind "select ";projectwind$ #prop.tbtitl projecttitl$ #prop.tbform projectform$ #prop.tbctrl "" #prop.tbtext "" #prop.tbreso "" #prop.tbxywh projectw;"x";projecth #prop.tbfont projectfont$ #prop.tbcolo projectfore$;"/";projectback$ return
[resetVars] obj=0:menuset=0:textEd=0:check=0:radio=0:sttx=0:txtbx=0:lstbx=0:radiobtn=0:chekbx=0 cmbobx=0:bttn=0:buttn = 0:bmpbtn=0:grbx=0:rdiobtn=0:chkbx=0:grpbx=0:combobx=0 : import = 0 return
[resize] #fful.tool "select Add New" #fful.form "select File" if wh=0 then wh=1 #fful.hand "selectindex ";wh #fful.grid "select Set Grid" #fful.font "select Set Font" #fful.color "select Set Color" #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawall] wait
[formsize] #fful.w "contents? w$" #fful.h "contents? h$" wf=val(w$) hf=val(h$) if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait projectw=wf projecth=hf insertx=grid inserty=grid gosub [drawgrid] #fful.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid spacing according to user choice, default is 10 #fful.grid "contents? g$" select case g$ case "Invisible" gridvisible=0 case "Visible" gridvisible=1 case else grid=val(g$) end select gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" wait
[drawgrid] if textEd<0 then textEd=0 projectgrid=grid #fful.gb "cls; fill buttonface" if grid > 0 and gridvisible = 1 then #fful.gb "color ";gridcolor$ ' Grid - Draw vertical lines if menuset = 0 and textEd = 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25 for xs = 0 to projectw step grid ' Grid - Draw horizontal lines #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-25 next xs for ys = 0 to projecth-25 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if 'adjust grid when menu, or texeditor control is selected - revert if menu and texeditor deleted /no longer used., if menuset = 1 or textEd > 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";gridcolor$ for xs = 0 to projectw step grid #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-50 next xs for ys = 0 to projecth-50 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if end if [nogrid]
if grid = 1 or gridvisible = 0 then if textEd =0 and menuset = 0 then #fful.gb "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; " "; projectw; " "; (projecth)/2 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25 #fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25 end if if textEd > 0 or menuset = 1 then #fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";crosshair$ #fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-50 #fful.gb "line "; 0; " "; (projecth-50)/2; " "; projectw; " "; (projecth-50)/2 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50 #fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50 end if end if #fful.gb "flush bak" #fful.grid "!Set Grid" return
[font] #fful.font "contents? f$" if f$="Project Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #fful.gb "font ";projectfont$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" projectctrh=(yp-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Control Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #fful.gb "font ";ctrf$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" ctrh=(yp-100)/2+7 end if if selected then obj$(selected,4)=ctrf$ 'font obj(selected,6)=ctrh 'text height end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="ResetControl" then ctrf$=projectfont$ ctrh=projectctrh if selected then obj$(selected,4)=ctrf$ obj(selected,6)=ctrh end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then #fful.gb "font ";ctrf$ obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #fful.font "select Set Font" gosub [drawall] #fful.gb "setfocus" wait
[color] #fful.color "contents? c$" select case c$ case "Control Background" gosub [colorpick] if cp$<>"" then if selected then 'insert color change event ahead of control if obj(selected,T)=2 then ct=22 : projecttbcl$=cp$ if obj(selected,T)=3 then ct=23 : projectlbcl$=cp$ if obj(selected,T)=4 then ct=24 : projectcbcl$=cp$ if obj(selected,T)=11 then ct=21 : projecttecl$=cp$ for n=obj+1 to selected+1 step -1 obj(n,X)=obj(n-1,X) obj(n,Y)=obj(n-1,Y) obj(n,W)=obj(n-1,W) obj(n,H)=obj(n-1,H) obj(n,T)=obj(n-1,T) obj(n,TH)=obj(n-1,TH) obj$(n,Ctr)=obj$(n-1,Ctr) obj$(n,Tex)=obj$(n-1,Tex) obj$(n,Res)=obj$(n-1,Res) obj$(n,Fon)=obj$(n-1,Fon) obj$(n,Bak)=obj$(n-1,Bak) obj$(n,Bas)=obj$(n-1,Bas) next obj(selected,T)=ct obj$(selected,Tex)="Color!" obj$(selected,Bak)=cp$ 'remove any previous color change statement if selected>=2 then if obj(selected-1,T)=ct then obj(selected-1,T)=0 end if obj=obj+1 end if end if case "Project Background" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Project Foreground" gosub [colorpick] if cp$<>"" then projectfore$=cp$ gosub [drawgrid] case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] case "Border Color" gosub [colorpick] if cp$<>"" then bordercolor$=cp$ gosub [drawgrid] case "CrossHair Color" gosub [colorpick] if cp$<>"" then crosshair$=cp$ gosub [drawgrid] end select #fful.color "select Set Color" gosub [drawall] #fful.gb "setfocus" wait
[windowtype] #prop.cbwind "contents? projectwind$" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #pick.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #pick #pick "font Consolas 9" #pick "trapclose [quitpick]" #pick.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white " c=1 for yc=1 to 160 step 40 for xc= 1 to 160 step 40 #pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40 c=c+1 if c>15 then c=15 next next #pick.gb "when leftButtonDown [pick]" wait
[pick] xp=int(MouseX/40) yp=int(MouseY/40) c=xp+yp*4+1 cp$=word$(cl$,c)
[quitpick] close #pick return
[help] run "notepad help.txt" wait
[quitfful] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectfile$ #ses projectwind$ #ses projectform$ #ses projecttitl$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth for n=1 to obj if obj(n,T)<>0 then #ses obj(n,X);","; #ses obj(n,Y);","; #ses obj(n,W);","; #ses obj(n,H);","; #ses obj(n,T);","; #ses obj(n,TH) #ses obj$(n,Ctr) #ses obj$(n,Tex) #ses obj$(n,Res) #ses obj$(n,Fon) #ses obj$(n,Bak) end if next close #ses close #prop close #fful end
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
'for n=1 to obj 'print n;" ";obj(n,X);" ";obj(n,Y);" ";obj(n,W);" ";obj(n,H);" ";obj(n,T);" ";obj(n,6);" "; 'print obj$(n,Ctr);" ";obj$(n,Tex);" ";obj$(n,Res);" ";obj$(n,Fon);" ";obj$(n,Bak);" ";obj$(n,6);" ";obj$(n,Bas);" " 'next
Hello
I tried version xx.1.1.4 and in oklogistirio form loading when I read the first form "startPage" And I ask for preview everything is ok. the second time I will request a preview then while the button was getting a tag [batton1click] the tag that the code for the button will be written gets a different value the second time and another the third time. That is, the variable does not reset to zero even if it starts from the beginning. This only happens in the tag where the code for the button will be written and not in the tag that each button takes. I am attaching photos. It doesn't leave me more than one photo.
Attachments:
|
|
gaslouk
Full Member
Hi from beautiful Greece.
Posts: 131
|
Post by gaslouk on May 31, 2023 12:37:49 GMT -5
Hello
I tried version xx.1.1.4 and in oklogistirio form loading when I read the first form "startPage" And I ask for preview everything is ok. the second time I will request a preview then while the button was getting a tag [batton1click] the tag that the code for the button will be written gets a different value the second time and another the third time. That is, the variable does not reset to zero even if it starts from the beginning. This only happens in the tag where the code for the button will be written and not in the tag that each button takes. I am attaching photos. It doesn't leave me more than one photo.
The same happens when you read another form from the file's set of forms into buttons and checkboxes and radiobuttons.
|
|
|
Post by xxgeek on May 31, 2023 13:46:14 GMT -5
Yes, I had 2 options. Let the preview crash with duplicates in the event handlers of user selected .bas file imports. Or let the numbers in the event handlers increase to avoid duplicates.
Here is the other option, but be forewarned that duplicates will crash the preview on some of the .bas files the user selects to import, but should work ok with FFUL created "preview.bas" , "save"'d .ffu files AND "write" .bas files.
Until this issue is fixed ver$="xx_1.1.4b" and ver$="xx_1.1.4" are what we have. I'll keep trying to get it sorted out.
ver$="xx_1.1.4
See next post
|
|
|
Post by xxgeek on May 31, 2023 14:18:39 GMT -5
oops, wrong code. lol I must have over 100 fful.bas files now.
Try this code.
Removed due to multiple errors. See next posts for updates.
|
|
|
Post by tsh73 on May 31, 2023 15:12:59 GMT -5
They invented version control for that
(but me still saving consecutive versions of a file on same folder, just now)
|
|
|
Post by xxgeek on May 31, 2023 15:37:39 GMT -5
They invented version control for that (but me still saving consecutive versions of a file on same folder, just now) Same here, and I have an nice app called codebank that'll practically automate the process for me and I don't fire it up much, except to save good solid working versions. btw Anatoly, have you looked into a fix for the duplicate event handlers that happen when a user imports a .bas file that has more than one 'button' or other control etc pointing to the same event handler?
|
|
|
Post by tsh73 on Jun 1, 2023 0:23:26 GMT -5
Why, yes. it needs: 1) to actually read these labels from source file 2) add a place in obj$() to store it 3) add these labels in property window, show/save properties 4) (likely) make program fill same place then creating controls of it's own 5) use these stored labels for writing things. And then fixing for duplicates is easy - you keep a list of labels written (string will do), and if you already made that label, you skip writing part.
Funny thing I even started to do it. And now it works for ordinary buttons. if/then I finish that mod I will post it here.
EDIT it just occurred to me that these labels probably should go to *.ffu file as well. That needs file format change. But I'll skip it, just concentrate on writing *.bas file.
|
|
|
Post by xxgeek on Jun 1, 2023 9:42:16 GMT -5
hmm, thanks for the reply Anatoly. Big job, glad you're on it. I think I'll stick to little touch ups until the next version
|
|
|
Post by xxgeek on Jun 2, 2023 10:29:08 GMT -5
I didn't notice the last version messed up a couple of things I wasn't checking. Fixed, with an addon. String is now too big for the clipboard, so copy half at a time.
ver$ = xx_v1.1.5
ver$="xx_1.1.5" 'freeform ultra lite v1.x by Rod 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1 'nomainwin dim info$(10,10) dim form$(10) form$(1)="Restore" form$(2)="New" form$(3)="Save .ffu" form$(4)="Load .ffu" form$(5)="-----------" form$(6)="Write .bas" form$(7)="Import .bas" form$(8)="Export .bas" form$(9)="File" dim tool$(14) tool$(1)="StatictText" tool$(2)="TextBox" tool$(3)="ListBox" tool$(5)="ComboBox" tool$(6)="Button" tool$(7)="BmpButton" tool$(8)="GraphicBox" tool$(9)="RadioButton" tool$(10)="CheckBox" tool$(11)="GroupBox" tool$(12)="Texteditor" tool$(13)="Menu" tool$(14)="Add New" dim hnd$(30) hnd$(1)="#1" dim grid$(20) grid$(1)="1" grid$(2)="3" g=3 for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Invisible" grid$(g+1)="Visible" grid$(g+2)="Set Grid" grid=10 gridvisible=1 gridcolor$="buttonface" bordercolor$=gridcolor$ crosshair$ =bordercolor$ projectctrh=25 ctrh=25 dim color$(10) color$(1)="Control Background" color$(2)="Project Background" color$(3)="Project Foreground" color$(4)="Grid Color" color$(5)="Border Color" color$(6)="CrossHair Color" color$(7)="Set Color" projectback$="white" projectfore$="black" 'ctrc$="white" dim font$(10) font$(1)="Control Font" font$(2)="ResetControl" font$(3)="Project Font" font$(4)="Set Font"'default is Consolas 9" dim wind$(20)'window type names wind$(1)="window" wind$(2)="window_nf" wind$(3)="window_popup" wind$(4)="dialog" wind$(5)="dialog_modal" wind$(6)="dialog_nf" wind$(7)="dialog_nf_modal" wind$(8)="dialog_fs" wind$(9)="dialog_nf_fs" wind$(10)="dialog_popup" wind$(11)="graphics" wind$(12)="graphics_fs" wind$(13)="graphics_fs_nsb" wind$(14)="graphics_nsb" wind$(15)="graphics_nf_nsb" wind$(16)="text" wind$(17)="text_fs" wind$(18)="text_nsb" wind$(19)="text_nsb_ins"
dim v$(2000) for n= 100 to 2000 step 20 v$(n)=str$(n) next dim obj(200,6) 'x,y,width/height,type,textheight X=1 Y=2 W=3 H=4 T=5 TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline Ctr=1 Tex=2 Res=3 Fon=4 Bak=5 Bas=7
'set default starting position obj=0 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" projectctrh=25 projectgrid=10 projectw=600 projecth=400 insertx=grid inserty=grid*2
'open a small properties window and hide it WindowWidth=230 WindowHeight=260 UpperLeftX=(DisplayWidth)/2 + 450 UpperLeftY=(DisplayHeight)/2 - 70 statictext #prop.st1 "File",5,10,30,25 textbox #prop.tbfile,45,5,150,25 statictext #prop.st2 "Wind",5,32,30,25 combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25 statictext #prop.st3 "Titl",5,54,30,25 textbox #prop.tbtitl,45,49,150,25 statictext #prop.st4 "Form",5,76,30,25 textbox #prop.tbform,45,71,150,25 statictext #prop.st5 "Ctrl",5,98,30,25 textbox #prop.tbctrl,45,93,150,25 statictext #prop.st6 "Text",5,120,30,25 textbox #prop.tbtext,45,115,150,25 statictext #prop.st7 "Reso",5,142,30,25 textbox #prop.tbreso,45,137,150,25 statictext #prop.st8 "xywh",5,164,30,25 textbox #prop.tbxywh,45,159,150,25 statictext #prop.st9 "Font",5,186,30,25 textbox #prop.tbfont,45,181,150,25 statictext #prop.st10 "Colo",5,208,30,25 textbox #prop.tbcolo,45,203,150,25
open "Properties" for window_nf as #prop #prop "font Consolas 9" #prop "trapclose [show]" #prop.cbwind "select window_nf" #prop.tbfile "!disable" #prop.tbxywh "!disable" #prop.tbfont "!disable" #prop.tbcolo "!disable" gosub [propertyupdate] #prop "hide"
'open the main form window 'this window is resizable, the graphicox will resize but the 'client area, which is a drawn representation of the window 'will only change size if you change the project w/h dimensions WindowWidth=860 WindowHeight=705 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #fful.form,form$(,[form],5,2,85,30 combobox #fful.hand,hnd$(,[hand],95,2,85,30 combobox #fful.tool,tool$(,[tool],185,2,85,30 button #fful.project,"Preview",[preview],UL,275,0,60,25 combobox #fful.w,v$(,[formsize],340,2,60,30 combobox #fful.h,v$(,[formsize],405,2,60,30 combobox #fful.grid,grid$(,[grid],470,2,90,30 combobox #fful.color,color$(,[color],585,2,90,30 combobox #fful.font,font$(,[font],680,2,90,30 button #fful.help,"?",[help],UL,825,0,20,25 textbox #fful.filePath, 5,22,1600,20 statictext #fful.gridsize, str$(grid),565,5,15,15 statictext #fful.Xco, "x 0000" ,772,0,45,15 statictext #fful.Yco, "y 0000",772,12,45,15 graphicbox #fful.gb,5,42,830,630 open ver$;" Forms Controls Form Dimensions Grid Size Colors Fonts" for window as #fful #fful "trapclose [quitfful]" #fful "font Consolas 9 bold" #fful "resizehandler [resize]" #fful.tool "select Add New" #fful.form "select File" #fful.hand "selectindex 1" #fful.grid "select Set Grid" #fful.color "select Set Color" #fful.font "select Set Font" #fful.w "select ";projectw #fful.h "select ";projecth #fful.gb "autoresize" #fful.gb "vertscrollbar on 0 ";projectw #fful.gb "horizscrollbar on 0 ";projecth #fful.gb "font ";projectfont$ #fful.gb "down" gosub [drawgrid] gosub [drawall] #fful.gb "when rightButtonDown [show]" #fful.gb "when leftButtonDown [select]" #fful.gb "when characterInput [keys]" #fful.gb "setfocus" #prop "show" show=1 #fful.filePath, "File - untitled.ffu" #fful.filePath, "!disable" wait
[show] if show then #prop "hide" show=0 else #prop "show" show=1 end if wait
'the user clicked on the form design window 'either to chose a control or to deselect a control [select] xs=MouseX ys=MouseY 'hide property window if it is open if show then #prop "hide" show=0 end if
'before we move on update the currently selected control from properties 'get the project data and only the editable contents of controls if selected=0 then 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ end if #prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$ #prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$ #prop.tbreso "!contents? t$" : obj$(selected,Res)=t$ 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if xs>obj(cn,X) and xs<(obj(cn,X)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then if xs>obj(cn,X)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2 if obj(cn,T)=6 then action=1 selected=cn exit for end if next if selected=0 then gosub [propertyupdate] action=0 end if if selected>0 and action=1 then #fful.gb "when leftButtonMove [track]" #fful.gb "when leftButtonUp [stop]" offsetX=xs-obj(selected,X) offsetY=ys-obj(selected,Y) end if if selected>0 and obj(selected,T)<>6 and action=2 then 'dont resize bmp #fful.gb "when leftButtonMove [tracksize]" #fful.gb "when leftButtonUp [stopsize]" offsetX=xs-(obj(selected,X)+obj(selected,W)) offsetY=ys-(obj(selected,Y)+obj(selected,H)) end if if selected>0 then gosub [drawit] else insertx=int((xs+(grid/2))/grid)*grid inserty=int((ys+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #fful.gb "rule xor" gosub [drawit] xt=int((MouseX-offsetX+(grid/2))/grid)*grid if xt<0 then xt=0'11 if xt+obj(selected,W)>projectw then xt=projectw-obj(selected,W) obj(selected,X)=xt yt=int((MouseY-offsetY+(grid/2))/grid)*grid if menuset = 0 and textEd = 0 then if yt<0 then yt=0 if yt+obj(selected,H)>projecth-25 then yt=projecth-obj(selected,H)-25 obj(selected,Y)=yt end if
if menuset = 1 or textEd > 0 then if yt < 0 then yt = 0 if yt+obj(selected,H)>projecth-50 then yt=projecth-obj(selected,H)-50 obj(selected,Y)=yt end if #fful.Xco "x ";str$(xt) #fful.Yco "y ";str$(yt) gosub [drawit] wait
[stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[tracksize] #fful.gb "rule xor" gosub [drawit] xs=int((MouseX-offsetX+(grid/2))/grid)*grid if xs>projectw then xs=projectw if xs<obj(selected,X) then xs=obj(selected,X)+grid ys=int((MouseY-offsetY+(grid/2))/grid)*grid if ys>projecth then ys=projecth if ys<obj(selected,Y)+ctrh then ys=obj(selected,Y)+ctrh obj(selected,W)=xs-obj(selected,X)'width if menuset = 1 or textEd > 0 then obj(selected,H)=ys-obj(selected,Y)-50'height if menuset = 0 and textEd = 0 then obj(selected,H)=ys-obj(selected,Y)-25'height #fful.Xco "x ";xs : #fful.Yco "y ";ys gosub [drawit] wait
[stopsize] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,T)=12 then menuset = 0 : gosub [drawgrid] 'menu if obj(selected,T)=11 then textEd = textEd-1 : gosub [drawgrid] 'texteditor obj(selected,T)=0 selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,X) 'x cpy(2)=obj(selected,Y) 'y cpy(3)=obj(selected,W) 'w cpy(4)=obj(selected,H) 'h cpy(5)=obj(selected,T) 'type cpy(6)=obj(selected,TH) 'textheight cpy$(1)=obj$(selected,Ctr) 'name cpy$(2)=obj$(selected,Tex) 'text content cpy$(3)=obj$(selected,Res) 'resource array or file path cpy$(4)=obj$(selected,Fon) 'ctrl specific font or "" cpy$(5)=obj$(selected,Bak) 'ctrl specific backcolor end if
if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 if obj(obj,T)=11 then textEd = textEd+1 'texteditor obj(obj,X)=insertx obj(obj,Y)=inserty inserty=inserty+cpy(4)+grid obj(obj,W)=cpy(3) obj(obj,H)=cpy(4) obj(obj,T)=cpy(5) obj(obj,TH)=cpy(6) obj$(obj,Ctr)=left$(cpy$(1),11)';obj obj$(obj,Tex)=cpy$(2) obj$(obj,Res)=cpy$(3) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) obj$(obj,Fon)=cpy$(4) obj$(obj,Bak)=cpy$(5) selected=obj gosub [drawall] end if end if #fful.gb "setfocus" wait
[tool] #fful.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext sttx = sttx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=1 obj$(obj,Ctr)="statictext";sttx obj$(obj,Tex)="Statictext-";sttx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 2 'textbox txtbx = txtbx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=2 obj$(obj,Ctr)="textbox";txtbx obj$(obj,Tex)="Textbox-";txtbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 3 'listbox lstbx = lstbx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh*5 obj(obj,T)=3 obj$(obj,Ctr)="listbox";lstbx obj$(obj,Tex)="Listbox-";lstbx;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectlbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 4 'combobox cmbobx = cmbobx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="combobox";cmbobx obj$(obj,Tex)="Combobox-";cmbobx;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectcbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 5 'button bttn = bttn +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=5 obj$(obj,Ctr)="button";bttn obj$(obj,Tex)="button-";bttn if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)="white" inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 6 'bmp button bmpbtn = bmpbtn +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=50 obj(obj,H)=50 obj(obj,T)=6 obj$(obj,Ctr)="bmp\bmpButton";bmpbtn filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Res)=file$ obj$(obj,Tex)="BMPbutton-";bmpbtn loadbmp obj$(obj,Ctr),file$ close #bmp inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid else obj(obj,T)=0 close #bmp end if else obj(obj,T)=0 end if
case 7 'graphicbox grbx = grbx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*3 obj(obj,T)=7 obj$(obj,Ctr)="graphicbox";grbx obj$(obj,Tex)="Graphicbox-";grbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton radio = 1 rdiobtn = rdiobtn + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 obj(obj,H)=ctrh obj(obj,T)=8 obj$(obj,Ctr)="radiobutton";rdiobtn obj$(obj,Tex)="(o) radioBtn-";rdiobtn obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 9 'checkbox check = 1 chkbx = chkbx+1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="checkbox";chkbx obj$(obj,Tex)="[x] checkbox-";chkbx obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox grpbx = grpbx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*4 obj(obj,T)=10 obj$(obj,Ctr)="groupbox";grpbx obj$(obj,Tex)="Group Box-";grpbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor textEd = textEd+1 gosub [drawgrid] obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh*4 obj(obj,T)=11 obj$(obj,Ctr)="texteditor";textEd obj$(obj,Tex)="Texteditor-";textEd if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttecl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,X)=0 obj(obj,Y)=0 obj(obj,W)=100 obj(obj,H)=10 obj(obj,T)=12 obj$(obj,Ctr)="menu";obj obj$(obj,Tex)=" Menu Added" inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid gosub [drawgrid] end if end select selected=obj gosub [drawall] #fful.tool "select Add New" #fful.gb "setfocus" wait
[form] #fful.form "selectionindex? i" select case i case 1 'restore file$="lastsession.ffu" #fful.filePath, "lastsession.ffu" gosub [loadit] case 2 'new gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 6 'write gosub [write] case 7 'import gosub [import] case 8 'export gosub [export] end select #fful.form "select File" gosub [drawall] #fful.gb "setfocus" wait
[drawall] #fful.gb "discard ; redraw bak" ocn=cn projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" for cn=1 to obj gosub [drawit] next cn=ocn #fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20 #fful.gb "setfocus" return
[drawit] 'redraws control cn 'set the color for the drawn object and action taking place if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if
'set the font for the drawn object if obj$(cn,Fon)="" then #fful.gb "font ";projectfont$ ch=projectctrh if obj(cn,H)<ch then obj(cn,H)=ch else #fful.gb "font ";obj$(cn,Fon) ch=obj(cn,TH) if obj(cn,H)<ch then obj(cn,H)=ch end if
'update the properties textboxes for selected control if cn=selected then #prop.tbctrl obj$(cn,Ctr) 'ctrlname #prop.tbtext obj$(cn,Tex) 'text #prop.tbreso obj$(cn,Res) 'resource #prop.tbxywh obj(cn,X);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height #prop.tbcolo obj$(cn,Bak) end if if projecttbcl$ = "" then projecttbcl$ = "white" if projectlbcl$ = "" then projectlbcl$ = "white" if projectcbcl$ = "" then projectcbcl$ = "white" if projecttecl$ = "" then projecttecl$ = "white" #fful.gb "place ";obj(cn,X);" ";obj(cn,Y) if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?" select case obj(cn,T) case 1 'statictext #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 2 'textbox #fful.gb "backcolor ";projecttbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 3 'listbox #fful.gb "backcolor ";projectlbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 4 'combobox #fful.gb "backcolor ";projectcbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 5 'button #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'buttons are always black on white #fful.gb "color black" 'centre button text #fful.gb "stringwidth? ";"A";" width" xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ #fful.gb "backcolor ";projectback$ case 6 'bmpbutton if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr) #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) case 7 ' graphicbox #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "backcolor ";projectback$ case 8 'radiobutton #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'radiobutton text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 9 'checkbox #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'checkbox text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 10 'groupbox #fful.gb "backcolor ";projectback$ 'groupbox is an outline #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'group box text is always black #fful.gb "color black" 'groupbox text is offset if action=0 then #fful.gb "place ";obj(cn,X)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 11 ' texteditor #fful.gb "backcolor ";projecttecl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 12 'menu 'pin to top left obj(cn,X)=10 : obj(cn,Y)=-10 : obj(cn,W)=100 : obj(cn,H)=10 xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X);" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) '#fful.gb "box ";obj(cn,X)+obj(cn,H);" ";obj(cn,Y)+obj(cn,H) #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 21 'tecolor projecttecl$=obj$(cn,Bak) case 22 'tbcolor projecttbcl$=obj$(cn,Bak) case 23 'lbcolor projectlbcl$=obj$(cn,Bak) case 24 'cbcolor projectcbcl$=obj$(cn,Bak) case 30 'font case 31 '!font end select return
[preview] file$="preview.bas" gosub [writeit] 'gosub [resetVars] wait
[quitnoform] close #noform wait
[write] projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas" filedialog "Save .bas",projectfile$,file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit] if file$<>"" then '#################################################### if projectwind$ = "" then wait '#################################################### open file$ for output as #op 'the header #op " 'Project ";projecttitl$ #op " 'Created with Freeform Ultra Lite v";ver$;" ";date$();time$() #op "" if projectback$<>"white" or projectfore$<>"black" then #op " 'Set BackgroundColor$ and ForegroundColor$ of project" #op " BackgroundColor$=";chr$(34);projectback$;chr$(34) #op " ForegroundColor$=";chr$(34);projectfore$;chr$(34) #op "" end if #op " 'Create arrays needed for controls listbox,combobox" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " dim ";obj$(n,Ctr);"$(10)" #op " for n = 1 to 10" #op " ";obj$(n,Ctr);"$(n)= str$(n)" #op " next" end if next #op "" #op " 'Create controls and open window" #op " nomainwin" #op " WindowWidth = ";projectw #op " WindowHeight = ";projecth #op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"Size";chr$(34);", ";chr$(34);"Small";chr$(34);", [dummy], ";chr$(34);"Large";chr$(34);", [dummy]" end if for n=1 to obj select case obj(n,T) case 1 'statictext #op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox #op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ctr);"$(, [";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ctr);"$(, [";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"],[no";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[";obj$(n,Ctr);"],[un";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor #op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 22 'tbcolor #op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'lbcolor #op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 24 'cbcolor #op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'tecolor #op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34) end select next #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op "" #op " 'Set any listbox or combobox to display the first item on the list" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34) end if next #op " 'apply any control specific fonts" for n= 1 to obj if obj(n,T)<>0 and obj$(n,Fon)<>"" then if obj(n,T)=1 or obj(n,T)=2 or obj(n,T)=5 or obj(n,T)=10 or obj(n,T)=11 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34) end if if obj(n,T)=3 or obj(n,T)=4 or obj(n,T)=7 or obj(n,T)=8 or obj(n,T)=9 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34) end if end if next #op " wait" #op ""
'if file$<>"preview.bas" then '#op " 'Create the required handlers for each control" '#op " 'Radiobutton and Checkboxes are given a single handler" 'check=0 'radio=0 for n=1 to obj select case obj(n,T) case 3 'listbox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op " " case 4 'combobox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);", ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op " " case 5 'button #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op " " case 6 'bmpbutton #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here" #op " wait" #op " " case 8 'radiobutton #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here." #op " wait" #op " " #op " [no";obj$(n,Ctr);"click]" #op " 'Your handler code here." #op " wait" #op " " case 9 'checkbox #op " [";obj$(n,Ctr);"click]" #op " 'Your handler code here." #op " wait" #op " " #op " [un";obj$(n,Ctr);"click]" #op " 'Your handler code here." #op " wait" [dontwrite2] #op " " end select next 'end if end if #op " " #op " [quit]" #op " close ";projectform$ #op " end" close #op
files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] return
[saveas] projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu" filedialog "Save As...",projectname$,file$ if file$<>"" then #fful.filePath "File - ";file$ open file$ for output as #op projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ #op projectfile$ #op projectwind$ #op projectform$ #op projecttitl$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth for n=1 to obj if obj(n,T)<>0 then #op obj(n,X);","; #op obj(n,Y);","; #op obj(n,W);","; #op obj(n,H);","; #op obj(n,T);","; #op obj(n,TH) #op obj$(n,Ctr) #op obj$(n,Tex) #op obj$(n,Res) #op obj$(n,Fon) #op obj$(n,Bak) end if next close #op gosub [propertyupdate] redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" end if return
[load] obj = 0 gosub [resetVars] filedialog "Open Project...","*.ffu",file$ #fful.filePath "File - ";file$ [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #ses input #ses, projectfile$ input #ses, projectwind$ input #ses, projectform$ input #ses, projecttitl$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #fful.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ projectctrh=val(c$) projectgrid=val(g$) grid=projectgrid projectw=val(w$) projecth=val(h$) #prop.cbwind "select ";projectwind$ redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.grid "select ";grid #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,X)=val(word$(l$,1,",")) obj(obj,Y)=val(word$(l$,2,",")) obj(obj,W)=val(word$(l$,3,",")) obj(obj,H)=val(word$(l$,4,",")) obj(obj,T)=val(word$(l$,5,",")) obj(obj,TH)=val(word$(l$,6,",")) line input #ses, obj$(obj,Ctr) line input #ses, obj$(obj,Tex) line input #ses, obj$(obj,Res) line input #ses, obj$(obj,Fon) line input #ses, obj$(obj,Bak) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) if obj(obj,T)=12 then menuset=1 if obj(obj,T)=11 then textEd= textEd+1 : gosub [drawgrid] wend close #ses gosub [propertyupdate] #prop "hide" #prop "show" end if return
[import] filedialog "Open .bas...","*.bas",file$ if file$<>"" then WindowWidth = 200 WindowHeight=100 UpperLeftX=(DisplayWidth)/2 - 400 UpperLeftY=(DisplayHeight)/2 - 200 statictext #Please.wait, "Please Wait", 30,35,140,40 open "Please Wait" for window_popup as #Please please = 1 #Please "trapclose [quitplease]" #Please.wait "!font arial 18 bold" cursor hourglass #Please.wait "Please Wait" projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) gosub [new] #fful.filePath "File - ";file$ grid=1 gridvisible=0 gosub [drawgrid] 'set grid to 1 and invisible so controls stay where they import from initially 'import only those lines defining controls we are interested in wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox " wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty " wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ " wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ " dim bas$(5000,2) basln=1 ln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, wln$ 'break into multiple lines if ":" found outside quotes pos=1 ln$="" while pos<=len(wln$) c$=mid$(wln$,pos,1) if c$=chr$(34)then if quote=0 then quote=1 else quote=0 end if if c$=":" and quote=0 then gosub [line] ln$="" pos=pos+1 else ln$=ln$+c$ pos=pos+1 end if wend gosub [line] basln=basln+1 wend 'print "first cut" 'for n=1 to ln 'print bas$(n,1);" ";bas$(n,2) 'next 'print
'now find width height title and handle for all windows found in bas$( 'up to 30 forms in a .bas '1=handle #main etc '2=title '3=width '4=height '5=windowtype '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
redim win$(30,10) redim hnd$(30) nl=ln wh=1 for ln=1 to nl 'find width and height ,assumes width and height are defined ahead of open 'so width height and colors can be set multiple times, so store bas line number involved if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1) if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1) if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1) if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1) if lower$(word$(bas$(ln,2),1)) = "open" and left$(word$(bas$(ln,2),2, " as "),1) = "#" then 'if instr(lower$(bas$(ln,2)),"open",1)>0 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 or instr(lower$(bas$(ln,2)),"text",1)>0 then win$(wh,10)=bas$(ln,1) n$=word$(bas$(ln,2),2,chr$(34)) hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1)) 'find last "for" in command line i=1 while i oi=i i=instr(lower$(bas$(ln,2))," for ",i+1) wend wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi) wt$=word$(wt$,2) win$(wh,1)=hn$ 'handle #fful etc win$(wh,2)=n$ 'title win$(wh,3)=w$ 'width win$(wh,4)=h$ 'height win$(wh,5)=wt$ 'windowtype hnd$(wh)=hn$ 'for combobox 'print wh;" ";hnd$(wh);" ";win$(wh,2);" ";win$(wh,3);" ";win$(wh,4);" ";win$(wh,5) wh=wh+1 end if end if next #fful.hand "reload" #fful.hand "selectindex 1" close #bas if wt$ = "" then #fful.hand "!No Forms" wh=1 gosub [loadwindow] end if cursor normal if please = 1 then close #Please : please = 0 return
[line] if ln$<>"" then w$=lower$(word$(ln$,1)) if instr(w$,"=",1)>1 then w$=word$(w$,1,"=") if len(w$)>3 then w1$=" "+w$+" " w2$=" "+w$+"=" if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 then bas$(ln,1)=str$(basln) bas$(ln,2)=trim$(ln$) ln=ln+1 end if end if end if return
[hand] gosub [resetVars] #fful.hand "selectionindex? wh" gosub [loadwindow] wait
[loadwindow] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font gosub [resetVars] obj=1 projectback$="white" TextboxColor$="white" ListboxColor$="white" ComboboxColor$="white" TexteditorColor$="white" projectfore$="black" projectw=val(win$(wh,3)) if projectw=0 then projectw=600 projecth=val(win$(wh,4)) if projecth=0 then projecth=400 projecttitl$=win$(wh,2) projectwind$=win$(wh,5) projectform$=win$(wh,1) tbc$="" lbc$="" cbc$="" tec$="" gosub [propertyupdate] #fful.w "!";str$(projectw) #fful.h "!";str$(projecth)
'find controls and create obj() for ln=1 to nl 'create hidden objects to control font and color only used in import/export, not displayed ct=0 if instr(bas$(ln,2),"TextboxColor$",1)>0 then tbc$=getcolor$(bas$(ln,2)):ct=20 if instr(bas$(ln,2),"ListboxColor$",1)>0 then lbc$=getcolor$(bas$(ln,2)):ct=21 if instr(bas$(ln,2),"ComboboxColor$",1)>0 then cbc$=getcolor$(bas$(ln,2)):ct=22 if instr(bas$(ln,2),"TexteditorColor$",1)>0 then tec$=getcolor$(bas$(ln,2)):ct=23 if ct then obj(obj,T)=ct if ct=20 then obj$(obj,Bak)=tbc$ if ct=21 then obj$(obj,Bak)=lbc$ if ct=22 then obj$(obj,Bak)=cbc$ if ct=23 then obj$(obj,Bak)=tec$ obj$(obj,Bas)=bas$(ln,1) obj=obj+1 end if for wc=1 to 12 if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for next if wc<=11 then obj$(obj,Bas)=bas$(ln,1) l$=bas$(ln,2) ll$="" 'remove spaces leaving only , separation but keep "" text untouched inString=0 for i=1 to len(l$) c$=mid$(l$,i,1) select case case c$=chr$(34) inString=1-inString case (inString=0) and c$=" " c$="" end select ll$=ll$+c$ next 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1) obj(obj,T)=wc 'type obj(obj,TH)=projectctrh 'get the .ctrl name obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1) 'for un-named controls if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj 'get the text if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc) 'get the array or bmp file name if wc=3 or wc=4 or wc=6 then obj$(obj,Res)=word$(ll$,2,",") 'get rid of "" if wc=6 and left$(obj$(obj,Res),1)=chr$(34) then obj$(obj,Res)=mid$(obj$(obj,Res),2,len(obj$(obj,Res))-2) 'array() -> array( if (wc=3 or wc=4) and right$(obj$(obj,Res),1)=")" then obj$(obj,Res)=left$(obj$(obj,Res), len(obj$(obj,Res))-1) i=1 while word$(ll$,i,",")<>"" i=i+1 wend i=i-4 if wc=6 or wc=5 then 'buttons and bmpbuttons can have xy, wh is optional and they have XX corners if i=3 then obj(obj,X)=val(word$(ll$,i+2,","))'x obj(obj,Y)=val(word$(ll$,i+3,","))'y if wc=5 then 'we need to find a way to calculate width and height if not given #fful.gb "stringwidth? ";"A";" width" obj(obj,W)=width*len(obj$(obj,Tex))+10 obj(obj,H)=projectctrh end if if wc=6 then 'we need a way to set bmp w and h on error goto [dummybmp] open obj$(obj,Res) for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Tex)="bmp" end if loadbmp obj$(obj,Ctr),obj$(obj,Res) close #bmp goto [passdummy]
[dummybmp] obj(obj,W)=25 obj(obj,H)=25 obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),"path.bmp" [passdummy] end if else obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y obj(obj,W)=val(word$(ll$,i+2,","))'w obj(obj,H)=val(word$(ll$,i+3,","))'h end if if upper$(word$(ll$,4,","))="LR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="LL" then 'obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="UR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x 'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if else 'write to .bas tweaks listbox and combobox controls to line up properly 'so we need to untweak them now obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y if wc=1 then obj(obj,Y)=obj(obj,Y)-5 if wc=10 then obj(obj,Y)=obj(obj,Y)+5 if wc=3 or wc=4 then obj(obj,X)=obj(obj,X)-1 obj(obj,W)=val(word$(ll$,i+2,","))'w if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2 obj(obj,H)=val(word$(ll$,i+3,","))'h end if
'save color if set if wc=2 then obj$(obj,Bak)=tbc$ if wc=3 then obj$(obj,Bak)=lbc$ if wc=4 then obj$(obj,Bak)=cbc$ if wc=11 then obj$(obj,Bak)=tec$ obj=obj+1 end if next 'now find font commands listed after the open statement referring to the #form '#form.ctrl !font fontname 'if so add a new font object basln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ lln$=lower$(ln$) if instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font",1)>0 or instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font",1)>0 then f$=right$(ln$,len(ln$)-instr(lln$,"font",1)-4) if instr(f$,";",1)=0 then obj$(obj,Fon)=f$ obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1) obj$(obj,Ctr)=word$(word$(ln$,1),2,".") if instr(lln$,"!font",1)>0 then obj(obj,T)=31 else obj(obj,T)=30 obj$(obj,Bas)=str$(basln)
'find the visible object and store the font change for n=1 to obj if obj$(n,Ctr)=obj$(obj,Ctr) then obj$(n,Fon)=obj$(obj,Fon) #fful.gb "font ";obj$(obj,Fon) #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" obj(n,TH)=(yp-100)/2+7 exit for end if next obj=obj+1 end if end if basln=basln+1 wend close #bas gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[export] dim oldbas$(5000) ln=1 if file$<>"" and right$(file$,3)="bas" then open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ oldbas$(ln)=ln$ ln=ln+1 wend close #bas '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline if win$(wh,6)<>"" then oldbas$(val(win$(wh,6)))=" BackgroundColor$=";chr$(34);projectback$;chr$(34) if win$(wh,7)<>"" then oldbas$(val(win$(wh,7)))=" ForegroundColor$=";chr$(34);projectfore$;chr$(34) if win$(wh,8)<>"" then oldbas$(val(win$(wh,8)))=" WindowWidth=";projectw if win$(wh,8)=win$(wh,9) then oldbas$(val(win$(wh,8)))=oldbas$(val(win$(wh,8)))+": WindowHeight=";projecth else oldbas$(val(win$(wh,9)))=" WindowHeight=";projecth if win$(wh,10)<>"" then oldbas$(val(win$(wh,10)))=" Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ for n=1 to obj select case obj(n,T) 'handle the visible controls case 1 'statictext oldbas$(val(obj$(n,Bas)))=" statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox oldbas$(val(obj$(n,Bas)))=" textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box oldbas$(val(obj$(n,Bas)))=" listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox oldbas$(val(obj$(n,Bas)))=" combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button oldbas$(val(obj$(n,Bas)))=" button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton oldbas$(val(obj$(n,Bas)))=" bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox oldbas$(val(obj$(n,Bas)))=" graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton oldbas$(val(obj$(n,Bas)))=" radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox oldbas$(val(obj$(n,Bas)))=" checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box oldbas$(val(obj$(n,Bas)))=" groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor oldbas$(val(obj$(n,Bas)))=" texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export case 20 'textboxcolor oldbas$(val(obj$(n,Bas)))=" TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'listboxcolor oldbas$(val(obj$(n,Bas)))=" ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 22 'comboboxcolor oldbas$(val(obj$(n,Bas)))=" ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'texteditorcolor oldbas$(val(obj$(n,Bas)))=" TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
'handle font changes case 30 'font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" font ";obj$(n,Fon);chr$(34) case 32 '!font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" !font ";obj$(n,Fon);chr$(34) end select next end if open file$ for output as #bas for n= 1 to ln #bas oldbas$(n) next close #bas return
function getsize$(l$) 'what if it is a variable? v$="" pos=1 n$=mid$(l$,pos,1) while instr("1234567890",n$,1)=0 and pos<len(l$) pos=pos+1 n$=mid$(l$,pos,1) wend while n$>="0" and n$<="9" and pos<=len(l$) v$=v$+n$ pos=pos+1 n$=mid$(l$,pos,1) wend getsize$=v$ end function
function getcolor$(l$) 'what if it is a variable? cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black " for c= 1 to 15 if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for next end function
[new] #fful.filePath "File - untitled.ffu" redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=0 gosub [resetVars] projectw=600 projecth=400 projectback$="white" projectfore$="black" projectctrc$="white" projecttitl$="Untitled" projectform$="#1" projectfile$="Untitled.bas" projectwind$="window_nf" #prop.cbwind "select window_nf" redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.w "select ";projectw #fful.h "select ";projecth gosub [propertyupdate] gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[propertyupdate] #prop.tbfile projectfile$ #prop.cbwind "select ";projectwind$ #prop.tbtitl projecttitl$ #prop.tbform projectform$ #prop.tbctrl "" #prop.tbtext "" #prop.tbreso "" #prop.tbxywh projectw;"x";projecth #prop.tbfont projectfont$ #prop.tbcolo projectfore$;"/";projectback$ return
[resetVars] menuset=0:textEd=0:check=0:radio=0:sttx=0:txtbx=0:lstbx=0 cmbobx=0:bttn=0:bmpbtn=0:grbx=0:rdiobtn=0:chkbx=0:grpbx=0 return
[resize] #fful.tool "select Add New" #fful.form "select File" if wh=0 then wh=1 #fful.hand "selectindex ";wh #fful.grid "select Set Grid" #fful.font "select Set Font" #fful.color "select Set Color" #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawall] wait
[formsize] #fful.w "contents? w$" #fful.h "contents? h$" wf=val(w$) hf=val(h$) if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait projectw=wf projecth=hf insertx=grid inserty=grid gosub [drawgrid] #fful.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid spacing according to user choice, default is 10 #fful.grid "contents? g$" select case g$ case "Invisible" gridvisible=0 case "Visible" gridvisible=1 case else grid=val(g$) end select gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" wait
[drawgrid] #fful.gridsize grid if textEd<0 then textEd=0 projectgrid=grid #fful.gb "cls; fill buttonface" if grid > 0 and gridvisible = 1 then #fful.gb "color ";gridcolor$ ' Grid - Draw vertical lines if menuset = 0 and textEd = 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25 for xs = 0 to projectw step grid ' Grid - Draw horizontal lines #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-25 next xs for ys = 0 to projecth-25 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if 'adjust grid when menu, or texeditor control is selected - revert if menu and texeditor deleted /no longer used., if menuset = 1 or textEd > 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";gridcolor$ for xs = 0 to projectw step grid #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-50 next xs for ys = 0 to projecth-50 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if end if [nogrid]
if grid = 1 or gridvisible = 0 then if textEd =0 and menuset = 0 then #fful.gb "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; " "; projectw; " "; (projecth)/2 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25 #fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25 end if if textEd > 0 or menuset = 1 then #fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";crosshair$ #fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-50 #fful.gb "line "; 0; " "; (projecth-50)/2; " "; projectw; " "; (projecth-50)/2 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50 #fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50 end if end if #fful.gb "flush bak" #fful.grid "!Set Grid" return
[font] #fful.font "contents? f$" if f$="Project Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #fful.gb "font ";projectfont$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" projectctrh=(yp-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Control Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #fful.gb "font ";ctrf$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" ctrh=(yp-100)/2+7 end if if selected then obj$(selected,4)=ctrf$ 'font obj(selected,6)=ctrh 'text height end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="ResetControl" then ctrf$=projectfont$ ctrh=projectctrh if selected then obj$(selected,4)=ctrf$ obj(selected,6)=ctrh end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then #fful.gb "font ";ctrf$ obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #fful.font "select Set Font" gosub [drawall] #fful.gb "setfocus" wait
[color] #fful.color "contents? c$" select case c$ case "Control Background" gosub [colorpick] if cp$<>"" then if selected then 'insert color change event ahead of control if obj(selected,T)=2 then ct=22 : projecttbcl$=cp$ if obj(selected,T)=3 then ct=23 : projectlbcl$=cp$ if obj(selected,T)=4 then ct=24 : projectcbcl$=cp$ if obj(selected,T)=11 then ct=21 : projecttecl$=cp$ for n=obj+1 to selected+1 step -1 obj(n,X)=obj(n-1,X) obj(n,Y)=obj(n-1,Y) obj(n,W)=obj(n-1,W) obj(n,H)=obj(n-1,H) obj(n,T)=obj(n-1,T) obj(n,TH)=obj(n-1,TH) obj$(n,Ctr)=obj$(n-1,Ctr) obj$(n,Tex)=obj$(n-1,Tex) obj$(n,Res)=obj$(n-1,Res) obj$(n,Fon)=obj$(n-1,Fon) obj$(n,Bak)=obj$(n-1,Bak) obj$(n,Bas)=obj$(n-1,Bas) next obj(selected,T)=ct obj$(selected,Tex)="Color!" obj$(selected,Bak)=cp$ 'remove any previous color change statement if selected>=2 then if obj(selected-1,T)=ct then obj(selected-1,T)=0 end if obj=obj+1 end if end if case "Project Background" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Project Foreground" gosub [colorpick] if cp$<>"" then projectfore$=cp$ gosub [drawgrid] case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] case "Border Color" gosub [colorpick] if cp$<>"" then bordercolor$=cp$ gosub [drawgrid] case "CrossHair Color" gosub [colorpick] if cp$<>"" then crosshair$=cp$ gosub [drawgrid] end select #fful.color "select Set Color" gosub [drawall] #fful.gb "setfocus" wait
[windowtype] #prop.cbwind "contents? projectwind$" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #pick.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #pick #pick "font Consolas 9" #pick "trapclose [quitpick]" #pick.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white " c=1 for yc=1 to 160 step 40 for xc= 1 to 160 step 40 #pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40 c=c+1 if c>15 then c=15 next next #pick.gb "when leftButtonDown [pick]" wait
[pick] xp=int(MouseX/40) yp=int(MouseY/40) c=xp+yp*4+1 cp$=word$(cl$,c) close #pick return
[quitplease] if please = 1 then close #Please : please =0 cursor normal wait
[quitpick] close #pick return
[help] run "notepad help.txt" wait
[quitfful] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectfile$ #ses projectwind$ #ses projectform$ #ses projecttitl$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth for n=1 to obj if obj(n,T)<>0 then #ses obj(n,X);","; #ses obj(n,Y);","; #ses obj(n,W);","; #ses obj(n,H);","; #ses obj(n,T);","; #ses obj(n,TH) #ses obj$(n,Ctr) #ses obj$(n,Tex) #ses obj$(n,Res) #ses obj$(n,Fon) #ses obj$(n,Bak) end if next close #ses close #prop close #fful end
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
|
|
|
Post by tsh73 on Jun 3, 2023 16:41:20 GMT -5
Here's mod that uses/supports imported labels Based on last Rod's version 1.11
as was said, it includes
Biggest problem - a place in obj$() to store labels does not get to/from FFU file, needs file format change.
kind of history - few more things got changes along the way:
'1.11_1 fix preview for 32 bit win XP '1.11_2 make [ ] ( ) for checkbox/radio only in drawIt, not text on create '1.11_3 Add Lbl=8, put labels in obj$(n,Lbl) 'get them created (Ok for btn) 'needs add then copied (Ok for btn) 'showed (+) 'written (Ok for btn) 'but needs create labels too (Ok for btn) 'and probably filter for dupes 'imported (Ok for btn) '1.11_3_1 create labels and filter for dupes '(Ok for btn) '1.11_3_2 accidental fix - typoo preventing control rename '1.11_3_3 Lbl support for bmpbutton (6) '1.11_3_4 Lbl support for listbox, combobox (3,4) '1.11_3_5 Lbl support for radiobutton, checkbox (8,9) '1.11_3_6 export. Did "file.bas" export as "file+.bas", so I could compare.
BTW I was not aware "export" actually works - it worked silently, overwritten source file. It is not the thing I would like to, so I changed it so "file.bas" export as "file+.bas" (line
file2$=left$(file$, len(file$)-4)+"+"+right$(file$, 4) next line opens file2$. If it will open file$, it will overwrite source file as before) )
Now it looks like I actually have thing I asked for:
Kind of. If I import - change - export, I get working program with changed control positions. But if I press "preview" in the process, "export" writes me "preview+.bas" file, with base file "preview.bas" with all things thrown out.
Another bug (?) is since I found / fixed typoo that prevented changing control name (was Ctl instead of Ctr in a single line, you can search), you can do it But if you change it on a bmpbutton, program loops (remember that single "on error"? Probably it hits the fan) Now if control is named "bb1" then it displayed design-time with loaded bitmap named "bb1" But if we just changed it to "bb2" - it dies on this line
#fful.gb "drawbmp ";obj$(cn,Ctr) with "Bitmap named bb2 not found" (debugger caught this)(but without debugger it just hangs)
And I have no idea how this situation could be fixed. Reload bmp under new name?
ver$="1.11_3_6" 'freeform ultra lite v1.x 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1
'nomainwin dim info$(10,10) dim form$(10) form$(1)="Restore" form$(2)="New" form$(3)="Save .ffu" form$(4)="Load .ffu" form$(5)="-----------" form$(6)="Write .bas" form$(7)="Import .bas" form$(8)="Export .bas" form$(9)="File" dim tool$(14) tool$(1)="StatictText" tool$(2)="TextBox" tool$(3)="ListBox" tool$(5)="ComboBox" tool$(6)="Button" tool$(7)="BmpButton" tool$(8)="GraphicBox" tool$(9)="RadioButton" tool$(10)="CheckBox" tool$(11)="GroupBox" tool$(12)="Texteditor" tool$(13)="Menu" tool$(14)="Add New" dim hnd$(30) hnd$(1)="#1" dim grid$(20) grid$(1)="1" g=2 for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Invisible" grid$(g+1)="Visible" grid$(g+2)="Set Grid" grid=10 gridvisible=1 gridcolor$="buttonface" projectctrh=25 ctrh=25 dim color$(10) color$(1)="Control Back" color$(2)="Project Back" color$(3)="Project Fore" color$(4)="Grid Color" color$(5)="Set Color" projectback$="white" projectfore$="black" 'ctrc$="white" dim font$(10) font$(1)="Control Font" font$(2)="ResetControl" font$(3)="Project Font" font$(4)="Set Font"'default is Consolas 9" dim wind$(20)'window type names wind$(1)="window" wind$(2)="window_nf" wind$(3)="window_popup" wind$(4)="dialog" wind$(5)="dialog_modal" wind$(6)="dialog_nf" wind$(7)="dialog_nf_modal" wind$(8)="dialog_fs" wind$(9)="dialog_nf_fs" wind$(10)="dialog_popup" wind$(11)="graphics" wind$(12)="graphics_fs" wind$(13)="graphics_fs_nsb" wind$(14)="graphics_nsb" wind$(15)="graphics_nf_nsb" wind$(16)="text" wind$(17)="text_fs" wind$(18)="text_nsb" wind$(19)="text_nsb_ins"
dim v$(2000) for n= 100 to 2000 step 20 v$(n)=str$(n) next dim obj(200,6) 'x,y,width/height,type,textheight X=1 Y=2 W=3 H=4 T=5 TH=6
dim obj$(200,8) 'name,text,resource,font,backcolor,basline Ctr=1 Tex=2 Res=3 Fon=4 Bak=5 Bas=7 Lbl=8 'for any controls with labels. () If 2 (set reset), then "[set],[reset]"
'set default starting position obj=0 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" projectctrh=25 projectgrid=10 projectw=320 projecth=360 insertx=grid inserty=grid*2
'open a small properties window and hide it WindowWidth=230 'WindowHeight=260 WindowHeight=285 '+25 UpperLeftX=(DisplayWidth-230)/2 UpperLeftY=(DisplayHeight-180)/2 statictext #prop.st1 "File",5,10,30,25 textbox #prop.tbfile,45,5,150,25 statictext #prop.st2 "Wind",5,32,30,25 combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25 statictext #prop.st3 "Titl",5,54,30,25 textbox #prop.tbtitl,45,49,150,25 statictext #prop.st4 "Form",5,76,30,25 textbox #prop.tbform,45,71,150,25 statictext #prop.st5 "Ctrl",5,98,30,25 textbox #prop.tbctrl,45,93,150,25 statictext #prop.st6 "Text",5,120,30,25 textbox #prop.tbtext,45,115,150,25 statictext #prop.st7 "Reso",5,142,30,25 textbox #prop.tbreso,45,137,150,25 statictext #prop.st8 "Lbls",5,164,30,25 textbox #prop.tblbls,45,159,150,25 statictext #prop.st9 "xywh",5,186,30,25 textbox #prop.tbxywh,45,181,150,25 statictext #prop.st10 "Font",5,208,30,25 textbox #prop.tbfont,45,203,150,25 statictext #prop.st11 "Colo",5,230,30,25 textbox #prop.tbcolo,45,225,150,25
open "Properties" for window_nf as #prop #prop "font Consolas 9" #prop "trapclose [show]" #prop.cbwind "select window_nf" #prop.tbfile "!disable" #prop.tbxywh "!disable" #prop.tbfont "!disable" #prop.tbcolo "!disable" gosub [propertyupdate] #prop "hide"
'open the main form window 'this window is resizable, the graphicox will resize but the 'client area, which is a drawn representation of the window 'will only change size if you change the project w/h dimensions WindowWidth=862 WindowHeight=705 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #fful.tool,tool$(,[tool],5,2,85,30 combobox #fful.form,form$(,[form],95,2,85,30 combobox #fful.hand,hnd$(,[hand],185,2,85,30 button #fful.project,"Preview",[preview],UL,275,0,60,25 combobox #fful.w,v$(,[formsize],340,2,60,30 combobox #fful.h,v$(,[formsize],405,2,60,30 combobox #fful.grid,grid$(,[grid],470,2,90,30 combobox #fful.color,color$(,[color],565,2,90,30 combobox #fful.font,font$(,[font],660,2,90,30 button #fful.help,"Help",[help],UL,755,0,80,25 graphicbox #fful.gb,5,25,830,630 open "Freeform Ultra Lite v";ver$ for window as #fful #fful "trapclose [quitfful]" #fful "font Consolas 9" #fful "resizehandler [resize]" #fful.tool "select Add New" #fful.form "select File" #fful.hand "selectindex 1" #fful.grid "select Set Grid" #fful.color "select Set Color" #fful.font "select Set Font" #fful.w "select ";projectw #fful.h "select ";projecth #fful.gb "autoresize" #fful.gb "vertscrollbar on 0 ";projectw #fful.gb "horizscrollbar on 0 ";projecth #fful.gb "font ";projectfont$ #fful.gb "down" gosub [drawgrid] gosub [drawall] #fful.gb "when rightButtonDown [show]" #fful.gb "when leftButtonDown [select]" #fful.gb "when characterInput [keys]" #fful.gb "setfocus" #prop "show" show=1 wait
[show] if show then #prop "hide" show=0 else #prop "show" show=1 end if wait
'the user clicked on the form design window 'either to chose a control or to deselect a control [select] xs=MouseX ys=MouseY
'hide property window if it is open if show then #prop "hide" show=0 end if
'before we move on update the currently selected control from properties 'get the project data and only the editable contents of controls if selected=0 then 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ end if #prop.tbctrl "!contents? t$" : obj$(selected,Ctr)=t$ #prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$ #prop.tbreso "!contents? t$" : obj$(selected,Res)=t$ #prop.tblbls "!contents? t$" : obj$(selected,Lbl)=t$ 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if xs>obj(cn,X) and xs<(obj(cn,X)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then if xs>obj(cn,X)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2 if obj(cn,T)=6 then action=1 selected=cn exit for end if next if selected=0 then gosub [propertyupdate] action=0 end if if selected>0 and action=1 then #fful.gb "when leftButtonMove [track]" #fful.gb "when leftButtonUp [stop]" offsetX=xs-obj(selected,X) offsetY=ys-obj(selected,Y) end if if selected>0 and obj(selected,T)<>6 and action=2 then 'dont resize bmp #fful.gb "when leftButtonMove [tracksize]" #fful.gb "when leftButtonUp [stopsize]" offsetX=xs-(obj(selected,X)+obj(selected,W)) offsetY=ys-(obj(selected,Y)+obj(selected,H)) end if if selected>0 then gosub [drawit] else insertx=int((xs+(grid/2))/grid)*grid inserty=int((ys+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #fful.gb "rule xor" gosub [drawit] xt=int((MouseX-offsetX+(grid/2))/grid)*grid if xt<0 then xt=0 if xt+obj(selected,W)>projectw then xt=projectw-obj(selected,W) obj(selected,X)=xt yt=int((MouseY-offsetY+(grid/2))/grid)*grid if yt<0 then yt=0 if yt+obj(selected,H)>projecth then yt=projecth-obj(selected,H) obj(selected,Y)=yt gosub [drawit] wait
[stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[tracksize] #fful.gb "rule xor" gosub [drawit] xs=int((MouseX-offsetX+(grid/2))/grid)*grid if xs>projectw then xs=projectw if xs<obj(selected,X) then xs=obj(selected,X)+grid ys=int((MouseY-offsetY+(grid/2))/grid)*grid if ys>projecth then ys=projecth if ys<obj(selected,Y)+ctrh then ys=obj(selected,Y)+ctrh obj(selected,W)=xs-obj(selected,X)'width obj(selected,H)=ys-obj(selected,Y)'height gosub [drawit] wait
[stopsize] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,T)=12 then menuset=0 obj(selected,T)=0 selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,X) 'x cpy(2)=obj(selected,Y) 'y cpy(3)=obj(selected,W) 'w cpy(4)=obj(selected,H) 'h cpy(5)=obj(selected,T) 'type cpy(6)=obj(selected,TH) 'textheight cpy$(1)=obj$(selected,Ctr)'name cpy$(2)=obj$(selected,Tex)'text content cpy$(3)=obj$(selected,Res)'resource array or file path cpy$(4)=obj$(selected,Fon)'ctrl specific font or "" cpy$(5)=obj$(selected,Bak)'ctrl specific backcolor end if if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty inserty=inserty+cpy(4)+grid obj(obj,W)=cpy(3) obj(obj,H)=cpy(4) obj(obj,T)=cpy(5) obj(obj,TH)=cpy(6) obj$(obj,Ctr)=left$(cpy$(1),2);obj obj$(obj,Tex)=cpy$(2) obj$(obj,Res)=cpy$(3) 'if obj(obj,T)=5 then obj$(obj,Lbl)="[";obj$(obj,Ctr);"Click]" if inlist(obj(obj,T), "3 4 5 6") then obj$(obj,Lbl)="[";obj$(obj,Ctr);"Click]" if inlist(obj(obj,T), "8 9") then obj$(obj,Lbl)="[";obj$(obj,Ctr);"Set],[";obj$(obj,Ctr);"Reset]" if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) obj$(obj,Fon)=cpy$(4) obj$(obj,Bak)=cpy$(5) selected=obj gosub [drawall] end if end if #fful.gb "setfocus" wait
[tool] #fful.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh obj(obj,T)=1 obj$(obj,Ctr)="st";obj obj$(obj,Tex)="statictext?" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 2 'textbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=ctrh obj(obj,T)=2 obj$(obj,Ctr)="tb";obj obj$(obj,Tex)="Textbox" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 3 'listbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=ctrh*5 obj(obj,T)=3 obj$(obj,Ctr)="lb";obj obj$(obj,Tex)="Listbox\item2\item3\item4\item5" obj$(obj,Lbl)="[";obj$(obj,Ctr);"Click]" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectlbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 4 'combobox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="cb";obj obj$(obj,Tex)="Combobox\item2\item3\item4\item5" obj$(obj,Lbl)="[";obj$(obj,Ctr);"Click]" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectcbcl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 5 'button obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=5 obj$(obj,Ctr)="bt";obj obj$(obj,Tex)="Button?" obj$(obj,Lbl)="[";obj$(obj,Ctr);"Click]" 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 obj$(obj,Lbl)="[";obj$(obj,Ctr);"Click]" filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Res)=file$ obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),file$ close #bmp inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid else obj(obj,T)=0 close #bmp end if else obj(obj,T)=0 end if
case 7 'graphicbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=100 obj(obj,T)=7 obj$(obj,Ctr)="gb";obj obj$(obj,Tex)="Graphicbox" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=8 obj$(obj,Ctr)="rb";obj obj$(obj,Tex)="Radio?" obj$(obj,Lbl)="[";obj$(obj,Ctr);"Set],[";obj$(obj,Ctr);"Reset]" obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid case 9 'checkbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="ch";obj obj$(obj,Tex)="Check?" obj$(obj,Lbl)="[";obj$(obj,Ctr);"Set],[";obj$(obj,Ctr);"Reset]" obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=100 obj(obj,T)=10 obj$(obj,Ctr)="gr";obj obj$(obj,Tex)="Group Box?" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=200 obj(obj,H)=100 obj(obj,T)=11 obj$(obj,Ctr)="te";obj obj$(obj,Tex)="Texteditor" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttecl$ inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,X)=0 obj(obj,Y)=0 obj(obj,W)=100 obj(obj,H)=10 obj(obj,T)=12 obj$(obj,Ctr)="mn";obj obj$(obj,Tex)=" Menu Added" menuset=1 end if end select selected=obj gosub [drawall] #fful.tool "select Add New" #fful.gb "setfocus" wait
[form] #fful.form "selectionindex? i" select case i case 1 'restore file$="lastsession.ffu" gosub [loadit] case 2 'new gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 6 'write gosub [write] case 7 'import gosub [import] case 8 'export gosub [export] end select #fful.form "select File" gosub [drawall] #fful.gb "setfocus" wait
[drawall] #fful.gb "discard ; redraw bak" ocn=cn projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" for cn=1 to obj gosub [drawit] next cn=ocn #fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20 #fful.gb "setfocus" return
[drawit] 'redraws control cn
'set the color for the drawn object and action taking place if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if
'set the font for the drawn object if obj$(cn,Fon)="" then #fful.gb "font ";projectfont$ ch=projectctrh if obj(cn,H)<ch then obj(cn,H)=ch else #fful.gb "font ";obj$(cn,Fon) ch=obj(cn,TH) if obj(cn,H)<ch then obj(cn,H)=ch end if
'update the properties textboxes for selected control if cn=selected then #prop.tbctrl obj$(cn,Ctr) 'ctrlname #prop.tbtext obj$(cn,Tex) 'text #prop.tbreso obj$(cn,Res) 'resource #prop.tblbls obj$(cn,Lbl) 'label(s) #prop.tbxywh obj(cn,X);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height #prop.tbcolo obj$(cn,Bak) end if #fful.gb "place ";obj(cn,X);" ";obj(cn,Y) if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?" select case obj(cn,T) case 1 'statictext #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 2 'textbox #fful.gb "backcolor ";projecttbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 3 'listbox #fful.gb "backcolor ";projectlbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 4 'combobox #fful.gb "backcolor ";projectcbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 5 'button #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'buttons are always black on white #fful.gb "color black" 'centre button text #fful.gb "stringwidth? ";"A";" width" xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ #fful.gb "backcolor ";projectback$ case 6 'bmpbutton if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr) #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) case 7 ' graphicbox #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "backcolor ";projectback$ case 8 'radiobutton #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'radiobutton text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\( )";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 9 'checkbox #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'checkbox text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\[ ]";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 10 'groupbox #fful.gb "backcolor ";projectback$ 'groupbox is an outline #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'group box text is always black #fful.gb "color black" 'groupbox text is offset if action=0 then #fful.gb "place ";obj(cn,X)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 11 ' texteditor #fful.gb "backcolor ";projecttecl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 12 'menu 'pin to top left obj(cn,X)=10 : obj(cn,Y)=-10 : obj(cn,W)=100 : obj(cn,H)=10 #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 21 'tecolor projecttecl$=obj$(cn,Bak) case 22 'tbcolor projecttbcl$=obj$(cn,Bak) case 23 'lbcolor projectlbcl$=obj$(cn,Bak) case 24 'cbcolor projectcbcl$=obj$(cn,Bak) case 30 'font case 31 '!font end select
return
[preview] file$="preview.bas" gosub [writeit] wait
[write] projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas" filedialog "Save .bas",projectfile$,file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit]
if file$<>"" then open file$ for output as #op 'the header #op " 'Project ";projecttitl$ #op " 'Created with Freeform Ultra Lite v";ver$;" ";date$() #op " nomainwin" #op "" if projectback$<>"white" or projectfore$<>"black" then #op " 'Set BackgroundColor$ and ForegroundColor$ of project" #op " BackgroundColor$=";chr$(34);projectback$;chr$(34) #op " ForegroundColor$=";chr$(34);projectfore$;chr$(34) #op "" end if #op " 'Create arrays needed for controls listbox,combobox" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " dim ";obj$(n,Res);"10)" #op " for n = 1 to 10" #op " ";obj$(n,Res);"n)= str$(n)" #op " next" end if next #op "" #op " 'Create controls and open window" #op " nomainwin" #op " WindowWidth = ";projectw #op " WindowHeight = ";projecth #op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"Size";chr$(34);", ";chr$(34);"Small";chr$(34);", [dummy], ";chr$(34);"Large";chr$(34);", [dummy]" end if for n=1 to obj select case obj(n,T) case 1 'statictext #op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox #op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);","; nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]");",";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);","; nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]");",";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button '#op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);","; nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]");", UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);","; nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]");", UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton if file$<>"preview.bas" then lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Set],[";obj$(n,Ctr);"Reset]") else lbl$="[radio],[radio]" end if #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";lbl$;",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox if file$<>"preview.bas" then lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Set],[";obj$(n,Ctr);"Reset]") else lbl$="[check],[check]" end if #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";lbl$;",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor #op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 22 'tbcolor #op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'lbcolor #op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 24 'cbcolor #op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'tecolor #op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34) end select next #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op "" #op " 'Set any listbox or combobox to display the first item on the list" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34) end if next #op " 'apply any control specific fonts" for n= 1 to obj if obj(n,T)<>0 and obj$(n,Fon)<>"" then if obj(n,T)=1 or obj(n,T)=2 or obj(n,T)=5 or obj(n,T)=10 or obj(n,T)=11 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34) end if if obj(n,T)=3 or obj(n,T)=4 or obj(n,T)=7 or obj(n,T)=8 or obj(n,T)=9 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34) end if end if next #op " wait" #op ""
labelList$="[quit]" if file$<>"preview.bas" then #op " 'Create the required handlers for each control" '#op " 'Radiobutton and Checkboxes are given a single handler" 'no more check=0 radio=0 for n=1 to obj select case obj(n,T) case 3,4 'listbox, combobox lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]") if instr(labelList$, lbl$)=0 then 'label NOT already written 'write label #op " ";lbl$ #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op "" 'and remember it labelList$= labelList$+" "+ lbl$ end if ' case 4 'combobox ' #op " [";obj$(n,Ctr);"click]" ' #op " 'Your handler code here, read the control with" ' #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) ' #op " wait" ' #op "" case 5, 6 'button, bmpbutton lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]") if instr(labelList$, lbl$)=0 then 'label NOT already written 'write label '#op " [";obj$(n,Ctr);"click]" #op " ";lbl$ #op " 'Your handler code here" #op " wait" #op "" 'and remember it labelList$= labelList$+" "+ lbl$ end if ' case 6 'bmpbutton ' #op " [";obj$(n,Ctr);"click]" ' #op " 'Your handler code here" ' #op " wait" ' #op "" case 8,9 'radiobutton, checkbox for i = 1 to 2 'set,reset labels lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Set],[";obj$(n,Ctr);"Reset]") lbl$=word$(lbl$,i,",") if instr(labelList$, lbl$)=0 then 'label NOT already written 'write label #op " ";lbl$ #op " 'Your ";obj$(n,Ctr);" ";word$("set reset",i);" handler code here" #op " wait" #op "" 'and remember it labelList$= labelList$+" "+ lbl$ end if next ' case 8 'radiobutton ' if radio=0 then ' #op " [radio]" ' #op " 'Your handler code here, read all radiobuttons to determine which is set" ' #op " 'this is an example of eading the first radiobutton" ' #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) ' #op " wait" ' #op "" ' radio=1 ' end if ' case 9 'checkbox ' if check=0 then ' #op " [check]" ' #op " 'Your handler code here, read all checkboxes in the group in sequence." ' #op " 'this is an example of eading the first checkbox" ' #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34) ' #op " wait" ' #op "" ' check=1 ' end if end select next else #op " [radio]" #op " wait" #op "" #op " [check]" #op " wait" #op "" end if #op " [quit]" #op " close ";projectform$ #op " end" close #op files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if
notice "FIXME: path to BASIC EXE not set" [done] end if return
[saveas] projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu" filedialog "Save As...",projectname$,file$ if file$<>"" then open file$ for output as #op projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ #op projectfile$ #op projectwind$ #op projectform$ #op projecttitl$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth for n=1 to obj if obj(n,T)<>0 then #op obj(n,X);","; #op obj(n,Y);","; #op obj(n,W);","; #op obj(n,H);","; #op obj(n,T);","; #op obj(n,TH) #op obj$(n,Ctr) #op obj$(n,Tex) #op obj$(n,Res) #op obj$(n,Fon) #op obj$(n,Bak) end if next close #op gosub [propertyupdate] redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" end if return
[load] filedialog "Open Project...","*.ffu",file$ [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #ses input #ses, projectfile$ input #ses, projectwind$ input #ses, projectform$ input #ses, projecttitl$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #fful.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ projectctrh=val(c$) projectgrid=val(g$) grid=projectgrid projectw=val(w$) projecth=val(h$) #prop.cbwind "select ";projectwind$ redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.grid "select ";grid #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,X)=val(word$(l$,1,",")) obj(obj,Y)=val(word$(l$,2,",")) obj(obj,W)=val(word$(l$,3,",")) obj(obj,H)=val(word$(l$,4,",")) obj(obj,T)=val(word$(l$,5,",")) obj(obj,TH)=val(word$(l$,6,",")) line input #ses, obj$(obj,Ctr) line input #ses, obj$(obj,Tex) line input #ses, obj$(obj,Res) line input #ses, obj$(obj,Fon) line input #ses, obj$(obj,Bak) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) if obj(obj,T)=12 then menuset=1 wend close #ses gosub [propertyupdate] #prop "hide" #prop "show" end if return
[import] filedialog "Open .bas...","*.bas",file$ if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) gosub [new] grid=1 gridvisible=0 gosub [drawgrid] 'set grid to 1 and invisible so controls stay where they import from initially 'import only those lines defining controls we are interested in wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox " wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty " wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ " wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ " dim bas$(5000,2) basln=1 ln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, wln$ 'break into multiple lines if ":" found outside quotes pos=1 ln$="" while pos<=len(wln$) c$=mid$(wln$,pos,1) if c$=chr$(34)then if quote=0 then quote=1 else quote=0 end if if c$=":" and quote=0 then gosub [line] ln$="" pos=pos+1 else ln$=ln$+c$ pos=pos+1 end if wend gosub [line] basln=basln+1 wend print "first cut" for n=1 to ln print bas$(n,1);" ";bas$(n,2) next print
'now find width height title and handle for all windows found in bas$( 'up to 30 forms in a .bas '1=handle #main etc '2=title '3=width '4=height '5=windowtype '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
redim win$(30,10) redim hnd$(30) nl=ln wh=1 for ln=1 to nl 'find width and height ,assumes width and height are defined ahead of open 'so width height and colors can be set multiple times, so store bas line number involved if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1) if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1) if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1) if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1) if instr(lower$(bas$(ln,2)),"open",1)>0 then if instr(lower$(bas$(ln,2)),"window",1)>0 or instr(lower$(bas$(ln,2)),"dialog",1)>0 or instr(lower$(bas$(ln,2)),"graphic",1)>0 then win$(wh,10)=bas$(ln,1) n$=word$(bas$(ln,2),2,chr$(34)) hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1)) 'find last "for" in command line i=1 while i oi=i i=instr(lower$(bas$(ln,2))," for ",i+1) wend wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi) wt$=word$(wt$,2) win$(wh,1)=hn$ 'handle #fful etc win$(wh,2)=n$ 'title win$(wh,3)=w$ 'width win$(wh,4)=h$ 'height win$(wh,5)=wt$ 'windowtype hnd$(wh)=hn$ 'for combobox 'print wh;" ";hnd$(wh);" ";win$(wh,2);" ";win$(wh,3);" ";win$(wh,4);" ";win$(wh,5) wh=wh+1 end if end if next #fful.hand "reload" #fful.hand "selectindex 1" close #bas wh=1 gosub [loadwindow] end if return
[line] if ln$<>"" then w$=lower$(word$(ln$,1)) if instr(w$,"=",1)>1 then w$=word$(w$,1,"=") if len(w$)>3 then w1$=" "+w$+" " w2$=" "+w$+"=" if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 then bas$(ln,1)=str$(basln) bas$(ln,2)=trim$(ln$) ln=ln+1 end if end if end if return
[hand] #fful.hand "selectionindex? wh" gosub [loadwindow] wait
[loadwindow] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,8) 'name,text content,resource,font obj=1 menuset=0 projectback$="white" TextboxColor$="white" ListboxColor$="white" ComboboxColor$="white" TexteditorColor$="white" projectfore$="black" projectw=val(win$(wh,3)) if projectw=0 then projectw=320 projecth=val(win$(wh,4)) if projecth=0 then projecth=360 projecttitl$=win$(wh,2) projectwind$=win$(wh,5) projectform$=win$(wh,1) tbc$="" lbc$="" cbc$="" tec$="" gosub [propertyupdate] #fful.w "!";str$(projectw) #fful.h "!";str$(projecth)
'find controls and create obj() for ln=1 to nl 'create hidden objects to control font and color only used in import/export, not displayed ct=0 if instr(bas$(ln,2),"TextboxColor$",1)>0 then tbc$=getcolor$(bas$(ln,2)):ct=20 if instr(bas$(ln,2),"ListboxColor$",1)>0 then lbc$=getcolor$(bas$(ln,2)):ct=21 if instr(bas$(ln,2),"ComboboxColor$",1)>0 then cbc$=getcolor$(bas$(ln,2)):ct=22 if instr(bas$(ln,2),"TexteditorColor$",1)>0 then tec$=getcolor$(bas$(ln,2)):ct=23 if ct then obj(obj,T)=ct if ct=20 then obj$(obj,Bak)=tbc$ if ct=21 then obj$(obj,Bak)=lbc$ if ct=22 then obj$(obj,Bak)=cbc$ if ct=23 then obj$(obj,Bak)=tec$ obj$(obj,Bas)=bas$(ln,1) obj=obj+1 end if for wc=1 to 12 if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for next if wc<=11 then obj$(obj,Bas)=bas$(ln,1) l$=bas$(ln,2) ll$="" 'remove spaces leaving only , separation but keep "" text untouched inString=0 for i=1 to len(l$) c$=mid$(l$,i,1) select case case c$=chr$(34) inString=1-inString case (inString=0) and c$=" " c$="" end select ll$=ll$+c$ next 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1) obj(obj,T)=wc 'type obj(obj,TH)=projectctrh 'get the .ctrl name obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1) 'for un-named controls if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj 'get the text if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc) 'get the array or bmp file name if wc=3 or wc=4 or wc=6 then obj$(obj,Res)=word$(ll$,2,",") 'get rid of "" if wc=6 and left$(obj$(obj,Res),1)=chr$(34) then obj$(obj,Res)=mid$(obj$(obj,Res),2,len(obj$(obj,Res))-2) 'array() -> array( if (wc=3 or wc=4) and right$(obj$(obj,Res),1)=")" then obj$(obj,Res)=left$(obj$(obj,Res), len(obj$(obj,Res))-1) i=1 while word$(ll$,i,",")<>"" i=i+1 wend i=i-4 if wc=6 or wc=5 then 'buttons and bmpbuttons can have xy, wh is optional and they have XX corners if i=3 then obj(obj,X)=val(word$(ll$,i+2,","))'x obj(obj,Y)=val(word$(ll$,i+3,","))'y if wc=5 then 'we need to find a way to calculate width and height if not given #fful.gb "stringwidth? ";"A";" width" obj(obj,W)=width*len(obj$(obj,Tex))+10 obj(obj,H)=projectctrh end if if wc=6 then 'we need a way to set bmp w and h on error goto [dummybmp] open obj$(obj,Res) for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Tex)="bmp" end if loadbmp obj$(obj,Ctr),obj$(obj,Res) close #bmp goto [passdummy]
[dummybmp] obj(obj,W)=25 obj(obj,H)=25 obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),"path.bmp" [passdummy] end if else obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y obj(obj,W)=val(word$(ll$,i+2,","))'w obj(obj,H)=val(word$(ll$,i+3,","))'h end if if upper$(word$(ll$,4,","))="LR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="LL" then 'obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="UR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x 'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if else 'write to .bas tweaks listbox and combobox controls to line up properly 'so we need to untweak them now obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y if wc=1 then obj(obj,Y)=obj(obj,Y)-5 if wc=10 then obj(obj,Y)=obj(obj,Y)+5 if wc=3 or wc=4 then obj(obj,X)=obj(obj,X)-1 obj(obj,W)=val(word$(ll$,i+2,","))'w if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2 obj(obj,H)=val(word$(ll$,i+3,","))'h end if if inlist(wc, "3 4 5 6") then obj$(obj,Lbl)=word$(ll$,3,",") if inlist(wc, "8 9 ") then obj$(obj,Lbl)=word$(ll$,3,",");",";word$(ll$,4,",")
'save color if set if wc=2 then obj$(obj,Bak)=tbc$ if wc=3 then obj$(obj,Bak)=lbc$ if wc=4 then obj$(obj,Bak)=cbc$ if wc=11 then obj$(obj,Bak)=tec$ obj=obj+1 end if next 'now find font commands listed after the open statement referring to the #form '#form.ctrl !font fontname 'if so add a new font object basln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ lln$=lower$(ln$) if instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font",1)>0 or instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font",1)>0 then f$=right$(ln$,len(ln$)-instr(lln$,"font",1)-4) if instr(f$,";",1)=0 then obj$(obj,Fon)=f$ obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1) obj$(obj,Ctr)=word$(word$(ln$,1),2,".") if instr(lln$,"!font",1)>0 then obj(obj,T)=31 else obj(obj,T)=30 obj$(obj,Bas)=str$(basln)
'find the visible object and store the font change for n=1 to obj if obj$(n,Ctr)=obj$(obj,Ctr) then obj$(n,Fon)=obj$(obj,Fon) #fful.gb "font ";obj$(obj,Fon) #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" obj(n,TH)=(yp-100)/2+7 exit for end if next obj=obj+1 end if end if basln=basln+1 wend
close #bas gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[export] dim oldbas$(5000) ln=1 if file$<>"" and right$(file$,3)="bas" then open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ oldbas$(ln)=ln$ ln=ln+1 wend close #bas '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
if win$(wh,6)<>"" then oldbas$(val(win$(wh,6)))=" BackgroundColor$=";chr$(34);projectback$;chr$(34) if win$(wh,7)<>"" then oldbas$(val(win$(wh,7)))=" ForegroundColor$=";chr$(34);projectfore$;chr$(34) if win$(wh,8)<>"" then oldbas$(val(win$(wh,8)))=" WindowWidth=";projectw if win$(wh,8)=win$(wh,9) then oldbas$(val(win$(wh,8)))=oldbas$(val(win$(wh,8)))+": WindowHeight=";projecth else oldbas$(val(win$(wh,9)))=" WindowHeight=";projecth if win$(wh,10)<>"" then oldbas$(val(win$(wh,10)))=" Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ for n=1 to obj select case obj(n,T) 'handle the visible controls case 1 'statictext oldbas$(val(obj$(n,Bas)))=" statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox oldbas$(val(obj$(n,Bas)))=" textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]") oldbas$(val(obj$(n,Bas)))=" listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",";lbl$;",";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]") oldbas$(val(obj$(n,Bas)))=" combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",";lbl$;",";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]") oldbas$(val(obj$(n,Bas)))=" button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";lbl$;", UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]") oldbas$(val(obj$(n,Bas)))=" bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",";lbl$;", UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox oldbas$(val(obj$(n,Bas)))=" graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Set],[";obj$(n,Ctr);"Reset]") oldbas$(val(obj$(n,Bas)))=" radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";lbl$;",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"Set],[";obj$(n,Ctr);"Reset]") oldbas$(val(obj$(n,Bas)))=" checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";lbl$;",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box oldbas$(val(obj$(n,Bas)))=" groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor oldbas$(val(obj$(n,Bas)))=" texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export case 20 'textboxcolor oldbas$(val(obj$(n,Bas)))=" TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'listboxcolor oldbas$(val(obj$(n,Bas)))=" ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 22 'comboboxcolor oldbas$(val(obj$(n,Bas)))=" ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'texteditorcolor oldbas$(val(obj$(n,Bas)))=" TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
'handle font changes case 30 'font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" font ";obj$(n,Fon);chr$(34) case 32 '!font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" !font ";obj$(n,Fon);chr$(34) end select next end if file2$=left$(file$, len(file$)-4)+"+"+right$(file$, 4) 'open file$ for output as #bas open file2$ for output as #bas for n= 1 to ln #bas oldbas$(n) next close #bas return
function getsize$(l$) 'what if it is a variable? v$="" pos=1 n$=mid$(l$,pos,1) while instr("1234567890",n$,1)=0 and pos<len(l$) pos=pos+1 n$=mid$(l$,pos,1) wend while n$>="0" and n$<="9" and pos<=len(l$) v$=v$+n$ pos=pos+1 n$=mid$(l$,pos,1) wend getsize$=v$ end function
function getcolor$(l$) 'what if it is a variable? cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black " for c= 1 to 15 if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for next end function
[new] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=0 menuset=0 projectw=320 projecth=360 projectback$="white" projectfore$="black" projectctrc$="white" projecttitl$="Untitled" projectform$="#1" projectfile$="Untitled.bas" projectwind$="window_nf" #prop.cbwind "select window_nf" redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.w "select ";projectw #fful.h "select ";projecth gosub [propertyupdate] gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[propertyupdate] #prop.tbfile projectfile$ #prop.cbwind "select ";projectwind$ #prop.tbtitl projecttitl$ #prop.tbform projectform$ #prop.tbctrl "" #prop.tbtext "" #prop.tbreso "" #prop.tblbls "" #prop.tbxywh projectw;"x";projecth #prop.tbfont projectfont$ #prop.tbcolo projectfore$;"/";projectback$ return
[resize] #fful.tool "select Add New" #fful.form "select File" if wh=0 then wh=1 #fful.hand "selectindex ";wh #fful.grid "select Set Grid" #fful.font "select Set Font" #fful.color "select Set Color" #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawall] wait
[formsize] #fful.w "contents? w$" #fful.h "contents? h$" wf=val(w$) hf=val(h$) if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait projectw=wf projecth=hf insertx=grid inserty=grid gosub [drawgrid] #fful.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid spacing according to user choice, default is 10 #fful.grid "contents? g$" select case g$ case "Invisible" gridvisible=0 case "Visible" gridvisible=1 case else grid=val(g$) end select gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" wait
[drawgrid] if grid>0 then projectgrid=grid insertx=int((insertx+(grid/2))/grid)*grid inserty=int((inserty+(grid/2))/grid)*grid #fful.gb "cls; fill buttonface" #fful.gb "place 0 0 ; color ";projectback$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth #fful.gb "color ";gridcolor$;" ; backcolor ";projectback$ if gridvisible then for xs = 0 to projectw step grid print #fful.gb, "line ";xs;" 0 ";xs;" ";projecth next for ys = 0 to projecth step grid #fful.gb, "line 0 ";ys;" ";projectw;" ";ys next end if #fful.gb "flush bak" #fful.gb "color black" end if #fful.grid "select Set Grid" return
[font] #fful.font "contents? f$" if f$="Project Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #fful.gb "font ";projectfont$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" projectctrh=(yp-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Control Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #fful.gb "font ";ctrf$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" ctrh=(yp-100)/2+7 end if if selected then obj$(selected,4)=ctrf$ 'font obj(selected,6)=ctrh 'text height end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="ResetControl" then ctrf$=projectfont$ ctrh=projectctrh if selected then obj$(selected,4)=ctrf$ obj(selected,6)=ctrh end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then #fful.gb "font ";ctrf$ obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #fful.font "select Set Font" gosub [drawall] #fful.gb "setfocus" wait
[color] #fful.color "contents? c$" select case c$ case "Control Back" gosub [colorpick] if cp$<>"" then if selected then 'insert color change event ahead of control if obj(selected,T)=2 then ct=22 : projecttbcl$=cp$ if obj(selected,T)=3 then ct=23 : projectlbcl$=cp$ if obj(selected,T)=4 then ct=24 : projectcbcl$=cp$ if obj(selected,T)=11 then ct=21 : projecttecl$=cp$ for n=obj+1 to selected+1 step -1 obj(n,X)=obj(n-1,X) obj(n,Y)=obj(n-1,Y) obj(n,W)=obj(n-1,W) obj(n,H)=obj(n-1,H) obj(n,T)=obj(n-1,T) obj(n,TH)=obj(n-1,TH) obj$(n,Ctr)=obj$(n-1,Ctr) obj$(n,Tex)=obj$(n-1,Tex) obj$(n,Res)=obj$(n-1,Res) obj$(n,Fon)=obj$(n-1,Fon) obj$(n,Bak)=obj$(n-1,Bak) obj$(n,Bas)=obj$(n-1,Bas) next obj(selected,T)=ct obj$(selected,Tex)="Color!" obj$(selected,Bak)=cp$ 'remove any previous color change statement if selected>=2 then if obj(selected-1,T)=ct then obj(selected-1,T)=0 end if obj=obj+1 end if end if case "Project Back" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Project Fore" gosub [colorpick] if cp$<>"" then projectfore$=cp$ case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] end select #fful.color "select Set Color" gosub [drawall] #fful.gb "setfocus" wait
[windowtype] #prop.cbwind "contents? projectwind$" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #pick.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #pick #pick "font Consolas 9" #pick "trapclose [quitpick]" #pick.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white " c=1 for yc=1 to 160 step 40 for xc= 1 to 160 step 40 #pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40 c=c+1 if c>15 then c=15 next next #pick.gb "when leftButtonDown [pick]" wait
[pick] xp=int(MouseX/40) yp=int(MouseY/40) c=xp+yp*4+1 cp$=word$(cl$,c)
[quitpick] close #pick return
[help] run "notepad help.txt" wait
[quitfful] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectfile$ #ses projectwind$ #ses projectform$ #ses projecttitl$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth for n=1 to obj if obj(n,T)<>0 then #ses obj(n,X);","; #ses obj(n,Y);","; #ses obj(n,W);","; #ses obj(n,H);","; #ses obj(n,T);","; #ses obj(n,TH) #ses obj$(n,Ctr) #ses obj$(n,Tex) #ses obj$(n,Res) #ses obj$(n,Fon) #ses obj$(n,Bak) end if next close #ses close #prop close #fful end
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
'------------------------------------------------ function nvl$(a$,b$) 'if a$ empty return b$, else a$ if a$<>"" then nvl$=a$ else nvl$=b$ end function
function inlist(aVal, list$) 'Inlist function (Is value in list?). 'Returns 0/1 (to be used in logic expressions) list$ = " "+list$+" " inlist = (instr(list$, " "+str$(aVal)+" ")<>0) end function
for n=1 to obj print n;" ";obj(n,X);" ";obj(n,Y);" ";obj(n,W);" ";obj(n,H);" ";obj(n,T);" ";obj(n,6);" "; print obj$(n,Ctr);" ";obj$(n,Tex);" ";obj$(n,Res);" ";obj$(n,Fon);" ";obj$(n,Bak);" ";obj$(n,6);" ";obj$(n,Bas);" " next
|
|
|
Post by xxgeek on Jun 4, 2023 11:04:58 GMT -5
Not yet. But if you use "Write" you can save the file with the added controls as a .bas, or if you use "Save" you can save the file as a .ffu (form). Either way, you are only saving the form, not the entire imported .bas file.
When I run your new version Anatoly, I can see right away that the version 1.11 that Rod posted does not include all the up to date fixes mentioned in previous posts. However, your new code does do wonders for the duplicates.
Working on 2 different files, and many versions of both has me getting dizzy trying to remember which is which, and what code has been included in each, so I will work on one version, and incorporate what I can into it as the latest version is updated.
Here is the latest version of FFU "Not so lite" with all the latest fixes and features including TRS73's new code to eliminate duplicates. No addfunctions support yet.
Give it a try, check out the code to see the differences. Too many for me to list. Still needs work, but getting there.
ver$="xx_1.1.6" 'freeform ultra lite v1.x by Rod 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1 nomainwin dim info$(10,10) dim form$(10) form$(1)="Restore" form$(2)="New" form$(3)="Save .ffu" form$(4)="Load .ffu" form$(5)="-----------" form$(6)="Write .bas" form$(7)="Import .bas" form$(8)="Export .bas" form$(9)="File" dim tool$(14) tool$(1)="StatictText" tool$(2)="TextBox" tool$(3)="ListBox" tool$(5)="ComboBox" tool$(6)="Button" tool$(7)="BmpButton" tool$(8)="GraphicBox" tool$(9)="RadioButton" tool$(10)="CheckBox" tool$(11)="GroupBox" tool$(12)="Texteditor" tool$(13)="Menu" tool$(14)="Add New" dim hnd$(30) hnd$(1)="#1" dim grid$(20) grid$(1)="1" grid$(2)="3" g=3 for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Invisible" grid$(g+1)="Visible" grid$(g+2)="Set Grid" grid=10 gridvisible=1 gridcolor$="buttonface" bordercolor$=gridcolor$ crosshair$ =bordercolor$ projectctrh=25 ctrh=25 dim color$(10) color$(1)="Control Background" color$(2)="Project Background" color$(3)="Project Foreground" color$(4)="Grid Color" color$(5)="Border Color" color$(6)="CrossHair Color" color$(7)="Set Color" projectback$="white" projectfore$="black" 'ctrc$="white" dim font$(10) font$(1)="Control Font" font$(2)="ResetControl" font$(3)="Project Font" font$(4)="Set Font"'default is Consolas 9" dim wind$(20)'window type names wind$(1)="window" wind$(2)="window_nf" wind$(3)="window_popup" wind$(4)="dialog" wind$(5)="dialog_modal" wind$(6)="dialog_nf" wind$(7)="dialog_nf_modal" wind$(8)="dialog_fs" wind$(9)="dialog_nf_fs" wind$(10)="dialog_popup" wind$(11)="graphics" wind$(12)="graphics_fs" wind$(13)="graphics_fs_nsb" wind$(14)="graphics_nsb" wind$(15)="graphics_nf_nsb" wind$(16)="text" wind$(17)="text_fs" wind$(18)="text_nsb" wind$(19)="text_nsb_ins"
dim v$(2000) for n= 100 to 2000 step 20 v$(n)=str$(n) next dim obj(200,6) 'x,y,width/height,type,textheight X=1 Y=2 W=3 H=4 T=5 TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline Ctr=1 Tex=2 Res=3 Fon=4 Bak=5 Bas=7
'set default starting position obj=0 projectfile$="Untitled.bas" projectwind$="window_nf" projecttitl$="Untitled" projectform$="#1" projectctrl$="" projecttext$="" projectreso$="" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" projectctrh=25 projectgrid=10 projectw=600 projecth=400 insertx=grid inserty=grid*2
'open a small properties window and hide it WindowWidth=230 WindowHeight=260 UpperLeftX=(DisplayWidth)/2 + 450 UpperLeftY=(DisplayHeight)/2 - 70 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=800 WindowHeight=600 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #fful.form,form$(,[form],5,2,85,30 combobox #fful.hand,hnd$(,[hand],95,2,85,30 combobox #fful.tool,tool$(,[tool],185,2,85,30 button #fful.project,"Preview",[preview],UL,275,0,60,25 combobox #fful.w,v$(,[formsize],340,2,60,30 combobox #fful.h,v$(,[formsize],405,2,60,30 combobox #fful.grid,grid$(,[grid],470,2,90,30 combobox #fful.color,color$(,[color],585,2,90,30 combobox #fful.font,font$(,[font],680,2,90,30 button #fful.help,"Help",[help],UL,915,0,50,25 textbox #fful.filePath, 5,27,1600,20 statictext #fful.gridsize, str$(grid),565,5,15,15 statictext #fful.Xco, "x 0" ,865,0,45,13 statictext #fful.Yco, "y 0",865,14,45,13 statictext #fful.corner, "UpperLeft",780,8,85,15 graphicbox #fful.gb,5,47,830,625 open ver$;" Forms Controls Form Dimensions Grid Size Colors Fonts" for window as #fful #fful "trapclose [quitfful]" #fful "font Consolas 9 bold" #fful "resizehandler [resize]" #fful.tool "select Add New" #fful.form "select File" #fful.hand "selectindex 1" #fful.grid "select Set Grid" #fful.color "select Set Color" #fful.font "select Set Font" #fful.w "select ";projectw #fful.h "select ";projecth #fful.gb "autoresize" #fful.gb "vertscrollbar on 0 ";projectw #fful.gb "horizscrollbar on 0 ";projecth #fful.gb "font ";projectfont$ #fful.gb "down" gosub [drawgrid] gosub [drawall] #fful.gb "when rightButtonDown [show]" #fful.gb "when leftButtonDown [select]" #fful.gb "when characterInput [keys]" #fful.gb "setfocus" #prop "show" show=1 #fful.filePath, "File - untitled.ffu" #fful.filePath, "!disable" wait
[show] if show then #prop "hide" show=0 else #prop "show" show=1 end if wait
'the user clicked on the form design window 'either to chose a control or to deselect a control [select] xs=MouseX ys=MouseY 'hide property window if it is open if show then #prop "hide" show=0 end if
'before we move on update the currently selected control from properties 'get the project data and only the editable contents of controls if selected=0 then 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ end if #prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$ #prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$ #prop.tbreso "!contents? t$" : obj$(selected,Res)=t$ 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if xs>obj(cn,X) and xs<(obj(cn,X)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then if xs>obj(cn,X)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2 if obj(cn,T)=6 then action=1 selected=cn exit for end if next if selected=0 then gosub [propertyupdate] action=0 end if if selected>0 and action=1 then #fful.gb "when leftButtonMove [track]" #fful.gb "when leftButtonUp [stop]" offsetX=xs-obj(selected,X) offsetY=ys-obj(selected,Y) #fful.corner "UpperLeft" 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)) #fful.corner "BottomRight" end if if selected>0 then gosub [drawit] else insertx=int((xs+(grid/2))/grid)*grid inserty=int((ys+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #fful.gb "rule xor" gosub [drawit] xt=int((MouseX-offsetX+(grid/2))/grid)*grid if xt<0 then xt=0'11 if xt+obj(selected,W)>projectw then xt=projectw-obj(selected,W) obj(selected,X)=xt yt=int((MouseY-offsetY+(grid/2))/grid)*grid if menuset = 0 and textEd = 0 then if yt<0 then yt=0 if yt+obj(selected,H)>projecth-25 then yt=projecth-obj(selected,H)-25 obj(selected,Y)=yt end if
if menuset = 1 or textEd > 0 then if yt < 0 then yt = 0 if yt+obj(selected,H)>projecth-50 then yt=projecth-obj(selected,H)-50 obj(selected,Y)=yt end if #fful.Xco "x ";str$(xt) #fful.Yco "y ";str$(yt) gosub [drawit] wait
[stop] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[tracksize] #fful.gb "rule xor" gosub [drawit] xs=int((MouseX-offsetX+(grid/2))/grid)*grid if xs>projectw then xs=projectw if xs<obj(selected,X) then xs=obj(selected,X)+grid ys=int((MouseY-offsetY+(grid/2))/grid)*grid if ys>projecth then ys=projecth if ys<obj(selected,Y)+ctrh then ys=obj(selected,Y)+ctrh obj(selected,W)=xs-obj(selected,X)'width if menuset = 1 or textEd > 0 then obj(selected,H)=ys-obj(selected,Y)-50'height if menuset = 0 and textEd = 0 then obj(selected,H)=ys-obj(selected,Y)-25'height #fful.Xco "x ";xs : #fful.Yco "y ";ys gosub [drawit] wait
[stopsize] #fful.gb "when leftButtonMove" #fful.gb "when leftButtonUp" action=0 #fful.gb "rule over" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,T)=12 then menuset = 0 : gosub [drawgrid] 'menu if obj(selected,T)=11 then textEd = textEd-1 : gosub [drawgrid] 'texteditor obj(selected,T)=0 selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,X) 'x cpy(2)=obj(selected,Y) 'y cpy(3)=obj(selected,W) 'w cpy(4)=obj(selected,H) 'h cpy(5)=obj(selected,T) 'type cpy(6)=obj(selected,TH) 'textheight cpy$(1)=obj$(selected,Ctr) 'name cpy$(2)=obj$(selected,Tex) 'text content cpy$(3)=obj$(selected,Res) 'resource array or file path cpy$(4)=obj$(selected,Fon) 'ctrl specific font or "" cpy$(5)=obj$(selected,Bak) 'ctrl specific backcolor end if
if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 if obj(obj,T)=11 then textEd = textEd+1 'texteditor obj(obj,X)=insertx obj(obj,Y)=inserty inserty=inserty+cpy(4)+grid obj(obj,W)=cpy(3) obj(obj,H)=cpy(4) obj(obj,T)=cpy(5) obj(obj,TH)=cpy(6) obj$(obj,Ctr)=left$(cpy$(1),11)';obj obj$(obj,Tex)=cpy$(2) obj$(obj,Res)=cpy$(3) if inlist(obj(obj,T), "3 4 5 6") then obj$(obj,Lbl)="[";obj$(obj,Ctr);"Click]" if inlist(obj(obj,T), "8 9") then obj$(obj,Lbl)="[";obj$(obj,Ctr);"],[un";obj$(obj,Ctr);"]"
if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) obj$(obj,Fon)=cpy$(4) obj$(obj,Bak)=cpy$(5) selected=obj gosub [drawall] end if end if #fful.gb "setfocus" wait
[tool] #fful.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext sttx = sttx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=1 obj$(obj,Ctr)="statictext";sttx obj$(obj,Tex)="Statictext-";sttx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 2 'textbox txtbx = txtbx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=2 obj$(obj,Ctr)="textbox";txtbx obj$(obj,Tex)="Textbox-";txtbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 3 'listbox lstbx = lstbx + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh*5 obj(obj,T)=3 obj$(obj,Ctr)="listbox";lstbx obj$(obj,Tex)="Listbox-";lstbx;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectlbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 4 'combobox cmbobx = cmbobx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=4 obj$(obj,Ctr)="combobox";cmbobx obj$(obj,Tex)="Combobox-";cmbobx;"\item2\item3\item4\item5" obj$(obj,Res)=obj$(obj,Ctr);"$(" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectcbcl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 5 'button bttn = bttn +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh obj(obj,T)=5 obj$(obj,Ctr)="button";bttn obj$(obj,Tex)="button-";bttn if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)="white" inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 6 'bmp button bmpbtn = bmpbtn +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=50 obj(obj,H)=50 obj(obj,T)=6 obj$(obj,Ctr)="bmpButton";bmpbtn filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Res)=file$ obj$(obj,Tex)="BMPbutton-";bmpbtn loadbmp obj$(obj,Ctr),file$ close #bmp inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid else obj(obj,T)=0 close #bmp end if else obj(obj,T)=0 end if
case 7 'graphicbox grbx = grbx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*3 obj(obj,T)=7 obj$(obj,Ctr)="graphicbox";grbx obj$(obj,Tex)="Graphicbox-";grbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton radio = 1 rdiobtn = rdiobtn + 1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 obj(obj,H)=ctrh obj(obj,T)=8 obj$(obj,Ctr)="radiobutton";rdiobtn obj$(obj,Tex)="(o) radioBtn-";rdiobtn obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 9 'checkbox check = 1 chkbx = chkbx+1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=110 obj(obj,H)=ctrh obj(obj,T)=9 obj$(obj,Ctr)="checkbox";chkbx obj$(obj,Tex)="[x] checkbox-";chkbx obj$(obj,Res)="" if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox grpbx = grpbx +1 obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=100 obj(obj,H)=ctrh*4 obj(obj,T)=10 obj$(obj,Ctr)="groupbox";grpbx obj$(obj,Tex)="Group Box-";grpbx if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projectback$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor textEd = textEd+1 gosub [drawgrid] obj=obj+1 obj(obj,X)=insertx obj(obj,Y)=inserty obj(obj,W)=150 obj(obj,H)=ctrh*4 obj(obj,T)=11 obj$(obj,Ctr)="texteditor";textEd obj$(obj,Tex)="Texteditor-";textEd if ctrf$<>projectfont$ then obj$(obj,Fon)=ctrf$ obj(obj,TH)=ctrh end if obj$(obj,Bak)=projecttecl$ inserty=5+int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,X)=0 obj(obj,Y)=0 obj(obj,W)=100 obj(obj,H)=10 obj(obj,T)=12 obj$(obj,Ctr)="menu";obj obj$(obj,Tex)=" Menu Added" inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid gosub [drawgrid] end if end select selected=obj gosub [drawall] #fful.tool "select Add New" #fful.gb "setfocus" wait
[form] #fful.form "selectionindex? i" select case i case 1 'restore file$="lastsession.ffu" #fful.filePath, "lastsession.ffu" gosub [loadit] case 2 'new gosub [new] case 3 'save as gosub [saveas] case 4 'load gosub [load] case 6 'write gosub [write] case 7 'import gosub [import] case 8 'export gosub [export] end select #fful.form "select File" gosub [drawall] #fful.gb "setfocus" wait
[drawall] #fful.gb "discard ; redraw bak" ocn=cn projecttbcl$="white" projectlbcl$="white" projectcbcl$="white" projecttecl$="white" for cn=1 to obj gosub [drawit] next cn=ocn #fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10 #fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20 #fful.gb "setfocus" return
[drawit] 'redraws control cn 'set the color for the drawn object and action taking place if cn=selected then #fful.gb "color red" 'action 1 or 2 if action=2 then #fful.gb "color green" else #fful.gb "color ";projectfore$ end if
'set the font for the drawn object if obj$(cn,Fon)="" then #fful.gb "font ";projectfont$ ch=projectctrh if obj(cn,H)<ch then obj(cn,H)=ch else #fful.gb "font ";obj$(cn,Fon) ch=obj(cn,TH) if obj(cn,H)<ch then obj(cn,H)=ch end if
'update the properties textboxes for selected control if cn=selected then #prop.tbctrl obj$(cn,Ctr) 'ctrlname #prop.tbtext obj$(cn,Tex) 'text #prop.tbreso obj$(cn,Res) 'resource #prop.tbxywh obj(cn,X);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height #prop.tbcolo obj$(cn,Bak) end if if projecttbcl$ = "" then projecttbcl$ = "white" if projectlbcl$ = "" then projectlbcl$ = "white" if projectcbcl$ = "" then projectcbcl$ = "white" if projecttecl$ = "" then projecttecl$ = "white" #fful.gb "place ";obj(cn,X);" ";obj(cn,Y) if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?" select case obj(cn,T) case 1 'statictext #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 2 'textbox #fful.gb "backcolor ";projecttbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 3 'listbox #fful.gb "backcolor ";projectlbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 4 'combobox #fful.gb "backcolor ";projectcbcl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 5 'button #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'buttons are always black on white #fful.gb "color black" 'centre button text #fful.gb "stringwidth? ";"A";" width" xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ #fful.gb "backcolor ";projectback$ case 6 'bmpbutton if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr) #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) case 7 ' graphicbox #fful.gb "backcolor white" #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "backcolor ";projectback$ case 8 'radiobutton #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'radiobutton text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 9 'checkbox #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'checkbox text is always black #fful.gb "color black" if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 10 'groupbox #fful.gb "backcolor ";projectback$ 'groupbox is an outline #fful.gb "box ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) 'group box text is always black #fful.gb "color black" 'groupbox text is offset if action=0 then #fful.gb "place ";obj(cn,X)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex) #fful.gb "color ";projectfore$ case 11 ' texteditor #fful.gb "backcolor ";projecttecl$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) if action=0 then #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 12 'menu 'pin to top left obj(cn,X)=10 : obj(cn,Y)=-10 : obj(cn,W)=100 : obj(cn,H)=10 xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2 if action=0 then #fful.gb "place ";obj(cn,X);" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) '#fful.gb "box ";obj(cn,X)+obj(cn,H);" ";obj(cn,Y)+obj(cn,H) #fful.gb "backcolor ";projectback$ #fful.gb "boxfilled ";obj(cn,X)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H) #fful.gb "place ";obj(cn,X)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex) case 21 'tecolor projecttecl$=obj$(cn,Bak) case 22 'tbcolor projecttbcl$=obj$(cn,Bak) case 23 'lbcolor projectlbcl$=obj$(cn,Bak) case 24 'cbcolor projectcbcl$=obj$(cn,Bak) case 30 'font case 31 '!font end select return
[preview] file$="preview.bas" gosub [writeit] 'gosub [resetVars] wait
[quitnoform] close #noform wait
[write] projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas" filedialog "Save .bas",projectfile$,file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit] if file$<>"" then '#################################################### if projectwind$ = "" then wait '#################################################### open file$ for output as #op 'the header #op " 'Project ";projecttitl$ #op " 'Created with Freeform Ultra not so Lite v";ver$;" ";date$();" ";time$() #op "" if projectback$<>"white" or projectfore$<>"black" then #op " 'Set BackgroundColor$ and ForegroundColor$ of project" #op " BackgroundColor$=";chr$(34);projectback$;chr$(34) #op " ForegroundColor$=";chr$(34);projectfore$;chr$(34) #op "" end if #op " 'Create arrays needed for controls listbox,combobox" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " dim ";obj$(n,Ctr);"$(10)" #op " for n = 1 to 10" #op " ";obj$(n,Ctr);"$(n)= str$(n)" #op " next" end if next #op "" #op " 'Create controls and open window" #op " nomainwin" #op " WindowWidth = ";projectw #op " WindowHeight = ";projecth #op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op " menu ";projectform$;", ";chr$(34);"Size";chr$(34);", ";chr$(34);"Small";chr$(34);", [dummy], ";chr$(34);"Large";chr$(34);", [dummy]" end if for n=1 to obj select case obj(n,T) case 1 'statictext #op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox #op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box #op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);","; nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]");",";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox #op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);","; nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]");",";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button #op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) '#op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]");", UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton #op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) '#op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",";nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]");", UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox #op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton if file$<>"preview.bas" then lbl$=nvl$(obj$(n,Lbl),"[set";obj$(n,Ctr);"],[reset";obj$(n,Ctr);"]") else #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[set";obj$(n,Ctr);"],[reset";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) end if ' #op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";lbl$;",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox if file$<>"preview.bas" then lbl$=nvl$(obj$(n,Lbl),"[check";obj$(n,Ctr);"],[uncheck";obj$(n,Ctr);"]") else #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ctr);chr$(34);",[check";obj$(n,Ctr);"],[uncheck";obj$(n,Ctr);"],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) end if ' #op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";lbl$;",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box #op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor #op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 22 'tbcolor #op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'lbcolor #op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 24 'cbcolor #op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'tecolor #op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34) end select next #op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ if instr(projectwind$, "text") then #op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34) else #op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34) end if #op "" #op " 'Set any listbox or combobox to display the first item on the list" for n= 1 to obj if obj(n,T)=3 or obj(n,T)=4 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34) end if next #op " 'apply any control specific fonts" for n= 1 to obj if obj(n,T)<>0 and obj$(n,Fon)<>"" then if obj(n,T)=1 or obj(n,T)=2 or obj(n,T)=5 or obj(n,T)=10 or obj(n,T)=11 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34) end if if obj(n,T)=3 or obj(n,T)=4 or obj(n,T)=7 or obj(n,T)=8 or obj(n,T)=9 then #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34) end if end if next #op " wait" #op "" labelList$="[quit]" 'if file$="preview.bas" then '#op " 'Create the required handlers for each control" '#op " 'Radiobutton and Checkboxes are given a single handler" 'check=0 'radio=0 for n=1 to obj select case obj(n,T) select case obj(n,T) case 3,4 'listbox, combobox lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]") if instr(labelList$, lbl$)=0 then 'label NOT already written 'write label #op " ";lbl$ #op " 'Your handler code here, read the control with" #op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? picked$";chr$(34) #op " wait" #op "" 'and remember it labelList$= labelList$+" "+ lbl$ end if 'case 4 'combobox '#op " [";obj$(n,Ctr);"click]" '#op " 'Your handler code here, read the control with" '#op " ";projectform$;".";obj$(n,Ctr);", ";chr$(34);"selection? picked$";chr$(34) '#op " wait" '#op " " case 5, 6 'button, bmpbutton lbl$=nvl$(obj$(n,Lbl),"[";obj$(n,Ctr);"click]") if instr(labelList$, lbl$)=0 then 'label NOT already written 'write label '#op " [";obj$(n,Ctr);"click]" #op " ";lbl$ #op " 'Your handler code here" #op " wait" #op "" 'and remember it labelList$= labelList$+" "+ lbl$ end if 'case 6 'bmpbutton '#op " [";obj$(n,Ctr);"click]" '#op " 'Your handler code here" '#op " wait" '#op " " case 8 'radiobutton for i = 1 to 2 'set,reset labels lbl$=nvl$(obj$(n,Lbl),"[set";obj$(n,Ctr);"],[reset";obj$(n,Ctr);"]") lbl$=word$(lbl$,i,",") if instr(labelList$, lbl$)=0 then 'label NOT already written 'write label #op " ";lbl$ #op " 'Your ";obj$(n,Ctr);" ";word$("set reset",i);" handler code here" #op " wait" #op "" 'and remember it labelList$= labelList$+" "+ lbl$ end if next case 9 'checkbox for i = 1 to 2 'set,reset labels lbl$=nvl$(obj$(n,Lbl),"[check";obj$(n,Ctr);"],[uncheck";obj$(n,Ctr);"]") lbl$=word$(lbl$,i,",") if instr(labelList$, lbl$)=0 then 'label NOT already written 'write label #op " ";lbl$ #op " 'Your ";obj$(n,Ctr);" ";word$("check uncheck",i);" handler code here" #op " wait" #op "" 'and remember it labelList$= labelList$+" "+ lbl$ end if next ' #op " [";obj$(n,Ctr);"click]" ' #op " 'Your handler code here." '#op " wait" '#op " " '#op " [un";obj$(n,Ctr);"click]" ' #op " 'Your handler code here." '#op " wait" '[dontwrite2] #op " " end select next 'end if end if #op " " #op " [quit]" #op " close ";projectform$ #op " end" close #op
files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] return
[saveas] projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu" filedialog "Save As...",projectname$,file$ if file$<>"" then #fful.filePath "File - ";file$ open file$ for output as #op projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) 'the form name #xxxx #prop.tbform "!contents? t$" if t$<>projectform$ then projectform$=t$ dim hnd$(10) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "select ";projectform$ end if 'the form/windo title text #prop.tbtitl "!contents? t$" if t$<>projecttitl$ then projecttitl$=t$ #op projectfile$ #op projectwind$ #op projectform$ #op projecttitl$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth for n=1 to obj if obj(n,T)<>0 then #op obj(n,X);","; #op obj(n,Y);","; #op obj(n,W);","; #op obj(n,H);","; #op obj(n,T);","; #op obj(n,TH) #op obj$(n,Ctr) #op obj$(n,Tex) #op obj$(n,Res) #op obj$(n,Fon) #op obj$(n,Bak) end if next close #op gosub [propertyupdate] redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" end if return
[load] obj = 0 gosub [resetVars] filedialog "Open Project...","*.ffu",file$ #fful.filePath "File - ";file$ [loadit] if file$<>"" then projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #ses input #ses, projectfile$ input #ses, projectwind$ input #ses, projectform$ input #ses, projecttitl$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #fful.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ projectctrh=val(c$) projectgrid=val(g$) grid=projectgrid projectw=val(w$) projecth=val(h$) #prop.cbwind "select ";projectwind$ redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.grid "select ";grid #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,X)=val(word$(l$,1,",")) obj(obj,Y)=val(word$(l$,2,",")) obj(obj,W)=val(word$(l$,3,",")) obj(obj,H)=val(word$(l$,4,",")) obj(obj,T)=val(word$(l$,5,",")) obj(obj,TH)=val(word$(l$,6,",")) line input #ses, obj$(obj,Ctr) line input #ses, obj$(obj,Tex) line input #ses, obj$(obj,Res) line input #ses, obj$(obj,Fon) line input #ses, obj$(obj,Bak) if obj(obj,T)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Res) if obj(obj,T)=12 then menuset=1 if obj(obj,T)=11 then textEd= textEd+1 : gosub [drawgrid] wend close #ses gosub [propertyupdate] #prop "hide" #prop "show" end if return
[import] filedialog "Open .bas...","*.bas",file$ if file$<>"" then cursor hourglass WindowWidth = 200 WindowHeight=100 UpperLeftX=(DisplayWidth)/2 - 100 UpperLeftY=(DisplayHeight)/2 - 100 statictext #Please.wait, "Please Wait", 30,35,140,40 open "Please Wait" for window_popup as #Please please = 1 #Please "trapclose [quitplease]" #Please.wait "!font arial 18 bold" projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1) gosub [new] #fful.filePath "File - ";file$ 'grid=1 'gridvisible=0 gosub [drawgrid] 'set grid to 1 and invisible so controls stay where they import from initially 'import only those lines defining controls we are interested in wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox " wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty " wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ " wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ " dim bas$(5000,2) basln=1 ln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, wln$ 'break into multiple lines if ":" found outside quotes pos=1 ln$="" while pos<=len(wln$) c$=mid$(wln$,pos,1) if c$=chr$(34)then if quote=0 then quote=1 else quote=0 end if if c$=":" and quote=0 then gosub [line] ln$="" pos=pos+1 else ln$=ln$+c$ pos=pos+1 end if wend gosub [line] basln=basln+1 wend 'print "first cut" 'for n=1 to ln 'print bas$(n,1);" ";bas$(n,2) 'next 'print
'now find width height title and handle for all windows found in bas$( 'up to 30 forms in a .bas '1=handle #main etc '2=title '3=width '4=height '5=windowtype '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline
redim win$(30,10) redim hnd$(30) nl=ln wh=1 for ln=1 to nl 'find width and height ,assumes width and height are defined ahead of open 'so width height and colors can be set multiple times, so store bas line number involved if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1) if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1) if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1) if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1) if lower$(word$(bas$(ln,2),1)) = "open" and left$(word$(bas$(ln,2),2, " as "),1) = "#" then 'if instr(lower$(bas$(ln,2)),"open",1)>0 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 or instr(lower$(bas$(ln,2)),"text",1)>0 then win$(wh,10)=bas$(ln,1) n$=word$(bas$(ln,2),2,chr$(34)) hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1)) 'find last "for" in command line i=1 while i oi=i i=instr(lower$(bas$(ln,2))," for ",i+1) wend wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi) wt$=word$(wt$,2) win$(wh,1)=hn$ 'handle #fful etc win$(wh,2)=n$ 'title win$(wh,3)=w$ 'width win$(wh,4)=h$ 'height win$(wh,5)=wt$ 'windowtype hnd$(wh)=hn$ 'for combobox 'print wh;" ";hnd$(wh);" ";win$(wh,2);" ";win$(wh,3);" ";win$(wh,4);" ";win$(wh,5) wh=wh+1 end if end if next #fful.hand "reload" #fful.hand "selectindex 1" close #bas if wt$ = "" then #fful.hand "!No Forms" wh=1 gosub [loadwindow] end if cursor normal if please = 1 then close #Please : please = 0 return
[line] if ln$<>"" then w$=lower$(word$(ln$,1)) if instr(w$,"=",1)>1 then w$=word$(w$,1,"=") if len(w$)>3 then w1$=" "+w$+" " w2$=" "+w$+"=" if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 then bas$(ln,1)=str$(basln) bas$(ln,2)=trim$(ln$) ln=ln+1 end if end if end if return
[hand] gosub [resetVars] #fful.hand "selectionindex? wh" gosub [loadwindow] wait
[loadwindow] redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font gosub [resetVars] obj=1 projectback$="white" TextboxColor$="white" ListboxColor$="white" ComboboxColor$="white" TexteditorColor$="white" projectfore$="black" projectw=val(win$(wh,3)) if projectw=0 then projectw=600 projecth=val(win$(wh,4)) if projecth=0 then projecth=400 projecttitl$=win$(wh,2) projectwind$=win$(wh,5) projectform$=win$(wh,1) tbc$="" lbc$="" cbc$="" tec$="" gosub [propertyupdate] #fful.w "!";str$(projectw) #fful.h "!";str$(projecth)
'find controls and create obj() for ln=1 to nl 'create hidden objects to control font and color only used in import/export, not displayed ct=0 if instr(bas$(ln,2),"TextboxColor$",1)>0 then tbc$=getcolor$(bas$(ln,2)):ct=20 if instr(bas$(ln,2),"ListboxColor$",1)>0 then lbc$=getcolor$(bas$(ln,2)):ct=21 if instr(bas$(ln,2),"ComboboxColor$",1)>0 then cbc$=getcolor$(bas$(ln,2)):ct=22 if instr(bas$(ln,2),"TexteditorColor$",1)>0 then tec$=getcolor$(bas$(ln,2)):ct=23 if ct then obj(obj,T)=ct if ct=20 then obj$(obj,Bak)=tbc$ if ct=21 then obj$(obj,Bak)=lbc$ if ct=22 then obj$(obj,Bak)=cbc$ if ct=23 then obj$(obj,Bak)=tec$ obj$(obj,Bas)=bas$(ln,1) obj=obj+1 end if for wc=1 to 12 if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for next if wc<=11 then obj$(obj,Bas)=bas$(ln,1) l$=bas$(ln,2) ll$="" 'remove spaces leaving only , separation but keep "" text untouched inString=0 for i=1 to len(l$) c$=mid$(l$,i,1) select case case c$=chr$(34) inString=1-inString case (inString=0) and c$=" " c$="" end select ll$=ll$+c$ next 'insert missing comma if missing if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1) if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1) obj(obj,T)=wc 'type obj(obj,TH)=projectctrh 'get the .ctrl name obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1) 'for un-named controls if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj 'get the text if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc) 'get the array or bmp file name if wc=3 or wc=4 or wc=6 then obj$(obj,Res)=word$(ll$,2,",") 'get rid of "" if wc=6 and left$(obj$(obj,Res),1)=chr$(34) then obj$(obj,Res)=mid$(obj$(obj,Res),2,len(obj$(obj,Res))-2) 'array() -> array( if (wc=3 or wc=4) and right$(obj$(obj,Res),1)=")" then obj$(obj,Res)=left$(obj$(obj,Res), len(obj$(obj,Res))-1) i=1 while word$(ll$,i,",")<>"" i=i+1 wend i=i-4 if wc=6 or wc=5 then 'buttons and bmpbuttons can have xy, wh is optional and they have XX corners if i=3 then obj(obj,X)=val(word$(ll$,i+2,","))'x obj(obj,Y)=val(word$(ll$,i+3,","))'y if wc=5 then 'we need to find a way to calculate width and height if not given #fful.gb "stringwidth? ";"A";" width" obj(obj,W)=width*len(obj$(obj,Tex))+10 obj(obj,H)=projectctrh end if if wc=6 then 'we need a way to set bmp w and h on error goto [dummybmp] open obj$(obj,Res) for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,W)=value(mid$(bmp$,19,4))'width obj(obj,H)=value(mid$(bmp$,23,4))'height obj$(obj,Tex)="bmp" end if loadbmp obj$(obj,Ctr),obj$(obj,Res) close #bmp goto [passdummy]
[dummybmp] obj(obj,W)=25 obj(obj,H)=25 obj$(obj,Tex)="bmp" loadbmp obj$(obj,Ctr),"path.bmp" [passdummy] end if else obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y obj(obj,W)=val(word$(ll$,i+2,","))'w obj(obj,H)=val(word$(ll$,i+3,","))'h end if if upper$(word$(ll$,4,","))="LR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="LL" then 'obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if if upper$(word$(ll$,4,","))="UR" then obj(obj,X)=projectw-obj(obj,X)-obj(obj,W)'x 'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y end if else 'write to .bas tweaks listbox and combobox controls to line up properly 'so we need to untweak them now obj(obj,X)=val(word$(ll$,i,","))'x obj(obj,Y)=val(word$(ll$,i+1,","))'y if wc=1 then obj(obj,Y)=obj(obj,Y)-5 if wc=10 then obj(obj,Y)=obj(obj,Y)+5 if wc=3 or wc=4 then obj(obj,X)=obj(obj,X)-1 obj(obj,W)=val(word$(ll$,i+2,","))'w if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2 obj(obj,H)=val(word$(ll$,i+3,","))'h end if
'save color if set if wc=2 then obj$(obj,Bak)=tbc$ if wc=3 then obj$(obj,Bak)=lbc$ if wc=4 then obj$(obj,Bak)=cbc$ if wc=11 then obj$(obj,Bak)=tec$ obj=obj+1 end if next 'now find font commands listed after the open statement referring to the #form '#form.ctrl !font fontname 'if so add a new font object basln=1 open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ lln$=lower$(ln$) if instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font",1)>0 or instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font",1)>0 then f$=right$(ln$,len(ln$)-instr(lln$,"font",1)-4) if instr(f$,";",1)=0 then obj$(obj,Fon)=f$ obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1) obj$(obj,Ctr)=word$(word$(ln$,1),2,".") if instr(lln$,"!font",1)>0 then obj(obj,T)=31 else obj(obj,T)=30 obj$(obj,Bas)=str$(basln)
'find the visible object and store the font change for n=1 to obj if obj$(n,Ctr)=obj$(obj,Ctr) then obj$(n,Fon)=obj$(obj,Fon) #fful.gb "font ";obj$(obj,Fon) #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" obj(n,TH)=(yp-100)/2+7 exit for end if next obj=obj+1 end if end if basln=basln+1 wend close #bas gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[export] dim oldbas$(5000) ln=1 'if file$<>"" and right$(file$,3)="bas" then open file$ for input as #bas while eof(#bas)=0 line input #bas, ln$ oldbas$(ln)=ln$ ln=ln+1 wend close #bas '6=backgroundcolor basline '7=foregroundcolor basline '8=windowwidth basline '9=windowheight basline '10=open basline if win$(wh,6)<>"" then oldbas$(val(win$(wh,6)))=" BackgroundColor$=";chr$(34);projectback$;chr$(34) if win$(wh,7)<>"" then oldbas$(val(win$(wh,7)))=" ForegroundColor$=";chr$(34);projectfore$;chr$(34) if win$(wh,8)<>"" then oldbas$(val(win$(wh,8)))=" WindowWidth=";projectw if win$(wh,9)=win$(wh,8) then oldbas$(val(win$(wh,8)))=oldbas$(val(win$(wh,8)))+": WindowHeight=";projecth else oldbas$(val(win$(wh,9)))=" WindowHeight=";projecth if win$(wh,10)<>"" then oldbas$(val(win$(wh,10)))=" Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$ for n=1 to obj select case obj(n,T) 'handle the visible controls case 1 'statictext oldbas$(val(obj$(n,Bas)))=" statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,X);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H) case 2 'textbox oldbas$(val(obj$(n,Bas)))=" textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 3 'list box oldbas$(val(obj$(n,Bas)))=" listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 4 'combobox oldbas$(val(obj$(n,Bas)))=" combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Res);",[";obj$(n,Ctr);"click],";obj(n,X)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H) case 5 'button oldbas$(val(obj$(n,Bas)))=" button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 6 'bmpbutton oldbas$(val(obj$(n,Bas)))=" bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Res);chr$(34);",[";obj$(n,Ctr);"click], UL, ";obj(n,X);",";obj(n,Y) case 7 'graphicbox oldbas$(val(obj$(n,Bas)))=" graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 8 'radiobutton oldbas$(val(obj$(n,Bas)))=" radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[radio],[radio],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 9 'checkbox oldbas$(val(obj$(n,Bas)))=" checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[check],[check],";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H) case 10 'group box oldbas$(val(obj$(n,Bas)))=" groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,X);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H) case 11 'texteditor oldbas$(val(obj$(n,Bas)))=" texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,X);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export case 20 'textboxcolor oldbas$(val(obj$(n,Bas)))=" TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 21 'listboxcolor oldbas$(val(obj$(n,Bas)))=" ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 22 'comboboxcolor oldbas$(val(obj$(n,Bas)))=" ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34) case 23 'texteditorcolor oldbas$(val(obj$(n,Bas)))=" TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
'handle font changes case 30 'font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" font ";obj$(n,Fon);chr$(34) case 32 '!font oldbas$(val(obj$(n,Bas)))=" ";projectform$;".";obj$(n,Ctr);" !font ";obj$(n,Fon);chr$(34) end select next 'end if file2$=left$(file$, len(file$)-4)+"+"+right$(file$, 4) 'open file$ for output as #bas open file2$ for output as #bas for n= 1 to ln #bas oldbas$(n) next close #bas 'open file$ for output as #bas 'for n= 1 to ln '#bas oldbas$(n) 'next 'close #bas return
function getsize$(l$) 'what if it is a variable? v$="" pos=1 n$=mid$(l$,pos,1) while instr("1234567890",n$,1)=0 and pos<len(l$) pos=pos+1 n$=mid$(l$,pos,1) wend while n$>="0" and n$<="9" and pos<=len(l$) v$=v$+n$ pos=pos+1 n$=mid$(l$,pos,1) wend getsize$=v$ end function
function getcolor$(l$) 'what if it is a variable? cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black " for c= 1 to 15 if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for next end function
[new] #fful.filePath "File - untitled.ffu" redim obj(300,6) 'x,y,width/height,type,textheight redim obj$(300,7) 'name,text content,resource,font obj=0 gosub [resetVars] projectw=600 projecth=400 projectback$="white" projectfore$="black" projectctrc$="white" projecttitl$="Untitled" projectform$="#1" projectfile$="Untitled.bas" projectwind$="window_nf" #prop.cbwind "select window_nf" redim hnd$(30) hnd$(1)=projectform$ #fful.hand "reload" #fful.hand "selectindex 1" #fful.w "select ";projectw #fful.h "select ";projecth gosub [propertyupdate] gosub [drawgrid] gosub [drawall] #prop "hide" #prop "show" show=1 return
[propertyupdate] #prop.tbfile projectfile$ #prop.cbwind "select ";projectwind$ #prop.tbtitl projecttitl$ #prop.tbform projectform$ #prop.tbctrl "" #prop.tbtext "" #prop.tbreso "" #prop.tbxywh projectw;"x";projecth #prop.tbfont projectfont$ #prop.tbcolo projectfore$;"/";projectback$ return
[resetVars] menuset=0:textEd=0:check=0:radio=0:sttx=0:txtbx=0:lstbx=0 cmbobx=0:bttn=0:bmpbtn=0:grbx=0:rdiobtn=0:chkbx=0:grpbx=0 return
[resize] #fful.tool "select Add New" #fful.form "select File" if wh=0 then wh=1 #fful.hand "selectindex ";wh #fful.grid "select Set Grid" #fful.font "select Set Font" #fful.color "select Set Color" #fful.w "select ";projectw #fful.h "select ";projecth gosub [drawall] wait
[formsize] #fful.w "contents? w$" #fful.h "contents? h$" wf=val(w$) hf=val(h$) if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait projectw=wf projecth=hf insertx=grid inserty=grid gosub [drawgrid] #fful.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid spacing according to user choice, default is 10 #fful.grid "contents? g$" select case g$ case "Invisible" gridvisible=0 case "Visible" gridvisible=1 case else grid=val(g$) end select gosub [drawgrid] gosub [drawall] #fful.gb "setfocus" wait
[drawgrid] #fful.gridsize grid if textEd<0 then textEd=0 projectgrid=grid #fful.gb "cls; fill buttonface" if grid > 0 and gridvisible = 1 then #fful.gb "color ";gridcolor$ ' Grid - Draw vertical lines if menuset = 0 and textEd = 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25 for xs = 0 to projectw step grid ' Grid - Draw horizontal lines #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-25 next xs for ys = 0 to projecth-25 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if 'adjust grid when menu, or texeditor control is selected - revert if menu and texeditor deleted /no longer used., if menuset = 1 or textEd > 0 then #fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";gridcolor$ for xs = 0 to projectw step grid #fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-50 next xs for ys = 0 to projecth-50 step grid #fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys next ys end if end if [nogrid] if grid = 1 or gridvisible = 0 then if textEd =0 and menuset = 0 then #fful.gb "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; " "; projectw; " "; (projecth)/2 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25 #fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25 end if if textEd > 0 or menuset = 1 then #fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50 #fful.gb "color ";crosshair$ #fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-50 #fful.gb "line "; 0; " "; (projecth-50)/2; " "; projectw; " "; (projecth-50)/2 #fful.gb "color ";bordercolor$ #fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50 #fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50 end if end if #fful.gb "flush bak" #fful.grid "!Set Grid" return
[font] #fful.font "contents? f$" if f$="Project Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #fful.gb "font ";projectfont$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" projectctrh=(yp-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Control Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #fful.gb "font ";ctrf$ #fful.gb "place 100 100 ;\Q\Q" #fful.gb "posxy xp yp" ctrh=(yp-100)/2+7 end if if selected then obj$(selected,4)=ctrf$ 'font obj(selected,6)=ctrh 'text height end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="ResetControl" then ctrf$=projectfont$ ctrh=projectctrh if selected then obj$(selected,4)=ctrf$ obj(selected,6)=ctrh end if 'for single line text controls auto adjust w and h if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then #fful.gb "font ";ctrf$ obj(selected,4)=ctrh #fful.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #fful.font "select Set Font" gosub [drawall] #fful.gb "setfocus" wait
[color] #fful.color "contents? c$" select case c$ case "Control Background" gosub [colorpick] if cp$<>"" then if selected then 'insert color change event ahead of control if obj(selected,T)=2 then ct=22 : projecttbcl$=cp$ if obj(selected,T)=3 then ct=23 : projectlbcl$=cp$ if obj(selected,T)=4 then ct=24 : projectcbcl$=cp$ if obj(selected,T)=11 then ct=21 : projecttecl$=cp$ for n=obj+1 to selected+1 step -1 obj(n,X)=obj(n-1,X) obj(n,Y)=obj(n-1,Y) obj(n,W)=obj(n-1,W) obj(n,H)=obj(n-1,H) obj(n,T)=obj(n-1,T) obj(n,TH)=obj(n-1,TH) obj$(n,Ctr)=obj$(n-1,Ctr) obj$(n,Tex)=obj$(n-1,Tex) obj$(n,Res)=obj$(n-1,Res) obj$(n,Fon)=obj$(n-1,Fon) obj$(n,Bak)=obj$(n-1,Bak) obj$(n,Bas)=obj$(n-1,Bas) next obj(selected,T)=ct obj$(selected,Tex)="Color!" obj$(selected,Bak)=cp$ 'remove any previous color change statement if selected>=2 then if obj(selected-1,T)=ct then obj(selected-1,T)=0 end if obj=obj+1 end if end if case "Project Background" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Project Foreground" gosub [colorpick] if cp$<>"" then projectfore$=cp$ gosub [drawgrid] case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] case "Border Color" gosub [colorpick] if cp$<>"" then bordercolor$=cp$ gosub [drawgrid] case "CrossHair Color" gosub [colorpick] if cp$<>"" then crosshair$=cp$ gosub [drawgrid] end select #fful.color "select Set Color" gosub [drawall] #fful.gb "setfocus" wait
[windowtype] #prop.cbwind "contents? projectwind$" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #pick.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #pick #pick "font Consolas 9" #pick "trapclose [quitpick]" #pick.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white " c=1 for yc=1 to 160 step 40 for xc= 1 to 160 step 40 #pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40 c=c+1 if c>15 then c=15 next next #pick.gb "when leftButtonDown [pick]" wait
[pick] xp=int(MouseX/40) yp=int(MouseY/40) c=xp+yp*4+1 cp$=word$(cl$,c) close #pick return
[quitplease] if please = 1 then close #Please : please =0 cursor normal wait
[quitpick] close #pick return
[help] run "notepad help.txt" wait
[quitfful] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectfile$ #ses projectwind$ #ses projectform$ #ses projecttitl$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth for n=1 to obj if obj(n,T)<>0 then #ses obj(n,X);","; #ses obj(n,Y);","; #ses obj(n,W);","; #ses obj(n,H);","; #ses obj(n,T);","; #ses obj(n,TH) #ses obj$(n,Ctr) #ses obj$(n,Tex) #ses obj$(n,Res) #ses obj$(n,Fon) #ses obj$(n,Bak) end if next close #ses close #prop close #fful end
function nvl$(a$,b$) 'if a$ empty return b$, else a$ if a$<>"" then nvl$=a$ else nvl$=b$ end function
function inlist(aVal, list$) 'Inlist function (Is value in list?). 'Returns 0/1 (to be used in logic expressions) list$ = " "+list$+" " inlist = (instr(list$, " "+str$(aVal)+" ")<>0) 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
|
|