|
Post by xxgeek on Apr 21, 2023 18:03:19 GMT
Sorry to say, the issue with the color picker persists. If the color picker is closed without picking a color, the app crashes. "Ctrl" is not a valid color" or "proj is not a valid color" depending on selected option.
Don't forget the resize issue, and apply the fix to the new color combobox.
The following code is the latest code edited to add the 0 grid option, and the allowance of off screen placement of controls.(color combobox highlight after a resize is fixed) No function support added to this version. The Help button has been disabled so no dependent files are needed to run it. btw - We could still place the file name in the "Preview Button" by putting back the code to do it. It was nice to know what file was being represented in the app.
'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.
nomainwin dim info$(10,10) dim form$(10) form$(1)="Restore" form$(2)="New" form$(3)="Write" form$(4)="Save as" form$(5)="Load" form$(6)="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=1 for n= 0 to 30 step 5 grid$(g)=str$(n) g=g+1 next grid$(g)="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)="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-230)/2 UpperLeftY=(DisplayHeight-180)/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=800+ThemeWidth+30 WindowHeight=600+ThemeHeight+45 'gb is offset by 25 UpperLeftX=(DisplayWidth-WindowWidth)/2 UpperLeftY=(DisplayHeight-WindowHeight)/2 combobox #1.tool,tool$(,[tool],5,2,90,30 combobox #1.form,form$(,[form],100,2,90,30 button #1.project,"Preview",[preview],UL,195,3,140,21 combobox #1.w,v$(,[formsize],340,2,60,30 combobox #1.h,v$(,[formsize],405,2,60,30 combobox #1.grid,grid$(,[grid],470,2,90,30 combobox #1.color,color$(,[color],565,2,90,30 combobox #1.font,font$(,[font],660,2,90,30 button #1.help,"Help",[help],UL,755,3,80,21 graphicbox #1.gb,5,25,830,630 open "Freeform Ultra Lite v1 " for window as #1 #1 "trapclose [quit]" #1 "font Consolas 9" #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" 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 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 xor" gosub [drawit] x=int((MouseX-offsetX+(grid/2))/grid)*grid 'if x<grid then x=grid 'if x+obj(selected,3)>projectw-grid then x=projectw-grid-obj(selected,3) obj(selected,1)=x y=int((MouseY-offsetY+(grid/2))/grid)*grid 'if y<grid then y=grid 'if y+obj(selected,4)>projecth-grid then y=projecth-grid-obj(selected,4) 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" gosub [drawit] x=int((MouseX-offsetX+(grid/2))/grid)*grid 'if x>projectw-grid then x=projectw-grid 'if x<obj(selected,1)+grid then x=obj(selected,1)+grid y=int((MouseY-offsetY+(grid/2))/grid)*grid 'if y>projecth-grid then y=projecth-grid 'if y<obj(selected,2)+ctrh then y=obj(selected,2)+ctrh 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 over" 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)=200 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 #1.tool "select Add New" : #1.gb "setfocus" : wait if file$<>"" then file$=right$(file$,len(file$)-len(DefaultDir$)-1) open file$ for input as #bmp 'the bmpfileheader bmp$ = Input$(#bmp,lof(#bmp)) obj(obj,3)=value(mid$(bmp$,19,4))'width obj(obj,4)=value(mid$(bmp$,23,4))'height close #bmp loadbmp obj$(obj,1),file$ end if obj$(obj,2)="bmp" obj$(obj,3)=file$ inserty=int((inserty+obj(obj,4)+(grid/2))/grid)*grid case 7 'graphicbox obj=obj+1 obj(obj,1)=insertx obj(obj,2)=inserty obj(obj,3)=100 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)=100 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)=100 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 'restore filename$="lastsession.ffu" gosub [loadit] case 2 'new gosub [new] case 3 'write gosub [write] case 4 'save as gosub [saveas] case 5 'load gosub [load] 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 #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 #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 if action=2 then #1.gb "color green" 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 red" 'action 1 or 2 if action=2 then #1.gb "color green" 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
[preview] 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$<>"white" or projectfore$<>"black" then #op "'Set BackgroundColor$ and ForegroundColor$ of project" #op "BackgroundColor$=";chr$(34);projectback$;chr$(34) #op "ForegroundColor$=";chr$(34);projectfore$;chr$(34) #op "" end if #op "'Create arrays needed for controls listbox,combobox" for n= 1 to obj if obj(n,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 #op "WindowHeight = ";projecth+ThemeHeight+menuset*projectctrh #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 window 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 files "c:\program files (x86)\liberty basic pro v4.5.1\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.5.1\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic pro v4.04\","lbpro.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic pro v4.04\lbpro.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\liberty basic v4.5.1\","liberty.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\liberty basic v4.5.1\liberty.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ goto [done] end if files "c:\program files (x86)\just basic v2.0\","jbasic.exe", info$() if val(info$(0, 0)) > 0 then run chr$(34);"c:\program files (x86)\just basic v2.0\jbasic.exe";chr$(34);" -R -A ";DefaultDir$;"\";file$ end if [done] end if return
[saveas] 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 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$ projectctrh=val(c$) projectgrid=val(g$) grid=projectgrid projectw=val(w$) projecth=val(h$) #1.grid "select ";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" gosub [drawall] wait
[formsize] #1.w "contents? w$" #1.h "contents? h$" w=val(w$) h=val(h$) 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 10 #1.grid "contents? g$" grid=val(g$) gosub [drawgrid] gosub [drawall] #1.gb "setfocus" wait
[drawgrid] if grid < 4 then grid = 4 ' if grid<0 then ' grid = 4 insertx=int((insertx+(grid/2))/grid)*grid inserty=int((inserty+(grid/2))/grid)*grid projectgrid=grid
#1.gb "cls; fill buttonface" #1.gb "place 0 0 ; color ";projectback$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth #1.gb "color ";projectfore$;" ; backcolor ";projectback$ for x= 0 to projectw step grid for y= 0 to projecth step grid if grid > 4 then #1.gb "set ";x;" ";y next next #1.gb "flush bak" 'end if #1.grid "select Set Grid" return
[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] ctrc$=c$ 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] projectback$=c$ ctrc$=c$ gosub [drawgrid] case "Proj Fore" gosub [colorpick] projectfore$=c$ 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 if selected then oc$=obj$(selected,6) else oc$=projectbak$ 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 c$=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 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
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
|
|