|
Post by Rod on Apr 28, 2023 1:32:57 GMT -5
Nice, I will weave that into the code. Currently battling through importing a .bas to a .ffu or at least into the program. The problems are challenging. The one that has me stumped so far is when a variable is used to set color or font. I can parse out literal colours or fonts but variables are problematic. No solution as yet other than trailing back through the program to find when the variable is set with a literal.
I had more luck converting .ffa to .ffu but not sure there will be any demand for that since ultra lite only deals with a subset and I am not sure anyone retains old .ffa files.
It may be that for .bas import I can only deal with a subset and target control placement, leaving aside font and color management.
I am coding all this because it’s fun and challenging. I do hope it will get used by other coders.
edit: I used buttonface to draw the lines, nice subtle grid.
#1.gb "color buttonface ; backcolor ";projectback$ for x = 0 to projectw step grid print #1.gb, "line ";x;" 0 ";x;" ";projecth next x for y = 0 to projecth step grid #1.gb, "line 0 ";y;" ";projectw;" ";y next y #1.gb "flush bak" #1.gb "color black"
|
|
gaslouk
Full Member
Hi from beautiful Greece.
Posts: 130
|
Post by gaslouk on Apr 28, 2023 7:21:55 GMT -5
Nice, I will weave that into the code. Currently battling through importing a .bas to a .ffu or at least into the program. The problems are challenging. The one that has me stumped so far is when a variable is used to set color or font. I can parse out literal colours or fonts but variables are problematic. No solution as yet other than trailing back through the program to find when the variable is set with a literal. I had more luck converting .ffa to .ffu but not sure there will be any demand for that since ultra lite only deals with a subset and I am not sure anyone retains old .ffa files. It may be that for .bas import I can only deal with a subset and target control placement, leaving aside font and color management. I am coding all this because it’s fun and challenging. I do hope it will get used by other coders. edit: I used buttonface to draw the lines, nice subtle grid. #1.gb "color buttonface ; backcolor ";projectback$ for x = 0 to projectw step grid print #1.gb, "line ";x;" 0 ";x;" ";projecth next x for y = 0 to projecth step grid #1.gb, "line 0 ";y;" ";projectw;" ";y next y #1.gb "flush bak" #1.gb "color black"
Is very good I tried it.
Gaslouk
Attachments:
|
|
|
Post by xxgeek on Apr 28, 2023 9:52:07 GMT -5
Nice, I will weave that into the code. Currently battling through importing a .bas to a .ffu or at least into the program. The problems are challenging. The one that has me stumped so far is when a variable is used to set color or font. I can parse out literal colours or fonts but variables are problematic. No solution as yet other than trailing back through the program to find when the variable is set with a literal. I had more luck converting .ffa to .ffu but not sure there will be any demand for that since ultra lite only deals with a subset and I am not sure anyone retains old .ffa files. It may be that for .bas import I can only deal with a subset and target control placement, leaving aside font and color management. I am coding all this because it’s fun and challenging. I do hope it will get used by other coders. edit: I used buttonface to draw the lines, nice subtle grid. #1.gb "color buttonface ; backcolor ";projectback$ for x = 0 to projectw step grid print #1.gb, "line ";x;" 0 ";x;" ";projecth next x for y = 0 to projecth step grid #1.gb, "line 0 ";y;" ";projectw;" ";y next y #1.gb "flush bak" #1.gb "color black"
Is very good I tried it. Gaslouk Good luck with the conversion code Rod it will be a great addition. Already using this to create forms, and will continue to use it. I never use the old freeform because I can lookup and copy paste code faster, then deal with the size and placement of controls manually by adjusting the numbers. Rod, what I did instead of having a set grid color I've added it to the list in the color combobox so it can be changed (gridcolor$), as well as other locations in the code. If the user chooses "buttonface" as a background color, the grid will not be visible. At least there is an option to change it to a visible color. It also gets saved to file like the other settings of the project, and reloaded when "Load" is used. The flashing that occurs now is restricted to the controls boxes, and since it only occurs intolerably when the background color differs from the control "box" color of textbox, texteditor, and listbox's I, or any user, can work around that by NOT coloring them, or ensuring the colors match. Let's revisit the 0 grid Rod, it deserves the attention with new evidence. Setting a grid of 5 gives the user precision of 5, 10 of 10, 20 of 20 etc. Meaning the control will jump the number of pixels the grid is set at, correct? What I have done is allowed for a setting of 0 for the grid, but when selected actually sets it at 1 since 0 would give "divide by 0" errors. With a setting of 1, the precision of control placement is 1. That's about the best precision you can get, if precision is what you are after. [drawgrid] if grid = 0 then grid = 1 insertx=int((insertx+(grid/2))/grid)*grid inserty=int((inserty+(grid/2))/grid)*grid projectgrid=grid #1.gb "cls; fill ";projectback$ #1.gb "place 0 0 ; color ";projectfore$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth if grid<3 then [nogrid] 'also added a grid size of 3 to "Set Grid" list #1.gb "color ";gridcolor$ if grid > 2 then y=0 ' Grid - Draw vertical lines #1.gb "size 1" for x = 0 to projectw step grid print #1.gb, "line "; x; " "; startX; " "; x; " "; projecth next x 'Grid - Draw horizontal lines for y = 0 to projecth step grid #1.gb, "line "; startX; " "; y; " "; projectw; " "; y next y end if
[nogrid] #1.gb "flush bak" #1.grid "select Set Grid" return
Not shown in the above code is the "Grid Border"(bordercolor$) , and the "Crosshair" (crosshair$) added to help place/line up controls in 0 grid. The code for the "Set Grid" and "Set Color" combobox's or the [load], [saveas], or [quit] etc for the extra options does not appear above either. If this new info changes your mind about 0 grid I will be happy to share what code I have.
|
|
gaslouk
Full Member
Hi from beautiful Greece.
Posts: 130
|
Post by gaslouk on Apr 28, 2023 11:06:15 GMT -5
Is very good I tried it. Gaslouk Good luck with the conversion code Rod it will be a great addition. Already using this to create forms, and will continue to use it. I never use the old freeform because I can lookup and copy paste code faster, then deal with the size and placement of controls manually by adjusting the numbers. Rod, what I did instead of having a set grid color I've added it to the list in the color combobox so it can be changed (gridcolor$), as well as other locations in the code. If the user chooses "buttonface" as a background color, the grid will not be visible. At least there is an option to change it to a visible color. It also gets saved to file like the other settings of the project, and reloaded when "Load" is used. The flashing that occurs now is restricted to the controls boxes, and since it only occurs intolerably when the background color differs from the control "box" color of textbox, texteditor, and listbox's I, or any user, can work around that by NOT coloring them, or ensuring the colors match. Let's revisit the 0 grid Rod, it deserves the attention with new evidence. Setting a grid of 5 gives the user precision of 5, 10 of 10, 20 of 20 etc. Meaning the control will jump the number of pixels the grid is set at, correct? What I have done is allowed for a setting of 0 for the grid, but when selected actually sets it at 1 since 0 would give "divide by 0" errors. With a setting of 1, the precision of control placement is 1. That's about the best precision you can get, if precision is what you are after. [drawgrid] if grid = 0 then grid = 1 insertx=int((insertx+(grid/2))/grid)*grid inserty=int((inserty+(grid/2))/grid)*grid projectgrid=grid #1.gb "cls; fill ";projectback$ #1.gb "place 0 0 ; color ";projectfore$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth if grid<3 then [nogrid] 'also added a grid size of 3 to "Set Grid" list #1.gb "color ";gridcolor$ if grid > 2 then y=0 ' Grid - Draw vertical lines #1.gb "size 1" for x = 0 to projectw step grid print #1.gb, "line "; x; " "; startX; " "; x; " "; projecth next x 'Grid - Draw horizontal lines for y = 0 to projecth step grid #1.gb, "line "; startX; " "; y; " "; projectw; " "; y next y end if
[nogrid] #1.gb "flush bak" #1.grid "select Set Grid" return
Not shown in the above code is the "Grid Border"(bordercolor$) , and the "Crosshair" (crosshair$) added to help place/line up controls in 0 grid. The code for the "Set Grid" and "Set Color" combobox's or the [load], [saveas], or [quit] etc for the extra options does not appear above either. If this new info changes your mind about 0 grid I will be happy to share what code I have.
And between lines 69 - 70 insert line with code
color$(4)="Grid Color"
rename color$(4) to (5) and color$(5) to (6)
and between lines 72 - 73 insert line with code
gridcolor$="yellow"
And that's it.
PS I forgot this After all this must insert between lines 1060 - 1061 this lines:
case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid]
Gaslouk
|
|
|
Post by xxgeek on Apr 28, 2023 13:16:15 GMT -5
gaslouk, There is more code needed, for saving settings to file etc.
The following is what I've been working with. Not complete yet, but for grid and crosshairs colors etc, working. (go biggie size to see all options, and to see full grid when dimensions require it.)
Note: This was written for JUST BASIC and some things may not work.
Crosshair color(corsshair$) will equal grid color(gridcolor$, and invisible) unless changed by the user. Grid Border color(bordercolor$) can also be changed by the user. Crosshair color stays the same as Bordercolor
'freeform ultra lite v1.1 by rodbird@hotmail 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1 '16/04/2023 'added xor drawing to reduce flicker '18/04/2023 'added insertion point code and .exe identification code '19/04/2023 'fixed insertion point code to show insert arrow always 'made insert arrow move automatically when controls added 'insert arrow stays where placed or moves with addition of control 'fixed ctrlV to move insert arrow on similar basis 'made insert arrow follow grid size changes and relocate automatically 'fixed line color for statictext, groupbox etc 'stopped bmpbutton from being resized it never goes green now 'amended select for expanding control, now bottom right quadrant selects expand 'all resource files are pathless, so expected to be in working directory '20/04/2023 'fixed ffufile name loaded error 'amended startup and lastsession.ffu is now loaded using Restore option 'added color management '21/04/2023 'fixed font menu, fonts ! now applied correctly 'font changes applied immediately to selected controls 'single line text controls adjust for font width and height 'fixed color dialog, made it modal and sorted return value if cancelled 'implemented the preview button idea. write is now essentially save as for .ffu/.bas 'preview always writes to preview.bas 'put more project info on the unselected properties pop up 'change the project name in properties.
global addfastfunction, funcs$, fastfuncs$, upath$', copiedText$', filename$ 'call getUserPath jbPath$ = "c:\Program Files (x86)\Just Basic v2.0\jbasic.exe" jbPath$ = "c:\Program Files (x86)\Liberty Basic Pro v4.5.1\lbpro.exe" dim windowTypes$(23) windowTypes$(1)= "dialog":windowTypes$(2)= "dialog_fs":windowTypes$(3)= "dialog_nf":windowTypes$(4)= "dialog_nf_fs" windowTypes$(5)= "dialog_modal":windowTypes$(6)= "dialog_popup":windowTypes$(7)= "" windowTypes$(8)= " ":windowTypes$(9)= "graphics":windowTypes$(10)= "graphics_fs":windowTypes$(11) = "graphics_nf":windowTypes$(12)= "graphics_nsb":windowTypes$(13)= "graphics_nsb_nf" windowTypes$(14)= " ":windowTypes$(15)= "text":windowTypes$(16)= "text_fs":windowTypes$(17)= "text_nsb":windowTypes$(18)= "text_nsb_ins" windowTypes$(19)= " ":windowTypes$(20)= "window":windowTypes$(21)= "window_nf":windowTypes$(22)= "window_popup" nomainwin dim info$(10,10) dim form$(10)
form$(1)="Last Form" form$(2)="New Form" form$(3)="Load Form" form$(4)="Save Form" form$(5)="--------------" form$(6)="Edit Code" form$(7)="Save Code" form$(8)="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 grid$(20) g=3 grid$(0)="0" grid$(1)="3" for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Crosshair" crosshair$ = "Crosshair" grid$(g+1)="noCrosshair" grid$(g+2)="Set Grid" grid=10 projectctrh=25 ctrh=25 dim color$(10) color$(1)="Ctrl Back" color$(2)="ResetBack" color$(3)="Proj Back" color$(4)="Proj Fore" color$(5)="Grid Color" color$(6)="Grid Border" color$(7)="Set Color" projectback$="white" projectfore$="black" ctrc$="white" dim font$(10) font$(1)="Ctrl Font" font$(2)="Ctrl Reset" font$(3)="Proj Font" font$(4)="Set Font"'default is Consolas 9" dim v$(100) for n= 1 to 20 v$(n)=str$(n*100) next dim obj(100,6) 'x,y,width/height,type,textheight dim obj$(100,6) 'name,text content,resource,font,backcolor,forecolor obj=0 projectname$="Untitled" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projectctrh=25 projectgrid=10 projectw=600 projecth=500 insertx=grid inserty=grid*2 obj=0
'find out what our pc's client area restrictions are 'first of find out how much space the 'windows theme takes for frame and title WindowWidth=200 WindowHeight=200 open "Measuring" for graphics as #1 #1 "home ; down ; posxy x y" ThemeWidth=WindowWidth-2*x-2 ThemeHeight=WindowHeight-2*y-2 close #1
'open a small properties window and hide it WindowWidth=230 WindowHeight=200 UpperLeftX=((DisplayWidth/2))+130 UpperLeftY=((DisplayHeight/2)) statictext #2.st1 "Proj",5,10,30,25 textbox #2.tbproj,45,5,150,25 statictext #2.st2 "Ctrl",5,32,30,25 textbox #2.tbname,45,27,150,25 statictext #2.st3 "Text",5,54,30,25 textbox #2.tbtext,45,49,150,25 statictext #2.st4 "Reso",5,76,30,25 textbox #2.tbreso,45,71,150,25 statictext #2.st5 "xywh",5,98,30,25 textbox #2.tbxywh,45,93,150,25 statictext #2.st6 "Font",5,120,30,25 textbox #2.tbfont,45,115,150,25 statictext #2.st7 "Colo",5,142,30,25 textbox #2.tbcolo,45,137,150,25
open "Properties" for window_nf as #2 #2 "font Consolas 9" #2 "trapclose [quit2]" #2.tbproj projectname$ #2.tbxywh "!disable" #2.tbfont "!disable" #2.tbcolo "!disable" #2.tbxywh projectw;"x";projecth #2.tbfont projectfont$ #2.tbcolo projectfore$;"/";projectback$;"/";ctrc$ #2 "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=1415+ThemeWidth+30 WindowWidth=905+ThemeWidth+33 WindowHeight=615+ThemeHeight+45 'gb is offset by 25 345 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 BackgroundColor$ = "lightgray" combobox #1.form,form$(,[form],5,8,120,35 combobox #1.tool,tool$(,[tool],130,8,120,35 button #1.project,"&Code",[prevCode2],UL,255,1,70,39 button #1.project2,"&Form",[preview],UL,330,1,70,39 combobox #1.w,v$(,[formsize],405,8,90,35 combobox #1.h,v$(,[formsize],495,8,90,35 combobox #1.grid,grid$(,[grid],590,8,100,35 statictext #1.st1 str$(grid),698,12,20,20 combobox #1.color,color$(,[color],725,8,110,35 combobox #1.font,font$(,[font],840, 8,110,35 combobox #1.fastfunctionsList, fastfunctionsList$(), fastfunctionSelected , 955, 8, 155, 35 combobox #1.userfunctionsList, userfunctionsList$(), userfunctionSelected , 1115, 8, 155, 35 combobox #1.windowtype,windowTypes$(,[windowType], 1275 , 8, 160, 35 button #1.help,"&Help",[help],UL,1440,8,60,30 graphicbox #1.gb,5,43,945,625 open "FFU+ Controls PREVIEW Form Dimensions Grid Size Colors Fonts" for window as #1 #1 "trapclose [quit]" #1 "font Consolas 12" #1 "resizehandler [resize]" #1.tool "select Add New" #1.form "select File" #1.grid "select Set Grid" #1.color "select Set Color" #1.font "select Set Font" #1.w "select ";projectw #1.h "select ";projecth #1.gb "autoresize" #1.gb "vertscrollbar on 0 ";projectw #1.gb "horizscrollbar on 0 ";projecth #1.gb "font ";projectfont$ #1.gb "down fill lightgray" gridcolor$ = BackgroundColor$ bordercolor$ =gridcolor$ gosub [drawgrid] gosub [drawall] #1.gb "when rightButtonDown [show]" #1.gb "when leftButtonDown [select]" #1.gb "when characterInput [keys]" #1.gb "setfocus" #2 "show" show=1 winType$ = "window" #1.windowtype "!Window Type" #1.fastfunctionsList "!JB Functions" #1.userfunctionsList "!My Functions" #1.windowtype "reload" '[call getfastfunctions wait
[show] if show then #2.tbproj "!contents? t$" projectname$=t$ #2 "hide" show=0 else #2 "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] if show then #2 "hide" show=0 #2.tbproj "!contents? t$" projectname$=t$ end if x=MouseX y=MouseY 'before we move on update the currently selected control from properties 'only get the editable contents #2.tbname "!contents? t$" : obj$(selected,1)=lower$(t$) #2.tbtext "!contents? t$" : obj$(selected,2)=t$ #2.tbreso "!contents? t$" : obj$(selected,3)=lower$(t$) 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if x>obj(cn,1) and x<(obj(cn,1)+obj(cn,3)) and y>obj(cn,2) and y<(obj(cn,2)+obj(cn,4)) then if x>obj(cn,1)+obj(cn,3)/1.4 and y>obj(cn,2)+obj(cn,4)/1.4 then action=2 if obj(cn,5)=6 then action=1 selected=cn exit for end if next if selected=0 then #2.tbname "" #2.tbtext "" #2.tbreso "" #2.tbxywh projectw;"x";projecth #2.tbfont projectfont$ #2.tbcolo projectfore$;"/";projectback$;"/";ctrc$ action=0 end if if selected>0 and action=1 then #1.gb "when leftButtonMove [track]" #1.gb "when leftButtonUp [stop]" offsetX=x-obj(selected,1) offsetY=y-obj(selected,2) end if if selected>0 and obj(selected,5)<>6 and action=2 then 'dont resize bmp #1.gb "when leftButtonMove [tracksize]" #1.gb "when leftButtonUp [stopsize]" offsetX=x-(obj(selected,1)+obj(selected,3)) offsetY=y-(obj(selected,2)+obj(selected,4)) end if if selected>0 then gosub [drawit] else insertx=int((x+(grid/2))/grid)*grid inserty=int((y+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #1.gb "rule ";_R2_NOTXORPEN '#1.gb "rule xor" gosub [drawit] x=int((MouseX-offsetX+(grid/2))/grid)*grid obj(selected,1)=x y=int((MouseY-offsetY+(grid/2))/grid)*grid obj(selected,2)=y gosub [drawit] wait
[stop] #1.gb "when leftButtonMove" #1.gb "when leftButtonUp" action=0 #1.gb "rule over" gosub [drawall] wait
[tracksize] '#1.gb "rule xor" #1.gb "rule "; _R2_NOTXORPEN
gosub [drawit] x=int((MouseX-offsetX+(grid/2))/grid)*grid y=int((MouseY-offsetY+(grid/2))/grid)*grid obj(selected,3)=x-obj(selected,1)'width obj(selected,4)=y-obj(selected,2)'height gosub [drawit] wait
[stopsize] #1.gb "when leftButtonMove" #1.gb "when leftButtonUp" action=0 #1.gb "rule _R2_NOTXORPEN" '#1.gb "rule xor" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,5)=12 then menuset=0 obj(selected,5)=0 #2.tbname "" #2.tbtext "" #2.tbreso "" #2.tbxywh "" #2.tbfont "" #2.tbcolo "" selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,1) 'x cpy(2)=obj(selected,2) 'y cpy(3)=obj(selected,3) 'w cpy(4)=obj(selected,4) 'h cpy(5)=obj(selected,5) 'type cpy(6)=obj(selected,6) 'textheight cpy$(1)=obj$(selected,1)'name cpy$(2)=obj$(selected,2)'text content cpy$(3)=obj$(selected,3)'resource array or file path cpy$(4)=obj$(selected,4)'ctrl specific font or "" cpy$(5)=obj$(selected,5)'ctrl specific backcolor or "" end if if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty inserty=inserty+cpy(4)+grid obj(obj,3)=cpy(3) obj(obj,4)=cpy(4) obj(obj,5)=cpy(5) obj(obj,6)=cpy(6) obj$(obj,1)=left$(cpy$(1),2);obj obj$(obj,2)=cpy$(2) obj$(obj,3)=cpy$(3) if obj(obj,5)=6 then loadbmp obj$(obj,1),obj$(obj,3) obj$(obj,4)=cpy$(4) obj$(obj,5)=cpy$(5) selected=obj gosub [drawall] end if end if #1.gb "setfocus" wait
[tool] #1.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=150 obj(obj,4)=ctrh obj(obj,5)=1 obj$(obj,1)="st";obj obj$(obj,2)="I am statictext " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 2 'textbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=200 obj(obj,4)=ctrh obj(obj,5)=2 obj$(obj,1)="tb";obj obj$(obj,2)="I am a textbox " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 3 'listbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=200 obj(obj,4)=ctrh*5 obj(obj,5)=3 obj$(obj,1)="lb";obj obj$(obj,2)="Listbox\item2\item3\item4\item5" obj$(obj,3)=obj$(obj,1);"$(" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 4 'combobox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=120 obj(obj,4)=ctrh obj(obj,5)=4 obj$(obj,1)="cb";obj obj$(obj,2)="Combobox\item2\item3\item4\item5" obj$(obj,3)=obj$(obj,1);"$(" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 5 'button obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=100 obj(obj,4)=ctrh obj(obj,5)=5 obj$(obj,1)="bt";obj obj$(obj,2)="Button? " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 6 'bmp button obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=50 obj(obj,4)=50 obj(obj,5)=6 obj$(obj,1)="bb";obj filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,3)=value(mid$(bmp$,19,4))'width obj(obj,4)=value(mid$(bmp$,23,4))'height obj$(obj,3)=file$ obj$(obj,2)="bmp" loadbmp obj$(obj,1),file$ close #bmp inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid else obj(obj,5)=0 close #bmp end if else obj(obj,5)=0 end if
case 7 'graphicbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=160 obj(obj,4)=100 obj(obj,5)=7 obj$(obj,1)="gb";obj obj$(obj,2)="I am a graphicbox " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 8 'radiobutton obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=125 obj(obj,4)=ctrh obj(obj,5)=8 obj$(obj,1)="rb";obj obj$(obj,2)="(o) radio?" obj$(obj,3)="" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 9 'checkbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=125 obj(obj,4)=ctrh obj(obj,5)=9 obj$(obj,1)="ch";obj obj$(obj,2)="[x] check?" obj$(obj,3)="" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 10 'groupbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=100 obj(obj,4)=100 obj(obj,5)=10 obj$(obj,1)="gr";obj obj$(obj,2)="Group Box? " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 11 'texteditor obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=200 obj(obj,4)=100 obj(obj,5)=11 obj$(obj,1)="te";obj obj$(obj,2)="I am texteditor " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,1)=0 obj(obj,2)=0 obj(obj,3)=100 obj(obj,4)=10 obj(obj,5)=12 obj$(obj,1)="mn";obj obj$(obj,2)=" Menu Added" menuset=1 end if end select selected=obj gosub [drawall] #1.tool "select Add New" #1.gb "setfocus" wait
[form] #1.form "selectionindex? i" select case i case 1 'Last Form filename$="lastsession.ffu" gosub [loadit] case 2 'new form gosub [new] case 3 ''load form gosub [load] case 4 'save form gosub [saveas] case 6 'edit code gosub [prevCode] case 7 'save code gosub [write] end select #1.form "select File" gosub [drawall] #1.gb "setfocus" wait
[drawall] #1.gb "discard ; redraw bak" ocn=cn for cn=1 to obj gosub [drawit] next cn=ocn
if grid <>1 then #1.gb "color black " #1.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";grid #1.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";grid #1.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";grid*2 else #1.gb "place ";insertx-8;" ";inserty+3 #1.gb "color black " #1.gb "\>" end if #1.gb "setfocus" return
[drawit] 'redraws control cn if obj(cn,5)=0 then return 'if this is a menu pin to top left to stop it being move or resized if obj(cn,5)=12 then obj(cn,1)=10 : obj(cn,2)=-10 : obj(cn,3)=100 : obj(cn,4)=10 'if there is a special font for the object in obj$(n,4) change 'the font and height stored in obj(n,6) or set to default if obj$(cn,4)="" then #1.gb "font ";projectfont$ ch=projectctrh if obj(cn,4)<ch then obj(cn,4)=ch else #1.gb "font ";obj$(cn,4) ch=obj(cn,6) if obj(cn,4)<ch then obj(cn,4)=ch end if 'update the properties textboxes for selected control if cn=selected then #2.tbname obj$(cn,1) 'name #2.tbtext obj$(cn,2) 'text #2.tbreso obj$(cn,3) 'resource #2.tbxywh obj(cn,1);" ";obj(cn,2);" ";obj(cn,3);" ";obj(cn,4) 'xywh if obj$(cn,4)="" then #2.tbfont projectfont$;":";obj(cn,6) else #2.tbfont obj$(cn,4);":";obj(cn,6) 'font and height if obj$(cn,5)="" then #2.tbcolo projectback$ else #2.tbcolo obj$(cn,5) end if 'set the color for the drawn object and action taking place if cn=selected then '#1.gb "color red" 'action 1 or 2 #1.gb "color darkred" 'action 1 or 2 if action=2 then #1.gb "color darkgreen" else #1.gb "color ";projectfore$ end if 'if it is a statictext, checkbox radiobox, groupbox or menu make background color transparent if obj(cn,5)=1 or obj(cn,5)=8 or obj(cn,5)=9 or obj(cn,5)=10 or obj(cn,5)=12 then #1.gb "backcolor ";projectback$ if selected<>cn then #1.gb "color 192 192 192" else if obj$(cn,5)<>"" then #1.gb "backcolor ";obj$(cn,5) else #1.gb "backcolor ";projectback$ end if 'now draw the object at desired location #1.gb "place ";obj(cn,1);" ";obj(cn,2) 'if it is a bmp draw actual bmp if it is stationary else just the outline if obj(cn,5)=6 then if action=0 then #1.gb "drawbmp ";obj$(cn,1) #1.gb "box ";obj(cn,1)+obj(cn,3);" ";obj(cn,2)+obj(cn,4) else 'draw outline if it is a groupbox else all others filled if obj(cn,5)=10 then #1.gb "box ";obj(cn,1)+obj(cn,3);" ";obj(cn,2)+obj(cn,4) else #1.gb "boxfilled ";obj(cn,1)+obj(cn,3);" ";obj(cn,2)+obj(cn,4) end if 'if we are stationary draw the text in the correct color if action=0 then if cn=selected then #1.gb "color darkred" 'action 1 or 2 if action=2 then #1.gb "color darkgreen" else #1.gb "color ";projectfore$ end if select case obj(cn,5) case 5 'centre button text #1.gb "stringwidth? ";"A";" width" xp=(obj(cn,3)-width*len(obj$(cn,2)))/2 #1.gb "place ";obj(cn,1)+xp;" ";obj(cn,2)+ch/1.33;" ;\";obj$(cn,2) case 10 'groupbox text is offset #1.gb "place ";obj(cn,1)+5;" ";obj(cn,2)+ch/1.33-ch/2;" ;\";obj$(cn,2) case else 'woa! normal left justified text #1.gb "place ";obj(cn,1)+5;" ";obj(cn,2)+ch/1.33;" ;\";obj$(cn,2) end select end if end if return [prevCode2] file$ = "test.bas" prev = 1 gosub [writeit] wait
[prevCode] file$ = "test.bas" prev = 1 gosub [writeit] return
[preview] prev = 2 file$ = "preview.bas" gosub [writeit] wait
[write] filedialog "Save .bas",projectname$;".bas",file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit] if file$<>"" then open file$ for output as #op 'the header #op "'Project ";projectname$ #op "'Created with Freeform Ultra Lite v1.2 on ";date$() #op "" #op "'Switch off mainwin debugging window" #op "nomainwin" #op "" if projectback$<>"buttonface" 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,5)=3 or obj(n,5)=4 then #op "dim ";obj$(n,3);"10)" #op "for n = 1 to 10" #op " ";obj$(n,3);"n)= str$(n)" #op "next" end if next #op "" #op "'Create controls and open window" #op "WindowWidth = ";projectw+ThemeWidth-15 #op "WindowHeight = ";(projecth+ThemeHeight+menuset*projectctrh)-15 #op "UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op "UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op "menu #1, ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op "menu #1, ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op "menu #1, ";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,5) case 1 'statictext #op "statictext #1.";obj$(n,1);" ";chr$(34);trim$(obj$(n,2));chr$(34);",";obj(n,1);",";obj(n,2)+5;",";obj(n,3);",";obj(n,4) case 2 'textbox if obj$(n,5)<>"" then #op "TextboxColor$=";chr$(34);obj$(n,5);chr$(34) #op "textbox #1.";obj$(n,1);",";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 3 'list box if obj$(n,5)<>"" then #op "ListboxColor$=";chr$(34);obj$(n,5);chr$(34) #op "listbox #1.";obj$(n,1);",";obj$(n,3);",[";obj$(n,1);"click],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 4 'combobox if obj$(n,5)<>"" then #op "ComboboxColor$=";chr$(34);obj$(n,5);chr$(34) #op "combobox #1.";obj$(n,1);",";obj$(n,3);",[";obj$(n,1);"click],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 5 'button #op "button #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",[";obj$(n,1);"click], UL, ";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 6 'bmpbutton #op "bmpbutton #1.";obj$(n,1);",";chr$(34);obj$(n,3);chr$(34);",[";obj$(n,1);"click], UL, ";obj(n,1);",";obj(n,2) case 7 'graphicbox #op "graphicbox #1.";obj$(n,1);",";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 8 'radiobutton #op "radiobutton #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",[radio],[radio],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 9 'checkbox #op "checkbox #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",[check],[check],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 10 'group box #op "groupbox #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",";obj(n,1);",";obj(n,2)-5;",";obj(n,3);",";obj(n,4) case 11 if obj$(n,5)<>"" then #op "TexteditorColor$=";chr$(34);obj$(n,5);chr$(34) #op "texteditor #1.";obj$(n,1);",";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) end select next #op "open ";chr$(34);projectname$;chr$(34);" for ";winType$;" as #1" #op "#1 ";chr$(34);"trapclose [quit]";chr$(34) #op "" #op "'apply any control specific fonts" for n= 1 to obj if obj(n,5)<>0 and obj$(n,4)<>"" then if obj(n,5)=1 or obj(n,5)=2 or obj(n,5)=5 or obj(n,5)=10 or obj(n,5)=11 then #op "#1.";obj$(n,1);" ";chr$(34);"!font ";obj$(n,4);chr$(34) end if if obj(n,5)=3 or obj(n,5)=4 or obj(n,5)=7 or obj(n,5)=8 or obj(n,5)=9 then #op "#1.";obj$(n,1);" ";chr$(34);"font ";obj$(n,4);chr$(34) end if end if next #op "wait" #op "" #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,5) case 3 'listbox #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 4 'combobox #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 5 'button #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 6 'bmpbutton #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 8 'radiobutton if radio=0 then #op "[radio]" #op "'Your handler code here" #op "wait" #op "" radio=1 end if case 9 'checkbox if check=0 then #op "[check]" #op "'Your handler code here" #op "wait" #op "" check=1 end if end select next #op "[quit]" #op "close #1" #op "end" close #op if prev = 2 then prev = 0 : goto [jump] if prev =1 then prev = 0 : run chr$(34);"c:\program files (x86)\liberty basic 4.5.1\liberty.exe";chr$(34);" ";DefaultDir$;"\";file$ : return if prev =0 then return [jump] 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)\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$ end if [done] end if open DefaultDir$;"\test.bas" for output as #copyfunction close #copyfunction call copyFunction #1.fastfunctionsList "!JB Functions" [donePrev] return
[saveas] filedialog "Save As...",projectname$;".ffu",file$ if file$<>"" then open file$ for output as #op file$=right$(file$,len(file$)-len(DefaultDir$)-1) projectname$=left$(file$,len(file$)-4) #op projectname$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth #op gridcolor$ #op bordercolor$ #op crosshair$ '#op grid for n=1 to obj if obj(n,5)<>0 then #op obj(n,1);","; #op obj(n,2);","; #op obj(n,3);","; #op obj(n,4);","; #op obj(n,5);","; #op obj(n,6) #op obj$(n,1) #op obj$(n,2) #op obj$(n,3) #op obj$(n,4) #op obj$(n,5) end if next close #op end if return
[load] filedialog "Open Project...","*.ffu",filename$ [loadit] if filename$<>"" then open filename$ for input as #ses input #ses, projectname$ #2.tbproj projectname$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #1.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ input #ses, gc$ input #ses, bordercolor$ input #ses, crosshair$ projectctrh=val(c$) projectgrid=val(g$) gridcolor$ = gc$ grid=projectgrid projectw=val(w$) projecth=val(h$) #1.grid "select ";grid if grid = 1 then #1.st1 grid-1 else #1.st1 grid #1.w "select ";projectw #1.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,1)=val(word$(l$,1,",")) obj(obj,2)=val(word$(l$,2,",")) obj(obj,3)=val(word$(l$,3,",")) obj(obj,4)=val(word$(l$,4,",")) obj(obj,5)=val(word$(l$,5,",")) obj(obj,6)=val(word$(l$,6,",")) line input #ses, obj$(obj,1) line input #ses, obj$(obj,2) line input #ses, obj$(obj,3) line input #ses, obj$(obj,4) line input #ses, obj$(obj,5) if obj(obj,5)=6 then loadbmp obj$(obj,1),obj$(obj,3) if obj(obj,5)=12 then menuset=1 wend close #ses end if return
[new] redim obj(100,6) 'x,y,width/height,type,textheight redim obj$(100,6) 'name,text content,resource,font obj=0 menuset=0 projectback$="white" projectfore$="black" projectname$="Untitled" #2.tbproj projectname$ return
[resize] #1.tool "select Add New" #1.form "select File" #1.grid "select Set Grid" #1.font "select Set Font" #1.w "select ";projectw #1.h "select ";projecth #1.color "select Set Color" #1.windowtype "!Window Type" #1.fastfunctionsList "!JB Functions" #1.userfunctionsList "!My Functions" gosub [drawall] wait
[formsize] #1.w "contents? w$" #1.h "contents? h$" w=val(w$)'+45 h=val(h$)'+50 if w=0 or h=0 or (w=projectw and h=projecth) then wait projectw=w projecth=h insertx=grid inserty=grid gosub [drawgrid] #1.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid according to user choice, default is 5 #1.grid "contents? g$" if g$ = "Crosshair" then crosshair$ = g$ goto [string] end if if g$ = "noCrosshair" then crosshair$ = g$ goto [string] end if grid=val(g$) [string] gosub [drawgrid] gosub [drawall] if grid >1 then #1.st1 grid else #1.st1 grid - 1 #1.gb "setfocus" wait
[drawgrid] if grid = 0 then grid = 1 insertx=int((insertx+(grid/2))/grid)*grid inserty=int((inserty+(grid/2))/grid)*grid projectgrid=grid #1.gb "cls; fill ";projectback$ #1.gb "place 0 0 ; color ";projectfore$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth if grid<3 then [nogrid] #1.gb "color ";gridcolor$ if grid > 2 then y=0 ' Grid - Draw vertical lines #1.gb "size 1" for x = 0 to projectw step grid print #1.gb, "line "; x; " "; startX; " "; x; " "; projecth next x 'Grid - Draw horizontal lines for y = 0 to projecth step grid #1.gb, "line "; startX; " "; y; " "; projectw; " "; y next y end if [nogrid] if bordercolor$ = "" then bordercolor$ = gridcolor$ #1.gb "color ";bordercolor$ 'draw crosshairs for easier line up of controls when grid = 0 if crosshair$ = "Crosshair" then #1.gb "color ";bordercolor$ #1.gb "line "; projectw/2; " "; startX; " "; projectw/2; " "; projecth #1.gb "line "; startX; " "; projecth/2; " "; projectw; " "; projecth/2 end if #1.gb "place 0 0" #1.gb "box ";projectw;" ";projecth #1.gb "flush bak" #1.grid "select Set Grid" return
[windowType] #1.windowtype "contents? winType$" wait
[font] #1.font "contents? f$" if f$="Proj Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #1.gb "font ";projectfont$ #1.gb "place 100 100 ;\Q\Q" #1.gb "posxy x y" projectctrh=(y-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Ctrl Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #1.gb "font ";ctrf$ #1.gb "place 100 100 ;\Q\Q" #1.gb "posxy x y" ctrh=(y-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 #1.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="Ctrl Reset" 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 #1.gb "font ";ctrf$ obj(selected,4)=ctrh #1.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #1.font "select Set Font" gosub [drawall] #1.gb "setfocus" wait
[color] #1.color "contents? c$" select case c$ case "Ctrl Back" gosub [colorpick] if cp$<>"" then ctrc$=cp$ if selected then if obj(selected,5)=2 or obj(selected,5)=3 or obj(selected,5)=4 or obj(selected,5)=11 then obj$(selected,5)=ctrc$ end if case "ResetBack" ctrc$=projectback$ if selected then obj$(selected,5)="" case "Proj Back" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Proj Fore" gosub [colorpick] if cp$<>"" then projectfore$=cp$ case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] case "Grid Border" gosub [colorpick] if cp$<>"" then bordercolor$=cp$ gosub [drawgrid] end select #1.color "select Set Color" gosub [drawall] #1.gb "setfocus" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #3.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #3 #3 "font Consolas 9" #3 "trapclose [quit3]" #3.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white" c=1 for y=1 to 160 step 40 for x= 1 to 160 step 40 #3.gb "backcolor ";word$(cl$,c);" ; place ";x;" ";y;" ; boxfilled ";x+40;" ";y+40 c=c+1 if c>15 then c=15 next next #3.gb "when leftButtonDown [pick]" wait
[pick] x=int(MouseX/40) y=int(MouseY/40) c=x+y*4+1 cp$=word$(cl$,c)
[quit3] if c$="" then c$=oc$ close #3 return
[help] loadbmp "h","helpme.bmp" #1.gb "drawbmp h 0 0 " wait
[quit2] 'prevent properties window closing by user 'playwave "beep" #1.gb "setfocus" wait
[quit] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectname$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth #ses gridcolor$ #ses bordercolor$ #ses crosshair$ for n=1 to obj if obj(n,5)<>0 then #ses obj(n,1);","; #ses obj(n,2);","; #ses obj(n,3);","; #ses obj(n,4);","; #ses obj(n,5);","; #ses obj(n,6) #ses obj$(n,1) #ses obj$(n,2) #ses obj$(n,3) #ses obj$(n,4) #ses obj$(n,5) end if next close #ses close #2 close #1 end
sub copyFunction x = 0 dim codeLine$(500) if fileExists(upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions", fastfuncs$) then open upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions\";fastfuncs$ for input as #fastfunc open DefaultDir$;"\preview.bas" for append as #copyfunction #copyfunction "" while eof(#fastfunc) = 0 line input #fastfunc, codeLine$(x) line$ = codeLine$(x) if x < 6 then [skipme] #copyfunction line$ copiedText$ = copiedText$+chr$(13)+line$ '#1.textHid line$ [skipme] x = x + 1 wend close #fastfunc close #copyfunction end if end sub
sub getfastfunctions dim folderInfo$(1, 1) dim fastfunctionsList$(10) files upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions", folderInfo$() numFiles = val(folderInfo$(0, 0)) redim fastfunctionsList$(numFiles+1) 'fastfunctionsList$(numFiles+1) = "Add Function" for x = 1 to numFiles filenam$ = folderInfo$(x, 0) if right$(filenam$, 3) <> "txt" then [skip] if filenam$ = "readme.txt" then [skip] fastfunctionsList$(x) = left$(filenam$, len(filenam$) - 4) [skip] next x sort fastfunctionsList$(), 0 ,numFiles #1.fastfunctionsList, "reload" end sub
sub fastfunctionSelected fastfunctionsList$ #1.fastfunctionsList, "selection? fastfuncs$" fastfuncs$ = fastfuncs$;".txt" open upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions";"\";fastfuncs$ for input as #copyText open "test.bas" for append as #test #test " " while eof(#copyText) = 0 line input #copyText, line$ 'codeLine$(x) 'line$ = codeLine$(x) if x < 6 then [skipme] #test line$ [skipme] x = x + 1 wend close #copyText close #test end sub
'get users homepath = aka %userprofile% = "c:\users\xxxxx" (5 characters long normally Win 10) sub getUserPath run "cmd.exe /c echo %userprofile% >UserHomePath.txt", HIDE do scan loop until fileExists(DefaultDir$, "UserHomePath.txt") open "UserHomePath.txt" for input as #1 upath$ = input$(#1, lof(#1)) close #1 if upath$ = "" then notice "Sorry, can't find user path " : end kill DefaultDir$;"\UserHomePath.txt" end sub
function GetFilename$(fName$) i = len(fName$) while mid$(fName$, i, 1) <> "\" and mid$(fName$, i, 1) <> "" i = i-1 wend GetFilename$ = mid$(fName$, i+1) end function
'Verify file existence function function fileExists(path$, name$) dim fileExistsInfo$(0,0) files path$, name$, fileExistsInfo$() fileExists = val(fileExistsInfo$(0, 0)) 'non zero is true end function
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
|
|
|
Post by Rod on Apr 29, 2023 1:17:09 GMT -5
Our thinking about precision differ greatly. For me precision is uniformity and regimentation of placement. So the grid becomes important, so too the snap to size. By losing the grid and any snap to regimentation you are spoiling one of the main design concepts. Placing of controls will be no more accurate than the original freeform. This visible snap too is important to me.
Neither do I think we have a problem with flashing, and for me eliminating the dots/grid lines did not make much of a difference.
However, I will introduce color choice and memory for the grid and I will introduce an option to make the grid invisible. But, the snap to will remain operational at the last chosen size. I will introduce a 1 pixel snap to option, I just hope it is rarely used, but there might be times when pixel perfect position helps.
I hope the invisible grid with working snap to feels like a good working compromise.
|
|
|
Post by xxgeek on Apr 29, 2023 10:18:45 GMT -5
I have found that with no grid and a crosshair a user can easily place controls within 1 pixel of each other. The crosshair acts as a a guide. The movement is also very fluid, and smooth. I was wrong in thinking a 1 pixel snap-to would provide the precision you were after. No need to compromise for me though. I have my own adaptation. My thoughts: Colored backgrounds on textboxes, texteditors or listboxes, especially the colors that are available, will never be in any of the controls I create, ever. (other than the white to black shades) I kind of hate those colors. Not sure why, maybe memories of the 1920's come to mind And who needs a colored listbox anyway? That said, I would not deprive other users the option to use those colors.
|
|
gaslouk
Full Member
Hi from beautiful Greece.
Posts: 130
|
Post by gaslouk on May 3, 2023 11:42:03 GMT -5
gaslouk, There is more code needed, for saving settings to file etc. The following is what I've been working with. Not complete yet, but for grid and crosshairs colors etc, working. (go biggie size to see all options, and to see full grid when dimensions require it.) Note: This was written for JUST BASIC and some things may not work. Crosshair color(corsshair$) will equal grid color(gridcolor$, and invisible) unless changed by the user. Grid Border color(bordercolor$) can also be changed by the user. Crosshair color stays the same as Bordercolor 'freeform ultra lite v1.1 by rodbird@hotmail 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1 '16/04/2023 'added xor drawing to reduce flicker '18/04/2023 'added insertion point code and .exe identification code '19/04/2023 'fixed insertion point code to show insert arrow always 'made insert arrow move automatically when controls added 'insert arrow stays where placed or moves with addition of control 'fixed ctrlV to move insert arrow on similar basis 'made insert arrow follow grid size changes and relocate automatically 'fixed line color for statictext, groupbox etc 'stopped bmpbutton from being resized it never goes green now 'amended select for expanding control, now bottom right quadrant selects expand 'all resource files are pathless, so expected to be in working directory '20/04/2023 'fixed ffufile name loaded error 'amended startup and lastsession.ffu is now loaded using Restore option 'added color management '21/04/2023 'fixed font menu, fonts ! now applied correctly 'font changes applied immediately to selected controls 'single line text controls adjust for font width and height 'fixed color dialog, made it modal and sorted return value if cancelled 'implemented the preview button idea. write is now essentially save as for .ffu/.bas 'preview always writes to preview.bas 'put more project info on the unselected properties pop up 'change the project name in properties.
global addfastfunction, funcs$, fastfuncs$, upath$', copiedText$', filename$ 'call getUserPath jbPath$ = "c:\Program Files (x86)\Just Basic v2.0\jbasic.exe" jbPath$ = "c:\Program Files (x86)\Liberty Basic Pro v4.5.1\lbpro.exe" dim windowTypes$(23) windowTypes$(1)= "dialog":windowTypes$(2)= "dialog_fs":windowTypes$(3)= "dialog_nf":windowTypes$(4)= "dialog_nf_fs" windowTypes$(5)= "dialog_modal":windowTypes$(6)= "dialog_popup":windowTypes$(7)= "" windowTypes$(8)= " ":windowTypes$(9)= "graphics":windowTypes$(10)= "graphics_fs":windowTypes$(11) = "graphics_nf":windowTypes$(12)= "graphics_nsb":windowTypes$(13)= "graphics_nsb_nf" windowTypes$(14)= " ":windowTypes$(15)= "text":windowTypes$(16)= "text_fs":windowTypes$(17)= "text_nsb":windowTypes$(18)= "text_nsb_ins" windowTypes$(19)= " ":windowTypes$(20)= "window":windowTypes$(21)= "window_nf":windowTypes$(22)= "window_popup" nomainwin dim info$(10,10) dim form$(10)
form$(1)="Last Form" form$(2)="New Form" form$(3)="Load Form" form$(4)="Save Form" form$(5)="--------------" form$(6)="Edit Code" form$(7)="Save Code" form$(8)="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 grid$(20) g=3 grid$(0)="0" grid$(1)="3" for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Crosshair" crosshair$ = "Crosshair" grid$(g+1)="noCrosshair" grid$(g+2)="Set Grid" grid=10 projectctrh=25 ctrh=25 dim color$(10) color$(1)="Ctrl Back" color$(2)="ResetBack" color$(3)="Proj Back" color$(4)="Proj Fore" color$(5)="Grid Color" color$(6)="Grid Border" color$(7)="Set Color" projectback$="white" projectfore$="black" ctrc$="white" dim font$(10) font$(1)="Ctrl Font" font$(2)="Ctrl Reset" font$(3)="Proj Font" font$(4)="Set Font"'default is Consolas 9" dim v$(100) for n= 1 to 20 v$(n)=str$(n*100) next dim obj(100,6) 'x,y,width/height,type,textheight dim obj$(100,6) 'name,text content,resource,font,backcolor,forecolor obj=0 projectname$="Untitled" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projectctrh=25 projectgrid=10 projectw=600 projecth=500 insertx=grid inserty=grid*2 obj=0
'find out what our pc's client area restrictions are 'first of find out how much space the 'windows theme takes for frame and title WindowWidth=200 WindowHeight=200 open "Measuring" for graphics as #1 #1 "home ; down ; posxy x y" ThemeWidth=WindowWidth-2*x-2 ThemeHeight=WindowHeight-2*y-2 close #1
'open a small properties window and hide it WindowWidth=230 WindowHeight=200 UpperLeftX=((DisplayWidth/2))+130 UpperLeftY=((DisplayHeight/2)) statictext #2.st1 "Proj",5,10,30,25 textbox #2.tbproj,45,5,150,25 statictext #2.st2 "Ctrl",5,32,30,25 textbox #2.tbname,45,27,150,25 statictext #2.st3 "Text",5,54,30,25 textbox #2.tbtext,45,49,150,25 statictext #2.st4 "Reso",5,76,30,25 textbox #2.tbreso,45,71,150,25 statictext #2.st5 "xywh",5,98,30,25 textbox #2.tbxywh,45,93,150,25 statictext #2.st6 "Font",5,120,30,25 textbox #2.tbfont,45,115,150,25 statictext #2.st7 "Colo",5,142,30,25 textbox #2.tbcolo,45,137,150,25
open "Properties" for window_nf as #2 #2 "font Consolas 9" #2 "trapclose [quit2]" #2.tbproj projectname$ #2.tbxywh "!disable" #2.tbfont "!disable" #2.tbcolo "!disable" #2.tbxywh projectw;"x";projecth #2.tbfont projectfont$ #2.tbcolo projectfore$;"/";projectback$;"/";ctrc$ #2 "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=1415+ThemeWidth+30 WindowWidth=905+ThemeWidth+33 WindowHeight=615+ThemeHeight+45 'gb is offset by 25 345 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 BackgroundColor$ = "lightgray" combobox #1.form,form$(,[form],5,8,120,35 combobox #1.tool,tool$(,[tool],130,8,120,35 button #1.project,"&Code",[prevCode2],UL,255,1,70,39 button #1.project2,"&Form",[preview],UL,330,1,70,39 combobox #1.w,v$(,[formsize],405,8,90,35 combobox #1.h,v$(,[formsize],495,8,90,35 combobox #1.grid,grid$(,[grid],590,8,100,35 statictext #1.st1 str$(grid),698,12,20,20 combobox #1.color,color$(,[color],725,8,110,35 combobox #1.font,font$(,[font],840, 8,110,35 combobox #1.fastfunctionsList, fastfunctionsList$(), fastfunctionSelected , 955, 8, 155, 35 combobox #1.userfunctionsList, userfunctionsList$(), userfunctionSelected , 1115, 8, 155, 35 combobox #1.windowtype,windowTypes$(,[windowType], 1275 , 8, 160, 35 button #1.help,"&Help",[help],UL,1440,8,60,30 graphicbox #1.gb,5,43,945,625 open "FFU+ Controls PREVIEW Form Dimensions Grid Size Colors Fonts" for window as #1 #1 "trapclose [quit]" #1 "font Consolas 12" #1 "resizehandler [resize]" #1.tool "select Add New" #1.form "select File" #1.grid "select Set Grid" #1.color "select Set Color" #1.font "select Set Font" #1.w "select ";projectw #1.h "select ";projecth #1.gb "autoresize" #1.gb "vertscrollbar on 0 ";projectw #1.gb "horizscrollbar on 0 ";projecth #1.gb "font ";projectfont$ #1.gb "down fill lightgray" gridcolor$ = BackgroundColor$ bordercolor$ =gridcolor$ gosub [drawgrid] gosub [drawall] #1.gb "when rightButtonDown [show]" #1.gb "when leftButtonDown [select]" #1.gb "when characterInput [keys]" #1.gb "setfocus" #2 "show" show=1 winType$ = "window" #1.windowtype "!Window Type" #1.fastfunctionsList "!JB Functions" #1.userfunctionsList "!My Functions" #1.windowtype "reload" '[call getfastfunctions wait
[show] if show then #2.tbproj "!contents? t$" projectname$=t$ #2 "hide" show=0 else #2 "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] if show then #2 "hide" show=0 #2.tbproj "!contents? t$" projectname$=t$ end if x=MouseX y=MouseY 'before we move on update the currently selected control from properties 'only get the editable contents #2.tbname "!contents? t$" : obj$(selected,1)=lower$(t$) #2.tbtext "!contents? t$" : obj$(selected,2)=t$ #2.tbreso "!contents? t$" : obj$(selected,3)=lower$(t$) 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if x>obj(cn,1) and x<(obj(cn,1)+obj(cn,3)) and y>obj(cn,2) and y<(obj(cn,2)+obj(cn,4)) then if x>obj(cn,1)+obj(cn,3)/1.4 and y>obj(cn,2)+obj(cn,4)/1.4 then action=2 if obj(cn,5)=6 then action=1 selected=cn exit for end if next if selected=0 then #2.tbname "" #2.tbtext "" #2.tbreso "" #2.tbxywh projectw;"x";projecth #2.tbfont projectfont$ #2.tbcolo projectfore$;"/";projectback$;"/";ctrc$ action=0 end if if selected>0 and action=1 then #1.gb "when leftButtonMove [track]" #1.gb "when leftButtonUp [stop]" offsetX=x-obj(selected,1) offsetY=y-obj(selected,2) end if if selected>0 and obj(selected,5)<>6 and action=2 then 'dont resize bmp #1.gb "when leftButtonMove [tracksize]" #1.gb "when leftButtonUp [stopsize]" offsetX=x-(obj(selected,1)+obj(selected,3)) offsetY=y-(obj(selected,2)+obj(selected,4)) end if if selected>0 then gosub [drawit] else insertx=int((x+(grid/2))/grid)*grid inserty=int((y+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #1.gb "rule ";_R2_NOTXORPEN '#1.gb "rule xor" gosub [drawit] x=int((MouseX-offsetX+(grid/2))/grid)*grid obj(selected,1)=x y=int((MouseY-offsetY+(grid/2))/grid)*grid obj(selected,2)=y gosub [drawit] wait
[stop] #1.gb "when leftButtonMove" #1.gb "when leftButtonUp" action=0 #1.gb "rule over" gosub [drawall] wait
[tracksize] '#1.gb "rule xor" #1.gb "rule "; _R2_NOTXORPEN
gosub [drawit] x=int((MouseX-offsetX+(grid/2))/grid)*grid y=int((MouseY-offsetY+(grid/2))/grid)*grid obj(selected,3)=x-obj(selected,1)'width obj(selected,4)=y-obj(selected,2)'height gosub [drawit] wait
[stopsize] #1.gb "when leftButtonMove" #1.gb "when leftButtonUp" action=0 #1.gb "rule _R2_NOTXORPEN" '#1.gb "rule xor" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,5)=12 then menuset=0 obj(selected,5)=0 #2.tbname "" #2.tbtext "" #2.tbreso "" #2.tbxywh "" #2.tbfont "" #2.tbcolo "" selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,1) 'x cpy(2)=obj(selected,2) 'y cpy(3)=obj(selected,3) 'w cpy(4)=obj(selected,4) 'h cpy(5)=obj(selected,5) 'type cpy(6)=obj(selected,6) 'textheight cpy$(1)=obj$(selected,1)'name cpy$(2)=obj$(selected,2)'text content cpy$(3)=obj$(selected,3)'resource array or file path cpy$(4)=obj$(selected,4)'ctrl specific font or "" cpy$(5)=obj$(selected,5)'ctrl specific backcolor or "" end if if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty inserty=inserty+cpy(4)+grid obj(obj,3)=cpy(3) obj(obj,4)=cpy(4) obj(obj,5)=cpy(5) obj(obj,6)=cpy(6) obj$(obj,1)=left$(cpy$(1),2);obj obj$(obj,2)=cpy$(2) obj$(obj,3)=cpy$(3) if obj(obj,5)=6 then loadbmp obj$(obj,1),obj$(obj,3) obj$(obj,4)=cpy$(4) obj$(obj,5)=cpy$(5) selected=obj gosub [drawall] end if end if #1.gb "setfocus" wait
[tool] #1.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=150 obj(obj,4)=ctrh obj(obj,5)=1 obj$(obj,1)="st";obj obj$(obj,2)="I am statictext " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 2 'textbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=200 obj(obj,4)=ctrh obj(obj,5)=2 obj$(obj,1)="tb";obj obj$(obj,2)="I am a textbox " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 3 'listbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=200 obj(obj,4)=ctrh*5 obj(obj,5)=3 obj$(obj,1)="lb";obj obj$(obj,2)="Listbox\item2\item3\item4\item5" obj$(obj,3)=obj$(obj,1);"$(" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 4 'combobox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=120 obj(obj,4)=ctrh obj(obj,5)=4 obj$(obj,1)="cb";obj obj$(obj,2)="Combobox\item2\item3\item4\item5" obj$(obj,3)=obj$(obj,1);"$(" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 5 'button obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=100 obj(obj,4)=ctrh obj(obj,5)=5 obj$(obj,1)="bt";obj obj$(obj,2)="Button? " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 6 'bmp button obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=50 obj(obj,4)=50 obj(obj,5)=6 obj$(obj,1)="bb";obj filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,3)=value(mid$(bmp$,19,4))'width obj(obj,4)=value(mid$(bmp$,23,4))'height obj$(obj,3)=file$ obj$(obj,2)="bmp" loadbmp obj$(obj,1),file$ close #bmp inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid else obj(obj,5)=0 close #bmp end if else obj(obj,5)=0 end if
case 7 'graphicbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=160 obj(obj,4)=100 obj(obj,5)=7 obj$(obj,1)="gb";obj obj$(obj,2)="I am a graphicbox " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 8 'radiobutton obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=125 obj(obj,4)=ctrh obj(obj,5)=8 obj$(obj,1)="rb";obj obj$(obj,2)="(o) radio?" obj$(obj,3)="" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 9 'checkbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=125 obj(obj,4)=ctrh obj(obj,5)=9 obj$(obj,1)="ch";obj obj$(obj,2)="[x] check?" obj$(obj,3)="" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 10 'groupbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=100 obj(obj,4)=100 obj(obj,5)=10 obj$(obj,1)="gr";obj obj$(obj,2)="Group Box? " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 11 'texteditor obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=200 obj(obj,4)=100 obj(obj,5)=11 obj$(obj,1)="te";obj obj$(obj,2)="I am texteditor " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,1)=0 obj(obj,2)=0 obj(obj,3)=100 obj(obj,4)=10 obj(obj,5)=12 obj$(obj,1)="mn";obj obj$(obj,2)=" Menu Added" menuset=1 end if end select selected=obj gosub [drawall] #1.tool "select Add New" #1.gb "setfocus" wait
[form] #1.form "selectionindex? i" select case i case 1 'Last Form filename$="lastsession.ffu" gosub [loadit] case 2 'new form gosub [new] case 3 ''load form gosub [load] case 4 'save form gosub [saveas] case 6 'edit code gosub [prevCode] case 7 'save code gosub [write] end select #1.form "select File" gosub [drawall] #1.gb "setfocus" wait
[drawall] #1.gb "discard ; redraw bak" ocn=cn for cn=1 to obj gosub [drawit] next cn=ocn
if grid <>1 then #1.gb "color black " #1.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";grid #1.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";grid #1.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";grid*2 else #1.gb "place ";insertx-8;" ";inserty+3 #1.gb "color black " #1.gb "\>" end if #1.gb "setfocus" return
[drawit] 'redraws control cn if obj(cn,5)=0 then return 'if this is a menu pin to top left to stop it being move or resized if obj(cn,5)=12 then obj(cn,1)=10 : obj(cn,2)=-10 : obj(cn,3)=100 : obj(cn,4)=10 'if there is a special font for the object in obj$(n,4) change 'the font and height stored in obj(n,6) or set to default if obj$(cn,4)="" then #1.gb "font ";projectfont$ ch=projectctrh if obj(cn,4)<ch then obj(cn,4)=ch else #1.gb "font ";obj$(cn,4) ch=obj(cn,6) if obj(cn,4)<ch then obj(cn,4)=ch end if 'update the properties textboxes for selected control if cn=selected then #2.tbname obj$(cn,1) 'name #2.tbtext obj$(cn,2) 'text #2.tbreso obj$(cn,3) 'resource #2.tbxywh obj(cn,1);" ";obj(cn,2);" ";obj(cn,3);" ";obj(cn,4) 'xywh if obj$(cn,4)="" then #2.tbfont projectfont$;":";obj(cn,6) else #2.tbfont obj$(cn,4);":";obj(cn,6) 'font and height if obj$(cn,5)="" then #2.tbcolo projectback$ else #2.tbcolo obj$(cn,5) end if 'set the color for the drawn object and action taking place if cn=selected then '#1.gb "color red" 'action 1 or 2 #1.gb "color darkred" 'action 1 or 2 if action=2 then #1.gb "color darkgreen" else #1.gb "color ";projectfore$ end if 'if it is a statictext, checkbox radiobox, groupbox or menu make background color transparent if obj(cn,5)=1 or obj(cn,5)=8 or obj(cn,5)=9 or obj(cn,5)=10 or obj(cn,5)=12 then #1.gb "backcolor ";projectback$ if selected<>cn then #1.gb "color 192 192 192" else if obj$(cn,5)<>"" then #1.gb "backcolor ";obj$(cn,5) else #1.gb "backcolor ";projectback$ end if 'now draw the object at desired location #1.gb "place ";obj(cn,1);" ";obj(cn,2) 'if it is a bmp draw actual bmp if it is stationary else just the outline if obj(cn,5)=6 then if action=0 then #1.gb "drawbmp ";obj$(cn,1) #1.gb "box ";obj(cn,1)+obj(cn,3);" ";obj(cn,2)+obj(cn,4) else 'draw outline if it is a groupbox else all others filled if obj(cn,5)=10 then #1.gb "box ";obj(cn,1)+obj(cn,3);" ";obj(cn,2)+obj(cn,4) else #1.gb "boxfilled ";obj(cn,1)+obj(cn,3);" ";obj(cn,2)+obj(cn,4) end if 'if we are stationary draw the text in the correct color if action=0 then if cn=selected then #1.gb "color darkred" 'action 1 or 2 if action=2 then #1.gb "color darkgreen" else #1.gb "color ";projectfore$ end if select case obj(cn,5) case 5 'centre button text #1.gb "stringwidth? ";"A";" width" xp=(obj(cn,3)-width*len(obj$(cn,2)))/2 #1.gb "place ";obj(cn,1)+xp;" ";obj(cn,2)+ch/1.33;" ;\";obj$(cn,2) case 10 'groupbox text is offset #1.gb "place ";obj(cn,1)+5;" ";obj(cn,2)+ch/1.33-ch/2;" ;\";obj$(cn,2) case else 'woa! normal left justified text #1.gb "place ";obj(cn,1)+5;" ";obj(cn,2)+ch/1.33;" ;\";obj$(cn,2) end select end if end if return [prevCode2] file$ = "test.bas" prev = 1 gosub [writeit] wait
[prevCode] file$ = "test.bas" prev = 1 gosub [writeit] return
[preview] prev = 2 file$ = "preview.bas" gosub [writeit] wait
[write] filedialog "Save .bas",projectname$;".bas",file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit] if file$<>"" then open file$ for output as #op 'the header #op "'Project ";projectname$ #op "'Created with Freeform Ultra Lite v1.2 on ";date$() #op "" #op "'Switch off mainwin debugging window" #op "nomainwin" #op "" if projectback$<>"buttonface" 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,5)=3 or obj(n,5)=4 then #op "dim ";obj$(n,3);"10)" #op "for n = 1 to 10" #op " ";obj$(n,3);"n)= str$(n)" #op "next" end if next #op "" #op "'Create controls and open window" #op "WindowWidth = ";projectw+ThemeWidth-15 #op "WindowHeight = ";(projecth+ThemeHeight+menuset*projectctrh)-15 #op "UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op "UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op "menu #1, ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op "menu #1, ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op "menu #1, ";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,5) case 1 'statictext #op "statictext #1.";obj$(n,1);" ";chr$(34);trim$(obj$(n,2));chr$(34);",";obj(n,1);",";obj(n,2)+5;",";obj(n,3);",";obj(n,4) case 2 'textbox if obj$(n,5)<>"" then #op "TextboxColor$=";chr$(34);obj$(n,5);chr$(34) #op "textbox #1.";obj$(n,1);",";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 3 'list box if obj$(n,5)<>"" then #op "ListboxColor$=";chr$(34);obj$(n,5);chr$(34) #op "listbox #1.";obj$(n,1);",";obj$(n,3);",[";obj$(n,1);"click],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 4 'combobox if obj$(n,5)<>"" then #op "ComboboxColor$=";chr$(34);obj$(n,5);chr$(34) #op "combobox #1.";obj$(n,1);",";obj$(n,3);",[";obj$(n,1);"click],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 5 'button #op "button #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",[";obj$(n,1);"click], UL, ";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 6 'bmpbutton #op "bmpbutton #1.";obj$(n,1);",";chr$(34);obj$(n,3);chr$(34);",[";obj$(n,1);"click], UL, ";obj(n,1);",";obj(n,2) case 7 'graphicbox #op "graphicbox #1.";obj$(n,1);",";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 8 'radiobutton #op "radiobutton #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",[radio],[radio],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 9 'checkbox #op "checkbox #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",[check],[check],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 10 'group box #op "groupbox #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",";obj(n,1);",";obj(n,2)-5;",";obj(n,3);",";obj(n,4) case 11 if obj$(n,5)<>"" then #op "TexteditorColor$=";chr$(34);obj$(n,5);chr$(34) #op "texteditor #1.";obj$(n,1);",";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) end select next #op "open ";chr$(34);projectname$;chr$(34);" for ";winType$;" as #1" #op "#1 ";chr$(34);"trapclose [quit]";chr$(34) #op "" #op "'apply any control specific fonts" for n= 1 to obj if obj(n,5)<>0 and obj$(n,4)<>"" then if obj(n,5)=1 or obj(n,5)=2 or obj(n,5)=5 or obj(n,5)=10 or obj(n,5)=11 then #op "#1.";obj$(n,1);" ";chr$(34);"!font ";obj$(n,4);chr$(34) end if if obj(n,5)=3 or obj(n,5)=4 or obj(n,5)=7 or obj(n,5)=8 or obj(n,5)=9 then #op "#1.";obj$(n,1);" ";chr$(34);"font ";obj$(n,4);chr$(34) end if end if next #op "wait" #op "" #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,5) case 3 'listbox #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 4 'combobox #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 5 'button #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 6 'bmpbutton #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 8 'radiobutton if radio=0 then #op "[radio]" #op "'Your handler code here" #op "wait" #op "" radio=1 end if case 9 'checkbox if check=0 then #op "[check]" #op "'Your handler code here" #op "wait" #op "" check=1 end if end select next #op "[quit]" #op "close #1" #op "end" close #op if prev = 2 then prev = 0 : goto [jump] if prev =1 then prev = 0 : run chr$(34);"c:\program files (x86)\liberty basic 4.5.1\liberty.exe";chr$(34);" ";DefaultDir$;"\";file$ : return if prev =0 then return [jump] 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)\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$ end if [done] end if open DefaultDir$;"\test.bas" for output as #copyfunction close #copyfunction call copyFunction #1.fastfunctionsList "!JB Functions" [donePrev] return
[saveas] filedialog "Save As...",projectname$;".ffu",file$ if file$<>"" then open file$ for output as #op file$=right$(file$,len(file$)-len(DefaultDir$)-1) projectname$=left$(file$,len(file$)-4) #op projectname$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth #op gridcolor$ #op bordercolor$ #op crosshair$ '#op grid for n=1 to obj if obj(n,5)<>0 then #op obj(n,1);","; #op obj(n,2);","; #op obj(n,3);","; #op obj(n,4);","; #op obj(n,5);","; #op obj(n,6) #op obj$(n,1) #op obj$(n,2) #op obj$(n,3) #op obj$(n,4) #op obj$(n,5) end if next close #op end if return
[load] filedialog "Open Project...","*.ffu",filename$ [loadit] if filename$<>"" then open filename$ for input as #ses input #ses, projectname$ #2.tbproj projectname$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #1.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ input #ses, gc$ input #ses, bordercolor$ input #ses, crosshair$ projectctrh=val(c$) projectgrid=val(g$) gridcolor$ = gc$ grid=projectgrid projectw=val(w$) projecth=val(h$) #1.grid "select ";grid if grid = 1 then #1.st1 grid-1 else #1.st1 grid #1.w "select ";projectw #1.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,1)=val(word$(l$,1,",")) obj(obj,2)=val(word$(l$,2,",")) obj(obj,3)=val(word$(l$,3,",")) obj(obj,4)=val(word$(l$,4,",")) obj(obj,5)=val(word$(l$,5,",")) obj(obj,6)=val(word$(l$,6,",")) line input #ses, obj$(obj,1) line input #ses, obj$(obj,2) line input #ses, obj$(obj,3) line input #ses, obj$(obj,4) line input #ses, obj$(obj,5) if obj(obj,5)=6 then loadbmp obj$(obj,1),obj$(obj,3) if obj(obj,5)=12 then menuset=1 wend close #ses end if return
[new] redim obj(100,6) 'x,y,width/height,type,textheight redim obj$(100,6) 'name,text content,resource,font obj=0 menuset=0 projectback$="white" projectfore$="black" projectname$="Untitled" #2.tbproj projectname$ return
[resize] #1.tool "select Add New" #1.form "select File" #1.grid "select Set Grid" #1.font "select Set Font" #1.w "select ";projectw #1.h "select ";projecth #1.color "select Set Color" #1.windowtype "!Window Type" #1.fastfunctionsList "!JB Functions" #1.userfunctionsList "!My Functions" gosub [drawall] wait
[formsize] #1.w "contents? w$" #1.h "contents? h$" w=val(w$)'+45 h=val(h$)'+50 if w=0 or h=0 or (w=projectw and h=projecth) then wait projectw=w projecth=h insertx=grid inserty=grid gosub [drawgrid] #1.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid according to user choice, default is 5 #1.grid "contents? g$" if g$ = "Crosshair" then crosshair$ = g$ goto [string] end if if g$ = "noCrosshair" then crosshair$ = g$ goto [string] end if grid=val(g$) [string] gosub [drawgrid] gosub [drawall] if grid >1 then #1.st1 grid else #1.st1 grid - 1 #1.gb "setfocus" wait
[drawgrid] if grid = 0 then grid = 1 insertx=int((insertx+(grid/2))/grid)*grid inserty=int((inserty+(grid/2))/grid)*grid projectgrid=grid #1.gb "cls; fill ";projectback$ #1.gb "place 0 0 ; color ";projectfore$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth if grid<3 then [nogrid] #1.gb "color ";gridcolor$ if grid > 2 then y=0 ' Grid - Draw vertical lines #1.gb "size 1" for x = 0 to projectw step grid print #1.gb, "line "; x; " "; startX; " "; x; " "; projecth next x 'Grid - Draw horizontal lines for y = 0 to projecth step grid #1.gb, "line "; startX; " "; y; " "; projectw; " "; y next y end if [nogrid] if bordercolor$ = "" then bordercolor$ = gridcolor$ #1.gb "color ";bordercolor$ 'draw crosshairs for easier line up of controls when grid = 0 if crosshair$ = "Crosshair" then #1.gb "color ";bordercolor$ #1.gb "line "; projectw/2; " "; startX; " "; projectw/2; " "; projecth #1.gb "line "; startX; " "; projecth/2; " "; projectw; " "; projecth/2 end if #1.gb "place 0 0" #1.gb "box ";projectw;" ";projecth #1.gb "flush bak" #1.grid "select Set Grid" return
[windowType] #1.windowtype "contents? winType$" wait
[font] #1.font "contents? f$" if f$="Proj Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #1.gb "font ";projectfont$ #1.gb "place 100 100 ;\Q\Q" #1.gb "posxy x y" projectctrh=(y-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Ctrl Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #1.gb "font ";ctrf$ #1.gb "place 100 100 ;\Q\Q" #1.gb "posxy x y" ctrh=(y-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 #1.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="Ctrl Reset" 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 #1.gb "font ";ctrf$ obj(selected,4)=ctrh #1.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #1.font "select Set Font" gosub [drawall] #1.gb "setfocus" wait
[color] #1.color "contents? c$" select case c$ case "Ctrl Back" gosub [colorpick] if cp$<>"" then ctrc$=cp$ if selected then if obj(selected,5)=2 or obj(selected,5)=3 or obj(selected,5)=4 or obj(selected,5)=11 then obj$(selected,5)=ctrc$ end if case "ResetBack" ctrc$=projectback$ if selected then obj$(selected,5)="" case "Proj Back" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Proj Fore" gosub [colorpick] if cp$<>"" then projectfore$=cp$ case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] case "Grid Border" gosub [colorpick] if cp$<>"" then bordercolor$=cp$ gosub [drawgrid] end select #1.color "select Set Color" gosub [drawall] #1.gb "setfocus" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #3.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #3 #3 "font Consolas 9" #3 "trapclose [quit3]" #3.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white" c=1 for y=1 to 160 step 40 for x= 1 to 160 step 40 #3.gb "backcolor ";word$(cl$,c);" ; place ";x;" ";y;" ; boxfilled ";x+40;" ";y+40 c=c+1 if c>15 then c=15 next next #3.gb "when leftButtonDown [pick]" wait
[pick] x=int(MouseX/40) y=int(MouseY/40) c=x+y*4+1 cp$=word$(cl$,c)
[quit3] if c$="" then c$=oc$ close #3 return
[help] loadbmp "h","helpme.bmp" #1.gb "drawbmp h 0 0 " wait
[quit2] 'prevent properties window closing by user 'playwave "beep" #1.gb "setfocus" wait
[quit] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectname$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth #ses gridcolor$ #ses bordercolor$ #ses crosshair$ for n=1 to obj if obj(n,5)<>0 then #ses obj(n,1);","; #ses obj(n,2);","; #ses obj(n,3);","; #ses obj(n,4);","; #ses obj(n,5);","; #ses obj(n,6) #ses obj$(n,1) #ses obj$(n,2) #ses obj$(n,3) #ses obj$(n,4) #ses obj$(n,5) end if next close #ses close #2 close #1 end
sub copyFunction x = 0 dim codeLine$(500) if fileExists(upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions", fastfuncs$) then open upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions\";fastfuncs$ for input as #fastfunc open DefaultDir$;"\preview.bas" for append as #copyfunction #copyfunction "" while eof(#fastfunc) = 0 line input #fastfunc, codeLine$(x) line$ = codeLine$(x) if x < 6 then [skipme] #copyfunction line$ copiedText$ = copiedText$+chr$(13)+line$ '#1.textHid line$ [skipme] x = x + 1 wend close #fastfunc close #copyfunction end if end sub
sub getfastfunctions dim folderInfo$(1, 1) dim fastfunctionsList$(10) files upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions", folderInfo$() numFiles = val(folderInfo$(0, 0)) redim fastfunctionsList$(numFiles+1) 'fastfunctionsList$(numFiles+1) = "Add Function" for x = 1 to numFiles filenam$ = folderInfo$(x, 0) if right$(filenam$, 3) <> "txt" then [skip] if filenam$ = "readme.txt" then [skip] fastfunctionsList$(x) = left$(filenam$, len(filenam$) - 4) [skip] next x sort fastfunctionsList$(), 0 ,numFiles #1.fastfunctionsList, "reload" end sub
sub fastfunctionSelected fastfunctionsList$ #1.fastfunctionsList, "selection? fastfuncs$" fastfuncs$ = fastfuncs$;".txt" open upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions";"\";fastfuncs$ for input as #copyText open "test.bas" for append as #test #test " " while eof(#copyText) = 0 line input #copyText, line$ 'codeLine$(x) 'line$ = codeLine$(x) if x < 6 then [skipme] #test line$ [skipme] x = x + 1 wend close #copyText close #test end sub
'get users homepath = aka %userprofile% = "c:\users\xxxxx" (5 characters long normally Win 10) sub getUserPath run "cmd.exe /c echo %userprofile% >UserHomePath.txt", HIDE do scan loop until fileExists(DefaultDir$, "UserHomePath.txt") open "UserHomePath.txt" for input as #1 upath$ = input$(#1, lof(#1)) close #1 if upath$ = "" then notice "Sorry, can't find user path " : end kill DefaultDir$;"\UserHomePath.txt" end sub
function GetFilename$(fName$) i = len(fName$) while mid$(fName$, i, 1) <> "\" and mid$(fName$, i, 1) <> "" i = i-1 wend GetFilename$ = mid$(fName$, i+1) end function
'Verify file existence function function fileExists(path$, name$) dim fileExistsInfo$(0,0) files path$, name$, fileExistsInfo$() fileExists = val(fileExistsInfo$(0, 0)) 'non zero is true end function
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
xxgeek it's a very good job Bravo. I tried it and the only problem is that my screen doesn't have "1440" resolution. So I slimmed it down a bit to fit my screen. Also even though I have JUST BASIC installed it doesn't load Fanctions. ¨"FFFanctions"
Very good job
Gaslouk.
|
|
|
Post by Rod on May 3, 2023 12:17:49 GMT -5
I am working on importing .bas files. It causes a number of problems. First off is that there may be more than one form in a .bas. Second is that any use of variables to define controls makes importing uber complex.
I now have properties showing the file.ext name, the window type, the form #xxx name, the control .xxx name and any text or resource associated with the control.
So I can now import any .bas file and then open any particular form within that. I have not tackled font and color yet but I can at least import and amend control position and size. The next hurdle is to export these changes leaving the bulk of the .bas unchanged.
I am currently trying to get the window size and control placement more precise. Windows does not line up the controls well. Statictext for example needs tweaked to appear where you expect. So I need to work through that, so too window size surrounding the client area depending on window type.
Once I have export working reasonably well I will post a new version.
I am thinking that I need to rename fful to something like GUIMaster or similar because we have moved on a bit from Freeform and it serves a purpose.
|
|
|
Post by xxgeek on May 3, 2023 13:06:43 GMT -5
gaslouk I commented 2 lines to prevent the JB functions getting in the way. Find 'call getUserPath - on the second line of the code (uncomment) Find 'call getfastfunctions - in the block of code that opens window #1, near the end of the block, before "wait" - uncomment That should allow the JB functions to appear in the list. Presently, you can choose 1 function, then "Preview - Form" and that code will appear in the JB IDE part that opens, but not in the Preview - Code if pressed. I am still working on an option to select multiple functions, and will also be adding an option for the user to select a folder of their own containing functions to populate the "My Functions" list for users to add multiple functions from their own saved functions/subs. RodI have faith in you Rod. If it can be done, you will get it done.
|
|
gaslouk
Full Member
Hi from beautiful Greece.
Posts: 130
|
Post by gaslouk on May 3, 2023 13:08:08 GMT -5
I am working on importing .bas files. It causes a number of problems. First off is that there may be more than one form in a .bas. Second is that any use of variables to define controls makes importing uber complex. I now have properties showing the file.ext name, the window type, the form #xxx name, the control .xxx name and any text or resource associated with the control. So I can now import any .bas file and then open any particular form within that. I have not tackled font and color yet but I can at least import and amend control position and size. The next hurdle is to export these changes leaving the bulk of the .bas unchanged. I am currently trying to get the window size and control placement more precise. Windows does not line up the controls well. Statictext for example needs tweaked to appear where you expect. So I need to work through that, so too window size surrounding the client area depending on window type. Once I have export working reasonably well I will post a new version. I am thinking that I need to rename fful to something like GUIMaster or similar because we have moved on a bit from Freeform and it serves a purpose. I'm waiting for the new version. Well done Rod.
|
|
gaslouk
Full Member
Hi from beautiful Greece.
Posts: 130
|
Post by gaslouk on May 3, 2023 13:25:18 GMT -5
gaslouk I commented 2 lines to prevent the JB functions getting in the way. Find 'call getUserPath - on the second line of the code (uncomment) Find 'call getfastfunctions - in the block of code that opens window #1, near the end of the block, before "wait" - uncomment That should allow the JB functions to appear in the list. Presently, you can choose 1 function, then "Preview - Form" and that code will appear in the JB IDE part that opens, but not in the Preview - Code if pressed. I am still working on an option to select multiple functions, and will also be adding an option for the user to select a folder of their own containing functions to populate the "My Functions" list for users to add multiple functions from their own saved functions/subs. Rod I have faith in you Rod. If it can be done, you will get it done. What is the "Reso" ?
|
|
|
Post by xxgeek on May 3, 2023 15:57:55 GMT -5
A quote from Rod's reply in JB forum.
"The Reso property is a place to name any resource used by the control. That will be the array$( or the .bmp file name."
|
|
|
Post by xxgeek on May 4, 2023 12:14:27 GMT -5
gasloukJust read this part "I tried it and the only problem is that my screen doesn't have "1440" resolution" Realized I posted the wrong file lol - 1440 res was just an experiment Try this code. Still a work in progress, but everything should work besides the "My Functions" Preview buttons - Code -shows only the window code. - Form shows the form, and the code behind it, including the function selected.(as of right now just 1 function can be selected) 'freeform ultra lite v1.1 by rodbird@hotmail 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1 '16/04/2023 'added xor drawing to reduce flicker '18/04/2023 'added insertion point code and .exe identification code '19/04/2023 'fixed insertion point code to show insert arrow always 'made insert arrow move automatically when controls added 'insert arrow stays where placed or moves with addition of control 'fixed ctrlV to move insert arrow on similar basis 'made insert arrow follow grid size changes and relocate automatically 'fixed line color for statictext, groupbox etc 'stopped bmpbutton from being resized it never goes green now 'amended select for expanding control, now bottom right quadrant selects expand 'all resource files are pathless, so expected to be in working directory '20/04/2023 'fixed ffufile name loaded error 'amended startup and lastsession.ffu is now loaded using Restore option 'added color management '21/04/2023 'fixed font menu, fonts ! now applied correctly 'font changes applied immediately to selected controls 'single line text controls adjust for font width and height 'fixed color dialog, made it modal and sorted return value if cancelled 'implemented the preview button idea. write is now essentially save as for .ffu/.bas 'preview always writes to preview.bas 'put more project info on the unselected properties pop up 'change the project name in properties.
global addfastfunction, funcs$, fastfuncs$, upath$', copiedText$', filename$ call getUserPath 'jbPath$ = "c:\Program Files (x86)\Just Basic v2.0\jbasic.exe" 'jbPath$ = "c:\Program Files (x86)\Liberty Basic Pro v4.5.1\lbpro.exe" dim windowTypes$(23) windowTypes$(1)= "dialog":windowTypes$(2)= "dialog_fs":windowTypes$(3)= "dialog_nf":windowTypes$(4)= "dialog_nf_fs" windowTypes$(5)= "dialog_modal":windowTypes$(6)= "dialog_popup":windowTypes$(7)= "" windowTypes$(8)= " ":windowTypes$(9)= "graphics":windowTypes$(10)= "graphics_fs":windowTypes$(11) = "graphics_nf":windowTypes$(12)= "graphics_nsb":windowTypes$(13)= "graphics_nsb_nf" windowTypes$(14)= " ":windowTypes$(15)= "text":windowTypes$(16)= "text_fs":windowTypes$(17)= "text_nsb":windowTypes$(18)= "text_nsb_ins" windowTypes$(19)= " ":windowTypes$(20)= "window":windowTypes$(21)= "window_nf":windowTypes$(22)= "window_popup" nomainwin dim info$(10,10) dim form$(10)
form$(1)="Last Form" form$(2)="New Form" form$(3)="Load Form" form$(4)="Save Form" form$(5)="--------------" form$(6)="Edit Code" form$(7)="Save Code" form$(8)="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 grid$(20) g=3 grid$(0)="0" grid$(1)="3" for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Crosshair" crosshair$ = "Crosshair" grid$(g+1)="noCrosshair" grid$(g+2)="Set Grid" grid=10 projectctrh=25 ctrh=25 dim color$(10) color$(1)="Ctrl Back" color$(2)="ResetBack" color$(3)="Proj Back" color$(4)="Proj Fore" color$(5)="Grid Color" color$(6)="Grid Border" color$(7)="Set Color" projectback$="white" projectfore$="black" ctrc$="white" dim font$(10) font$(1)="Ctrl Font" font$(2)="Ctrl Reset" font$(3)="Proj Font" font$(4)="Set Font"'default is Consolas 9" dim v$(100) for n= 1 to 20 v$(n)=str$(n*100) next dim obj(100,6) 'x,y,width/height,type,textheight dim obj$(100,6) 'name,text content,resource,font,backcolor,forecolor obj=0 projectname$="Untitled" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projectctrh=25 projectgrid=10 projectw=600 projecth=500 insertx=grid inserty=grid*2 obj=0
'find out what our pc's client area restrictions are 'first of find out how much space the 'windows theme takes for frame and title WindowWidth=200 WindowHeight=200 open "Measuring" for graphics as #1 #1 "home ; down ; posxy x y" ThemeWidth=WindowWidth-2*x-2 ThemeHeight=WindowHeight-2*y-2 close #1
'open a small properties window and hide it WindowWidth=230 WindowHeight=200 UpperLeftX=((DisplayWidth/2))+130 UpperLeftY=((DisplayHeight/2)) statictext #2.st1 "Proj",5,10,30,25 textbox #2.tbproj,45,5,150,25 statictext #2.st2 "Ctrl",5,32,30,25 textbox #2.tbname,45,27,150,25 statictext #2.st3 "Text",5,54,30,25 textbox #2.tbtext,45,49,150,25 statictext #2.st4 "Reso",5,76,30,25 textbox #2.tbreso,45,71,150,25 statictext #2.st5 "xywh",5,98,30,25 textbox #2.tbxywh,45,93,150,25 statictext #2.st6 "Font",5,120,30,25 textbox #2.tbfont,45,115,150,25 statictext #2.st7 "Colo",5,142,30,25 textbox #2.tbcolo,45,137,150,25
open "Properties" for window_nf as #2 #2 "font Consolas 9" #2 "trapclose [quit2]" #2.tbproj projectname$ #2.tbxywh "!disable" #2.tbfont "!disable" #2.tbcolo "!disable" #2.tbxywh projectw;"x";projecth #2.tbfont projectfont$ #2.tbcolo projectfore$;"/";projectback$;"/";ctrc$ #2 "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=905+ThemeWidth+33 WindowHeight=615+ThemeHeight+45 'gb is offset by 25 345 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 BackgroundColor$ = "lightgray" combobox #1.form,form$(,[form],5,8,120,35 combobox #1.tool,tool$(,[tool],130,8,120,35 button #1.project,"&Code",[prevCode2],UL,255,1,70,39 button #1.project2,"&Form",[preview],UL,330,1,70,39 combobox #1.w,v$(,[formsize],405,8,90,35 combobox #1.h,v$(,[formsize],495,8,90,35 combobox #1.grid,grid$(,[grid],590,8,100,35 statictext #1.st1 str$(grid),698,12,20,20 combobox #1.color,color$(,[color],725,8,110,35 combobox #1.font,font$(,[font],840, 8,110,35 combobox #1.fastfunctionsList, fastfunctionsList$(), fastfunctionSelected , 955, 8, 155, 35 combobox #1.userfunctionsList, userfunctionsList$(), userfunctionSelected , 1115, 8, 155, 35 combobox #1.windowtype,windowTypes$(,[windowType], 1275 , 8, 160, 35 button #1.help,"&Help",[help],UL,1440,8,60,30 graphicbox #1.gb,5,43,945,625 open "FFU+vXX1.4-beta Controls PREVIEW Form Dimensions Grid Size Colors Fonts" for window as #1 #1 "trapclose [quit]" #1 "font Consolas 12" #1 "resizehandler [resize]" #1.tool "select Add New" #1.form "select File" #1.grid "select Set Grid" #1.color "select Set Color" #1.font "select Set Font" #1.w "select ";projectw #1.h "select ";projecth #1.gb "autoresize" #1.gb "vertscrollbar on 0 ";projectw #1.gb "horizscrollbar on 0 ";projecth #1.gb "font ";projectfont$ #1.gb "down fill lightgray" gridcolor$ = BackgroundColor$ bordercolor$ =gridcolor$ gosub [drawgrid] gosub [drawall] #1.gb "when rightButtonDown [show]" #1.gb "when leftButtonDown [select]" #1.gb "when characterInput [keys]" #1.gb "setfocus" #2 "show" show=1 winType$ = "window" #1.windowtype "!Window Type" #1.fastfunctionsList "!JB Functions" #1.userfunctionsList "!My Functions" #1.windowtype "reload" call getfastfunctions wait
[show] if show then #2.tbproj "!contents? t$" projectname$=t$ #2 "hide" show=0 else #2 "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] if show then #2 "hide" show=0 #2.tbproj "!contents? t$" projectname$=t$ end if x=MouseX y=MouseY 'before we move on update the currently selected control from properties 'only get the editable contents #2.tbname "!contents? t$" : obj$(selected,1)=lower$(t$) #2.tbtext "!contents? t$" : obj$(selected,2)=t$ #2.tbreso "!contents? t$" : obj$(selected,3)=lower$(t$) 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if x>obj(cn,1) and x<(obj(cn,1)+obj(cn,3)) and y>obj(cn,2) and y<(obj(cn,2)+obj(cn,4)) then if x>obj(cn,1)+obj(cn,3)/1.4 and y>obj(cn,2)+obj(cn,4)/1.4 then action=2 if obj(cn,5)=6 then action=1 selected=cn exit for end if next if selected=0 then #2.tbname "" #2.tbtext "" #2.tbreso "" #2.tbxywh projectw;"x";projecth #2.tbfont projectfont$ #2.tbcolo projectfore$;"/";projectback$;"/";ctrc$ action=0 end if if selected>0 and action=1 then #1.gb "when leftButtonMove [track]" #1.gb "when leftButtonUp [stop]" offsetX=x-obj(selected,1) offsetY=y-obj(selected,2) end if if selected>0 and obj(selected,5)<>6 and action=2 then 'dont resize bmp #1.gb "when leftButtonMove [tracksize]" #1.gb "when leftButtonUp [stopsize]" offsetX=x-(obj(selected,1)+obj(selected,3)) offsetY=y-(obj(selected,2)+obj(selected,4)) end if if selected>0 then gosub [drawit] else insertx=int((x+(grid/2))/grid)*grid inserty=int((y+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #1.gb "rule ";_R2_NOTXORPEN '#1.gb "rule xor" gosub [drawit] x=int((MouseX-offsetX+(grid/2))/grid)*grid obj(selected,1)=x y=int((MouseY-offsetY+(grid/2))/grid)*grid obj(selected,2)=y gosub [drawit] wait
[stop] #1.gb "when leftButtonMove" #1.gb "when leftButtonUp" action=0 #1.gb "rule over" gosub [drawall] wait
[tracksize] '#1.gb "rule xor" #1.gb "rule "; _R2_NOTXORPEN
gosub [drawit] x=int((MouseX-offsetX+(grid/2))/grid)*grid y=int((MouseY-offsetY+(grid/2))/grid)*grid obj(selected,3)=x-obj(selected,1)'width obj(selected,4)=y-obj(selected,2)'height gosub [drawit] wait
[stopsize] #1.gb "when leftButtonMove" #1.gb "when leftButtonUp" action=0 #1.gb "rule _R2_NOTXORPEN" '#1.gb "rule xor" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,5)=12 then menuset=0 obj(selected,5)=0 #2.tbname "" #2.tbtext "" #2.tbreso "" #2.tbxywh "" #2.tbfont "" #2.tbcolo "" selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,1) 'x cpy(2)=obj(selected,2) 'y cpy(3)=obj(selected,3) 'w cpy(4)=obj(selected,4) 'h cpy(5)=obj(selected,5) 'type cpy(6)=obj(selected,6) 'textheight cpy$(1)=obj$(selected,1)'name cpy$(2)=obj$(selected,2)'text content cpy$(3)=obj$(selected,3)'resource array or file path cpy$(4)=obj$(selected,4)'ctrl specific font or "" cpy$(5)=obj$(selected,5)'ctrl specific backcolor or "" end if if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty inserty=inserty+cpy(4)+grid obj(obj,3)=cpy(3) obj(obj,4)=cpy(4) obj(obj,5)=cpy(5) obj(obj,6)=cpy(6) obj$(obj,1)=left$(cpy$(1),2);obj obj$(obj,2)=cpy$(2) obj$(obj,3)=cpy$(3) if obj(obj,5)=6 then loadbmp obj$(obj,1),obj$(obj,3) obj$(obj,4)=cpy$(4) obj$(obj,5)=cpy$(5) selected=obj gosub [drawall] end if end if #1.gb "setfocus" wait
[tool] #1.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=150 obj(obj,4)=ctrh obj(obj,5)=1 obj$(obj,1)="st";obj obj$(obj,2)="I am statictext " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 2 'textbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=200 obj(obj,4)=ctrh obj(obj,5)=2 obj$(obj,1)="tb";obj obj$(obj,2)="I am a textbox " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 3 'listbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=200 obj(obj,4)=ctrh*5 obj(obj,5)=3 obj$(obj,1)="lb";obj obj$(obj,2)="Listbox\item2\item3\item4\item5" obj$(obj,3)=obj$(obj,1);"$(" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 4 'combobox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=120 obj(obj,4)=ctrh obj(obj,5)=4 obj$(obj,1)="cb";obj obj$(obj,2)="Combobox\item2\item3\item4\item5" obj$(obj,3)=obj$(obj,1);"$(" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 5 'button obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=100 obj(obj,4)=ctrh obj(obj,5)=5 obj$(obj,1)="bt";obj obj$(obj,2)="Button? " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 6 'bmp button obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=50 obj(obj,4)=50 obj(obj,5)=6 obj$(obj,1)="bb";obj filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,3)=value(mid$(bmp$,19,4))'width obj(obj,4)=value(mid$(bmp$,23,4))'height obj$(obj,3)=file$ obj$(obj,2)="bmp" loadbmp obj$(obj,1),file$ close #bmp inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid else obj(obj,5)=0 close #bmp end if else obj(obj,5)=0 end if
case 7 'graphicbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=160 obj(obj,4)=100 obj(obj,5)=7 obj$(obj,1)="gb";obj obj$(obj,2)="I am a graphicbox " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 8 'radiobutton obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=125 obj(obj,4)=ctrh obj(obj,5)=8 obj$(obj,1)="rb";obj obj$(obj,2)="(o) radio?" obj$(obj,3)="" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 9 'checkbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=125 obj(obj,4)=ctrh obj(obj,5)=9 obj$(obj,1)="ch";obj obj$(obj,2)="[x] check?" obj$(obj,3)="" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 10 'groupbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=100 obj(obj,4)=100 obj(obj,5)=10 obj$(obj,1)="gr";obj obj$(obj,2)="Group Box? " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 11 'texteditor obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=200 obj(obj,4)=100 obj(obj,5)=11 obj$(obj,1)="te";obj obj$(obj,2)="I am texteditor " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,1)=0 obj(obj,2)=0 obj(obj,3)=100 obj(obj,4)=10 obj(obj,5)=12 obj$(obj,1)="mn";obj obj$(obj,2)=" Menu Added" menuset=1 end if end select selected=obj gosub [drawall] #1.tool "select Add New" #1.gb "setfocus" wait
[form] #1.form "selectionindex? i" select case i case 1 'Last Form filename$="lastsession.ffu" gosub [loadit] case 2 'new form gosub [new] case 3 ''load form gosub [load] case 4 'save form gosub [saveas] case 6 'edit code gosub [prevCode] case 7 'save code gosub [write] end select #1.form "select File" gosub [drawall] #1.gb "setfocus" wait
[drawall] #1.gb "discard ; redraw bak" ocn=cn for cn=1 to obj gosub [drawit] next cn=ocn
if grid <>1 then #1.gb "color black " #1.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";grid #1.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";grid #1.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";grid*2 else #1.gb "place ";insertx-8;" ";inserty+3 #1.gb "color black " #1.gb "\>" end if #1.gb "setfocus" return
[drawit] 'redraws control cn if obj(cn,5)=0 then return 'if this is a menu pin to top left to stop it being move or resized if obj(cn,5)=12 then obj(cn,1)=10 : obj(cn,2)=-10 : obj(cn,3)=100 : obj(cn,4)=10 'if there is a special font for the object in obj$(n,4) change 'the font and height stored in obj(n,6) or set to default if obj$(cn,4)="" then #1.gb "font ";projectfont$ ch=projectctrh if obj(cn,4)<ch then obj(cn,4)=ch else #1.gb "font ";obj$(cn,4) ch=obj(cn,6) if obj(cn,4)<ch then obj(cn,4)=ch end if 'update the properties textboxes for selected control if cn=selected then #2.tbname obj$(cn,1) 'name #2.tbtext obj$(cn,2) 'text #2.tbreso obj$(cn,3) 'resource #2.tbxywh obj(cn,1);" ";obj(cn,2);" ";obj(cn,3);" ";obj(cn,4) 'xywh if obj$(cn,4)="" then #2.tbfont projectfont$;":";obj(cn,6) else #2.tbfont obj$(cn,4);":";obj(cn,6) 'font and height if obj$(cn,5)="" then #2.tbcolo projectback$ else #2.tbcolo obj$(cn,5) end if 'set the color for the drawn object and action taking place if cn=selected then '#1.gb "color red" 'action 1 or 2 #1.gb "color darkred" 'action 1 or 2 if action=2 then #1.gb "color darkgreen" else #1.gb "color ";projectfore$ end if 'if it is a statictext, checkbox radiobox, groupbox or menu make background color transparent if obj(cn,5)=1 or obj(cn,5)=8 or obj(cn,5)=9 or obj(cn,5)=10 or obj(cn,5)=12 then #1.gb "backcolor ";projectback$ if selected<>cn then #1.gb "color 192 192 192" else if obj$(cn,5)<>"" then #1.gb "backcolor ";obj$(cn,5) else #1.gb "backcolor ";projectback$ end if 'now draw the object at desired location #1.gb "place ";obj(cn,1);" ";obj(cn,2) 'if it is a bmp draw actual bmp if it is stationary else just the outline if obj(cn,5)=6 then if action=0 then #1.gb "drawbmp ";obj$(cn,1) #1.gb "box ";obj(cn,1)+obj(cn,3);" ";obj(cn,2)+obj(cn,4) else 'draw outline if it is a groupbox else all others filled if obj(cn,5)=10 then #1.gb "box ";obj(cn,1)+obj(cn,3);" ";obj(cn,2)+obj(cn,4) else #1.gb "boxfilled ";obj(cn,1)+obj(cn,3);" ";obj(cn,2)+obj(cn,4) end if 'if we are stationary draw the text in the correct color if action=0 then if cn=selected then #1.gb "color darkred" 'action 1 or 2 if action=2 then #1.gb "color darkgreen" else #1.gb "color ";projectfore$ end if select case obj(cn,5) case 5 'centre button text #1.gb "stringwidth? ";"A";" width" xp=(obj(cn,3)-width*len(obj$(cn,2)))/2 #1.gb "place ";obj(cn,1)+xp;" ";obj(cn,2)+ch/1.33;" ;\";obj$(cn,2) case 10 'groupbox text is offset #1.gb "place ";obj(cn,1)+5;" ";obj(cn,2)+ch/1.33-ch/2;" ;\";obj$(cn,2) case else 'woa! normal left justified text #1.gb "place ";obj(cn,1)+5;" ";obj(cn,2)+ch/1.33;" ;\";obj$(cn,2) end select end if end if return
[prevCode2] file$ = "test.bas" prev = 1 gosub [writeit] wait
[prevCode] file$ = "test.bas" prev = 1 gosub [writeit] return
[preview] prev = 2 file$ = "preview.bas" gosub [writeit] wait
[write] filedialog "Save .bas",projectname$;".bas",file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit] if file$<>"" then open file$ for output as #op 'the header #op "'Project ";projectname$ #op "'Created with Freeform Ultra Lite v1.2 on ";date$();" at ";time$() #op "" #op "'Switch off mainwin debugging window" #op "nomainwin" #op "" if fastfuncs$ ="FolderDialog.txt" or fastfuncs$ = "fileExistst.txt" then #op "Dim info$(10,10)" if projectback$<>"buttonface" 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,5)=3 or obj(n,5)=4 then #op "dim ";obj$(n,3);"10)" #op "for n = 1 to 10" #op " ";obj$(n,3);"n)= str$(n)" #op "next" end if next #op "" #op "'Create controls and open window" #op "WindowWidth = ";projectw+ThemeWidth-15 #op "WindowHeight = ";(projecth+ThemeHeight+menuset*projectctrh)-15 #op "UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op "UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op "menu #1, ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op "menu #1, ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op "menu #1, ";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,5) case 1 'statictext #op "statictext #1.";obj$(n,1);" ";chr$(34);trim$(obj$(n,2));chr$(34);",";obj(n,1);",";obj(n,2)+5;",";obj(n,3);",";obj(n,4) case 2 'textbox if obj$(n,5)<>"" then #op "TextboxColor$=";chr$(34);obj$(n,5);chr$(34) #op "textbox #1.";obj$(n,1);",";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 3 'list box if obj$(n,5)<>"" then #op "ListboxColor$=";chr$(34);obj$(n,5);chr$(34) #op "listbox #1.";obj$(n,1);",";obj$(n,3);",[";obj$(n,1);"click],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 4 'combobox if obj$(n,5)<>"" then #op "ComboboxColor$=";chr$(34);obj$(n,5);chr$(34) #op "combobox #1.";obj$(n,1);",";obj$(n,3);",[";obj$(n,1);"click],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 5 'button #op "button #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",[";obj$(n,1);"click], UL, ";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 6 'bmpbutton #op "bmpbutton #1.";obj$(n,1);",";chr$(34);obj$(n,3);chr$(34);",[";obj$(n,1);"click], UL, ";obj(n,1);",";obj(n,2) case 7 'graphicbox #op "graphicbox #1.";obj$(n,1);",";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 8 'radiobutton #op "radiobutton #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",[radio],[radio],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 9 'checkbox #op "checkbox #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",[check],[check],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 10 'group box #op "groupbox #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",";obj(n,1);",";obj(n,2)-5;",";obj(n,3);",";obj(n,4) case 11 if obj$(n,5)<>"" then #op "TexteditorColor$=";chr$(34);obj$(n,5);chr$(34) #op "texteditor #1.";obj$(n,1);",";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) end select next #op "open ";chr$(34);projectname$;chr$(34);" for ";winType$;" as #1" #op "#1 ";chr$(34);"trapclose [quit]";chr$(34) #op "" #op "'apply any control specific fonts" for n= 1 to obj if obj(n,5)<>0 and obj$(n,4)<>"" then if obj(n,5)=1 or obj(n,5)=2 or obj(n,5)=5 or obj(n,5)=10 or obj(n,5)=11 then #op "#1.";obj$(n,1);" ";chr$(34);"!font ";obj$(n,4);chr$(34) end if if obj(n,5)=3 or obj(n,5)=4 or obj(n,5)=7 or obj(n,5)=8 or obj(n,5)=9 then #op "#1.";obj$(n,1);" ";chr$(34);"font ";obj$(n,4);chr$(34) end if end if next #op "wait" #op "" #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,5) case 3 'listbox #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 4 'combobox #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 5 'button #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 6 'bmpbutton #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 8 'radiobutton if radio=0 then #op "[radio]" #op "'Your handler code here" #op "wait" #op "" radio=1 end if case 9 'checkbox if check=0 then #op "[check]" #op "'Your handler code here" #op "wait" #op "" check=1 end if end select next #op "[quit]" #op "close #1" #op "end" close #op if prev = 2 then prev = 0 : goto [jump] if prev = 1 then prev = 0 : run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" ";DefaultDir$;"\";file$ : return if prev = 0 then return [jump] files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] end if open DefaultDir$;"\test.bas" for output as #copyfunction close #copyfunction call copyFunction #1.fastfunctionsList "!JB Functions" [donePrev] return
[saveas] filedialog "Save As...",projectname$;".ffu",file$ if file$<>"" then open file$ for output as #op file$=right$(file$,len(file$)-len(DefaultDir$)-1) projectname$=left$(file$,len(file$)-4) #op projectname$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth #op gridcolor$ #op bordercolor$ #op crosshair$ '#op grid for n=1 to obj if obj(n,5)<>0 then #op obj(n,1);","; #op obj(n,2);","; #op obj(n,3);","; #op obj(n,4);","; #op obj(n,5);","; #op obj(n,6) #op obj$(n,1) #op obj$(n,2) #op obj$(n,3) #op obj$(n,4) #op obj$(n,5) end if next close #op end if return
[load] filedialog "Open Project...","*.ffu",filename$ [loadit] if filename$<>"" then open filename$ for input as #ses input #ses, projectname$ #2.tbproj projectname$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #1.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ input #ses, gc$ input #ses, bordercolor$ input #ses, crosshair$ projectctrh=val(c$) projectgrid=val(g$) gridcolor$ = gc$ grid=projectgrid projectw=val(w$) projecth=val(h$) #1.grid "select ";grid if grid = 1 then #1.st1 grid-1 else #1.st1 grid #1.w "select ";projectw #1.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,1)=val(word$(l$,1,",")) obj(obj,2)=val(word$(l$,2,",")) obj(obj,3)=val(word$(l$,3,",")) obj(obj,4)=val(word$(l$,4,",")) obj(obj,5)=val(word$(l$,5,",")) obj(obj,6)=val(word$(l$,6,",")) line input #ses, obj$(obj,1) line input #ses, obj$(obj,2) line input #ses, obj$(obj,3) line input #ses, obj$(obj,4) line input #ses, obj$(obj,5) if obj(obj,5)=6 then loadbmp obj$(obj,1),obj$(obj,3) if obj(obj,5)=12 then menuset=1 wend close #ses end if return
[new] redim obj(100,6) 'x,y,width/height,type,textheight redim obj$(100,6) 'name,text content,resource,font obj=0 menuset=0 projectback$="white" projectfore$="black" projectname$="Untitled" #2.tbproj projectname$ return
[resize] #1.tool "select Add New" #1.form "select File" #1.grid "select Set Grid" #1.font "select Set Font" #1.w "select ";projectw #1.h "select ";projecth #1.color "select Set Color" #1.windowtype "!Window Type" #1.fastfunctionsList "!JB Functions" #1.userfunctionsList "!My Functions" gosub [drawall] wait
[formsize] #1.w "contents? w$" #1.h "contents? h$" w=val(w$)'+45 h=val(h$)'+50 if w=0 or h=0 or (w=projectw and h=projecth) then wait projectw=w projecth=h insertx=grid inserty=grid gosub [drawgrid] #1.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid according to user choice, default is 5 #1.grid "contents? g$" if g$ = "Crosshair" then crosshair$ = g$ goto [string] end if if g$ = "noCrosshair" then crosshair$ = g$ goto [string] end if grid=val(g$) [string] gosub [drawgrid] gosub [drawall] if grid >1 then #1.st1 grid else #1.st1 grid - 1 #1.gb "setfocus" wait
[drawgrid] if grid = 0 then grid = 1 insertx=int((insertx+(grid/2))/grid)*grid inserty=int((inserty+(grid/2))/grid)*grid projectgrid=grid #1.gb "cls; fill ";projectback$ #1.gb "place 0 0 ; color ";projectfore$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth if grid<3 then [nogrid] #1.gb "color ";gridcolor$ if grid > 2 then y=0 ' Grid - Draw vertical lines #1.gb "size 1" for x = 0 to projectw step grid #1.gb "line "; x; " "; startX; " "; x; " "; projecth next x 'Grid - Draw horizontal lines for y = 0 to projecth step grid #1.gb "line "; startX; " "; y; " "; projectw; " "; y next y end if [nogrid] if bordercolor$ = "" then bordercolor$ = gridcolor$ #1.gb "color ";bordercolor$ '#1.gb "color ";projectback$ 'draw crosshairs for easier line up of controls when grid = 0 if crosshair$ = "Crosshair" then #1.gb "color ";bordercolor$ #1.gb "line "; projectw/2; " "; startX; " "; projectw/2; " "; projecth #1.gb "line "; startX; " "; projecth/2; " "; projectw; " "; projecth/2 end if
#1.gb "place 0 0" #1.gb "box ";projectw;" ";projecth #1.gb "flush bak" #1.grid "select Set Grid" return
[windowType] #1.windowtype "contents? winType$" wait
[font] #1.font "contents? f$" if f$="Proj Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #1.gb "font ";projectfont$ #1.gb "place 100 100 ;\Q\Q" #1.gb "posxy x y" projectctrh=(y-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Ctrl Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #1.gb "font ";ctrf$ #1.gb "place 100 100 ;\Q\Q" #1.gb "posxy x y" ctrh=(y-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 #1.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="Ctrl Reset" 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 #1.gb "font ";ctrf$ obj(selected,4)=ctrh #1.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #1.font "select Set Font" gosub [drawall] #1.gb "setfocus" wait
[color] #1.color "contents? c$" select case c$ case "Ctrl Back" gosub [colorpick] if cp$<>"" then ctrc$=cp$ if selected then if obj(selected,5)=2 or obj(selected,5)=3 or obj(selected,5)=4 or obj(selected,5)=11 then obj$(selected,5)=ctrc$ end if case "ResetBack" ctrc$=projectback$ if selected then obj$(selected,5)="" case "Proj Back" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Proj Fore" gosub [colorpick] if cp$<>"" then projectfore$=cp$ case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] case "Grid Border" gosub [colorpick] if cp$<>"" then bordercolor$=cp$ gosub [drawgrid] end select #1.color "select Set Color" gosub [drawall] #1.gb "setfocus" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #3.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #3 #3 "font Consolas 9" #3 "trapclose [quit3]" #3.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white" c=1 for y=1 to 160 step 40 for x= 1 to 160 step 40 #3.gb "backcolor ";word$(cl$,c);" ; place ";x;" ";y;" ; boxfilled ";x+40;" ";y+40 c=c+1 if c>15 then c=15 next next #3.gb "when leftButtonDown [pick]" wait
[pick] x=int(MouseX/40) y=int(MouseY/40) c=x+y*4+1 cp$=word$(cl$,c)
[quit3] if c$="" then c$=oc$ close #3 return
[help] loadbmp "h","helpme.bmp" #1.gb "drawbmp h 0 0 " wait
[quit2] 'prevent properties window closing by user 'playwave "beep" #1.gb "setfocus" wait
[quit] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectname$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth #ses gridcolor$ #ses bordercolor$ #ses crosshair$ for n=1 to obj if obj(n,5)<>0 then #ses obj(n,1);","; #ses obj(n,2);","; #ses obj(n,3);","; #ses obj(n,4);","; #ses obj(n,5);","; #ses obj(n,6) #ses obj$(n,1) #ses obj$(n,2) #ses obj$(n,3) #ses obj$(n,4) #ses obj$(n,5) end if next close #ses close #2 close #1 if fileExists(DefaultDir$, "preview.bas") then kill DefaultDir$;"\preview.bas" if fileExists(DefaultDir$, "test.bas") then kill DefaultDir$;"\test.bas" if fileExists(DefaultDir$, "untitled.bas") then kill DefaultDir$;"\untitled.bas" end
sub copyFunction x = 0 dim codeLine$(500) if fileExists(upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions", fastfuncs$) then open upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions\";fastfuncs$ for input as #fastfunc open DefaultDir$;"\preview.bas" for append as #copyfunction #copyfunction "" while eof(#fastfunc) = 0 line input #fastfunc, codeLine$(x) line$ = codeLine$(x) if x < 6 then [skipme] #copyfunction line$ copiedText$ = copiedText$+chr$(13)+line$ [skipme] x = x + 1 wend close #fastfunc close #copyfunction end if end sub
sub getfastfunctions dim folderInfo$(1, 1) dim fastfunctionsList$(10) files upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions", folderInfo$() numFiles = val(folderInfo$(0, 0)) redim fastfunctionsList$(numFiles+1) for x = 1 to numFiles filenam$ = folderInfo$(x, 0) if right$(filenam$, 3) <> "txt" then [skip] if filenam$ = "readme.txt" then [skip] fastfunctionsList$(x) = left$(filenam$, len(filenam$) - 4) [skip] next x sort fastfunctionsList$(), 0 ,numFiles #1.fastfunctionsList, "reload" end sub
sub fastfunctionSelected fastfunctionsList$ #1.fastfunctionsList, "selection? fastfuncs$" fastfuncs$ = fastfuncs$;".txt" open upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions";"\";fastfuncs$ for input as #copyText open "test.bas" for append as #test #test " " while eof(#copyText) = 0 line input #copyText, line$ if x < 6 then [skipme] #test line$ [skipme] x = x + 1 wend close #copyText close #test end sub
'get users homepath = aka %userprofile% = "c:\users\xxxxx" (5 characters long normally Win 10) sub getUserPath run "cmd.exe /c echo %userprofile% >UserHomePath.txt", HIDE do scan loop until fileExists(DefaultDir$, "UserHomePath.txt") open "UserHomePath.txt" for input as #1 upath$ = input$(#1, lof(#1)) close #1 if upath$ = "" then notice "Sorry, can't find user path " : end kill DefaultDir$;"\UserHomePath.txt" end sub
function GetFilename$(fName$) i = len(fName$) while mid$(fName$, i, 1) <> "\" and mid$(fName$, i, 1) <> "" i = i-1 wend GetFilename$ = mid$(fName$, i+1) end function
'Verify file existence function function fileExists(path$, name$) dim fileExistsInfo$(0,0) files path$, name$, fileExistsInfo$() fileExists = val(fileExistsInfo$(0, 0)) 'non zero is true end function
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function
|
|
gaslouk
Full Member
Hi from beautiful Greece.
Posts: 130
|
Post by gaslouk on May 4, 2023 12:31:13 GMT -5
gaslouk Just read this part "I tried it and the only problem is that my screen doesn't have "1440" resolution" Realized I posted the wrong file lol - 1440 res was just an experiment Try this code. Still a work in progress, but everything should work besides the "My Functions" Preview buttons - Code -shows only the window code. - Form shows the form, and the code behind it, including the function selected.(as of right now just 1 function can be selected) 'freeform ultra lite v1.1 by rodbird@hotmail 'https://libertybasiccom.proboards.com/thread/2308/freeform-ultra-lite-v1 'https://justbasiccom.proboards.com/thread/991/freeform-ultra-v1 '16/04/2023 'added xor drawing to reduce flicker '18/04/2023 'added insertion point code and .exe identification code '19/04/2023 'fixed insertion point code to show insert arrow always 'made insert arrow move automatically when controls added 'insert arrow stays where placed or moves with addition of control 'fixed ctrlV to move insert arrow on similar basis 'made insert arrow follow grid size changes and relocate automatically 'fixed line color for statictext, groupbox etc 'stopped bmpbutton from being resized it never goes green now 'amended select for expanding control, now bottom right quadrant selects expand 'all resource files are pathless, so expected to be in working directory '20/04/2023 'fixed ffufile name loaded error 'amended startup and lastsession.ffu is now loaded using Restore option 'added color management '21/04/2023 'fixed font menu, fonts ! now applied correctly 'font changes applied immediately to selected controls 'single line text controls adjust for font width and height 'fixed color dialog, made it modal and sorted return value if cancelled 'implemented the preview button idea. write is now essentially save as for .ffu/.bas 'preview always writes to preview.bas 'put more project info on the unselected properties pop up 'change the project name in properties.
global addfastfunction, funcs$, fastfuncs$, upath$', copiedText$', filename$ call getUserPath 'jbPath$ = "c:\Program Files (x86)\Just Basic v2.0\jbasic.exe" 'jbPath$ = "c:\Program Files (x86)\Liberty Basic Pro v4.5.1\lbpro.exe" dim windowTypes$(23) windowTypes$(1)= "dialog":windowTypes$(2)= "dialog_fs":windowTypes$(3)= "dialog_nf":windowTypes$(4)= "dialog_nf_fs" windowTypes$(5)= "dialog_modal":windowTypes$(6)= "dialog_popup":windowTypes$(7)= "" windowTypes$(8)= " ":windowTypes$(9)= "graphics":windowTypes$(10)= "graphics_fs":windowTypes$(11) = "graphics_nf":windowTypes$(12)= "graphics_nsb":windowTypes$(13)= "graphics_nsb_nf" windowTypes$(14)= " ":windowTypes$(15)= "text":windowTypes$(16)= "text_fs":windowTypes$(17)= "text_nsb":windowTypes$(18)= "text_nsb_ins" windowTypes$(19)= " ":windowTypes$(20)= "window":windowTypes$(21)= "window_nf":windowTypes$(22)= "window_popup" nomainwin dim info$(10,10) dim form$(10)
form$(1)="Last Form" form$(2)="New Form" form$(3)="Load Form" form$(4)="Save Form" form$(5)="--------------" form$(6)="Edit Code" form$(7)="Save Code" form$(8)="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 grid$(20) g=3 grid$(0)="0" grid$(1)="3" for n= 5 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="Crosshair" crosshair$ = "Crosshair" grid$(g+1)="noCrosshair" grid$(g+2)="Set Grid" grid=10 projectctrh=25 ctrh=25 dim color$(10) color$(1)="Ctrl Back" color$(2)="ResetBack" color$(3)="Proj Back" color$(4)="Proj Fore" color$(5)="Grid Color" color$(6)="Grid Border" color$(7)="Set Color" projectback$="white" projectfore$="black" ctrc$="white" dim font$(10) font$(1)="Ctrl Font" font$(2)="Ctrl Reset" font$(3)="Proj Font" font$(4)="Set Font"'default is Consolas 9" dim v$(100) for n= 1 to 20 v$(n)=str$(n*100) next dim obj(100,6) 'x,y,width/height,type,textheight dim obj$(100,6) 'name,text content,resource,font,backcolor,forecolor obj=0 projectname$="Untitled" projectfont$="Consolas 9" projectback$="white" projectfore$="black" projectctrh=25 projectgrid=10 projectw=600 projecth=500 insertx=grid inserty=grid*2 obj=0
'find out what our pc's client area restrictions are 'first of find out how much space the 'windows theme takes for frame and title WindowWidth=200 WindowHeight=200 open "Measuring" for graphics as #1 #1 "home ; down ; posxy x y" ThemeWidth=WindowWidth-2*x-2 ThemeHeight=WindowHeight-2*y-2 close #1
'open a small properties window and hide it WindowWidth=230 WindowHeight=200 UpperLeftX=((DisplayWidth/2))+130 UpperLeftY=((DisplayHeight/2)) statictext #2.st1 "Proj",5,10,30,25 textbox #2.tbproj,45,5,150,25 statictext #2.st2 "Ctrl",5,32,30,25 textbox #2.tbname,45,27,150,25 statictext #2.st3 "Text",5,54,30,25 textbox #2.tbtext,45,49,150,25 statictext #2.st4 "Reso",5,76,30,25 textbox #2.tbreso,45,71,150,25 statictext #2.st5 "xywh",5,98,30,25 textbox #2.tbxywh,45,93,150,25 statictext #2.st6 "Font",5,120,30,25 textbox #2.tbfont,45,115,150,25 statictext #2.st7 "Colo",5,142,30,25 textbox #2.tbcolo,45,137,150,25
open "Properties" for window_nf as #2 #2 "font Consolas 9" #2 "trapclose [quit2]" #2.tbproj projectname$ #2.tbxywh "!disable" #2.tbfont "!disable" #2.tbcolo "!disable" #2.tbxywh projectw;"x";projecth #2.tbfont projectfont$ #2.tbcolo projectfore$;"/";projectback$;"/";ctrc$ #2 "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=905+ThemeWidth+33 WindowHeight=615+ThemeHeight+45 'gb is offset by 25 345 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 BackgroundColor$ = "lightgray" combobox #1.form,form$(,[form],5,8,120,35 combobox #1.tool,tool$(,[tool],130,8,120,35 button #1.project,"&Code",[prevCode2],UL,255,1,70,39 button #1.project2,"&Form",[preview],UL,330,1,70,39 combobox #1.w,v$(,[formsize],405,8,90,35 combobox #1.h,v$(,[formsize],495,8,90,35 combobox #1.grid,grid$(,[grid],590,8,100,35 statictext #1.st1 str$(grid),698,12,20,20 combobox #1.color,color$(,[color],725,8,110,35 combobox #1.font,font$(,[font],840, 8,110,35 combobox #1.fastfunctionsList, fastfunctionsList$(), fastfunctionSelected , 955, 8, 155, 35 combobox #1.userfunctionsList, userfunctionsList$(), userfunctionSelected , 1115, 8, 155, 35 combobox #1.windowtype,windowTypes$(,[windowType], 1275 , 8, 160, 35 button #1.help,"&Help",[help],UL,1440,8,60,30 graphicbox #1.gb,5,43,945,625 open "FFU+vXX1.4-beta Controls PREVIEW Form Dimensions Grid Size Colors Fonts" for window as #1 #1 "trapclose [quit]" #1 "font Consolas 12" #1 "resizehandler [resize]" #1.tool "select Add New" #1.form "select File" #1.grid "select Set Grid" #1.color "select Set Color" #1.font "select Set Font" #1.w "select ";projectw #1.h "select ";projecth #1.gb "autoresize" #1.gb "vertscrollbar on 0 ";projectw #1.gb "horizscrollbar on 0 ";projecth #1.gb "font ";projectfont$ #1.gb "down fill lightgray" gridcolor$ = BackgroundColor$ bordercolor$ =gridcolor$ gosub [drawgrid] gosub [drawall] #1.gb "when rightButtonDown [show]" #1.gb "when leftButtonDown [select]" #1.gb "when characterInput [keys]" #1.gb "setfocus" #2 "show" show=1 winType$ = "window" #1.windowtype "!Window Type" #1.fastfunctionsList "!JB Functions" #1.userfunctionsList "!My Functions" #1.windowtype "reload" call getfastfunctions wait
[show] if show then #2.tbproj "!contents? t$" projectname$=t$ #2 "hide" show=0 else #2 "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] if show then #2 "hide" show=0 #2.tbproj "!contents? t$" projectname$=t$ end if x=MouseX y=MouseY 'before we move on update the currently selected control from properties 'only get the editable contents #2.tbname "!contents? t$" : obj$(selected,1)=lower$(t$) #2.tbtext "!contents? t$" : obj$(selected,2)=t$ #2.tbreso "!contents? t$" : obj$(selected,3)=lower$(t$) 'find the object selected selected=0 action=1 '1=move 2=expand bmps dont expand for cn=obj to 1 step -1 if x>obj(cn,1) and x<(obj(cn,1)+obj(cn,3)) and y>obj(cn,2) and y<(obj(cn,2)+obj(cn,4)) then if x>obj(cn,1)+obj(cn,3)/1.4 and y>obj(cn,2)+obj(cn,4)/1.4 then action=2 if obj(cn,5)=6 then action=1 selected=cn exit for end if next if selected=0 then #2.tbname "" #2.tbtext "" #2.tbreso "" #2.tbxywh projectw;"x";projecth #2.tbfont projectfont$ #2.tbcolo projectfore$;"/";projectback$;"/";ctrc$ action=0 end if if selected>0 and action=1 then #1.gb "when leftButtonMove [track]" #1.gb "when leftButtonUp [stop]" offsetX=x-obj(selected,1) offsetY=y-obj(selected,2) end if if selected>0 and obj(selected,5)<>6 and action=2 then 'dont resize bmp #1.gb "when leftButtonMove [tracksize]" #1.gb "when leftButtonUp [stopsize]" offsetX=x-(obj(selected,1)+obj(selected,3)) offsetY=y-(obj(selected,2)+obj(selected,4)) end if if selected>0 then gosub [drawit] else insertx=int((x+(grid/2))/grid)*grid inserty=int((y+(grid/2))/grid)*grid gosub [drawall] end if wait
[track] #1.gb "rule ";_R2_NOTXORPEN '#1.gb "rule xor" gosub [drawit] x=int((MouseX-offsetX+(grid/2))/grid)*grid obj(selected,1)=x y=int((MouseY-offsetY+(grid/2))/grid)*grid obj(selected,2)=y gosub [drawit] wait
[stop] #1.gb "when leftButtonMove" #1.gb "when leftButtonUp" action=0 #1.gb "rule over" gosub [drawall] wait
[tracksize] '#1.gb "rule xor" #1.gb "rule "; _R2_NOTXORPEN
gosub [drawit] x=int((MouseX-offsetX+(grid/2))/grid)*grid y=int((MouseY-offsetY+(grid/2))/grid)*grid obj(selected,3)=x-obj(selected,1)'width obj(selected,4)=y-obj(selected,2)'height gosub [drawit] wait
[stopsize] #1.gb "when leftButtonMove" #1.gb "when leftButtonUp" action=0 #1.gb "rule _R2_NOTXORPEN" '#1.gb "rule xor" gosub [drawall] wait
[keys] k1=asc(right$(Inkey$,1)) k2=asc(left$(Inkey$,1)) if k1=46 then 'delete selected if obj(selected,5)=12 then menuset=0 obj(selected,5)=0 #2.tbname "" #2.tbtext "" #2.tbreso "" #2.tbxywh "" #2.tbfont "" #2.tbcolo "" selected=0 gosub [drawall] end if if k1=3 then 'copy cpy(1)=obj(selected,1) 'x cpy(2)=obj(selected,2) 'y cpy(3)=obj(selected,3) 'w cpy(4)=obj(selected,4) 'h cpy(5)=obj(selected,5) 'type cpy(6)=obj(selected,6) 'textheight cpy$(1)=obj$(selected,1)'name cpy$(2)=obj$(selected,2)'text content cpy$(3)=obj$(selected,3)'resource array or file path cpy$(4)=obj$(selected,4)'ctrl specific font or "" cpy$(5)=obj$(selected,5)'ctrl specific backcolor or "" end if if k1=22 then 'paste if cpy(5)<>0 then obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty inserty=inserty+cpy(4)+grid obj(obj,3)=cpy(3) obj(obj,4)=cpy(4) obj(obj,5)=cpy(5) obj(obj,6)=cpy(6) obj$(obj,1)=left$(cpy$(1),2);obj obj$(obj,2)=cpy$(2) obj$(obj,3)=cpy$(3) if obj(obj,5)=6 then loadbmp obj$(obj,1),obj$(obj,3) obj$(obj,4)=cpy$(4) obj$(obj,5)=cpy$(5) selected=obj gosub [drawall] end if end if #1.gb "setfocus" wait
[tool] #1.tool "selectionindex? i" cpy(5)=0 select case i case 1 'statictext obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=150 obj(obj,4)=ctrh obj(obj,5)=1 obj$(obj,1)="st";obj obj$(obj,2)="I am statictext " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 2 'textbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=200 obj(obj,4)=ctrh obj(obj,5)=2 obj$(obj,1)="tb";obj obj$(obj,2)="I am a textbox " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 3 'listbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=200 obj(obj,4)=ctrh*5 obj(obj,5)=3 obj$(obj,1)="lb";obj obj$(obj,2)="Listbox\item2\item3\item4\item5" obj$(obj,3)=obj$(obj,1);"$(" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 4 'combobox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=120 obj(obj,4)=ctrh obj(obj,5)=4 obj$(obj,1)="cb";obj obj$(obj,2)="Combobox\item2\item3\item4\item5" obj$(obj,3)=obj$(obj,1);"$(" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 5 'button obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=100 obj(obj,4)=ctrh obj(obj,5)=5 obj$(obj,1)="bt";obj obj$(obj,2)="Button? " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 6 'bmp button obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=50 obj(obj,4)=50 obj(obj,5)=6 obj$(obj,1)="bb";obj filedialog "Choose an image","*.bmp",file$ if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) if mid$(bmp$,1,2) ="BM" then 'always BM obj(obj,3)=value(mid$(bmp$,19,4))'width obj(obj,4)=value(mid$(bmp$,23,4))'height obj$(obj,3)=file$ obj$(obj,2)="bmp" loadbmp obj$(obj,1),file$ close #bmp inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid else obj(obj,5)=0 close #bmp end if else obj(obj,5)=0 end if
case 7 'graphicbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=160 obj(obj,4)=100 obj(obj,5)=7 obj$(obj,1)="gb";obj obj$(obj,2)="I am a graphicbox " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 8 'radiobutton obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=125 obj(obj,4)=ctrh obj(obj,5)=8 obj$(obj,1)="rb";obj obj$(obj,2)="(o) radio?" obj$(obj,3)="" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 9 'checkbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=125 obj(obj,4)=ctrh obj(obj,5)=9 obj$(obj,1)="ch";obj obj$(obj,2)="[x] check?" obj$(obj,3)="" if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 10 'groupbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=100 obj(obj,4)=100 obj(obj,5)=10 obj$(obj,1)="gr";obj obj$(obj,2)="Group Box? " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 11 'texteditor obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=200 obj(obj,4)=100 obj(obj,5)=11 obj$(obj,1)="te";obj obj$(obj,2)="I am texteditor " if ctrf$<>projectfont$ then obj$(obj,4)=ctrf$ obj(obj,6))=ctrh end if if ctrc$<>projectback$ then obj$(obj,5)=ctrc$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid
case 12 'menu if menuset=0 then obj=obj+1 obj(obj,1)=0 obj(obj,2)=0 obj(obj,3)=100 obj(obj,4)=10 obj(obj,5)=12 obj$(obj,1)="mn";obj obj$(obj,2)=" Menu Added" menuset=1 end if end select selected=obj gosub [drawall] #1.tool "select Add New" #1.gb "setfocus" wait
[form] #1.form "selectionindex? i" select case i case 1 'Last Form filename$="lastsession.ffu" gosub [loadit] case 2 'new form gosub [new] case 3 ''load form gosub [load] case 4 'save form gosub [saveas] case 6 'edit code gosub [prevCode] case 7 'save code gosub [write] end select #1.form "select File" gosub [drawall] #1.gb "setfocus" wait
[drawall] #1.gb "discard ; redraw bak" ocn=cn for cn=1 to obj gosub [drawit] next cn=ocn
if grid <>1 then #1.gb "color black " #1.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";grid #1.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";grid #1.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";grid*2 else #1.gb "place ";insertx-8;" ";inserty+3 #1.gb "color black " #1.gb "\>" end if #1.gb "setfocus" return
[drawit] 'redraws control cn if obj(cn,5)=0 then return 'if this is a menu pin to top left to stop it being move or resized if obj(cn,5)=12 then obj(cn,1)=10 : obj(cn,2)=-10 : obj(cn,3)=100 : obj(cn,4)=10 'if there is a special font for the object in obj$(n,4) change 'the font and height stored in obj(n,6) or set to default if obj$(cn,4)="" then #1.gb "font ";projectfont$ ch=projectctrh if obj(cn,4)<ch then obj(cn,4)=ch else #1.gb "font ";obj$(cn,4) ch=obj(cn,6) if obj(cn,4)<ch then obj(cn,4)=ch end if 'update the properties textboxes for selected control if cn=selected then #2.tbname obj$(cn,1) 'name #2.tbtext obj$(cn,2) 'text #2.tbreso obj$(cn,3) 'resource #2.tbxywh obj(cn,1);" ";obj(cn,2);" ";obj(cn,3);" ";obj(cn,4) 'xywh if obj$(cn,4)="" then #2.tbfont projectfont$;":";obj(cn,6) else #2.tbfont obj$(cn,4);":";obj(cn,6) 'font and height if obj$(cn,5)="" then #2.tbcolo projectback$ else #2.tbcolo obj$(cn,5) end if 'set the color for the drawn object and action taking place if cn=selected then '#1.gb "color red" 'action 1 or 2 #1.gb "color darkred" 'action 1 or 2 if action=2 then #1.gb "color darkgreen" else #1.gb "color ";projectfore$ end if 'if it is a statictext, checkbox radiobox, groupbox or menu make background color transparent if obj(cn,5)=1 or obj(cn,5)=8 or obj(cn,5)=9 or obj(cn,5)=10 or obj(cn,5)=12 then #1.gb "backcolor ";projectback$ if selected<>cn then #1.gb "color 192 192 192" else if obj$(cn,5)<>"" then #1.gb "backcolor ";obj$(cn,5) else #1.gb "backcolor ";projectback$ end if 'now draw the object at desired location #1.gb "place ";obj(cn,1);" ";obj(cn,2) 'if it is a bmp draw actual bmp if it is stationary else just the outline if obj(cn,5)=6 then if action=0 then #1.gb "drawbmp ";obj$(cn,1) #1.gb "box ";obj(cn,1)+obj(cn,3);" ";obj(cn,2)+obj(cn,4) else 'draw outline if it is a groupbox else all others filled if obj(cn,5)=10 then #1.gb "box ";obj(cn,1)+obj(cn,3);" ";obj(cn,2)+obj(cn,4) else #1.gb "boxfilled ";obj(cn,1)+obj(cn,3);" ";obj(cn,2)+obj(cn,4) end if 'if we are stationary draw the text in the correct color if action=0 then if cn=selected then #1.gb "color darkred" 'action 1 or 2 if action=2 then #1.gb "color darkgreen" else #1.gb "color ";projectfore$ end if select case obj(cn,5) case 5 'centre button text #1.gb "stringwidth? ";"A";" width" xp=(obj(cn,3)-width*len(obj$(cn,2)))/2 #1.gb "place ";obj(cn,1)+xp;" ";obj(cn,2)+ch/1.33;" ;\";obj$(cn,2) case 10 'groupbox text is offset #1.gb "place ";obj(cn,1)+5;" ";obj(cn,2)+ch/1.33-ch/2;" ;\";obj$(cn,2) case else 'woa! normal left justified text #1.gb "place ";obj(cn,1)+5;" ";obj(cn,2)+ch/1.33;" ;\";obj$(cn,2) end select end if end if return
[prevCode2] file$ = "test.bas" prev = 1 gosub [writeit] wait
[prevCode] file$ = "test.bas" prev = 1 gosub [writeit] return
[preview] prev = 2 file$ = "preview.bas" gosub [writeit] wait
[write] filedialog "Save .bas",projectname$;".bas",file$ file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit] if file$<>"" then open file$ for output as #op 'the header #op "'Project ";projectname$ #op "'Created with Freeform Ultra Lite v1.2 on ";date$();" at ";time$() #op "" #op "'Switch off mainwin debugging window" #op "nomainwin" #op "" if fastfuncs$ ="FolderDialog.txt" or fastfuncs$ = "fileExistst.txt" then #op "Dim info$(10,10)" if projectback$<>"buttonface" 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,5)=3 or obj(n,5)=4 then #op "dim ";obj$(n,3);"10)" #op "for n = 1 to 10" #op " ";obj$(n,3);"n)= str$(n)" #op "next" end if next #op "" #op "'Create controls and open window" #op "WindowWidth = ";projectw+ThemeWidth-15 #op "WindowHeight = ";(projecth+ThemeHeight+menuset*projectctrh)-15 #op "UpperLeftX = int((DisplayWidth-WindowWidth)/2)" #op "UpperLeftY = int((DisplayHeight-WindowHeight)/2)" if menuset then #op "menu #1, ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Load";chr$(34);", [dummy]" #op "menu #1, ";chr$(34);"&Color";chr$(34);", ";chr$(34);"&Red";chr$(34);", [dummy], ";chr$(34);"&Green";chr$(34);", [dummy]" #op "menu #1, ";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,5) case 1 'statictext #op "statictext #1.";obj$(n,1);" ";chr$(34);trim$(obj$(n,2));chr$(34);",";obj(n,1);",";obj(n,2)+5;",";obj(n,3);",";obj(n,4) case 2 'textbox if obj$(n,5)<>"" then #op "TextboxColor$=";chr$(34);obj$(n,5);chr$(34) #op "textbox #1.";obj$(n,1);",";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 3 'list box if obj$(n,5)<>"" then #op "ListboxColor$=";chr$(34);obj$(n,5);chr$(34) #op "listbox #1.";obj$(n,1);",";obj$(n,3);",[";obj$(n,1);"click],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 4 'combobox if obj$(n,5)<>"" then #op "ComboboxColor$=";chr$(34);obj$(n,5);chr$(34) #op "combobox #1.";obj$(n,1);",";obj$(n,3);",[";obj$(n,1);"click],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 5 'button #op "button #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",[";obj$(n,1);"click], UL, ";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 6 'bmpbutton #op "bmpbutton #1.";obj$(n,1);",";chr$(34);obj$(n,3);chr$(34);",[";obj$(n,1);"click], UL, ";obj(n,1);",";obj(n,2) case 7 'graphicbox #op "graphicbox #1.";obj$(n,1);",";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 8 'radiobutton #op "radiobutton #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",[radio],[radio],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 9 'checkbox #op "checkbox #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",[check],[check],";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) case 10 'group box #op "groupbox #1.";obj$(n,1);",";chr$(34);obj$(n,2);chr$(34);",";obj(n,1);",";obj(n,2)-5;",";obj(n,3);",";obj(n,4) case 11 if obj$(n,5)<>"" then #op "TexteditorColor$=";chr$(34);obj$(n,5);chr$(34) #op "texteditor #1.";obj$(n,1);",";obj(n,1);",";obj(n,2);",";obj(n,3);",";obj(n,4) end select next #op "open ";chr$(34);projectname$;chr$(34);" for ";winType$;" as #1" #op "#1 ";chr$(34);"trapclose [quit]";chr$(34) #op "" #op "'apply any control specific fonts" for n= 1 to obj if obj(n,5)<>0 and obj$(n,4)<>"" then if obj(n,5)=1 or obj(n,5)=2 or obj(n,5)=5 or obj(n,5)=10 or obj(n,5)=11 then #op "#1.";obj$(n,1);" ";chr$(34);"!font ";obj$(n,4);chr$(34) end if if obj(n,5)=3 or obj(n,5)=4 or obj(n,5)=7 or obj(n,5)=8 or obj(n,5)=9 then #op "#1.";obj$(n,1);" ";chr$(34);"font ";obj$(n,4);chr$(34) end if end if next #op "wait" #op "" #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,5) case 3 'listbox #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 4 'combobox #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 5 'button #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 6 'bmpbutton #op "[";obj$(n,1);"click]" #op "'Your handler code here" #op "wait" #op "" case 8 'radiobutton if radio=0 then #op "[radio]" #op "'Your handler code here" #op "wait" #op "" radio=1 end if case 9 'checkbox if check=0 then #op "[check]" #op "'Your handler code here" #op "wait" #op "" check=1 end if end select next #op "[quit]" #op "close #1" #op "end" close #op if prev = 2 then prev = 0 : goto [jump] if prev = 1 then prev = 0 : run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" ";DefaultDir$;"\";file$ : return if prev = 0 then return [jump] files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] end if open DefaultDir$;"\test.bas" for output as #copyfunction close #copyfunction call copyFunction #1.fastfunctionsList "!JB Functions" [donePrev] return
[saveas] filedialog "Save As...",projectname$;".ffu",file$ if file$<>"" then open file$ for output as #op file$=right$(file$,len(file$)-len(DefaultDir$)-1) projectname$=left$(file$,len(file$)-4) #op projectname$ #op projectfont$ #op projectback$ #op projectfore$ #op projectctrh #op projectgrid #op projectw #op projecth #op gridcolor$ #op bordercolor$ #op crosshair$ '#op grid for n=1 to obj if obj(n,5)<>0 then #op obj(n,1);","; #op obj(n,2);","; #op obj(n,3);","; #op obj(n,4);","; #op obj(n,5);","; #op obj(n,6) #op obj$(n,1) #op obj$(n,2) #op obj$(n,3) #op obj$(n,4) #op obj$(n,5) end if next close #op end if return
[load] filedialog "Open Project...","*.ffu",filename$ [loadit] if filename$<>"" then open filename$ for input as #ses input #ses, projectname$ #2.tbproj projectname$ input #ses, projectfont$ if projectfont$="" then projectfont$="Consolas 9" #1.gb "font ";projectfont$ input #ses, projectback$ input #ses, projectfore$ input #ses, c$ input #ses, g$ input #ses, w$ input #ses, h$ input #ses, gc$ input #ses, bordercolor$ input #ses, crosshair$ projectctrh=val(c$) projectgrid=val(g$) gridcolor$ = gc$ grid=projectgrid projectw=val(w$) projecth=val(h$) #1.grid "select ";grid if grid = 1 then #1.st1 grid-1 else #1.st1 grid #1.w "select ";projectw #1.h "select ";projecth gosub [drawgrid] obj=0 while eof(#ses) = 0 obj=obj+1 line input #ses, l$ obj(obj,1)=val(word$(l$,1,",")) obj(obj,2)=val(word$(l$,2,",")) obj(obj,3)=val(word$(l$,3,",")) obj(obj,4)=val(word$(l$,4,",")) obj(obj,5)=val(word$(l$,5,",")) obj(obj,6)=val(word$(l$,6,",")) line input #ses, obj$(obj,1) line input #ses, obj$(obj,2) line input #ses, obj$(obj,3) line input #ses, obj$(obj,4) line input #ses, obj$(obj,5) if obj(obj,5)=6 then loadbmp obj$(obj,1),obj$(obj,3) if obj(obj,5)=12 then menuset=1 wend close #ses end if return
[new] redim obj(100,6) 'x,y,width/height,type,textheight redim obj$(100,6) 'name,text content,resource,font obj=0 menuset=0 projectback$="white" projectfore$="black" projectname$="Untitled" #2.tbproj projectname$ return
[resize] #1.tool "select Add New" #1.form "select File" #1.grid "select Set Grid" #1.font "select Set Font" #1.w "select ";projectw #1.h "select ";projecth #1.color "select Set Color" #1.windowtype "!Window Type" #1.fastfunctionsList "!JB Functions" #1.userfunctionsList "!My Functions" gosub [drawall] wait
[formsize] #1.w "contents? w$" #1.h "contents? h$" w=val(w$)'+45 h=val(h$)'+50 if w=0 or h=0 or (w=projectw and h=projecth) then wait projectw=w projecth=h insertx=grid inserty=grid gosub [drawgrid] #1.gb "setfocus" gosub [drawall] wait
[grid] 'resize the grid according to user choice, default is 5 #1.grid "contents? g$" if g$ = "Crosshair" then crosshair$ = g$ goto [string] end if if g$ = "noCrosshair" then crosshair$ = g$ goto [string] end if grid=val(g$) [string] gosub [drawgrid] gosub [drawall] if grid >1 then #1.st1 grid else #1.st1 grid - 1 #1.gb "setfocus" wait
[drawgrid] if grid = 0 then grid = 1 insertx=int((insertx+(grid/2))/grid)*grid inserty=int((inserty+(grid/2))/grid)*grid projectgrid=grid #1.gb "cls; fill ";projectback$ #1.gb "place 0 0 ; color ";projectfore$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth if grid<3 then [nogrid] #1.gb "color ";gridcolor$ if grid > 2 then y=0 ' Grid - Draw vertical lines #1.gb "size 1" for x = 0 to projectw step grid #1.gb "line "; x; " "; startX; " "; x; " "; projecth next x 'Grid - Draw horizontal lines for y = 0 to projecth step grid #1.gb "line "; startX; " "; y; " "; projectw; " "; y next y end if [nogrid] if bordercolor$ = "" then bordercolor$ = gridcolor$ #1.gb "color ";bordercolor$ '#1.gb "color ";projectback$ 'draw crosshairs for easier line up of controls when grid = 0 if crosshair$ = "Crosshair" then #1.gb "color ";bordercolor$ #1.gb "line "; projectw/2; " "; startX; " "; projectw/2; " "; projecth #1.gb "line "; startX; " "; projecth/2; " "; projectw; " "; projecth/2 end if
#1.gb "place 0 0" #1.gb "box ";projectw;" ";projecth #1.gb "flush bak" #1.grid "select Set Grid" return
[windowType] #1.windowtype "contents? winType$" wait
[font] #1.font "contents? f$" if f$="Proj Font" then fontdialog projectfont$,f$ if f$<>"" then projectfont$=f$ #1.gb "font ";projectfont$ #1.gb "place 100 100 ;\Q\Q" #1.gb "posxy x y" projectctrh=(y-100)/2+7 ctrf$=projectfont$ ctrh=projectctrh end if end if if f$="Ctrl Font" then fontdialog projectfont$,f$ if f$<>"" then ctrf$=f$ #1.gb "font ";ctrf$ #1.gb "place 100 100 ;\Q\Q" #1.gb "posxy x y" ctrh=(y-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 #1.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if if f$="Ctrl Reset" 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 #1.gb "font ";ctrf$ obj(selected,4)=ctrh #1.gb "stringwidth? ";"A";" width" obj(selected,3)=width*len(obj$(selected,2))+10 end if end if #1.font "select Set Font" gosub [drawall] #1.gb "setfocus" wait
[color] #1.color "contents? c$" select case c$ case "Ctrl Back" gosub [colorpick] if cp$<>"" then ctrc$=cp$ if selected then if obj(selected,5)=2 or obj(selected,5)=3 or obj(selected,5)=4 or obj(selected,5)=11 then obj$(selected,5)=ctrc$ end if case "ResetBack" ctrc$=projectback$ if selected then obj$(selected,5)="" case "Proj Back" gosub [colorpick] if cp$<>"" then projectback$=cp$ if cp$<>"" then ctrc$=cp$ gosub [drawgrid] case "Proj Fore" gosub [colorpick] if cp$<>"" then projectfore$=cp$ case "Grid Color" gosub [colorpick] if cp$<>"" then gridcolor$=cp$ gosub [drawgrid] case "Grid Border" gosub [colorpick] if cp$<>"" then bordercolor$=cp$ gosub [drawgrid] end select #1.color "select Set Color" gosub [drawall] #1.gb "setfocus" wait
[colorpick] WindowWidth=230 WindowHeight=225 UpperLeftX = insertx UpperLeftY = inserty graphicbox #3.gb,25,10,170,170 open "Color Pick" for dialog_nf_modal as #3 #3 "font Consolas 9" #3 "trapclose [quit3]" #3.gb "down ; fill white ; flush" cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white" c=1 for y=1 to 160 step 40 for x= 1 to 160 step 40 #3.gb "backcolor ";word$(cl$,c);" ; place ";x;" ";y;" ; boxfilled ";x+40;" ";y+40 c=c+1 if c>15 then c=15 next next #3.gb "when leftButtonDown [pick]" wait
[pick] x=int(MouseX/40) y=int(MouseY/40) c=x+y*4+1 cp$=word$(cl$,c)
[quit3] if c$="" then c$=oc$ close #3 return
[help] loadbmp "h","helpme.bmp" #1.gb "drawbmp h 0 0 " wait
[quit2] 'prevent properties window closing by user 'playwave "beep" #1.gb "setfocus" wait
[quit] 'save away current session to lastsession.ffu open "lastsession.ffu" for output as #ses #ses projectname$ #ses projectfont$ #ses projectback$ #ses projectfore$ #ses projectctrh #ses projectgrid #ses projectw #ses projecth #ses gridcolor$ #ses bordercolor$ #ses crosshair$ for n=1 to obj if obj(n,5)<>0 then #ses obj(n,1);","; #ses obj(n,2);","; #ses obj(n,3);","; #ses obj(n,4);","; #ses obj(n,5);","; #ses obj(n,6) #ses obj$(n,1) #ses obj$(n,2) #ses obj$(n,3) #ses obj$(n,4) #ses obj$(n,5) end if next close #ses close #2 close #1 if fileExists(DefaultDir$, "preview.bas") then kill DefaultDir$;"\preview.bas" if fileExists(DefaultDir$, "test.bas") then kill DefaultDir$;"\test.bas" if fileExists(DefaultDir$, "untitled.bas") then kill DefaultDir$;"\untitled.bas" end
sub copyFunction x = 0 dim codeLine$(500) if fileExists(upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions", fastfuncs$) then open upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions\";fastfuncs$ for input as #fastfunc open DefaultDir$;"\preview.bas" for append as #copyfunction #copyfunction "" while eof(#fastfunc) = 0 line input #fastfunc, codeLine$(x) line$ = codeLine$(x) if x < 6 then [skipme] #copyfunction line$ copiedText$ = copiedText$+chr$(13)+line$ [skipme] x = x + 1 wend close #fastfunc close #copyfunction end if end sub
sub getfastfunctions dim folderInfo$(1, 1) dim fastfunctionsList$(10) files upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions", folderInfo$() numFiles = val(folderInfo$(0, 0)) redim fastfunctionsList$(numFiles+1) for x = 1 to numFiles filenam$ = folderInfo$(x, 0) if right$(filenam$, 3) <> "txt" then [skip] if filenam$ = "readme.txt" then [skip] fastfunctionsList$(x) = left$(filenam$, len(filenam$) - 4) [skip] next x sort fastfunctionsList$(), 0 ,numFiles #1.fastfunctionsList, "reload" end sub
sub fastfunctionSelected fastfunctionsList$ #1.fastfunctionsList, "selection? fastfuncs$" fastfuncs$ = fastfuncs$;".txt" open upath$;"\AppData\Roaming\Just Basic v2.0\FFFunctions";"\";fastfuncs$ for input as #copyText open "test.bas" for append as #test #test " " while eof(#copyText) = 0 line input #copyText, line$ if x < 6 then [skipme] #test line$ [skipme] x = x + 1 wend close #copyText close #test end sub
'get users homepath = aka %userprofile% = "c:\users\xxxxx" (5 characters long normally Win 10) sub getUserPath run "cmd.exe /c echo %userprofile% >UserHomePath.txt", HIDE do scan loop until fileExists(DefaultDir$, "UserHomePath.txt") open "UserHomePath.txt" for input as #1 upath$ = input$(#1, lof(#1)) close #1 if upath$ = "" then notice "Sorry, can't find user path " : end kill DefaultDir$;"\UserHomePath.txt" end sub
function GetFilename$(fName$) i = len(fName$) while mid$(fName$, i, 1) <> "\" and mid$(fName$, i, 1) <> "" i = i-1 wend GetFilename$ = mid$(fName$, i+1) end function
'Verify file existence function function fileExists(path$, name$) dim fileExistsInfo$(0,0) files path$, name$, fileExistsInfo$() fileExists = val(fileExistsInfo$(0, 0)) 'non zero is true end function
function value(x$) select case len(x$) case 1 value = asc(x$) case 2 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) case 3 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) case 4 value=asc(mid$(x$,1,1)) value=value+(asc(mid$(x$,2,1))*256) value=value+(asc(mid$(x$,3,1))*65536) value=value+(asc(mid$(x$,4,1))*16777216) end select end function I think it's the same as the one you uploaded earlier.
|
|