|
|
Post by Admin on Sept 17, 2023 20:33:16 GMT
CodeTankPlus v2.0 was written in Liberty Basic 4.5.1 Pro to save code, and use it whenever needed.
- choose between several categories of code
- all categories save code automatically
- keeps your projects organized, with backups. Automated
- ability to share([Merge]) category files with other users
- ability to [Revert] back to an earlier version.
- create, save, copy, delete code in any category
- create, save, copy, delete, load, import, export forms (GUI's), and their code
- quick reference for ASCII codes, LB Help Menu and Tutorial, and Reserved words
- access to LB Examples, and Backups (.BAK files)
- and more
It includes
- a Liberty Basic help file search engine.
- a fast window and associated code generator.
- a fast GUI and and associated GUI code generator.
- 3 separate EXE file creation methods for your programs.(Automated)
Methods
1.) Uses the Liberty Basic way - collects the necessay .dll files,.sll files, and .tkn file, plus the run451.exe and renames the run451.exe to the same name as the TKN file file, placing all in a folder of the same name as the selected .bas file. These EXE files are the run451.exe renamed, and need all the mentioned support files to RUN, or Execute.
2.) Uses IEXPRESS commandline and created SED file to create a single 'temp' EXE file. All the support files mentioned above are rounded up etc, placed in a folder of the same name as the selected .bas file, then IEXPRESS creates a single EXE file with the mentioned files imbedded.
These exe files get opened\unpacked in the users 'temp' dir, and are deleted when the app is closed, so not good for saving files to DefaultDir$ etc., but have other worthy uses, such as graphics, testing, when no "created" files etc will be necessary for the next time it is RUN , or Executed.
When used manually, there are a few more options to consider as well.
3.) Uses LB Booster to compile and create a single .exe file from a user selected.bas file
These EXE files are opened\unpacked in the dir they run from - ie:(DefaultDir$)
When used manually the user can add support files to be embedded in the EXE file, and a few more options.
Included = BAS<2>EXE
- automation of the EXE file creation (user selects a working .bas file - that's it)
- add a password
- add date/time to exe filename
- add version # to exe filename
- Choose EXE creation method (IEXPRESS or LB Booster)
- Multiple categories for your saved code.
- RUN your TKN files, EXE files, or the Saved Code.
- Every 'MyProject' and MyProgram created [From File] also creates dated\timed backups of the BAS and TKN files in order to [Revert] back if needed.
MyProjects [New From File] creates a dir with all the needed support dll's, sll's and renamed exe file etc Browse to Projects dir to view.
MyPrograms ONLY creates a project dir with the TKN, and a copy of thee .bas file.
Credit goes to the following Authors.
Carl Gundel, author of Liberty Basic, for the original 'Dictionary' code (the core program for saving the code)
Cundo, a member of the Just Basic forums for, 'Fastcode', and for the original 'Help Search Engine'.
Rod, an Administrator at both the JB and LB forums, for 'FFUL' (FreeFormUltraLite)
- the original Fast GUI creation tool.
Original code edited by xxgeek to suit CodeTankPlus.
xxgeek is also a member of both the JB and LB forums.
For more information on CodeTankPlus post your questions here.
There are also a few instructions at the top of the code.
!Warning! - Keep it in a folder of it's own. It creates a lot of files and folders in DefaultDir$
Link to the CodeTankPlus_v2.0.zip file to be posted soon.....
|
|
|
|
Post by Admin on Sept 18, 2023 15:25:31 GMT
Save the following code to a folder with LBB.exe, and LBRUN.exe. Link to LB Booster FilesLink to CodeTank7A.zip(Latest .bas Version)
'CodeTank v1.7.3F - For Liberty Basic v4.5.1 and (Pro)
'created by xxgeek Aug 2023
'This app uses "Dictionary" code, written by Carl Gundel, at it's core
'This app also uses FastCode written by cundo - a member of the JustBasic Forums
'This app also uses a Help search engine originally created by cundo - (orig name = JB Search)
'This app also uses a version of FFUL(FreeFormUltraLite) written by Rod - Admin at both JB and LB Forums
' All edited to suit this app
'Purposes -
' (1) To create reservoir(s) of code, subs, functions, scripts and example programs with ability to share_
'_ with others each category file, to merge with their own reservoir(s).
' (2) To automate the collection of support dll and sll files along with TKN file creation and renaming_
'_ of the run451.exe, and to automate the creation of EXE files with 3 differing methods
' (3) To create dated\timestamped backups of each .bas file, and a .tkn backup file of each .bas_
'_ file to 'Revert' back if\when needed.
'Use alt +
' Char Button
' c = [copy] - copies selected code in editor
' d = [Delete] - deletes a selected listing, and offers to delete it's project files as well
' e = [Create Single &EXE File] - creates a single EXE file from a selected BAS file
' f = [New From File] - user selects the file to add to the listing using filedialog
' g = [Merge File] - merge a file of a particular 'categorie' with another , possibly downloaded file
' l = [Edit in LB IDE] - opens selected code in LB IDE
' m = [Mirror Editor] - opens a window with a full screen editor mirroring the existing one.
' n = [New (Copy\Paste)] - Create a 'New' listing manually (not from a file)
' p = [paste] - pastes code into editor at location of I-Beam
' r = [RUN] - runs selected listing
' s = [Select All] - selects all the text in the texteditor
' s = [Scratch] button - on the Mirror window
' t = [Update TKN] - updates the TKN file of a selected listing (MyProjects, and MyPrograms ONLY)
' u = [cut] - cuts selected text from editor
' v = [Revert to Backup] - Overwrites the files of a selected listing with a selected backup
' + = Increase Font Size [+]
' - = Decrease Font Size [-]
'WARNING - Save to a folder of it's own, it creates files, and folders when used.
' Please Note:
' When selecting a .bas file to create a New Project, or Program.......
' Make sure the .bas file is a known good one, and runs/starts ok in the LB IDE
' If the .bas file cannot pass the compiler's check, it can cause havoc with the automation'
' process, and probably crash CodeTank.
'When RUNing any files be aware that the file you are running 'MAY' be the culprit if a problem arises.
'The LB IDE may stay open, along with a mainwin, and the user must close both manually.
'For help using CodeTank visit the Liberty Basic forums
' @ https://libertybasiccom.proboards.com/
'on error goto [abort]
nomainwin
gosub [initiate]
[start]
dim searchList$(500), info$(0,0), oneOf$(2500), mainList$(500) 'declare some variables
global LBpath$, helpFilePath$, fname$
helpFilePath$ = LBpath$;"\lb4help\LibertyBASIC_4_web"
helpFileMenu$ = "amber_menu.htm"
'dim arrays for key$ and info$
dim key$(1000)
dim info$(500, 500)
global toPrint$
res = mkdir("EXE")
'declare variables
q$ = chr$(34)
codeTank$ = "#codeTank"
LBruntime$ = "run451.exe"
lbReservedWords$ = " AND, APPEND, AS, BEEP, BMPBUTTON, BMPSAVE, BUTTON, BYREF, CALL, CALLDLL, CALLFN, CASE, CHECKBOX, CLOSE, CLS, COLORDIALOG, COMBOBOX, CONFIRM, CURSOR, DATA, DIALOG, DIM, DLL, DO, DUMP, DWORD, ELSE, END, ERROR, EXIT, FIELD, FILEDIALOG, FILES, FONTDIALOG, FOR, FUNCTION, GET, GETTRIM, GLOBAL, GOSUB, GOTO, GRAPHICBOX, GRAPHICS, GROUPBOX, IF, INPUT, INPUTCSV, KILL, LET, LINE, LISTBOX, LOADBMP, LONG, LOOP, LP, PRINT, MAINWIN, MAPHANDLE, MENU, NAME, NEXT, NOMAINWIN, NOTICE, ON, ONCOMERROR, OR, OPEN, OUTPUT, PASSWORD, PLAYMIDI, PLAYWAVE, POPUPMENU, PRINT, PRINTERDIALOG, PROMPT, PUT, PTR, RADIOBUTTON, RANDOM, RANDOMIZE, READ, READJOYSTICK, REDIM, REM, RESTORE, RESUME, RETURN, RUN, SCAN, SELECT, SHORT, SORT, STATICTEXT, STOP, STOPMIDI, STRUCT, SUB, TEXT, TEXTBOX, TEXTEDITOR, THEN, TIMER, TITLEBAR, TRACE, ULONG, UNLOADBMP, UNTIL, USHORT, VOID, WAIT, WINDOW, WEND, WHILE, XOR, ABS(, ACS(, AFTER$(, AFTERLAST$(, ASC(, ASN(, ATN(, CHR$(, COS(, DATE$(, DECHEX$(, EOF(, HBMP(, HEXDEC(, HTTPGET$(, HWND(, INP(, INPUT$(, INPUTTO$(, INSTR(, INT(, LEFT$(, LEN(, LOF(, LOG(, LOWER$(, MAX(, MIDIPOS(, MID$(, MIN(, MKDIR(, NOT(EXP(, HEXDEC(, INPUT$(, INPUTTO$(, INSTR(, INT(, LEFT$(, LEN(, LOF(, LOG(, LOWER$(, MAX(, MIDIPOS(, MID$(, MIN(, MKDIR(, NOT(, REMCHAR$(, REPLSTR$(, RIGHT$(, RMDIR(, RND(, SIN(, SPACE$(, SQR(, STR$(, TAB(, TAN(, TIME$(, TRIM$(, TXCOUNT(, UPPER$(, UPTO$(, USING(, VAL(, WINSTRING(, WORD$(, BackgroundColor$, ComboboxColor$, CommandLine$, DefaultDir$, DisplayHeight, DisplayWidth, Drives$, Err, Err$, ForegroundColor$, Joy1x, Joy1y, Joy1z, Joy1button1, Joy1button2, Joy2x, Joy2y, Joy2z, Joy2button1, Joy2button2, ListboxColor$, Platform$, PrintCollate, PrintCopies, PrinterFont$, PrinterName$, TextboxColor$, TexteditorColor$, Version$, WindowHeight, WindowWidth, UpperLeftX, UpperLeftY"
DllList$="vbas31w.sll vgui31w.sll voflr31w.sll vthk31w.dll vtk1631w.dll vtk3231w.dll vvm31w.dll vvmt31w.dll"
savedProjects$ = "savedProjects"
MyProjects$ = "MyProjects"
MyBackups$ = "MyBackups"
programs$ = "Programs"
vbs$ = "VBS-Scripts"
cmd$ = "CMD-Scripts"
examples$ = "Examples"
snippets$ = "Snippets"
lbExamples$ = "LB-Examples"
lbBakFiles$ = "LB-BAK-Files"
subroutines$ = "Subroutines"
functions$ = "Functions"
mainFontsize = 10
project = 1
WinWide = 1000 '1000
WinHigh = 600
UserMonitorResx = 1000 '800
UserMonitorResy = 600 '600
IF UserMonitorResx < WinWide THEN
Diff = WinWide - UserMonitorResx
WinWide = WinWide - Diff
END IF
IF UserMonitorResy < WinHigh THEN
Diff = WinHigh - UserMonitorResy
WinHigh = WinHigh - Diff
END IF
RetVal = FN.ScreenCenter(Cx, Cy) '<--- get screen center
RetVal = FN.SetWinPos(Cx - INT(WinWide / 2), Cy - INT(WinHigh / 2)) '<--- set window pos
RetVal = FN.SetWinSize(WinWide, WinHigh) '<--- set window size
UpperLeftX= int((DisplayWidth-WindowWidth)/2)-70
UpperLeftY= int((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "lightgray"
menu #codeTank, "File" , "Open Liberty Basic", [openlb], "Open a File in Liberty Basic", [openlbFile], "Exit", [quit.codeTank]
menu #codeTank, "Edit"
menu #codeTank, "Browse" , "My Projects", [projectsDir], ".EXE Files", [EXEDir], ".TKN Files", [tknDir], ".BAS Files", [basFiles],"DefaultDir$", [defaultDir],"LB Code Examples", [lbexamplesDir]
menu #codeTank, "Help" , "Liberty Basic Forums", [forumlink], "Help", [codeTankHelp], "About", [about]
texteditor #codeTank.value, 440, 75, 545, 425
hscroll$ = "#codeTank.keys"
stylebits #hscroll$, _WS_HSCROLL, 0, 0, 0
listbox #codeTank.keys, keys$(), [keySelected], 100, 75, 340, 270
'category radio buttons
radiobutton #codeTank.savedprojects, "MyProjects", [projs], resetHandler, 5, 90, 95, 20
radiobutton #codeTank.programs, "MyPrograms", [progs], resetHandler, 5, 110, 95, 20
radiobutton #codeTank.backups, "MyBackups", [mybackups], resetHandler, 5, 140, 95, 20
radiobutton #codeTank.examples, "Examples", [exams], resetHandler, 5, 170, 80, 20
radiobutton #codeTank.snippets, "Snippets", [snipps], resetHandler, 5, 190, 95, 20
radiobutton #codeTank.subroutines, "Subroutines", [subroutines], resetHandler, 5, 210, 95, 20
radiobutton #codeTank.functions, "Functions", [functions], resetHandler, 5, 230, 95, 20
radiobutton #codeTank.VBS, "VBS-Scripts", [vbs], resetHandler, 5, 250, 95, 20
radiobutton #codeTank.CMD, "CMD-Scripts", [cmd], resetHandler, 5, 270, 95, 20
radiobutton #codeTank.lbexamples, "LB-Examples", [lbCodeExamples], resetHandler, 5, 305, 95, 20
radiobutton #codeTank.lbbakfiles, "LB-BakFiles", [lbbakfiles], resetHandler, 5, 325, 95, 20
radiobutton #codeTank.folderChoice, "Any Folder", [folderChoice], resetHandler, 5, 355, 95, 20
'Event buttons etc
wh=WinHigh-100
button #codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1)), [newKey], LL, 270, wh-365, 165, 25
button #codeTank.fromFile, "New from &File", [makeproject], LL, 105, wh-365, 155, 25
button #codeTank.remakeproject, "Update &TKN File", [remakeproject], LL, 105, wh-415, 155, 25
button #codeTank.runlb, "Edit Item in &Liberty Basic", [edit_In_LB_IDE], LL, 105, wh-390, 155, 25
button #codeTank.merge, "Mer&ge Shared File ";categorie$, [mergeFile], LL, 270, wh-415, 165, 25
button #codeTank.runListing, "&Run", [runKey], LL, 270, wh-390, 165, 25
button #codeTank.revert, "Re&vert to Backup", [revert], LL, 105, wh-440, 155, 25
button #codeTank.deleteListing, " &Delete ", [deleteKey], LL, 270, wh-440, 165, 25
button #codeTank.exe, "BAS*2*&EXE - IEXPRESS", [singleEXE], LL, 105, wh-465, 155, 25
button #codeTank.lbbEXE, "BAS*2*EXE - LB Booster", [LBB_EXE], LL, 270, wh-465, 165, 25
button #codeTank.IEXP_man, "&IEXPRESS Manually", [IEXP_man], LL, 105, wh-490, 155, 25
button #codeTank.lbbEX_man, "LB Booster Manually", [lbbEX_man], LL, 270, wh-490, 165, 25
button #codeTank.lbbFileEdit, "Edit File in LB Booster", [lbbEdit], LL, 270, wh-515, 165, 25
button #codeTank.lbbSelEdit, "Edit Item in LB Booster", [lbbSelEdit], LL, 105, wh-515, 155, 25
button #codeTank.incFont, "&+", [incFont], UL, 25, 390, 20, 23
button #codeTank.decFont, "&-", [decFont], UL, 50, 390, 20, 23
button #codeTank.mirror, "&Mirror Editor", [textEdMirror], UL, 5, 425, 95, 25
button #codeTank.cut, "C&ut", [cut], LL, 560, wh-520, 65, 20
button #codeTank.copy, "&Copy", [copy], LL, 630, wh-520, 65, 20
button #codeTank.selectAll, "Select &All", [selectall], LL, 700, wh-520, 85, 20
button #codeTank.paste, "&Paste", [paste], LL, 790, wh-520, 85, 20
button #codeTank.fastwindows, "&Fast Windows", [fastcode], ul, 5, 460, 95, 25
button #codeTank.fastgui, "&Fast GUI's", [fastGui], UL, 5, 495, 90, 25
textbox #codeTank.filePath, 100, 50, WinWide-235, 25
statictext #codeTank.categories, "Categories", 20, 60, 80, 15
combobox #codeTank.asciiList, asciiList$(), asciiSelected , 320, 2, 150, 12
combobox #codeTank.lbreservedwordsList, lbreservedwordsList$(), lbreservedwordSelected , 475, 2, 170, 10
textbox #codeTank.tb 175, 27, 120, 23
statictext #codeTank.searchFor, "Search For", 105, 30, 65, 15
textbox #codeTank.numLines, 860, 50, 120, 25
button #codeTank.searchlb, "&Search | IN >", [startSearching], UL, 325, 27, 120, 23
button #codeTank.incFont, "&+", [incFontSearch], UL, 710, 27, 25, 23
button #codeTank.decFont, "&-", [decFontSearch], UL, 740, 27, 25, 23
button #codeTank.contents, "&LB Help Menu", [Contents], UL, 770, 27, 100, 25
button #codeTank.help, "?", [searchhelp], UL, 300, 27, 20, 23
checkbox #codeTank.lbhelp, "Help", [lbHelp], [nolbHelp], 455, 30, 45, 15
checkbox #codeTank.lbexamples, "Examples Code ", [lbexamples], [nolbexamples], 510, 30, 110, 15
checkbox #codeTank.cbank, "CodeTank", [cbank], [nocbank], 625, 30, 80, 15
texteditor #codeTank.fake, 0, 0, 0, 0
open "CodeTank Plus v1.7.3F" for window as #codeTank
#codeTank.addListing "!disable"
#codeTank.deleteListing "!disable"
#codeTank.remakeproject "!disable"
#codeTank.runListing "!disable"
#codeTank.runlb "!disable"
#codeTank.fromFile "!disable"
#codeTank.merge "!disable"
#codeTank.revert "!disable"
#codeTank "trapclose [quit.codeTank]"
#codeTank "font Arial ";mainFontsize
call getlbreservedwords
call getAscii
#codeTank.keys "singleclickselect"
#codeTank.value "!autoresize"
#codeTank "resizehandler resized"
#codeTank.lbhelp "set"
lbHelp = 1
codetankOpen = 1
categorie$ = "ScratchPad"
open "ScratchPad" for append as #1 : #1 date$();time$() : close #1
wait
'[abort]
'Notice "An Error Has Occured";chr$(13);"Error #";Err;" ";chr$(13);Err$;" ";chr$(13);"CodeTank will need to Shutdown"
'goto [quit.codeTank]
[selectall]
#codeTank.value "!selectall"
wait
[cut]
#codeTank.value "!cut"
wait
[copy]
#codeTank.value "!copy"
wait
[paste]
#codeTank.value "!paste"
wait
[IEXP_man]
run "IEXPRESS"
wait
[lbbEX_man]
filedialog "Open a Liberty Basic Source File (.bas) ", "*.bas", fname$
if fname$ = "" then wait
if fileExists(DefaultDir$,"LBB.exe") then run DefaultDir$;"\LBB.exe -C -M -A ";fname$
wait
[lbbEdit]
filedialog "Open a Liberty Basic Source File (.bas) ", "*.bas", fname$
if fname$ = "" then wait
if fileExists(DefaultDir$,"LBB.exe") then run DefaultDir$;"\LBB.exe ";fname$
wait
[lbbSelEdit]
if selectedKey$ = "" then notice "Select an item from a list, try again" : wait
#codeTank.value, "!contents? valueNow$";
open "untitled.bas" for output as #1
#1 "WARNING - To Preserve the Integrity of the CodeTank File(s) and the Liberty Basic Files(s)"
#1 "THIS CODE IS ACTUALLY a COPY OF ";selectedKey$;".bas Named -> 'untitled.bas' "
#1 "'Remember to 'Save As' a name of your Choice if/when done editing"
#1 ""
#1 valueNow$
close #1
tempfile$ = DefaultDir$;"\untitled.bas"
run DefaultDir$;"\LBB.exe ";q$;tempfile$;q$
#codeTank.filePath "cls" : #codeTank.filePath "Editing ";tempfile$;" in Liberty Basic Editor"
#codeTank.keys "select 0"
wait
[singleEXE]
' Use at your own risk - Author accepts NO liabilities
'########################################################################################
' IMPORTANT
' before running this code - save this code to a file named b2e.bas - (in a folder of it's own)
' If you do not wish to have commandline support, which copies the files of this app, along
' _with creating folders and new files, in the Users Home dir, you can delete or uncomment
' _the following 3 lines of code in the top 1st block of code..
'if not(fileExists(DefaultDir$, "b2e.exe")) then
'command = 1 : firstRun = 1 : project = 1 : fname$ = DefaultDir$;"\b2e.bas" : goto [checklbpath]
'end if
'If you do the above, disregard deleting the folder after first run, it will be needed.
'You can run the .bas from there, or create the TKN file, and run it from there.
'########################################################################################
'BAS2EXE Version v1.8.9c For Windows 10 (possibly XP, 7, 8 and 11) - try it and let me know
' Date Introduced to Public = Jan 29 2023
' Title - BAS2EXE v1.8.9c (with CommandLine support)
' Author - xxgeek, a member of the Libertybasiccom.proboards.com/ forums
' {Purpose} - To automate bas file to exe file (self extracting exe) making creation quick and easy while
' storing dated copies (users choice), of every selected bas file, the created tkn, and the created exe (self extracting)
' exe file containing the dll files, sll files, lbrun2.exe(renamed to same name as .bas file selected)
' Along with that there is a project folder created holding the same files as the exe that gets updated
' if and when the same bas file is selected, Note, the dated files are in their appropriate folders, EXE, TKN, and BAS
' NOTE -They will be overwritten if the same .bas file is selected on the same day within one minute
' The options are user generated by selecting the appropriate checkboxes (GUI)
' Or by Using the appropriate switches (Command Mode)
'GUI MODE
' Place this bas file in it's own folder as it will create some folders and temp files as well as the above
' IMPORTANT > Name this file b2e.bas (or it won't work)
' After first run, delete the folder, including the folders created, and the b2e.bas file
'_ they are no longer needed as this app copies it's files to the users home dir
' There will be a shortcut on the desktop created, use this to open BAS2EXE from now on.
' Note - The Home dir is used in order to make the command line work properly
' Choose 32bit exe or 64`bit exe - defaults to 64 bit if no selection made
' Option to password the EXE file - Check off the checkbox, [Select File] and enter a password when prompted.
' When bas2exe opens a filedialog to choose a bas file choose a bas file that is a
' _good working bas file (or there will be trouble with the compiler)
' Add a version number and or Date/Time stamp the EXE filename
' View the Menu after EXE file creation
'The "Save tkn" file dialog and the Information "saved as" dialog close automatically and save the tkn file to where it is needed.
' If you keep the project folders you will have a "project" folder with each saved project which
'_ includes the dll, sll files and lbrun2.exe(renamed), the selected .bas file and the tkn file.
'The EXE File is saved to the EXE folder in the same folder as this program is located.
' _unless otherwise specified for eg: when using the (CommandLine) and not the GUI (no GUI option for destination - v4.5.1.0 maybe )
' Next Window is to choose to Run the EXE or view the EXE Files Created by this Program
'_ or Make a New EXE
' Note - For standalone bas files only with no dependent files or folders - at this time (Maybe Version 2, we''ll see)
' If the .bas file you select runs in the lb IDE when RUN, the EXE will be made. If there are programming
'_ runtime errors your EXE could still crash at some point (Not BAS2EXE's fault)
' If it won't run in the lb IDE there will be an error reported by the lb compiler when this app attempts to
'_ make the tkn file, and the lb window that opens showing the code for the selected bas file will stay opened
'_, close it manually.
'IMPORTANT INFORMATION
' This new version has CommandLine support, meaning it works from a command prompt.
' or it can be used in code projects with the Run command as well.
'COMMAND MODE
' Syntax for commandline:
' If using the EXE
' b2e -sourceFilePath\file.bas -destinationPath /bas /dt /kp /pw /r /s /tkn /v'number' /bit'number'
' or b2e.exe -sourceFilePath\file.bas -destinationPath /bas /dt /kp /pw /r /s /tkn /v'number' /bit'number'
' If using the TKN in code
' b2e.tkn -sourceFilePath\file.bas -destinationPath /bas /dt /kp /pw /r /s /tkn /v'number' /bit'number'
' if destinationPath is ommtted the default destinationPath is DefaultDir$\EXE
' If sourcePath\file.bas is ommitted BAS2EXE defaults to opening in GUI mode
' If no switches used, all switches defaults are false, 0 or "", except for the bit64 default
' Switches MUST be separated with a 'space'
' Switches are Optional
' Liberty typing b2e by itself BAS2EXE defaults to opening in GUI mode
'Switches
' /bas - saves a dated backup of the selected bas file
' /bit32 - creates a 32 bit exe file
' /bit64 - creates a 64 bit exe file (Defaults to 64bit EXE file if no swtich used)
' /dt - appends date/time to the created exe filename.
' /kp - saves the Project Folder (tkn, renamed lbrun2.exe dll and sll files) Created anyway - they are needed for the EXE file.
' /o - opens windows explorer with the created EXE file selected
' /pw - Prompts user for a password to open the created EXE file (If used the EXE file won't run without it, so save the password somewhere safe.)
' /q - Stops the "Please Wait" activity window from appearing while in command mode.
' /r - Runs the New EXE file after it is created
' /s - shows the Post Creation EXE Menu Window (GUI) to (View / Run / MakeNew - EXE file)
' /tkn - saves a dated backup of the tkn file.
' /v'number' - appends the EXE filename with a version number or text
' (No Spaces) examples: /v4.5.1.51 /v.001 /v123.Any_thing Note: The "v" is not included.
' If you want a v in your EXE filename then you must add one eg: /vv4.5.1 /vvTest123 etc
' Here are some examples of commandline use.
' eg: b2e (alone this opens the GUI)
' b2e -sourceFilePath\file.bas (Creates a single exe file in DefaultDir$\EXE) no project folder, no backups, no appended date/time, or version etc
' b2e -sourceFilePath\file.bas -f:\MyStuff\MyEXEcollection Creates a single 64bit EXE file in f:\MyStuff\MyEXEcollection
' b2e -sourceFilePath\file.bas /bas /bit32 /dt /kp /pw /q /r /s /tkn /vv1.0 (Creates a single 32bit exe file in DefaultDir$\EXE)
' _ including all the optional swtches
' Switches can be in ANY order as long as they preceed the -path(s)
' if -sourceFilePath\file.bas is a lone .bas file with no path, BAS2EXE assumes the file is in the DefaultDir$
' The dashes before the path(S) ARE necessaary
' the spaces between the switches ARE necessary
' Please NOTE - About the app and it's limitations
' This app uses a built in Windows app named IEXPRESS to create the EXE file by way of a SED(Self Extracting Dirctive) file.
' This app write the SED file, then IEXPRESS reads, and executes the instructions in it to create the EXE file.
' IEXPRESS has limits.
' It won't copy a folder, so for now this app can only create EXE files with the necessary runtime support files
' That means (for now anyway) the files needed to work (dll's, sll's tkn renamed lbrun2.exe and the bas file if user wants it.)
' If your .bas file uses any support files from the DefaultDir$ or sub folders of DefaultDir$ such as
' _bmp, txt, etc, they won't be in the EXE file when created.
' The app is great for testing, or for apps that need no support files (other than the lb dlls/slls the tkn and renamed lbrun2.exe )
' _and if your .bas doesn't create any files needed the next time it is opened.
' When an EXE that is created by IEXPRESS executes, it is unpacked in the users temp folder, into a folder
' _named IXP001.tmp, or the number can vary on each persons PC. IXP001......IXP00n (depends on other temp apps I guess)
' These temp folders get deleted when the app is finished doing it's thing as is closed.
' That means if your app saves any data to files in DefaultDir$, or copies any files\folders to DefaultDir$, they get deleted too.
' If the interest is there, and I get some feedback on this app I'll work on a version 2.
' Version 2 will have support for adding extra folders and files to the EXE
' It will also get around the temp folder issue. I have that part working already.
' It may also have an option to batch create the EXE files.
' By having .bas files in a folder, and executing a loop to create one after the other.
' Other suggestions are welcome
' If you use this, please take the time to give some feedback so I know what's up,
' Any issues, don't hesitate to report them
' This App is actually part of a larger app, and the defaults are set 'as is' to accomodate the larger app.
' I didn't want to re-write the whole thing for the 1 person that 'may' use it.
' This app is free to use, edit, and/or distibute. Feel free to make it work the way you want it to.
' New Version v1.8.9
' added ini file to hold Users lb install dir path when detected to be other than default
' added checkbox to allow showing created exe file in Windows Explorer when complete
' added onerror notice, and restart of BAS2EXE
' hardened some more
'New Version 1.9.0c
' changed method of auto[enter] of TKN creation "save as" dialog, and "Information" notice
' changed file verification loops of created exe file and tkn file to allow escape from loop after a set time
' _ to avoid infinite looping with BAS2EXE running invisible, forcing user to use taskmanager to close
' _ when/if exe file or tkn file is NOT created for whatever reason
' added detection of spaces in filename. IEXPRESS will not create a file with spaces in the name of the
' _source file - BAS2EXE will give Notice, then close when Notice closes.
' Tested on files up to 11000 lines - User may need to increase the 2 largest pauses if files have
' _ 11000+ lines of code (look for 'call pause 1500') - 2 of them
[TOP]
if mainOpen = 1 then close #main : mainOpen = 0
command = 0 : s = 0 : openDest = 0 : runEXE = 0 : p = 0 : q = 0 : show = 0
tkn = 0 : bas = 0 : r = 0 : ve$ = "" : ve = 0 : project = 0 : dt = 0 : fname$ = ""
exeDest$ = "" : selectedpath$ = "" : fixeddate$ = "" : fixedtime$ = "" : exe$ = ""
q$ = chr$(34)
if CommandLine$ <> "" then
if not(instr(CommandLine$, ".bas")) then [GUI]
sourc3$ = word$(CommandLine$, 3)
sourc2$ = word$(CommandLine$, 2)
sourc1$ = word$(CommandLine$, 1)
sourc = 1
if instr(sourc1$, ".bas") then fname$ = word$(CommandLine$, 1) : goto [getDest]
sourc = 2
if instr(sourc2$, ".bas") then fname$ = word$(CommandLine$, 2) : goto [getDest]
sourc = 3
if instr(sourc3$, ".bas") then fname$ = word$(CommandLine$, 3)
[getDest]
fname$ = trim$(fname$)
if right$(fname$, 1) = chr$(34) then fname$ = left$(fname$, len(fname$)-1)
if left$(fname$, 1) = chr$(34) then fname$ = right$(fname$, len(fname$)-1)
if left$(fname$ ,1) = "-" then fname$ = right$(fname$, len(fname$)-1)
if left$(fname$ ,1) = "\" then fname$ = right$(fname$, len(fname$)-1)
fname$ = trim$(fname$)
if left$(fname$ ,1) = "\" then fname$ = right$(fname$, len(fname$)-1)
if not(instr(fname$, ":\")) and instr(fname$, ".bas") then fname$ = DefaultDir$;"\";fname$
dest$ = word$(CommandLine$, 2)
if instr(dest$, ":\") and sourc = 1 then exeDest$ = word$(CommandLine$, 2) : goto [gotDest]
dest$ = word$(CommandLine$, 3)
if instr(dest$, ":\") and sourc = 2 then exeDest$ = word$(CommandLine$, 3) : goto [gotDest]
dest$ = word$(CommandLine$, 4)
if instr(dest$, ":\") and sourc = 3 then exeDest$ = word$(CommandLine$, 4) : goto [gotDest]
exeDest$ = DefaultDir$;"\EXE"
[gotDest]
if left$(exeDest$ , 1) = "-" then exeDest$ = right$(exeDest$, len(exeDest$)-1)
if right$(exeDest$, 1) = chr$(34) then exeDest$ = left$(exeDest$, len(exeDest$)-1)
if left$(exeDest$, 1) = chr$(34) then exeDest$ = right$(exeDest$, len(exeDest$)-1)
if left$(exeDest$ , 1) = "-" then exeDest$ = right$(exeDest$, len(exeDest$)-1)
if instr(CommandLine$, "/bas") then bas = 1 'creates a dated backup of the user selected .BAS file in DefaultDir$\BAS
if instr(CommandLine$, "/dt") then dt = 1 'appends the date and time to the EXE file
if instr(CommandLine$, "/kp") then project = 1 'keep the project folder (temp project folder gets deleted by default in command mode)
if instr(CommandLine$, "/o") then openDest = 1 'opens windows explorer to the created EXE file when done
if instr(CommandLine$, "/pw") then p = 1 'password - adds password to bas file - if chosen, the EXE file won't run without it.
if instr(CommandLine$, "/q") then quiet = 1 'no "please wait" window will appear
if instr(CommandLine$, "/r") then runEXE = 1 'Run the newly created exe file.
if instr(CommandLine$, "/s") then show = 1 'show final options window (defaults to not show in command mode)
if instr(CommandLine$, "/tkn") then tkn = 1 'creates a dated backup of the user selected TKN file in DefaultDir$\TKN
if instr(CommandLine$, "/v") then 'ALL CommandLine options default to false, '0' , "", unless switch options are utilized
ve = 1 ' appends a version number to the EXE filename - defaults to false - 0
ve$ = word$(CommandLine$, 2 , "/v") : ve$ = word$(ve$, 1)
end if
bit = 64
if instr(CommandLine$, "/bit") then
bit$ = word$(CommandLine$, 2 , "/bit") : bit$ = word$(bit$, 1) : bit = val(bit$)
end if
command = 1 : goto [noGUI]
end if
[GUI]
exeDest$ = ""
titlebar$ = "BAS2EXE v1.9.0c"
[noGUI]
if command = 1 then [commandPath]
' setup a Window for User to Select a .bas File, to select options for the EXE file.
WindowWidth = 600
WindowHeight = 450
UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "lightgray"
ForegroundColor$ = "black"
'add some text ,some buttons, and checkboxes to the Window
statictext #pick.exe, "EXE File", 35, 30, 95, 30
statictext #pick.head, "BAS<2>EXE v1.9.0c", 250, 25, 190, 30
statictext #pick.temp, "Project Files", 425, 100, 195, 30
statictext #pick.datedtext, "Dated Backups", 225, 100, 185, 30
statictext #pick.info, "Select a working Liberty Basic Source Code File (.bas)", 50, 270, 590, 30
button #pick.default, "Select File", [defaultClick],UL 140, 340, 135, 35
button #pick.lbforums, "Visit the Liberty Basic Forums @ https://Libertybasiccom.proboards.com/", [forumLink],UL 0, 395, 595, 25
checkbox #pick.opendest, "Show EXE File When Completed", [OpenDest], [noOpenDest], 20, 210, 250, 20
checkbox #pick.bit32, "32 Bit", [bit32], [nobit32], 20, 65, 50, 20
checkbox #pick.bit64, "64 Bit", [bit64], [nobit64], 75, 65, 50, 20
checkbox #pick.password, "Add a Password", [yespass], [nopass], 20, 90, 140, 20
checkbox #pick.appDT, "Append Date/Time", [appDT], [noappDT], 20, 115, 140, 20
checkbox #pick.appversion, "Append Version Number", [appVersion], [noappVersion], 20, 140, 140, 20
checkbox #pick.project, "Keep Project Dir", [project], [noproject], 430, 135, 160, 20
checkbox #pick.TKN, "SaveTKN File", [noTKN], [yesTKN], 250, 135, 140, 20
checkbox #pick.BAS,"Save BAS File", [noBAS], [yesBAS], 250, 160, 140, 20
checkbox #pick.ShowOptionsMenu,"Show Post Creation Options Menu", [yesShow], [noShow], 20, 190, 190, 20
checkbox #pick.batch,"Select Folder for Batch EXE Creation", [yaBatch], [noBatch], 50, 310, 190, 20
button #pick.32, "Cancel", [cancel],UL 320, 340, 135, 35
statictext #pick.versionText, "Version #", 40, 170, 50, 20
textbox #pick.ve, 90, 165, 85, 20
'open the Window, and set some Fonts for each statictext, and buttons
open "BAS2EXE v1.9.0c (CommandLine Support)" for window_nf as #pick : pickOpen = 1
#pick, "trapclose [cancel]"
#pick.exe, "!font Arial_bold"
#pick.temp, "!font Arial_bold"
#pick.datedtext, "!font Arial_bold"
#pick.info, "!font Arial_bold"
#pick.head "!font Arial_bold"
#pick.bit64, "set"
#pick.project, "set"
#pick.TKN "set"
#pick.BAS "set"
#pick.appDT "set"
#pick.versionText "!hide"
#pick.ve "!hide"
#pick.default, "!setfocus"
pickOpen = 1
project = 1
tkn = 1
bas = 1
bit = 64
dt = 1
wait
'Create exe files for all bas files in selected folder
[yaBatch]
#pick.info, "Select a Folder with 'Working' Source Files (.bas)"
#pick.default "Select Folder"
batch = 1
wait
[noBatch]
#pick.info, "Select a working Liberty Basic Source Code File (.bas)"
#pick.default "Select File"
batch = 0
wait
[OpenDest]
#pick.opendest "set"
openDest = 1
wait
[noOpenDest]
#pick.opendest "reset"
wait
[yesShow]
show = 1
wait
[noShow]
show = 0
wait
[project]
project = 1
wait
[noproject]
project = 0
wait
[yesTKN]
tkn = 0
wait
[noTKN]
tkn = 1
wait
[yesBAS]
bas=0
wait
[noBAS]
bas = 1
wait
' passworded exe is true(user selected)
[yespass]
p = 1
wait
'passworded exe is false, default
[nopass]
p = 0
wait
'make 32 bit exe = true(user selected)
[bit32]
bit=32
#pick.bit64, "reset" : #pick.bit64 "hide"
wait
'make 64 bit exe, default
[bit64]
bit=64
#pick.bit32, "reset" : #pick.bit32 "hide"
wait
[nobit32]
bit=64
#pick.bit64, "show" : #pick.bit32 "hide"
wait
[nobit64]
bit=32
#pick.bit32, "show" : #pick.bit64 "hide"
wait
'append date/time to backed up tkn, and bas files - defaults to true
[appDT]
dt = 1
wait
[noappDT]
dt = 0
wait
[appVersion]
#pick.versionText "!show"
#pick.ve "!show" : #pick.ve "!setfocus"
ve = 1
wait
[noappVersion]
#pick.ve ""
#pick.versionText "!hide"
#pick.ve "!hide"
ve = 0
wait
[forumLink]
run "explorer https://Libertybasiccom.proboards.com"
wait
[defaultClick]
if ve = 1 then #pick.ve "!contents? ve$" : ve$ = "-";ve$
[commandPath]
'close the opening window for Selecting bas file
if pickOpen = 1 then close #pick : pickOpen = 0
'define some variables
supportFileList$="run451.exe vbas31w.sll vgui31w.sll voflr31w.sll vthk31w.dll vtk1631w.dll vtk3231w.dll vvm31w.dll vvmt31w.dll"
projects$ = "b2eProjects"
'make sure the support files exist
fileCount = 0
while 1
fileCount = fileCount + 1
runtimeSupportFile$ = word$(supportFileList$, fileCount)
if runtimeSupportFile$ = "" then exit while
if fileExists(LBpath$,runtimeSupportFile$) = 0 then notice "File doesn't Exist";chr$(13);LBpath$;"\";runtimeSupportFile$;chr$(13);"BAS2EXE will now Close" : end
wend
if command = 1 then [commandByPass]
' Use the filedialog function to allow user to select a source file (.bas)
[filediag]
global FolderDialog$
caption$ = "Select a Folder with Known Good .bas Files"
if batch = 1 then
call browser caption$
batchDir$ = FolderDialog$
if FolderDialog$ = "" then batch = 0 : wait
gosub [getBatchDir]
goto [commandByPass]
end if
fname$ = ""
filedialog "Open a Liberty Basic Source File (.bas) ", "*.bas", fname$
if fname$ = "" then wait
[commandByPass]
'if batchFileCount = 0 then batchFileCount = 1 : batchFiles$(numRuns) = fname$
if batchFileCount = 0 then batchFiles$(numRuns+1) = fname$
for numRuns = 0 to batchFileCount
fname$=batchFiles$(numRuns+1)
if fname$ = "" then wait
if batch=1 then fname$ = FolderDialog$;"\";fname$
print "numRuns = ";numRuns
print "batchFiles$(numRuns+1) = ";batchFiles$(numRuns+1)
print "fname$ = ";fname$
print "batch = ";batch
if p = 1 then
Prompt "TYPE a PASSWORD"+chr$(13)+ "Password For Your EXE File is? : (no spaces)";passwerd$
if passwerd$ = "" then p = 0 : notice "BAS2EXE will continue, without placing a password on the EXE file created"
end if
'Separate path from selected filename, and extension from selected filename
for var1 = len(fname$) to 1 step -1
if mid$(fname$, var1, 1) = "\" then var2 = var1 -1 : var3 = var2 - ((len(fname$))) : exit for
next var1
var3 = abs(var3)
orig$ = left$(fname$, var2)
fname0$ = right$(fname$, var3 -1)
for var4 = len(fname0$) to 1 step -1
if mid$(fname0$, var4, 1) = "." then var5 = var4 -1 : var6 = var5 - ((len(fname0$))) : exit for
next var4
var6 = abs(var6)
fnamenobas$ = left$(fname0$, var5)
for x = 1 to len(fnamenobas$)
spaceCheck$ = mid$(fnamenobas$, x, 1)
if spaceCheck$ = " " then notice "No Spaces Allowed in File Name"+chr$(13)+"Space found in Selected Filename. Cannot Create EXE File."+chr$(13)+"BAS2EXE will now Close" : end
next x
' fname$ = Full Path of User Selected .bas file (including the filename.bas)
' fname0$ = Name of the Selected .bas File Only - eg ; filename.bas
' fnamenobas$ = Name of the Selected .bas File (without the .bas) - eg: filename
[begin2]
'define Destpath1$ as lb Projects\Current Project Folder
DestPath$=DefaultDir$ 'Where this file is RUN from
DestPathU$ = DestPath$;"\";projects$ 'Projects Folder
DestPath1$=DestPathU$;"\";fnamenobas$ 'Current Project Folder
'Make Folders for Liberty Basic Projects, EXE files, TKN files, BAS files, SED files and Current Projects
res = mkdir(DestPathU$) 'projects dir
res = mkdir(DestPath1$) 'new project dir = name of selected bas file (no .bas) in Projects Dir
res =mkdir(DefaultDir$;"\";"EXE") 'exe files saved here
res = mkdir(DefaultDir$;"\";"TKN") 'tkn files saved here
res= mkdir(DefaultDir$;"\";"BAS") 'selected bas file saved here (includes password code if exe was passworded)
'make sure Folders were actually created
if pathExists(DestPathU$) = 0 then notice "Projects folder was NOT Created in ";DestPath$ : end
if pathExists(DestPath1$) = 0 then notice "New Folder ";fnamenobas$;" was NOT Created in ";DestPath1$ : end
if pathExists(DefaultDir$;"\";"TKN") = 0 then notice "TKN Folder was NOT Created in ";DestPath$ : end
if pathExists(DefaultDir$;"\";"BAS") = 0 then notice "BAS Folder was NOT Created in ";DestPath$ : end
if pathExists(DefaultDir$;"\";"EXE") = 0 then notice "EXE Folder was NOT Created in ";DestPath$ : end
'copy selected bas file to Projects\current project folder
q$= chr$(34)
open fname$ for input as #fname
fnameTemp$="tempBas.bas"
open fnameTemp$ for output as #2
'add a password prompt to the begining of the temp bas file(to be added to the exe)
if p=0 then [nopasswerd] '
#2, "prompt ";q$;"Enter the Password to Run";q$;";";"passwerd$"
#2, "if passwerd$ <> ";q$;passwerd$;q$;" then end"
[nopasswerd]
#2, input$(#fname, lof(#fname));
close #fname
close #2
'copy temp.bas file to current project folder
open fnameTemp$ for input as #fnameTemp
open DestPath1$;"\";fname0$ for output as #1
#1, input$(#fnameTemp, lof(#fnameTemp));
close #1
close #fnameTemp
if fileExists(DefaultDir$, fnameTemp$) then kill fnameTemp$
'check if the current project .bas file was copied to new dir
if fileExists(DestPath1$,fname0$) = 0 then notice fname0$; " Was not copied to ";DestPath1$;" BAS2EXE will now close" : end
'activity message to user - please wait message
if quiet = 0 then call pleasewait
'Copy the needed DLL and SLL files from Liberty Basic dir to projects\projectname Dir
w$ = ""
i = 0
while 1
i = i + 1
w$=word$(supportFileList$, i)
if w$="" then exit while
from$=LBpath$;"\";w$
to$=DestPath1$;"\";w$
if fileExists(DestPath1$,w$) then [noneed]
open from$ for input as #file
open to$ for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
[noneed]
wend
'remove existing lbrun2.exe from new project before creating new one
if fileExists(DestPath1$, LBruntime$) then kill DestPath1$;"\"; LBruntime$
'copy lbrun2.exe to current project Folder
open LBpath$;"\";LBruntime$ for input as #file
open DestPath1$;"\";LBruntime$ for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
'Liberty Basic can't create\rename a file that exists, so if it does already exist - kill it (delete it)
if fileExists(DestPath1$, fnamenobas$ + ".exe") <> 0 then kill DestPath1$;"\";fnamenobas$ + ".exe"
'rename lbrun2.exe to name of User Selected .bas File - .bas +.exe
name DestPath1$;"\";LBruntime$ as DestPath1$;"\";fnamenobas$ + ".exe"
'check new exe (renamed lbrun2.exe) file for existence in current project Folder )
if fileExists(DestPath1$,fnamenobas$;".exe") = 0 then notice "lbrun2.exe not copied or renamed - EXITING Program": end
'remove any existing exe from projectdir - of same name as bas file selected only if created on same date at same time
if fileExists(DestPath$;"\EXE",fnamenobas$;".exe") then kill DestPath$;"\EXE\";fnamenobas$;".exe"
if command = 1 and fileExists(exeDest$,fnamenobas$;".exe") then kill exeDest$;"\"; fnamenobas$;".exe"
'check for old tkn existence, delete it if it exists
if fileExists(DestPath1$,fnamenobas$;".tkn") then kill DestPath1$;"\";fnamenobas$;".tkn"
gosub [makeSED]
'verify sed file existence before proceeding
do
scan
loop until fileExists(DestPath$,fnamenobas$;".sed")
call writeAutoSave
'loop until autoSave$ File is verified
while fileExists(DefaultDir$, autoSave$) = 0 : scan : wend
'#######################################################################
'run the script to close the "save" dialog, and the follow up notice of creation automatically
run "wscript ";autoSave$
'#######################################################################
'Create the TKN file in Projects\current project folder.
run LBpath$;"\";LBexe$;" -T -A ";DestPath1$;"\";fname0$
'#######################################################################
'loop until TKN File is verified saved
do
countTime = countTime + 1
call pause 500
if countTime > 50 then exit do '- In case of unreported error - EXE file verification loop exit
scan
loop until fileExists(DestPath1$, fnamenobas$;".tkn")
call pause 1500
call fixtime : call fixdate ' append date/time to backup .bas and .tkn filename
'copy selected .bas file to BAS dir and date it
if bas = 1 then
open fname$ for input as #file
open DefaultDir$;"\BAS\";fnamenobas$;ve$;fixeddate$;fixedtime$;".bas" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
end if
' copy TKN file to TKN dir, and append date\time to it's name
if tkn = 1 and fileExists(DestPath1$, fnamenobas$;".tkn") <> 0 then
open DestPath1$;"\";fnamenobas$;".tkn" for input as #file
open DefaultDir$;"\TKN\";fnamenobas$;ve$;fixeddate$;fixedtime$;".tkn" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
end if
fixeddate$ = "" : fixedtime$ = ""
'First Run setup in User Home Dir for CommandLine use
if command = 1 and firstRun = 1 then
run "cmd.exe /c xcopy ";DestPath1$;" ";upath$;" /e /s /c /h /i /y", hide
call pause 1000
'call wDS
run upath$;"\b2e.exe"
end if
if firstRun = 1 then close #pleasewait : end
'Check if iexpress.exe is installed (a built in Windows Install Maker = Self Extracting exe File)
[makeexe]
'makes 64 bit exe
if bit=32 then [do32bit]
'run iexpress commandline using the sed file created (sort of like an ini file)
express64$ = "C:\Windows\System32"
if fileExists(express64$,"iexpress.exe") then
run "iexpress /N /q ";sedfile$ : goto [verifyEXE]
else
noie = 1 : goto [quit.main]
end if
'makes 32 bit exe
[do32bit]
express32$ = "C:\Windows\SysWOW64"
if fileExists(express32$,"iexpress.exe") then
run "iexpress /N /q ";sedfile$
else
noie = 2 : goto [quit.main]
end if
'verify the exe file was created - loop until it exists
[verifyEXE]
if command = 1 then
do
countTime = countTime + 1
call pause 500
if countTime > 50 then exit do '- In case of unreported error - EXE file verification loop exit
scan
loop until fileExists(exeDest$, exe$)
end if
if command = 0 then
do
countTime = countTime + 1
call pause 500
if countTime > 50 then exit do '- In case of unreported error - EXE file verification loop exit
scan
loop until fileExists(DefaultDir$;"\EXE\", exe$)
end if
call pause 1500
if dt = 1 then call fixdate : call fixtime
' append version, date, time to filename if selected
if command = 1 then
if fileExists(exeDest$, fnamenobas$;".exe") then
exefilename$ = fnamenobas$;ve$;fixeddate$;fixedtime$;".exe"
name exeDest$;"\";fnamenobas$;".exe" as exeDest$;"\";exefilename$
end if
end if
if command <> 1 then
if fileExists(DefaultDir$;"\EXE", fnamenobas$;".exe") then
exefilename$ = fnamenobas$;ve$;fixeddate$;fixedtime$;".exe"
name DefaultDir$;"\EXE\";fnamenobas$;".exe" as DefaultDir$;"\EXE\";exefilename$
end if
end if
if runEXE = 1 and command = 1 and fileExists(exeDest$, exefilename$) then run exeDest$;"\";exefilename$
[main]
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
'create a window with options to view created files or run the new exe file.
WindowWidth = 400
WindowHeight = 320
UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "darkgray"
ForegroundColor$ = "black"
button #main.default, "Make New Single EXE File (GUI Mode)", [rerun],UL 90, 200, 220, 40
button #main.run, "Run the Created EXE File", [progrun],UL 125, 150, 150, 40
button #main.browseT, "View TKN Files", [browseT],UL 125, 15, 150, 25
button #main.browseB "View BAS Files", [browseB],UL 125, 45, 150, 25
button #main.browseE, "View EXE Files", [browseE],UL 125, 75, 150, 25
button #main.browseP, "View Projects", [browseP],UL 125, 105, 150, 25
button #main.lbforums, "For more Information > Click Here to Visit the Liberty Basic Forums", [forumLink], UL 0, 270, 400, 20
open "View Files\ Run Created EXE \ Make New EXE" for window_nf as #main
#main, "trapclose [quit.main]"
mainOpen = 1
if show <> 1 then close #main : mainOpen = 0
if command = 0 and openDest = 1 then
run "cmd.exe /c explorer /select, ";q$;DefaultDir$;"\EXE\";exefilename$;q$, hide
openDest = 0
if mainOpen = 0 then [quit.main]
end if
if command = 1 and openDest = 1 then
run "cmd.exe /c start explorer.exe /select, ";q$;exeDest$;"\";exefilename$;q$, hide
openDest = 0
if mainOpen = 0 then [quit.main]
end if
cursor normal
next numRuns
batch=0
gosub [cleanUp]
if batch = 1 then [quit.main]
if mainOpen=1 then
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
wait
else
goto [quit.main]
end if
'Make another EXE file
[rerun]
if command = 1 then CommandLine$ = "" : exeDest$ = "" : fname$ = "" : command = 0
goto [TOP]
'open Windows explorer to the EXE Files
[browseE]
if command = 1 and exeDest$ <> "" then run "explorer.exe ";exeDest$
if command = 0 then run "explorer.exe ";DefaultDir$;"\EXE"
wait
'open Windows explorer to the backup TKN Files Files
[browseT]
run "explorer.exe ";DefaultDir$;"\TKN"
wait
'open Windows explorer to the backup BAS Files
[browseB]
run "explorer.exe ";DefaultDir$;"\BAS"
wait
'open Windows explorer to the Projects Dir
[browseP]
run "explorer.exe ";DefaultDir$;"\b2eProjects"
wait
'Run the new CommandLine created exe file chosen
[progrun]
if command = 1 then
run exeDest$;"\";exefilename$
end if
if command = 0 then
run DestPath$;"\EXE\";exefilename$
end if
wait
[getBatchDir]
dim Info$(1, 1)
files batchDir$, Info$()
batchFileCount = val(Info$(0, 0))
dim batchFiles$(batchFileCount+1)
for x = 1 to batchFileCount
filename$ = Info$(x, 0)
if right$(filename$, 4) <> ".bas" then [noThanks]
batchFiles$(x) = filename$
print batchFiles$(x)
[noThanks]
next x
return
[makeSED]
'can't write text to files that include quotes, so use the characters so they will print without syntax errors
sedfile$=fnamenobas$;".sed"
open sedfile$ for output as #sed
#sed "[Version]"
#sed "Class=IEXPRESS"
#sed "SEDVersion=3"
#sed "[Options]"
#sed "PackagePurpose=InstallApp"
#sed "ShowInstallProgramWindow=1"
#sed "HideExtractAnimation=1"
#sed "UseLongFileName=1"
#sed "InsideCompressed=0"
#sed "CAB_FixedSize=0"
#sed "CAB_ResvCodeSigning=0"
#sed "RebootMode=N"
#sed "InstallPrompt=%InstallPrompt%"
#sed "DisplayLicense=%DisplayLicense%"
#sed "FinishMessage=%FinishMessage%"
#sed "TargetName=%TargetName%"
#sed "FriendlyName=%FriendlyName%"
#sed "AppLaunched=%AppLaunched%"
#sed "PostInstallCmd=%PostInstallCmd%"
#sed "AdminQuietInstCmd=%AdminQuietInstCmd%"
#sed "UserQuietInstCmd=%UserQuietInstCmd%"
#sed "SourceFiles=SourceFiles"
#sed "[Strings]"
#sed "InstallPrompt="
#sed "DisplayLicense="
#sed "FinishMessage="
exe$=fnamenobas$;".exe"
if command = 1 and exeDest$ <> "" then
#sed "TargetName=";q$;exeDest$;"\";exe$;q$
else
#sed "TargetName=";q$;DefaultDir$;"\EXE\";exe$;q$
end if
#sed "FriendlyName=";q$;fnamenobas$;q$
#sed "AppLaunched=";q$;exe$;q$
#sed "PostInstallCmd=<None>"
#sed "AdminQuietInstCmd="
#sed "UserQuietInstCmd="
#sed "FILE0=";q$;exe$;q$
sedtkn$=fnamenobas$;".tkn"
#sed "FILE1=";q$;sedtkn$;q$
sll1$="vbas31w.sll"
sll2$="vgui31w.sll"
sll3$="voflr31w.sll"
dll1$="vthk31w.dll"
dll2$="vtk1631w.dll"
dll3$="vtk3231w.dll"
dll4$="vvm31w.dll"
dll5$="vvmt31w.dll"
#sed "FILE2=";q$;sll1$;q$
#sed "FILE3=";q$;sll2$;q$
#sed "FILE4=";q$;sll3$;q$
#sed "FILE5=";q$;dll1$;q$
#sed "FILE6=";q$;dll2$;q$
#sed "FILE7=";q$;dll3$;q$
#sed "FILE8=";q$;dll4$;q$
#sed "FILE9=";q$;dll5$;q$
#sed "[SourceFiles]"
#sed "SourceFiles0=";q$;DestPath1$;q$
#sed "[SourceFiles0]"
#sed "%FILE0%="
#sed "%FILE1%="
#sed "%FILE2%="
#sed "%FILE3%="
#sed "%FILE4%="
#sed "%FILE5%="
#sed "%FILE6%="
#sed "%FILE7%="
#sed "%FILE8%="
#sed "%FILE9%="
close #sed
return
[cleanUp]
if fileExists(DefaultDir$, fnameTemp$) then kill fnameTemp$
if fileExists(DefaultDir$,"temp.txt") then kill "temp.txt"
if fileExists(DefaultDir$, "FolderDialog.vbs") then kill "FolderDialog.vbs"
if fileExists(DefaultDir$, autoSave$) then kill autoSave$
if fileExists(DefaultDir$,desktopShortcut$) then kill desktopShortcut$
'if user chose to, - delete the current project dir and files (copied bas file, tkn file, sll,dll, run451.exe(renamed file)
if project = 0 then
if fileExists(DestPath1$, "vbas31w.sll") then kill DestPath1$;"\";"vbas31w.sll"
if fileExists(DestPath1$, "vgui31w.sll") then kill DestPath1$;"\";"vgui31w.sll"
if fileExists(DestPath1$, "voflr31w.sll") then kill DestPath1$;"\";"voflr31w.sll"
if fileExists(DestPath1$, "vtk1631w.dll") then kill DestPath1$;"\";"vtk1631w.dll"
if fileExists(DestPath1$, "vthk31w.dll") then kill DestPath1$;"\";"vthk31w.dll"
if fileExists(DestPath1$, "vtk3231w.dll") then kill DestPath1$;"\";"vtk3231w.dll"
if fileExists(DestPath1$, "vvm31w.dll") then kill DestPath1$;"\";"vvm31w.dll"
if fileExists(DestPath1$, "vvmt31w.dll") then kill DestPath1$;"\";"vvmt31w.dll"
if fileExists(DestPath1$, exe$) then kill DestPath1$;"\";exe$
if fileExists(DestPath1$, fnamenobas$;".tkn") then kill DestPath1$;"\";fnamenobas$;".tkn"
if fileExists(DestPath1$, fnamenobas$;".bas") then kill DestPath1$;"\";fnamenobas$;".bas"
if pathExists(DestPath1$) then deldir = rmdir(DestPath1$)
end if
if fileExists(DefaultDir$, fnamenobas$;".sed") then kill DefaultDir$;"\";fnamenobas$;".sed"
if noie = 1 then notice "64Bit Version of IEXPRESS not installed"+chr$(13)+" No EXE File Created - BAS2EXE closing."
if noie = 2 then notice "32Bit Version of IEXPRESS not installed"+chr$(13)+" No EXE File Created - BAS2EXE closing."
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
run "cmd.exe /c del ";DefaultDir$;"\*.INF", HIDE
run "cmd.exe /c del ";DefaultDir$;"\*.vbs", HIDE
run "cmd.exe /c del ";DefaultDir$;"\*.sed", HIDE
run "cmd.exe /c del ";DefaultDir$;"\EXE\*.RPT", HIDE
run "cmd.exe /c del ";DefaultDir$;"\EXE\*.CAB", HIDE
run "cmd.exe /c del ";DefaultDir$;"\EXE\*.DDF", HIDE
'if mainOpen = 1 then close #main : mainOpen = 0
if pickOpen = 1 then close #pick : pickOpen = 0
if fileExists(DefaultDir$;"\EXE", "~";fnamenobas$;".CAB") <> 0 then kill DefaultDir$;"\EXE\~";fnamenobas$;".CAB"
if fileExists(DefaultDir$;"\EXE", "~";fnamenobas$;".DDF") <> 0 then kill DefaultDir$;"\EXE\~";fnamenobas$;".DDF"
if fileExists(DefaultDir$;"\EXE", "~";fnamenobas$;".RPT") <> 0 then kill DefaultDir$;"\EXE\~";fnamenobas$;".RPT"
if fileExists(DefaultDir$;"\EXE", "~";fnamenobas$;"_LAYOUT.INF") <> 0 then kill DefaultDir$;"\EXE\~";fnamenobas$;"_LAYOUT.INF"
return
[quit.main]
if command = 0 and openDest = 1 then run "cmd.exe /c explorer /select, ";q$;DefaultDir$;"\EXE\";exefilename$;q$, hide
gosub [cleanUp]
if command = 1 and fileExists(exeDest$, exefilename$) = 0 then notice "No EXE Created"+chr$(13)+"EXE file was NOT created"+chr$(13)+"Check Selected File 'name' for Spaces"
if command = 0 and fileExists(DefaultDir$;"\EXE\", exefilename$) = 0 then notice chr$(13)+"EXE file was NOT created"+chr$(13)+"Check Selected File 'name' for Spaces"
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
if mainOpen = 1 then close #main : mainOpen = 0
wait
[quit.pleasewait]
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
wait
[cancel]
close #pick
wait
[newKey] 'ask the user for a name for the new listing
call saveValue
newKey$ = ""
if len(left$(categorie$, (len(categorie$) - 1))) < 4 then [notPlural]
prompt "Enter a Name (or Title) for the New " + left$(categorie$,(len(categorie$)-1)); newKey$
if newKey$ <> "" then [continue] else wait
[notPlural]
prompt "Enter a Name (or Title) for the New "+categorie$+" Script"; newKey$
if newKey$ = "" then wait
'if user selects 'New From File' instead of New (copy/paste) to add new Project, or new Program
[continue]
if newKey$ <> "" then
call setValueByName newKey$, ""
call loadKeys
#codeTank.keys "select "; newKey$
#codeTank.value "!cls";
call collectGarbage
call writeDictionary
lastKey$ = newKey$
end if
if tkn = 2 or tkn = 4 then
open fname$ for input as #1
open categorie$ for append as #2
#2 input$(#1, lof(#1));
close #1
close #2
gosub [cleanUp]
tkn = 0
end if
call saveValue
call readDictionary
call loadKeys
#codeTank.keys "select 0"
#codeTank.value "!setfocus"
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
wait
[keySelected]
call saveValue
#codeTank.keys "selection? selectedKey$"
if categorie$ = anyFolder$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";anyFolder$;" Section - ";selectedKey$
if categorie$ = examples$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";examples$;" Section - ";selectedKey$
if categorie$ = snippets$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";snippets$;" Section - ";selectedKey$
if categorie$ = cmd$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";cmd$;" Section - ";selectedKey$
if categorie$ = vbs$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";vbs$;" Section - ";selectedKey$
if categorie$ = subroutines$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";subroutines$;" Section - ";selectedKey$
if categorie$ = functions$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";functions$;" Section - ";selectedKey$
if categorie$ = MyProjects$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";MyProjects$;" Section - ";selectedKey$
if categorie$ = programs$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";programs$;" Section - ";selectedKey$
if categorie$ = lbExamples$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";lbExamples$;" File - ";uAppPath$;"\";selectedKey$;".bas"
#codeTank.value "!cls"
open uAppPath$;"\";selectedKey$;".bas" for input as #1
#codeTank.value, "!contents #1";
close #1
#codeTank.value, "!origin 0, 0"
#codeTank.value, "!lines numLines$"
#codeTank.numLines "# of Lines = ";numLines$
wait
end if
if categorie$ = lbBakFiles$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";lbBakFiles$;" File - ";uAppPath$;"\bak\";selectedKey$;".bak"
#codeTank.value "!cls"
open uAppPath$;"\bak\";selectedKey$;".bak" for input as #1
#codeTank.value, "!contents #1";
close #1
#codeTank.value, "!origin 0, 0"
#codeTank.value, "!lines numLines$"
#codeTank.numLines "# of Lines = ";numLines$
wait
end if
if categorie$ = anyFolder$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";folderChoice$;" File - ";folderpath$;"\";selectedKey$;".bas"
#codeTank.value "!cls"
open folderpath$;"\";selectedKey$;".bas" for input as #1
#codeTank.value, "!contents #1";
close #1
#codeTank.value "!origin 0 0"
#codeTank.value, "!lines numLines$"
#codeTank.numLines "# of Lines = ";numLines$
wait
end if
if categorie$ = MyBackups$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";MyBackups$;" File - ";DefaultDir$;"\BAS\";selectedKey$;".bas"
#codeTank.value "!cls"
open DefaultDir$;"\";"BAS\";selectedKey$;".bas" for input as #1
#codeTank.value, "!contents #1";
close #1
#codeTank.value, "!origin 0 0"
#codeTank.value, "!lines numLines$"
#codeTank.numLines "# of Lines = ";numLines$
wait
end if
selectedValue$ = getValue$(selectedKey$)
#codeTank.value "!contents selectedValue$";
lastKey$ = selectedKey$
#codeTank.value, "!origin 0 0"
#codeTank.value, "!lines numLines$"
#codeTank.numLines "# of Lines = ";numLines$
wait
[deleteKey]
'delete a Listing
gosub [deleteNow]
wait
[deleteNow]
#codeTank.keys "selection? selectedKey$"
if selectedKey$ = "" then notice "Select an item from list, try again" : cursor normal : wait
[deleteOrig]
cursor hourglass
call pleasewait : pleasewaitOpen = 1
#codeTank.filePath "cls" : #codeTank.filePath "Erasing ";selectedKey$;" code from - ";categorie$
#codeTank.value, "!selectall"
#codeTank.value, "!cut"
#pleasewait.fake "!setfocus"
call saveValue
if categorie$ = "" then
categorie$ = "ScratchPad" : selectedKey$ = "Scratch"
open categorie$ for append as #1
#1 chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 Pad$
close #1
end if
open categorie$ for input as #1
tempfile$ = "tempfile"
open tempfile$ for output as #2
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
while eof(#1) = 0
line input #1, line$
if line$ = word1$ then [dontSave]
#2, line$
[dontSave]
wend
close #1
close #2
if fileExists(DefaultDir$, categorie$) then kill DefaultDir$;"\";categorie$
name tempfile$ as categorie$
lastKey$ = ""
call readDictionary
call loadKeys
call saveValue
#codeTank.keys "select 0"
if pleasewaitOpen = 1 then pleasewaitOpen = 0 : close #pleasewait
cursor normal
if pathExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$) <> 0 and mir = 0 then
folder$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$
text$ = "Title: "+selectedKey$+chr$(13)+" Has been Deleted"+chr$(13)+chr$(13)+"Do you wish to delete the project folder as well?"
a$ = custcon$(text$)
if answer$ <> "Yes" then wait
a$ = delete$(folder$)
end if
return
'run selected MyProjects, or MyPrograms
[runKey]
if selectedKey$ = "" then notice "Select an item from list, try again" : wait
text$ = "Warning "+chr$(13)+"RUNing this Code May Leave an IDE Window"+chr$(13)+"and or"+chr$(13)+"Leave Mainwin Open when it Closes";chr$(13)+"It May Not Open at all, or it May Just Flash Open and Close"+chr$(13)+"Run it Anyway ?"
if categorie$ = lbBakFiles$ then
runFile$ = uAppPath$;"\bak\";selectedKey$;".bak"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(code$,"trapclose",1) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
temp$ = DefaultDir$;"\untitled.bas"
open temp$ for output as #1
#codeTank.value "!contents? code$"
#1 ""
#1 " 'This Code is a Copy of - ";q$;selectedKey$;".bak";q$
#1 ""
#1 code$
close #1
run LBpath$;"\";LBexe$;" -R -A ";temp$
wait
end if
if categorie$ = MyBackups$ then
runFile$ = DefaultDir$;"\BAS\";selectedKey$;".bas"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(lower$(code$),lower$("trapclose")) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
temp$ = DefaultDir$;"\untitled.bas"
open temp$ for output as #1
#codeTank.value "!contents? code$"
#1 ""
#1 " 'This Code is a Copy of - ";q$;selectedKey$;".bas";q$
#1 ""
#1 code$
close #1
run LBpath$;"\";LBexe$;" -R -A ";temp$
wait
end if
if categorie$ = anyFolder$ then
runFile$ = FolderDialog$;"\";selectedKey$;".bas"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(lower$(code$),lower$("trapclose")) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
temp$ = DefaultDir$;"\untitled.bas"
open temp$ for output as #1
#codeTank.value "!contents? code$"
#1 ""
#1 " 'This Code is a Copy of - ";q$;selectedKey$;".bas";q$
#1 ""
#1 code$
close #1
run LBpath$;"\";LBexe$;" -R -A ";temp$
wait
end if
if categorie$ = lbExamples$ then
runFile$ = uAppPath$;"\";selectedKey$;".bas"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(lower$(code$),lower$("trapclose")) = 0 or instr(lower$(code$),lower$("'nomainwin")) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
run LBpath$;"\";LBexe$;" -R -A ";runFile$
wait
end if
if categorie$ = programs$ and fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".tkn") <> 0 then
runFile$ = savedProjects$;"\";selectedKey$;"\";selectedKey$;".tkn"
#codeTank.filePath "cls" : #codeTank.filePath "Running - ";DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".tkn"
run runFile$
wait
end if
if categorie$ = MyProjects$ or categorie$ = programs$ and fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".exe") <> 0 then
runFile$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".exe"
#codeTank.filePath "cls" : #codeTank.filePath "Running - ";DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".exe"
run runFile$
wait
end if
if categorie$ = MyProjects$ or categorie$ = programs$ and fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".bas") = 0 then
notice "Cannot be RUN"+chr$(13)+"This Title was Created Manually"+chr$(13)+selectedKey$+chr$(13)_
+" Not created using 'New from File'"+chr$(13)+chr$(13)_
+"Edit with Liberty Basic and save it as the 'Same Name..bas"+chr$(13)+"Select Radio Button "+categorie$+chr$(13)+"Select Button [New from File]"+chr$(13)_
+"Select the .bas file you just saved."+chr$(13)+" It will be available to RUN from then on"
end if
#codeTank.value "!cls"
#codeTank.keys "select 0"
wait
'open selected listing in just Basic IDE
[edit_In_LB_IDE]
if selectedKey$ = "" then notice "Select an item from a list, try again" : wait
#codeTank.value, "!contents? valueNow$";
open "untitled.bas" for output as #1
#1 "WARNING - To Preserve the Integrity of the CodeTank File(s) and the Liberty Basic Files(s)"
#1 "THIS CODE IS ACTUALLY a COPY OF ";selectedKey$;".bas Named -> 'untitled.bas' "
#1 "'Remember to 'Save As' a name of your Choice if/when done editing"
#1 ""
#1 valueNow$
close #1
tempfile$ = DefaultDir$;"\untitled.bas"
run LBpath$;"\";LBexe$;" ";q$;tempfile$;q$
#codeTank.filePath "cls" : #codeTank.filePath "Editing ";tempfile$;" in Liberty Basic Editor"
#codeTank.keys "select 0"
wait
[mergeFile]
filedialog "Select a ";categorie$ ;" file to merge ",DefaultDir$, mergefile$
if mergefile$ = "" then wait
a$ = GetFilename$(mergefile$)
if a$ <> categorie$ then
answer$ = "yes"
prompt " Categories Don't Match "+chr$(13)+" Merge Anyway?" ; answer$
if answer$ <> "yes" then wait
end if
open mergefile$ for input as #1
line input #1, dataline$ : close #1
mergeCheck$ = chr$(134)+chr$(165)+chr$(134)
if left$(dataline$, 3) <> mergeCheck$ then notice "Merge with ";categorie$+" Issue"+chr$(13)+chr$(13)+"Unable to Merge File named "+chr$(13)+a$+chr$(13)+"The formatting of file "+a$+" is incompatible" : wait
call pleasewait : cursor hourglass
open mergefile$ for input as #1
open DefaultDir$;"\";categorie$ for append as #2
#2 input$(#1, lof(#1));
close #2 : close #1
call readDictionary
call collectGarbage
call writeDictionary
call loadKeys
close #pleasewait
cursor normal
#codeTank.keys "select 0"
wait
[codeTankHelp]
notice "codeTank is curently in development, For Help, please visit the LB forums";chr$(13);chr$(13);"@ https://libertybasiccom.proboards.com/"
wait
[about]
notice "codeTank is curently in development. Please Visit ";chr$(13);chr$(13);"https://libertybasiccom.proboards.com/"
wait
[revert]
revert = 1
'Work starts here
#codeTank.keys "selection? name$"
if name$ = "" then notice "Select an item from list, try again" : wait
filedialog "Open a 'KNOWN WORKING' Source File (.bas) ", DefaultDir$;"\BAS\*";selectedKey$;"*.bas", fname$
if fname$ = "" then wait
open fname$ for input as #1
fnamenobas$ = word$(fname$, 2, "--") : fnamenobas$ = left$(fnamenobas$, len(fnamenobas$) - 4)
open DefaultDir$;"\";savedProjects$;"\";fnamenobas$;"\";fnamenobas$;".bas" for output as #2
#2 input$(#1, lof(#1)) : close #1 : close #2
goto [remakeproject]
wait
[openlb]
run LBpath$;"\";LBexe$
wait
'top menu "Open File in LB IDE"
[openlbFile]
filedialog "Open \ Select a Liberty Basic Source File (.bas) ", upath$; "\*.bas", openFilename$
if openFilename$ = "" then wait
#codeTank.filePath "cls" : #codeTank.filePath "File Opened in Liberty Basic - ";openFilename$
run LBpath$;"\";LBexe$;" ";openFilename$
wait
[basFiles]
run "explorer.exe ";q$;DefaultDir$;"\";"BAS";q$
wait
'open the following in Windows Explorer
[projectsDir]
run "explorer.exe ";q$;DefaultDir$;"\";"savedProjects";q$
wait
[EXEDir]
a$ = DefaultDir$;"\EXE"
run "explorer.exe ";q$;a$;q$
wait
[tknDir]
a$ = DefaultDir$;"\TKN"
run "explorer.exe ";q$;a$;q$
wait
[lbexamplesDir]
if pathExists(uAppPath$) <> 0 then
run "explorer.exe ";q$;uAppPath$;q$
else
if pathExists(uAppPath$) <> 0 then run "explorer.exe ";uAppPath$
end if
wait
[defaultDir]
run "explorer.exe ";q$;DefaultDir$;q$
wait
'radio button selections from MyProjects to Help
[projs]
#codeTank.runListing, "!enable"
#codeTank.remakeproject, "!enable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!enable"
#codeTank.merge "!enable"
#codeTank.merge "!enable"
#codeTank.revert, "!enable"
call saveValue
#codeTank.value, "!cls"
categorie$ = MyProjects$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
category$ = right$(category$,7)
#codeTank.addListing, "&New ";category$;" (Copy/Paste)"
#codeTank.fromFile, "&New ";category$;" (From File)"
wait
[progs]
#codeTank.runListing, "!enable"
#codeTank.remakeproject, "!enable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!enable"
#codeTank.merge, "!enable"
#codeTank.revert, "!enable"
call saveValue
#codeTank.value, "!cls"
categorie$ = programs$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.keys "singleclickselect"
#codeTank.addListing, "&New ";category$;" (Copy/Paste)"
#codeTank.fromFile, "&New ";category$;" (From File)"
wait
[exams]
#codeTank.runListing, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = examples$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1))
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.addListing, "&New ";category$
wait
[snipps]
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.runListing, "!disable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = snippets$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1))
wait
[subroutines]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = subroutines$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.addListing, "&New ";category$
wait
[functions]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = functions$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1))
category$= left$(categorie$, (len(categorie$) - 1))
wait
[vbs]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = vbs$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, len(categorie$)-1)
category$ = categorie$
wait
[cmd]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = cmd$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, len(categorie$)-1)
category$ = categorie$
wait
[lbCodeExamples]
if fileExists(DefaultDir$, lbExamples$) <> 0 then kill DefaultDir$;"\";lbExamples$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = lbExamples$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
dim folderInfo$(1, 1)
files uAppPath$, folderInfo$()
numExamps = val(folderInfo$(0, 0))
dim lbExamplesList$(numExamps)
open lbExamples$ for append as #1
x = 0
[skipp]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : wait
filename$ = folderInfo$(x, 0)
if right$(filename$, 3) <> "bas" then [skipp]
lbExamplesList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = lbExamplesList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skipp]
[lbbakfiles]
if fileExists(DefaultDir$, lbBakFiles$) <> 0 then kill DefaultDir$;"\"; lbBakFiles$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = lbBakFiles$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
dim folderInfo$(1, 1)
files uAppPath$;"\bak\", info$()
numExamps = val(info$(0, 0))
dim lbBakFilesList$(numExamps)
open lbBakFiles$ for append as #1
x = 0
[skipit]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : wait
filename$ = info$(x, 0)
if right$(filename$, 3) <> "bak" then [skipit]
lbBakFilesList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = lbBakFilesList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skipit]
[mybackups]
if fileExists(DefaultDir$, MyBackups$) <> 0 then kill DefaultDir$;"\";MyBackups$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = MyBackups$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
gettingMybackupFiles = 1
dim folderInfo$(1, 1)
files DefaultDir$;"\";"BAS", folderInfo$()
numExamps = val(folderInfo$(0, 0))
dim MyBackupsList$(numExamps)
a$=DefaultDir$;"\";categorie$
open DefaultDir$;"\";categorie$ for append as #1
x = 0
[skiphere]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : wait
filename$ = folderInfo$(x, 0)
if right$(filename$, 3) <> "bas" then [skiphere]
MyBackupsList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = MyBackupsList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skiphere]
[folderChoice]
folderChoice$ = "folderChoice.txt"
if fileExists(DefaultDir$, folderChoice$) <> 0 then kill DefaultDir$;"\";folderChoice$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
caption$ = "Navigate to, and Select YOUR Liberty Basic (or Pro) Install Dir"
call browser (caption$)
if right$(FolderDialog$,1) = "\" then FolderDialog$ = left$(FolderDialog$, len(FolderDialog$)-1)
if FolderDialog$ = "" then notice "No Folder Selected" : wait
if len(FolderDialog$) = 2 then notice "Drive ";left$(FolderDialog$, 2);" Selected - You MUST Select a Folder" : goto [folderChoice]
folderpath$ = FolderDialog$
#codeTank.value, "!cls"
categorie$ = folderChoice$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
redim folderInfo$(1, 1)
files folderpath$, folderInfo$()
numExamps = val(folderInfo$(0, 0))
redim folderList$(numExamps)
open folderChoice$ for append as #1
x = 0
[skipnow]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : categorie$ = anyFolder$ : wait
filename$ = folderInfo$(x, 0)
if right$(filename$, 3) <> "bas" then [skipnow]
folderList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = folderList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skipnow]
[forumlink]
run "explorer.exe https://libertybasiccom.proboards.com/"
wait
'resize window font - sets all fonts equal
[incFont]
mainFontsize = mainFontsize + 1
#codeTank.value "!font Arial ";mainFontsize
#codeTank.keys "font Arial ";mainFontsize
wait
[decFont]
mainFontsize = mainFontsize - 1
#codeTank.value "!font Arial ";mainFontsize
#codeTank.keys "font Arial ";mainFontsize
wait
'create a project and tkn file and add it to the MyProjects List
[makeproject]
call saveValue
#codeTank.filePath "cls" : #codeTank.filePath "Creating Project ";DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas"
tkn = 2
if categorie$ <> MyProjects$ then tkn = 4
goto [defaultclick]
[remakeproject]
call saveValue
if selectedKey$ = "" then notice "Select an item from list, try again" : wait
tempCat$=categorie$
if fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$,selectedKey$;".bas") = 0 then
notice "Cannot be Updated - Title was Created Manually"+chr$(13)+selectedKey$+chr$(13)_
+" Wasn't created using a File"+chr$(13)+chr$(13)_
+"Edit with Liberty Basic and save it using the SAME NAME.bas."+chr$(13)+"Select Radio Button My"+categorie$+chr$(13)+"Select Button [New "+left$(categorie$, len(categorie$)-1);" from File]"+chr$(13)_
+"Select the appropriate .bas file."+chr$(13)+" In Future it Will be Available for Updating"
#codeTank.keys "select 0"
#codeTank.value "!cls"
categorie$ = tempCat$
else
fname$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas"
end if
categorie$ = tempCat$
#codeTank.value "!contents? code$"
open fname$ for input as #1
code$ = input$(#1,lof(#1))
close #1
open DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas" for output as #1
#1 code$
close #1
tkn = 4
if revert = 1 then fname$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas"
#codeTank.filePath "cls" : #codeTank.filePath "Updating ";fname$
if tkn = 4 then [makeTKN]
[defaultclick]
'Checking all paths and file locations for existence (dll's, sll's, lbasic.exe, and lbrun2.exe)
res=fileExists(LBpath$, LBexe$)
if res then a = a + 1 else notice LBexe$;" Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,LBruntime$)
if res then a = a + 1 else notice LBrun$;" Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vbas31w.sll")
if res then a = a + 1 else notice " vbas31w.sll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vgui31w.sll")
if res then a = a + 1 else notice " vgui31w.sll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"voflr31w.sll")
if res then a = a + 1 else notice " voflr31w.sll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vthk31w.dll")
if res then a = a + 1 else notice " vthk31w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vtk1631w.dll")
if res then a = a + 1 else notice " vtk1631w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vtk3231w.dll")
if res then a = a + 1 else notice " vtk3231w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vvm31w.dll")
if res then a = a + 1 else notice " vvm31w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vvmt31w.dll")
if res then a = a + 1 else notice " vvmt31w.dll Does not exist in ";LBpath$;" Closing Program": goto [quit.codeTank]
' Use the filedialog function to allow user to select a source file (.bas)
[fileDiag]
'open file dialog to choose a .bas file for exe conversion, "*.bas;*.bak",.txt
filedialog "Open a 'KNOWN WORKING' Source File (.bas) ", DefaultDir$, fname$
if fname$ = "" then wait
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$;" Creating tkn file for - ";fname$
[makeTKN]
call pleasewait : pleasewaitOpen = 1
#pleasewait.fake "!setfocus"
'Separate path from selected filename, and extension from selected filename
for var1 = len(fname$) to 1 step -1
if mid$(fname$, var1, 1) = "\" then var2 = var1 -1 : var3 = var2 - ((len(fname$))) : exit for
next var1
var3 = abs(var3)
orig$ = left$(fname$, var2)
fname0$ = right$(fname$, var3 -1)
'finish separating filename from extension
for var4 = len(fname0$) to 1 step -1
if mid$(fname0$, var4, 1) = "." then var5 = var4 -1 : var6 = var5 - ((len(fname0$))) : exit for
next var4
var6 = abs(var6)
fnamenobas$ = left$(fname0$, var5)
' fname$ = Full Path of User Selected .bas file (including the filename.bas)
' fname0$ = Name of the Selected .bas File Only - eg ; filename.bas
' fnamenobas$ = Name of the Selected .bas File (without the .bas) - eg: filename
[begin]
'define Destpath1$ as LB Projects\Current Project Folder
DestPath$=DefaultDir$ 'Where this file is RUN from
DestPathU$ = DestPath$;"\";savedProjects$ 'Projects Folder
DestPath1$=DestPathU$;"\";fnamenobas$ 'Current created Project Folder
'Make Folders for Liberty Basic Projects, EXE files, TKN files, BAS files, SED files and Current Projects
res = mkdir(DestPathU$) 'projects dir
res = mkdir(DestPath1$) 'new project dir = name of selected bas file (no .bas) in Projects Dir
res = mkdir(DefaultDir$;"\";"TKN") 'tkn files saved here
res= mkdir(DefaultDir$;"\";"BAS") 'selected bas file saved here (includes password code if exe was passworded)
'make sure Folders were actually created
res=pathExists(DestPathU$)
if res then a=a+1 else notice "savedProjects folder was NOT Created in ";DestPath$;" codeTank Closing" : goto [quit.codeTank]
if res then a=a+1 else notice "New Folder ";fnamenobas$;" was NOT Created in ";DestPath1$;" codeTank Closing" : goto [quit.codeTank]
tknFolder$=DefaultDir$;"\";"TKN"
res=pathExists(tknFolder$)
if res then a=a+1 else notice "TKN Folder was NOT Created in ";DestPath$;" codeTank Closing" : goto [quit.codeTank]
basFolder$=DefaultDir$;"\";"BAS"
res=pathExists(basFolder$)
if res then a=a+1 else notice "BAS Folder was NOT Created in ";DestPath$;" codeTank Closing" : goto [quit.codeTank]
'copy selected bas file to Projects\current project folder
open fname$ for input as #1
data$ = input$(#1,lof(#1)) : close #1
open DestPath1$;"\";fname0$ for output as #2
#2 data$
close #2
'check if the current project .bas file was copied to new dir
if fileExists(DestPath1$,fname0$) = 0 then notice fname0$; " Was not copied to ";DestPath1$;" codeTank Closing" : goto [quit.codeTank]
if tkn = 4 then [tknOnly] 'bypass for Categorie Programs and Updates - tkn and bas file only needed
'Copy the needed DLL and SLL files from Liberty Basic dir to projects\projectname Dir
i = 0
while 1
i = i + 1
runtimeSupportFile$=word$(DllList$,i)
if runtimeSupportFile$ ="" then exit while
sourceFile$=LBpath$;"\";runtimeSupportFile$
destinationFile$=DestPath1$;"\";runtimeSupportFile$
'don't copy runtime files if they already exists
if fileExists(DestPath1$, runtimeSupportFile$) <> 0 then [fileExists]
open sourceFile$ for input as #file
open destinationFile$ for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
[fileExists]
wend
'verify dll's and sll's were copied to new project folder
res=fileExists(DestPath1$,"vbas31w.sll")
if res then a = a + 1 else notice " vbas31w.sll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vgui31w.sll")
if res then a = a + 1 else notice " vgui31w.sll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"voflr31w.sll")
if res then a = a + 1 else notice " voflr31w.sll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vthk31w.dll")
if res then a = a + 1 else notice " vthk31w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vtk1631w.dll")
if res then a = a + 1 else notice " vtk1631w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vtk3231w.dll")
if res then a = a + 1 else notice " vtk3231w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vvm31w.dll")
if res then a = a + 1 else notice " vvm31w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vvmt31w.dll")
if res then a = a + 1 else notice " vvmt31w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
'remove any left over existing lbrun2.exe from new project before creating new one
'Liberty Basic can't create\rename a file that exists, so if it does already exist - kill it (delete it)
if fileExists(DestPath1$, LBruntime$) <> 0 then kill DestPath1$;"\"; LBruntime$
'copy lbrun2.exe to Current Project Folder
open LBpath$;"\";LBruntime$ for input as #file
open DestPath1$;"\";fnamenobas$;".exe" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
'check new exe (renamed lbrun2.exe) file for existence in current project Folder )
if fileExists(DestPath1$,fnamenobas$;".exe") = 0 then notice "lbrun2.exe not copied or renamed - EXITING Program": goto [quit.codeTank]
[tknOnly]
call fixtime
call fixdate
'copy selected .bas file to BAS dir and date it
open DestPath1$;"\";fname0$ for input as #file
open DestPath$;"\BAS\";fixeddate$;fixedtime$;"-";fnamenobas$;".bas" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
'remove any existing tkn of same name in TKN dir
if fileExists(DestPath1$, fnamenobas$;".tkn") <> 0 then kill DestPath1$;"\";fnamenobas$;".tkn"
'write/run the script to close the "save" dialog, and the follow up "information" notice of creation automatically
call writeAutoSave
'loop until autoSave$ File is verified
while fileExists(DefaultDir$, autoSave$) = 0 : scan : wend
run "wscript ";autoSave$
'#######################################################################
'Create the TKN file in Projects\current project folder.
RUN q$;LBpath$;"\";LBexe$;q$;" -T -A ";DestPath1$;"\";fname0$
'loop until TKN File is verified
while www = 0
if fileExists(DestPath1$,fnamenobas$;".tkn") <> 0 then exit while
scan
wend
call pause 3500
'copy TKN$ file to TKN dir, and date it
open DestPath1$;"\";fnamenobas$;".tkn" for input as #file
open DefaultDir$;"\TKN\";fixeddate$;fixedtime$;"-";fnamenobas$;".tkn" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
if fileExists (DefaultDir$;"\TKN", fixeddate$;fixedtime$;"-";fnamenobas$;".tkn") = 0 then notice fixeddate$;fixedtime$;"-";fnamenobas$;".tkn";" was NOT created in ";DefaultDir$;"\TKN" : wait
[continueOn]
'check what tkn value =, and continue to create the 'new key'
if tkn = 2 or tkn = 4 then newKey$ = fnamenobas$
goto [continue]
[initiate]
global selectedKey$, lastKey$, categorie$, FolderDialog$, dictionary$, q$, codetankOpen, fixeddate$, fixedtime$, folder$, lastKey$
'global 'selectedKey$, fixeddate$, fixedtime$, project, fnamenobas$, DestPath$, DestPath1$, JBexe$,_
'LBpath$, keyCount, q$, lastKey$, selectedpath$, upath$, folder$, folderpath$
'First we need the users home path
CSIDL.PROFILE = 40
upath$ = GetSpecialFolder$(CSIDL.PROFILE)
if fileExists(DefaultDir$, "codetank.ini") then
open DefaultDir$;"\codetank.ini" for input as #1
line input #1, LBpath$ : close #1
if fileExists(LBpath$, "liberty.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic v4.5.1"
LBexe$ = "liberty.exe"
end if
if fileExists(LBpath$, "lbpro.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic Pro v4.5.1"
LBexe$ = "lbpro.exe"
end if
goto [check]
end if
if fileExists(upath$;"\AppData\Roaming\Liberty Basic Pro v4.5.1", "freeform404.bas") then
uAppPath$ = upath$;"\AppData\Roaming\Liberty Basic Pro v4.5.1"
LBpath$ = "c:\Program Files (x86)\Liberty Basic Pro v4.5.1"
if fileExists(LBpath$, "lbpro.exe") then
LBexe$ = "lbpro.exe"
goto [check]
end if
end if
if fileExists(upath$;"\Application Data\Liberty Basic v4.5.1", "freeform450.bas") then
uAppPath$ = upath$;"\Application Data\Liberty Basic v4.5.1"
LBpath$ = "c:\Program Files (x86)\Liberty Basic v4.5.1"
if fileExists(LBpath$, "liberty.exe") then
LBexe$ = "liberty.exe"
end if
end if
[check]
text$ = chr$(13)+" Liberty Basic v4.5.1 was not installed to the default Install folder."+chr$(13)+chr$(13)+"Would you like to Browse to and Select your Liberty Basic 4.5.1"+chr$(13)+"(or Pro)"+chr$(13)+"Install Folder"
'if Liberty Basic v4.5.1 is NOT installed to it's Default Install Dir, get Path from User using folder dialog
if fileExists(LBpath$, LBexe$) <> 0 then [start] else a$ = custcon$(text$)
if answer$ <> "Yes" then end
caption$ = "Navigate to, and Select YOUR Liberty Basic v4.5.1 (or Pro) Install Dir"
call browser, caption$
if right$(FolderDialog$, 1) = "\" then FolderDialog$ = left$(FolderDialog$, len(FolderDialog$)-1)
if FolderDialog$ = "" then notice "Liberty Basic v4.5.1 must be installed to continue" : end
LBpath$ = FolderDialog$
open "codetank.ini" for output as #1
#1 LBpath$ : close #1
if fileExists(LBpath$, "liberty.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic v4.5.1"
LBexe$ = "liberty.exe"
end if
if fileExists(LBpath$, "lbpro.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic Pro v4.5.1"
LBexe$ = "lbpro.exe"
end if
return
'FastCode written by cundo, a member of the Liberty Basic / Just Basic Forums
'edited by xxgeek to suit this app
[fastcode]
dim windowTypes$(19)
windowTypes$(0)= "":windowTypes$(1)= "dialog":windowTypes$(2)= "dialog_fs":windowTypes$(3)= "dialog_nf":windowTypes$(4)= "dialog_nf_fs"
windowTypes$(5)= "dialog_ns_modal":windowTypes$(6)= "dialog_modal":windowTypes$(7)= "dialog_popup":windowTypes$(8)= "graphics"
windowTypes$(9)= "graphics_fs":windowTypes$(10) = "graphics_nf":windowTypes$(11)= "graphics_nsb":windowTypes$(12)= "graphics_nsb_nf"
windowTypes$(13)= "text":windowTypes$(14)= "text_fs":windowTypes$(15)= "text_nsb":windowTypes$(16)= "text_nsb_ins":windowTypes$(17)= "window"
windowTypes$(18)= "window_nf":windowTypes$(19)= "window_popup"
WindowWidth = 430:WindowHeight = 470
UpperLeftX= int((DisplayWidth-WindowWidth)/2)
UpperLeftY= int((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "lightgray"
ForegroundColor$ = "black"
texteditor #fastcode.ed, 8, 130, 400, 200
statictext #fastcode.fastcode, "Create Window Code", 135, 5, 165, 20
statictext #fastcode.st1, "< Name && Handle >", 150, 25, 128, 20
statictext #fastcode.st1, "Window Type", 50, 55, 90, 20
textbox #fastcode.txt1, 290, 20, 115, 20
textbox #fastcode.txt2, 20, 20, 115, 20
combobox #fastcode.combo, windowTypes$(, dummy, 145, 50, 140, 20
checkbox #fastcode.r1, "Use Labels instead of Subs", dummy, dummy, 8, 90, 222, 20
button #fastcode.button1, "&Generate Code ^ + > Copy to Clipboard", dummy, ul, 70, 340, 270, 25
button #fastcode.preview, "Preview", [preview], ul, 160, 375, 75, 25
open "FastCode by cundo" for window as #fastcode
#fastcode "trapclose [quit.fastcode]"
#fastcode "font arial 10 Bold"
#fastcode.txt1 "#main"
#fastcode.txt2 "untiltled"
#fastcode.combo "selectindex 17"
fastcodeOpen = 1
#codeTank.fastwindows "!disable"
#fastcode.r1 "set"
wait
[preview]
temp$ = "temp.bas"
open temp$ for output as #1
#fastcode.ed "!contents? code$"
#1 code$
close #1
run LBpath$;"\";LBexe$;" -A ";DefaultDir$;"\";temp$
wait
[quit.fastcode]
close #fastcode
fastcodeOpen = 0
#codeTank.fastwindows "!enable"
wait
'The [Search] button was pressed, or after searching/changing font size etc, the program was directed back here.
[search]
#codeTank.tb "!enable" : #codeTank.tb "!selectall"
done = 0
count = 0
#results.default "!setfocus"'
wait
[startSearching]
#codeTank.tb "!disable"
redim searchList$(10)
if resultsOpen = 0 then gosub [results]
#codeTank.tb "!contents? searchFor$"
if searchFor$ = "" then [search]
searchList$(0) = " "
searchList$(1) = " "
searchList$(2) = " Searching the Liberty Basic v4.5.1 Files"
searchList$(3) = " "
searchList$(4) = " For Files containing ";upper$(searchFor$)
searchList$(5) = " "
searchList$(6) = " "
searchList$(7) = " "
searchList$(8) = " "
searchList$(9) = " P L E A S E W A I T"
#results.listbox2 "reload"
searchFor$=trim$(searchFor$)
count = 3
cursor hourglass
redim searchList$(2600)
redim oneOf$(2500)
#results.listbox2 "setfocus"
'search lb help files
if lbHelp = 1 then
files helpFilePath$;"\html", info$()
numFiles = val(info$(0,0 ))
for i = 1 to numFiles
fileToOpen$ = info$(i, 0)
open helpFilePath$;"\html\"; fileToOpen$ for input as #2
contents$ = input$(#2, lof(#2)) : close #2
if instr(lower$(contents$), lower$(searchFor$)) then
x = 1
if lower$(searchFor$) = "and" then oneOf$(count) = "H_AND" : count = count + 1
if lower$(searchFor$) = "not" then oneOf$(count) = "H_NOT" : count = count + 1
if lower$(searchFor$) = "xor" then oneOf$(count) = "H_XOR" : count = count + 1
if lower$(searchFor$) = "or" then oneOf$(count) = "H_OR" : count = count + 1
listName$ = helpFilePath$;"\html\"; fileToOpen$
open listName$ for input as #1 : isOpen = 1
while not(eof(#1))
scan
line input #1, name$
if x = 5 and lower$(left$(name$, 7)) = lower$("<TITLE>") then
name3$ = mid$(name$, 8, len(name$)-15) : if right$(name3$, 4) = "Etc." then name3$ = left$(name3$, len(name3$) - 1)
oneOf$(count) = "H_";name3$ : count = count + 1
end if'
if x = 8 and left$(lower$(name$), 7) = lower$("<TITLE>") then
name5$ = mid$(name$, 8, len(name$)-15)
oneOf$(count) = "H_";name5$ : count = count + 1
end if
if x = 12 and left$(name$ , 5) = "<P><A" then
name8$ = word$(name$, 2, "</A><B>") : name8$ = left$(name8$, len(name8$)-8)
oneOf$(count) = "H_";name8$ : count = count + 1
end if
if x = 14 and left$(name$ , 3) = "<P>" then
name7$ = mid$(name$, 4, len(name$)-7)
oneOf$(count) = "H_";name7$ : count = count + 1
end if
if x = 15 and right$(name$, 8) = "</B></P>" then
name11$ =word$(name$, 2, "B>") : name11$ = left$(name11$, len(name11$)-2)
oneOf$(count) = "H_";name11$ : count = count + 1
exit while
end if
x = x + 1
wend
if isOpen = 1 then close #1 : isOpen = 0
end if
next i
end if
'Search the LB Code Examples Files
if lbexamples = 1 then
files uAppPath$, "*.bas", info$()
numFiles = val(info$(0,0 ))
for i = 1 to numFiles
fileToOpen$ = info$(i, 0)
open uAppPath$;"\";fileToOpen$ for input as #2
contents$ = input$(#2, lof(#2)) : close #2
if instr(lower$(contents$), lower$(searchFor$)) then
name$ = upper$(fileToOpen$)
name20$ = left$(name$, len(name$)-4)
oneOf$(count) = "CE_";name20$ : count = count + 1
end if
next i
end if
'Search the CodeBank saved .bas files
if codeTank = 1 then
files DefaultDir$;"\BAS", "*.bas", info$()
numFiles = val(info$(0,0 ))
for i = 1 to numFiles
fileToOpen$ = info$(i, 0)
open "BAS";"\";fileToOpen$ for input as #2
contents$ = input$(#2, lof(#2)) : close #2
if instr(lower$(contents$), lower$(searchFor$)) then
name$ = upper$(fileToOpen$)
name20$ = left$(name$, len(name$)-4)
oneOf$(count) = "CB_";name20$ : count = count + 1
end if
next i
end if
'if no search results found
if count < 4 then
#results.listbox2 "reload"
searchList$(0) = " "
searchList$(1) = " "
searchList$(2) = " "
searchList$(3) = " Nothing found for: ";upper$(searchFor$)
searchList$(4) = " "
searchList$(5) = " "
searchList$(6) = " "
searchList$(7) = " Try Adding more Categories "
searchList$(8) = " "
searchList$(9) = " To the Search Engine"
searchList$(10) = " "
searchList$(11) = " Using the CheckBoxes"
searchList$(12) = " "
searchList$(13) = " To Visit the Liberty Basic Forums"
searchList$(14) = " "
searchList$(15) = " Click the Link Below"
searchList$(16) = " "
searchList$(17) = " https://libertybasiccom.proboards.com/"
searchList$(18) = " "
searchList$(19) = " "
searchList$(20) = " "
#results.listbox2 "reload"
cursor normal
end if
'sort the list of possible results
sort oneOf$(), 0, count
dim b$(count+1)
happened$="|"
K = 0
'filter out the false Titles (Due to differences in html help pages source code - Title not on same line in all files)
for i = 0 to count
name$ = oneOf$(i)
if right$(name$, 1) = ">" or right$(name$, 6) = "window" or left$(name$, 5) = "H_ame" or right$(name$, 8) = "position"_
or left$(name$, 5) = "H_GCO" or right$(name$, 1) = ":" or left$(name$, 3) = "H_<" _
or left$(name$, 3) = "H_"+chr$(39) or right$(name$, 1) = "." or right$(name$, 1) = " " or right$(name$, 8) = "[branch]"_
or right$(name$, 3) = "] )" or right$(name$, 3) = "] ]" or right$(name$, 6) = "items)" or name$ = "H_WHILE...WEND"_
or right$(name$, 5) = "size)" or right$(name$, 1) = ";" or right$(name$, 5) = "LEN=n" or right$(name$, 7) = "number)" _
or right$(name$, 7) = "#handle" or right$(name$, 4) = "varN" or right$(name$, 4) = "...)" or right$(name$, 2) = "];" _
or right$(name$, 1) = "v" or right$(name$, 8) = "fontSpec" or right$(name$, 7) = "expr2 )" or right$(name$, 2) = "))"_
or right$(name$, 12) = "variableName" or right$(name$, 4) = "num2"or right$(name$, 5) = ".bmp"+chr$(34)_
or right$(name$, 2) = chr$(34)+")" or right$(name$, 4) = "var"+chr$(36) or right$(name$, 4) = ",n])"_
or right$(name$, 4) = "expr" or right$(name$, 4) = "num2" or right$(name$, 9) = chr$(34)+"refresh"+chr$(34)_
or right$(name$, 3) = "g])" or right$(name$, 6) = "Label]" or right$(name$, 8) = "#handle)" or right$(name$, 9) = "String$ )"_
or right$(name$, 11) = "Expression)" or right$(name$, 10) = "expression" or right$(name$, 9) = "[number])"_
or right$(name$, 7) = "struct)" or right$(name$, 7) = "comment" or right$(name$, 12) = "recordNumber"_
or right$(name$, 5) = "size)" or right$(name$, 6) = "follow" or right$(name$, 6) = "mode ]" or right$(name$, 8) = "number )" or name$ = "H_TRACE number"_
or right$(name$, 8) = "[column]" or right$(name$, 10) = "#handle, n" or right$(name$, 2) = " 1" or right$((left$(name$, 7)), 5) = chr$(34)+"Font"_
or right$(name$, 9) = "{LEN = n}" or right$(name$, 5) = "Expr2" or right$(name$, 6) = "length"or left$(name$, 9) = "H_Install"_
or right$(name$, 10) = "#newHandle" or right$(name$, 12) = "columns rows" or right$(name$, 5) = "Expr$"_
or left$(name$, 4) = "var =" or right$(name$, 6) = "xpr2 )" or left$(name$, 3) = "H_(" or right$(name$, 6) = chr$(34)+"name"+chr$(34) _
or right$(name$, 4) = "#h )" or right$(name$, 9) = "#handle )" or right$(name$, 1) = "�" or right$(name$, 1) = "."_
or name$ = "H_DO LOOP" or name$ = "H_FOR...NEXT" or name$ = "H_Winstring" or right$(name$, 8) = "value"+chr$(34)+" )"_
or right$(name$,1) = "?" or right$(name$,3) = "c$)" or right$(name$,8) = "Keywords" or name$ ="H_Boolean Evaluations"_
or left$(name$, 3) = "H_&" or name$ = "H_" or name$= "H_var = MIDIPOS( )" or name$ = "H_TRACE ( number )"_
or name$ = "H_StartupDir" or name$ = "H_EVAL" or name$ = "H_EVAL$" or right$(name$, 4) = "face" or left$(name$, 10) = "H_The Liberty"_
or name$ = "H_REPLSTR" or name$ = "H_UPPER$(s)" or right$(name$,8) = "[END IF]" or name$ = "H_LOWER$(s$)" then
oneOf$(i) = ""
end if
'remove any duplicates from search list (Thanks to tsh73)
'if instr(oneOf$(i), "Liberty") then oneOf$(i) = replace$(name$, "Liberty", "Liberty")
if lower$(nameLast$) = lower$(name$) then oneOf$(i) = ""
if instr(happened$, "|";oneOf$(i);"|")=0 then
happened$=happened$;oneOf$(i);"|"
K=K+1: b$(K)=oneOf$(i)
end if
nameLast$ = name$
next i
'Create final list of search results
for x = 0 to K
if lower$(word$(b$(x), 2, "_")) = lower$(searchFor$) then match$ = b$(x)
if instr(lower$(b$(x)), lower$(searchFor$)) _
and lower$(mid$(b$(x), 3, len(searchFor$))) = lower$(searchFor$)_
or lower$(mid$(b$(x), 4, len(searchFor$))) = lower$(searchFor$) then_
searchList$(u+7) = b$(x) : u = u+1
next x
for t = 0 to K
if instr(lower$(b$(t)), lower$(searchFor$)) then
if lower$(mid$(b$(t), 3, len(searchFor$))) <> lower$(searchFor$)_
and lower$(mid$(b$(t), 4, len(searchFor$))) <> lower$(searchFor$) then
searchList$(u+v+16) = b$(t) : v = v+1
end if
end if
next t
for a = 0 to K
if not(instr(lower$(b$(a)), lower$(searchFor$))) then_
searchList$(u+v+ww+23) = b$(a) : ww = ww+1
next a
'manage the headers
searchList$(0) = " Search Results"
searchList$(1) = " "
searchList$(2) = " ";u+v;" Titles Containing ";q$;upper$(searchFor$);q$
if u+v <> 0 then searchList$(3) = " "
if u+v = 0 then searchList$(2) = " No Titles Found for ";q$;upper$(searchFor$);q$';" Found"
searchList$(4) = " "
if u <> 0 and v<>0 then searchList$(5) = " ";u;" Top Picks For ";q$;upper$(searchFor$);q$
searchList$(u+11) =" "
if v <> 0 and v<>u+v then searchList$(u+13) = " ";v;" Remaining Titles "'
if v <> 0 then searchList$(u+14) =" "
if v <> 0 then searchList$(v+u+19) = " "
if ww-2 <> 0 then searchList$(v+u+20) = " ";ww-3;" Other Pages Containing ";upper$(searchFor$)
if u+v = 0 then searchList$(1) = " ";ww-2;" Pages Containing ";upper$(searchFor$)
searchList$(v+u+21) = " "
searchList$(v+u+ww+22) = " "
searchList$(v+u+ww+23) = " If you need more information "
searchList$(v+u+ww+24) = " on "
searchList$(v+u+ww+25) = " Liberty Basic v4.5.1 Coding "
searchList$(v+u+ww+26) = " "
searchList$(v+u+ww+27) = " Please Visit"
searchList$(v+u+ww+28) = " "
searchList$(v+u+ww+29) = " The Liberty Basic Forums by"
searchList$(v+u+ww+30) = " "
searchList$(v+u+ww+31) = " Clicking the link Below"
searchList$(v+u+ww+32) = " "
searchList$(v+u+ww+33) = " https://libertybasiccom.proboards.com/"
searchList$(v+u+ww+34) = " "
searchList$(v+u+ww+35) = " "
searchList$(v+u+ww+36) = " "
searchList$(v+u+ww+37) = " "
if match$ <> "" then searchList$(4) = " 1 Match "
#results.listbox2 "reload" : #results.default "!setfocus"
'finished displaying results - reset variables - cursor back to normal
[doneSearching]
u = 0 : v = 0 : ww = 0 : match$ = "" : count = 0
#codeTank.tb "!enable"
#codeTank.tb "!selectall"
#codeTank.tb "!setfocus"
#results.listbox2 "setfocus"
cursor normal
wait
'One of the Help Search results was Selected - Open the Help File in user's default browser
[openFile]
if lbHelp = 1 then
#results.listbox2 "selection? selectionH$"
selectionH$ = trim$(selectionH$)
if selection$ = " https://libertybasiccom.proboards.com/" then_
selection$ = right$(selection$, len(selection$)-1) : run "explorer ";selection$ : wait
selectionH$ = right$(selectionH$, len(selectionH$) - 2)
if selectionH$ = "XOR" or selectionH$ = "AND" or selectionH$ = "NOT" or selectionH$ = "OR" then
run "explorer.exe ";helpFilePath$;"\html\libe0azy.htm" : wait
end if
files helpFilePath$;"\html", info$()
numFiles = val(info$(0,0 ))
for i = 1 to numFiles
fileToOpen$ = info$(i, 0)
open helpFilePath$;"\html\";fileToOpen$ for input as #3
contents$ = input$(#3, lof(#3)) : close #3
if instr(lower$(contents$), lower$("<title>";selectionH$;"</TITLE>")) then
if fileToOpen$ = "idecode451.html" then fileToOpen$ = "libe0ze8.htm"
if fileExists("", "htmlviewer.exe") <> 0 then
run "htmlviewer.exe ";helpFilePath$;"\html\";fileToOpen$ : done = 1 : wait
else
run "explorer.exe ";helpFilePath$;"\html\";fileToOpen$ : done = 1 : wait
if done = 1 then exit for
if done = 1 then wait
if instr(lower$(contents$), lower$("</A><B>";selectionH$;"</B></P>")) then
if fileExists("", "htmlviewer.exe") <> 0 then
run "htmlviewer.exe ";helpFilePath$;"\html\";fileToOpen$ : done = 1 : wait
else
run "explorer.exe ";helpFilePath$;"\html\";fileToOpen$ : done = 1 : wait
if done = 1 then exit for
end if
end if
end if
end if
next i
if done = 1 then wait
end if
'a Code Example file was selected
if lbexamples = 1 then
#results.listbox2 "selection? selectionCE$"
selectionCE$ = right$(selectionCE$, len(selectionCE$) - 3)
if fileExists(uAppPath$, selectionCE$;".bas") then
run LBpath$;"\";LBexe$;" ";uAppPath$;"\";selectionCE$;".bas" : wait
end if
end if
'a Code Bank .bas file backup was selected
if codeTank = 1 then
#results.listbox2 "selection? selectionCB$"
selectionCB$ = right$(selectionCB$, len(selectionCB$) - 3)
if fileExists(DefaultDir$;"\BAS", selectionCB$;".bas") then
run LBpath$;"\";LBexe$;" ";DefaultDir$;"\BAS\";selectionCB$;".bas" : wait
end if
end if
'if the link to the Liberty basic Forums is clicked (link at bottom of search results)
#results.listbox2 "selection? selection$"
if selection$ = " https://libertybasiccom.proboards.com/" then_
selection$ = right$(selection$, len(selection$)-1) : run "explorer ";selection$ : wait
wait
'a selection was made from the Help Menu list
[mainList]
#codeTankList.listbox1 "selection? h$"
fileToOpen$= word$( h$,2,chr$(0))
fileToOpen$=replace$( fileToOpen$ , "/", "\" )
if fileExists(DefaultDir$, "htmlviewer.exe") <> 0 then run "htmlviewer.exe ";helpFilePath$; "\"; fileToOpen$_
else_
if fileExists(helpFilePath$, fileToOpen$) <> 0 then run "explorer.exe ";helpFilePath$; "\"; fileToOpen$
wait
'show results
[results]
if resultsOpen = 1 then return
WindowWidth = 255 : WindowHeight = 600
UpperLeftX=int((DisplayWidth-WindowWidth)/2) + 600
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
listbox #results.listbox2, searchList$(, [openFile], 0, 0, 256, 600
button #results.default, "", [startSearching], UL, 0, 0, 0, 0
Open "LB HELP SEARCH RESULTS" for dialog as #results
resultsOpen = 1
#results "trapclose [quitResults]"
#results.listbox2 "reload"
#results.listbox2 "singleclickselect"
if fontsize <> 0 then fontsize = fontsize else fontsize = 9
#results.listbox2 "font Arial_bold 0 ";fontsize+6
#results.listbox2 "setfocus"
return
'show LB Help Menu - button
[Contents]
if mainListOpen = 1 then #codeTankList.default "!setfocus" : #codeTank.tb "!setfocus" : wait
open helpFilePath$; "\"; helpFileMenu$ for input as #1
txt$ = input$(#1, lof(#1))
close #1
'Load the "Contents" menu list array
lowerTxt$= lower$(txt$)
while 1
scan
startAt = c+1
a = instr(lowerTxt$, "href",startAt)
b = instr(lowerTxt$, ">",a+1)
c = instr(lowerTxt$, "</a>",b+1)
if a=0 or b=0 or c= 0 then exit while
hrefA= instr(lowerTxt$,chr$(34),a+1)
hrefB= instr(lowerTxt$,chr$(34),hrefA+1)
idx = idx +1
mainList$(idx)= trim$(mid$(txt$,b+1,c-b-1));chr$(0);_
trim$(mid$(txt$,hrefA+1,hrefB-hrefA-1))
wend
WindowWidth = 255 : WindowHeight = 600
UpperLeftX=int((DisplayWidth-WindowWidth)/2 + 600)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
listbox #codeTankList.listbox1, mainList$(, [mainList], 0, 0, 256, 600
button #codeTankList.default, "&GO", [search], UL, 0, 0, 0, 0
Open "Liberty Basic v4.5.1 Help Menu" for dialog as #codeTankList
mainListOpen = 1
#codeTankList "trapclose [quitMainList]"
#codeTankList.listbox1 "singleclickselect"
#codeTankList.listbox1 "reload"
if fontsize <> 0 then fontsize = fontsize else fontsize = 9
#codeTankList.listbox1 "font Arial_bold 0 ";fontsize+6
idx = 0
#codeTankList.listbox1 "setfocus"
'if resultsOpen = 1 then #codeTank.tb "!setfocus"
wait
'resize window font - sets all Listbox fonts equal
[incFontSearch]
fontsize = fontsize + 1
if resultsOpen = 1 then #results.listbox2 "font Arial_bold 0 ";fontsize+6
if mainListOpen = 1 then #codeTankList.listbox1 "font Arial 0 ";fontsize+6
if resultsOpen = 1 then #results.default "!setfocus"
wait
[decFontSearch]
fontsize = fontsize - 1
if resultsOpen = 1 then #results.listbox2 "font Arial_bold 0 ";fontsize+6
if mainListOpen = 1 then #codeTankList.listbox1 "font Arial 0 ";fontsize+6
if resultsOpen = 1 then #results.default "!setfocus"
wait
'set and reset checkboxes for search categories
[lbHelp] lbHelp = 1
if resultsOpen = 1 then #results.default "!setfocus"
wait
[nolbHelp] lbHelp = 0
if resultsOpen = 1 then #results.default "!setfocus"
wait
[lbexamples] lbexamples = 1
if resultsOpen = 1 then #results.default "!setfocus"
wait
[nolbexamples] lbexamples = 0
if resultsOpen = 1 then #results.default "!setfocus"
wait
[cbank] codeTank = 1
if resultsOpen = 1 then #results.default "!setfocus"
wait
[nocbank] codeTank = 0
if resultsOpen = 1 then #results.default "!setfocus"
wait
'The [?] or 'help' button for this program was pressed
[searchhelp]
if helpOpen = 1 then wait
notice " Tiny LB-Search Help File";_
CHR$(13);CHR$(13);_
"Type your Search Word ( no char minimum ), and hit [Search In >]";_
" If your text doesn't appear at any time, just hit [Enter] and start typing agin";_
CHR$(13);_
CHR$(13);_
"Search results are marked to indicate the category they represent";_
CHR$(13);_
CHR$(13);" CHECKBOXES and CATEGORIES: ";_
CHR$(13);_
"H= LB Help, CE= LB Code Examples, CT = CodeTank Files";_
CHR$(13);_
CHR$(13);_
"Results marked H open help pages in your default browser";_
CHR$(13);_
"C stands for Code - Results marked CE, and CT open in Liberty Basic";_
CHR$(13);CHR$(13);_
CHR$(13);CHR$(13);_
"Alt + F4 closes the open window with focus";_
" unless another window is clicked on";_
CHR$(13);CHR$(13);_
"Use + or - to Adjust Font Size - Fontsize changes on all Lists, opened or not";_
CHR$(13);CHR$(13);_
CHR$(13);CHR$(13);" ADDING TO the Liberty BASIC RUN MENU";_
CHR$(13);CHR$(13);_
"How to ADD this to the Liberty BASIC menu Run > for easy access.";_
CHR$(13);_
"1) To Make the TKN file : Top Menu > Run > Make *.tkn File.";_
" Use any name for the file when the -File 'Save As'- window opens";_
" Remember the File Location, and Name of the File.";_
CHR$(13);_
"2) In Liberty Basic click the menu item: Setup > External Programs";_
CHR$(13);_
"3) Click on New , type a name that suits the app, eg: LB_Help_Search";_
" This name will appear in LB's Menu as Run > NameYouChose ";_
CHR$(13);_
"4) Click on Create Item.";_
CHR$(13);_
"5) Click the Browse Button, then navigate to the .tkn File created in step 1.";_
CHR$(13);_
"6) Liberty BASIC will inform you changes take effect after restarting Liberty Basic."
helpOpen = 1
wait
'close Help List
[quitMainList]
if resultsOpen = 1 then close #results : resultsOpen = 0
close #codeTankList : mainListOpen = 0
wait
'close results List
[quitResults]
close #results : resultsOpen = 0
wait
[fastGui]
'Title FFUltra v2.x author = Rod
'version FFNSL_vxx2.0
'edited by xxgeek
fastGuiOpen = 1
ver$="xx2.0"
'nomainwin
dim info$(10,10)
dim form$(10)
form$(1)="Restore"
form$(2)="New"
form$(3)="Save .ffu"
form$(4)="Load .ffu"
form$(5)="-----------"
form$(6)="Write .bas"
form$(7)="Import .bas"
form$(8)="Export .bas"
form$(9)="File"
dim hnd$(30)
hnd$(1)="#1"
dim grid$(20)
grid$(1)="1"
grid$(2)="3"
g=3
for n= 5 to 30 step 5
grid$(g)=str$(n)
g=g+1
next
grid$(g)="Invisible"
grid$(g+1)="Visible"
grid$(g+2)="Set Grid"
grid=10
gridvisible=1
gridcolor$="buttonface"
projectctrh=25
ctrh=25
dim color$(10)
color$(1)="Control Back"
color$(2)="Project Back"
color$(3)="Project Fore"
color$(4)="Grid Color"
color$(5)="Border Color"
color$(6)="CrossHair"
color$(7)="Set Color"
projectback$="white"
projectfore$="black"
dim font$(10)
font$(1)="Control Font"
font$(2)="ResetControl"
font$(3)="Project Font"
font$(4)="Set Font"'default is Consolas 9"
dim wind$(20)'window type names
wind$(1)="window"
wind$(2)="window_nf"
wind$(3)="window_popup"
wind$(4)="dialog"
wind$(5)="dialog_modal"
wind$(6)="dialog_nf"
wind$(7)="dialog_nf_modal"
wind$(8)="dialog_fs"
wind$(9)="dialog_nf_fs"
wind$(10)="dialog_popup"
wind$(11)="graphics"
wind$(12)="graphics_fs"
wind$(13)="graphics_fs_nsb"
wind$(14)="graphics_nsb"
wind$(15)="graphics_nf_nsb"
wind$(16)="text"
wind$(17)="text_fs"
wind$(18)="text_nsb"
wind$(19)="text_nsb_ins"
dim v$(2000)
for n= 100 to 2000 step 20
v$(n)=str$(n)
next
dim obj(200,6) 'x,y,width/height,type,textheight
XX=1
Y=2
W=3
H=4
TT=5
TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline
Ctr=1
Tex=2
Ress=3
Fon=4
Bak=5
Bass=7
'set default starting position
projectfile$="Untitled.bas"
projectwind$="window_nf"
projecttitl$="Untitled"
projectform$="#1"
projectctrl$=""
projecttext$=""
projectreso$=""
projectfont$="Consolas 9"
projectback$="white"
projectfore$="black"
projecttbcl$="white"
projectlbcl$="white"
projectcbcl$="white"
projecttecl$="white"
gridcolor$="buttonface"
bordercolor$ = "darkgray" 'border of grid dimension limits of x,y
crosshair$ = gridcolor$ 'crosshair available in grid = 0 or grid = 1
barrier = 1 'barrier - form dimension limit - when tracking / resizing controls
negbar = 1 'negative barrier - less than zero - when tracking / resizing controls
projectctrh=25
projectgrid=10
projectw=600
projecth=400
insertx=grid
inserty=grid*2
'open a small progress bar window and hide it
WindowWidth=230
WindowHeight=60
UpperLeftX=(DisplayWidth-230)/2
UpperLeftY=(DisplayHeight-350)/2
graphicbox #prog.gb1,10,0,200,25
open "Import" for window_nf as #prog
#prog "font Consolas 9"
#prog "hide"
progOpen = 1
'open a small properties window and hide it
WindowWidth=230
WindowHeight=260
UpperLeftX=(DisplayWidth)/2+420
UpperLeftY=(DisplayHeight-180)/2
statictext #prop.st1 "File",5,10,30,25
textbox #prop.tbfile,45,5,150,25
statictext #prop.st2 "Wind",5,32,30,25
combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25
statictext #prop.st3 "Titl",5,54,30,25
textbox #prop.tbtitl,45,49,150,25
statictext #prop.st4 "Form",5,76,30,25
textbox #prop.tbform,45,71,150,25
statictext #prop.st5 "Ctrl",5,98,30,25
textbox #prop.tbctrl,45,93,150,25
statictext #prop.st6 "Text",5,120,30,25
textbox #prop.tbtext,45,115,150,25
statictext #prop.st7 "Reso",5,142,30,25
textbox #prop.tbreso,45,137,150,25
statictext #prop.st8 "xywh",5,164,30,25
textbox #prop.tbxywh,45,159,150,25
statictext #prop.st9 "Font",5,186,30,25
textbox #prop.tbfont,45,181,150,25
statictext #prop.st10 "Colo",5,208,30,25
textbox #prop.tbcolo,45,203,150,25
open "Properties" for window_nf as #prop
#prop "font Consolas 9"
#prop "trapclose [show]"
#prop.cbwind "select window_nf"
#prop.tbfile "!disable"
#prop.tbxywh "!disable"
#prop.tbfont "!disable"
#prop.tbcolo "!disable"
gosub [propertyupdate]
#prop "hide"
propOpen = 1
'open the main form window
'this window is resizable, the graphicox will resize but the
'client area, which is a drawn representation of the window
'will only change size if you change the project w/h dimensions
WindowWidth=862
WindowHeight=600 'gb is offset by 25
UpperLeftX=(DisplayWidth-WindowWidth)/2
UpperLeftY=(DisplayHeight-WindowHeight)/2
combobox #fful.fastfunctionsList,fastfunctionsList$(),fastfunctionSelected,680,2,140,25
combobox #fful.form,form$(,[form],5,2,85,30
combobox #fful.hand,hnd$(,[hand],91,2,85,30
button #fful.code,"Co&de",[code],UL,177,0,43,25
button #fful.gui,"G&UI",[prev],UL,222,0,40,25
combobox #fful.w,v$(,[formsize],265,2,55,30
combobox #fful.h,v$(,[formsize],321,2,55,30
combobox #fful.grid,grid$(,[grid],375,2,90,30
statictext #fful.gridsize "10",470,7,15,15
combobox #fful.color,color$(,[color],490,2,90,30
combobox #fful.font,font$(,[font],585,2,90,30
button #fful.barrier,"No Barrier &+",[barrier],UL,850,0,100,20
button #fful.help,"&?",[help],UL,820,0,25,25
button #fful.negbarrier,"No Barrier &-",[negbarrier],UL,850,22,100,20
statictext #fful.corner, "UpperLeft",960,12,75,15
statictext #fful.cornertext, " Corner >",960,25,85,15
statictext #fful.Xco, "x 0" ,1045,2,65,20
statictext #fful.Yco, "y 0",1045,24,65,20
button #fful.mnu,"&Menu",[bttnMNU],UL,5,25,45,20
button #fful.button,"&Button",[bttnBTTN],UL,50,25,55,20
button #fful.textbox,"&Textbox",[bttnTXBX],UL,105,25,65,20
button #fful.lstbx,"&Listbox",[bttnLSTBX],UL,170,25,65,20
button #fful.cmbobx,"&Combobox",[bttnCMBOBX],UL,235,25,65,20
button #fful.statictext,"&Statictext",[bttnSTTX],UL,300,25,80,20
button #fful.bmpbttn,"BM&Pbutton",[bttnBMPBTTN],UL,380,25,75,20
button #fful.grphcbx,"&Graphicbox",[bttnGRPHCBX],UL,455,25,80,20
button #fful.rdiobttn,"&Radiobutton",[bttnRDBTTN],UL,535,25,85,20
button #fful.chckbx,"Chec&kbox",[bttnCHKBX],UL,620,25,70,20
button #fful.grpbx,"Groupbo&x",[bttnGRPBX],UL,690,25,70,20
button #fful.txtedtr,"Text&editor",[bttnTXTEDTR],UL,760,25,85,20
graphicbox #fful.gb,5,45,830,510
textbox #fful.path,1115,0,200,20
combobox #fful.blocks,block$(,[block],1115,22,200,30
open ver$;" Form Preview Form Dimensions Grid - Size Colors Fonts Add Subs\Functions Help Form Limits (X,Y) Coordinates" for window as #fful
#fful "trapclose [quitfful]"
#fful "font Consolas 9 "
#fful.Xco "!font Consolas 11 "
#fful.Yco "!font Consolas 11 "
#fful "resizehandler [resize]"
#fful.hand "selectindex 1"
#fful.grid "select Set Grid"
#fful.color "select Set Color"
#fful.font "select Set Font"
#fful.w "select ";projectw
#fful.h "select ";projecth
#fful.gb "autoresize"
#fful.gb "vertscrollbar on 0 ";projectw
#fful.gb "horizscrollbar on 0 ";projecth
#fful.gb "font ";projectfont$
#fful.gb "down"
#fful.path "File - untitled.ffu"
#fful.form "!File"
block$(1) = " ! COMING SOON ! "
#fful.blocks "reload"
#fful.blocks "!Add Code Blocks/Snippets"
#fful.fastfunctionsList "!Subs / Functions"
fastfunctionsList$(1) = " ! COMING SOON ! "
#fful.fastfunctionsList "reload"
gosub [drawgrid]
gosub [drawall]
#fful.gb "when rightButtonDown [show]"
#fful.gb "when leftButtonDown [select]"
#fful.gb "when characterInput [keys]"
'load subs and functions combobox
#fful.gb "setfocus"
#prop "show"
show=1
fastGuiOpen = 1
#codeTank.fastgui "!disable"
wait
[show]
if show then
#prop "hide"
show=0
else
#prop "show"
show=1
end if
wait
'the user clicked on the form design window
'either to chose a control or to deselect a control
[select]
xs=MouseX
ys=MouseY
'hide property window if it is open
if show then
#prop "hide"
show=0
end if
'before we move on update the currently selected control from properties
'get the project data and only the editable contents of controls
if selected=0 then
'the form name #xxxx
#prop.tbform "!contents? t$"
if t$<>projectform$ then
projectform$=t$
dim hnd$(10)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "select ";projectform$
end if
'the form/window title text
#prop.tbtitl "!contents? t$"
if t$<>projecttitl$ then projecttitl$=t$
end if
#prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$
#prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$
#prop.tbreso "!contents? t$" : obj$(selected,Ress)=t$
'find the object selected by user
selected=0
action=1 ' 1=move 2=expand - bmps dont expand
for cn=obj to 1 step -1
if xs>obj(cn,XX) and xs<(obj(cn,XX)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then
if xs>obj(cn,XX)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2
if obj(cn,TT)=6 then action=1
selected=cn
exit for
end if
next
if selected=0 then
gosub [propertyupdate]
action=0
end if
if selected>0 and action=1 then
#fful.gb "when leftButtonMove [track]"
#fful.gb "when leftButtonUp [stop]"
offsetX=xs-obj(selected,XX)
offsetY=ys-obj(selected,Y)
end if
if selected>0 and obj(selected,TT)<>6 and action=2 then 'dont resize bmp
#fful.gb "when leftButtonMove [tracksize]"
#fful.gb "when leftButtonUp [stopsize]"
offsetX=xs-(obj(selected,XX)+obj(selected,W))
offsetY=ys-(obj(selected,Y)+obj(selected,H))
end if
if selected>0 then
gosub [drawit]
else
insertx=int((xs+(grid/2))/grid)*grid
inserty=int((ys+(grid/2))/grid)*grid
gosub [drawall]
end if
wait
'moving controls on form
[track]
#fful.corner "UpperLeft"
#fful.gb "rule xor"
gosub [drawit]
xt=int((MouseX-offsetX+(grid/2))/grid)*grid
if negbar then
if xt<1 then xt=0
end if
if xt+obj(selected,W)>projectw and barrier then xt=projectw-obj(selected,W)
obj(selected,XX)=xt
yt=int((MouseY-offsetY+(grid/2))/grid)*grid
if menuset = 0 and textEd = 0 then
if negbar then
if yt<0 then yt=0
end if
if yt+obj(selected,H)>projecth-25 and barrier then yt=projecth-obj(selected,H)-25
obj(selected,Y)=yt
end if
if menuset = 1 or textEd > 0 then
if negbar then
if yt < 0 then yt =0
end if
if yt+obj(selected,H)>projecth-50 and barrier then yt=projecth-obj(selected,H)-50
obj(selected,Y)=yt
end if
#fful.Xco "x ";str$(xt)
#fful.Yco "y ";str$(yt)
gosub [drawit]
wait
'when user stops moving mouse or lifts left button
[stop]
#fful.gb "when leftButtonMove"
#fful.gb "when leftButtonUp"
action=0
#fful.gb "rule over"
gosub [drawall]
wait
'resizing controls on form
[tracksize]
#fful.corner "BottomRight" 'print to window #fful for x,y coordinates
#fful.gb "rule xor"
gosub [drawit]
xs=int((MouseX-offsetX+(grid/2))/grid)*grid
if xs>projectw and barrier then xs=projectw
if xs<obj(selected,XX) then xs=obj(selected,XX)+grid
ys=int((MouseY-offsetY+(grid/2))/grid)*grid
if ys>projecth and barrier then ys=projecth
if ys<obj(selected,Y)+ctrh and barrier then ys=obj(selected,Y)+ctrh
obj(selected,W)=xs-obj(selected,XX)'
'form workspace changes when menu, or textEditor added/removed
if menuset = 1 or textEd > 0 then obj(selected,H)=ys-obj(selected,Y)-50'height
if menuset = 0 and textEd = 0 then obj(selected,H)=ys-obj(selected,Y)-25'height
#fful.Xco "x ";xs : #fful.Yco "y ";ys
gosub [drawit]
wait
[stopsize]
#fful.gb "when leftButtonMove"
#fful.gb "when leftButtonUp"
action=0
#fful.gb "rule over"
gosub [drawall]
wait
'user uses keys to copy/paste or delete controls
[keys]
k1=asc(right$(Inkey$,1))
k2=asc(left$(Inkey$,1))
if k1=46 then 'delete selected
if obj(selected,TT)=12 then menuset=0
if obj(selected,TT)=11 then textEd = textEd - 1
obj(selected,TT)=0
selected=0
gosub [drawgrid]
gosub [drawall]
end if
if k1=3 then 'copy control
cpy(1)=obj(selected,XX) 'x
cpy(2)=obj(selected,Y) 'y
cpy(3)=obj(selected,W) 'w
cpy(4)=obj(selected,H) 'h
cpy(5)=obj(selected,TT) 'type
cpy(6)=obj(selected,TH) 'textheight
cpy$(1)=obj$(selected,Ctr)'name
cpy$(2)=obj$(selected,Tex)'text content
cpy$(3)=obj$(selected,Ress)'resource array or file path
cpy$(4)=obj$(selected,Fon)'ctrl specific font or ""
cpy$(5)=obj$(selected,Bak)'ctrl specific backcolor
end if
if k1=22 then 'paste control
if cpy(5)<>0 then
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
inserty=inserty+cpy(4)+grid
obj(obj,W)=cpy(3)
obj(obj,H)=cpy(4)
obj(obj,TT)=cpy(5)
obj(obj,TH)=cpy(6)
obj$(obj,Ctr)=left$(cpy$(1),2);obj
obj$(obj,Tex)=cpy$(2)
obj$(obj,Ress)=cpy$(3)
if obj(obj,TT)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Ress)
if obj(selected,TT)=11 then textEd = textEd + 1 : gosub [drawgrid] 'keep track of # of texteditors
obj$(obj,Fon)=cpy$(4)
obj$(obj,Bak)=cpy$(5)
selected=obj
gosub [drawall]
end if
end if
#fful.gb "setfocus"
wait
'[tool]
'#fful.tool "selectionindex? i"
[drawTool]
cpy(5)=0
select case i
case 1 'statictext
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=130
obj(obj,H)=ctrh
obj(obj,TT)=1
obj$(obj,Ctr)="sttctxt";obj
obj$(obj,Tex)="StaticText ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectback$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 2 'textbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=140
obj(obj,H)=ctrh
obj(obj,TT)=2
obj$(obj,Ctr)="txtbx";obj
obj$(obj,Tex)="TextBox ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projecttbcl$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 3 'listbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=120
obj(obj,H)=ctrh*5
obj(obj,TT)=3
obj$(obj,Ctr)="lstbx";obj
obj$(obj,Tex)="ListBox ";obj;"\item2\item3\item4\item5"
obj$(obj,Ress)=obj$(obj,Ctr);"$("
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectlbcl$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 4 'combobox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=120
obj(obj,H)=ctrh
obj(obj,TT)=4
obj$(obj,Ctr)="cmbbx";obj
obj$(obj,Tex)="ComboBox ";obj;"\item2\item3\item4\item5"
obj$(obj,Ress)=obj$(obj,Ctr);"$("
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectcbcl$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 5 'button
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=90
obj(obj,H)=ctrh
obj(obj,TT)=5
obj$(obj,Ctr)="btn";obj
obj$(obj,Tex)="Button ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)="white"
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 6 'bmp button
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=50
obj(obj,H)=50
obj(obj,TT)=6
obj$(obj,Ctr)="bmpbtn";obj
filedialog "Choose an image","*.bmp",file$
if file$<>"" then
file$=right$(file$,len(file$)-len(DefaultDir$)-1)
open file$ for input as #bmp
'the bmpfileheader
bmp$ = Input$(#bmp,lof(#bmp))
if mid$(bmp$,1,2) ="BM" then 'always BM
obj(obj,W)=value(mid$(bmp$,19,4))'width
obj(obj,H)=value(mid$(bmp$,23,4))'height
obj$(obj,Ress)=file$
obj$(obj,Tex)="bmp"
loadbmp obj$(obj,Ctr),file$
close #bmp
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
else
obj(obj,TT)=0
close #bmp
obj=obj-1
end if
else
obj(obj,TT)=0
obj=obj-1
end if
case 7 'graphicbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=90
obj(obj,H)=90
obj(obj,TT)=7
obj$(obj,Ctr)="grphcbx";obj
obj$(obj,Tex)="GraphicBox ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=100
obj(obj,H)=ctrh
obj(obj,TT)=8
obj$(obj,Ctr)="rdbtn";obj
obj$(obj,Tex)="RadioButton ";obj
obj$(obj,Ress)="[";obj$(obj,Ctr);"Set],[";obj$(obj,Ctr);"Reset]"
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 9 'checkbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=90
obj(obj,H)=ctrh
obj(obj,TT)=9
obj$(obj,Ctr)="chkbx";obj
obj$(obj,Tex)="CheckBox ";obj
obj$(obj,Ress)="[";obj$(obj,Ctr);"Checked],[";obj$(obj,Ctr);"Unchecked]"
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectback$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=110
obj(obj,H)=110
obj(obj,TT)=10
obj$(obj,Ctr)="grpbx";obj
obj$(obj,Tex)="GroupBox ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectback$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor
obj=obj+1
textEd = textEd + 1 : gosub [drawgrid]
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=150
obj(obj,H)=100
obj(obj,TT)=11
obj$(obj,Ctr)="txtedtr";obj
obj$(obj,Tex)="TextEditor ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projecttecl$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu
if menuset=0 then
obj=obj+1
obj(obj,XX)=0
obj(obj,Y)=0
obj(obj,W)=100
obj(obj,H)=10
obj(obj,TT)=12
obj$(obj,Ctr)="mn";obj
obj$(obj,Tex)=" Menu Added ";obj
menuset=1
end if
end select
selected=obj
gosub [drawall]
'#fful.tool "select Add New"
#fful.gb "setfocus"
wait
[form]
#fful.form "selectionindex? i"
select case i
case 1 'restore
#fful.path "lastsession.ffu"
file$ = "lastsession.ffu"
gosub [loadit]
#fful.path "lastsession.ffu"
case 2 'new
if import <> 1 then #fful.path "Untitled.bas"
gosub [new]
case 3 'save as
gosub [saveas]
case 4 'load
gosub [load]
case 6 'write
gosub [write]
#fful.path file$
case 7 'import
import = 1
gosub [import]
import = 0
case 8 'export
gosub [export]
end select
#fful.form "select File"
gosub [drawall]
#fful.gb "setfocus"
wait
[drawall]
#fful.gb "discard ; redraw bak"
ocn=cn
projecttbcl$="white"
projectlbcl$="white"
projectcbcl$="white"
projecttecl$="white"
for cn=1 to obj
gosub [drawit]
next
cn=ocn
#fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10
#fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10
#fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20
#fful.gb "setfocus"
return
[drawit]
'redraws control cn
'set the color for the drawn object and action taking place
if cn=selected then
#fful.gb "color red" 'action 1 or 2
if action=2 then #fful.gb "color green"
else
#fful.gb "color ";projectfore$
end if
'set the font for the drawn object
if obj$(cn,Fon)="" then
#fful.gb "font ";projectfont$
ch=projectctrh
if obj(cn,H)<ch then obj(cn,H)=ch
else
#fful.gb "font ";obj$(cn,Fon)
ch=obj(cn,TH)
if obj(cn,H)<ch then obj(cn,H)=ch
end if
'update the properties textboxes for selected control
if cn=selected then
#prop.tbctrl obj$(cn,Ctr) 'ctrlname
#prop.tbtext obj$(cn,Tex) 'text
#prop.tbreso obj$(cn,Ress) 'resource
#prop.tbxywh obj(cn,XX);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh
if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height
#prop.tbcolo obj$(cn,Bak)
end if
#fful.gb "place ";obj(cn,XX);" ";obj(cn,Y)
if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?"
select case obj(cn,TT)
case 1 'statictext
#fful.gb "backcolor ";projectback$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
#fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 2 'textbox
#fful.gb "backcolor ";projecttbcl$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 3 'listbox
#fful.gb "backcolor ";projectlbcl$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 4 'combobox
#fful.gb "backcolor ";projectcbcl$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 5 'button
#fful.gb "backcolor white"
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
'buttons are always black on white
#fful.gb "color black"
'centre button text
#fful.gb "stringwidth? ";"A";" width"
xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2
if action=0 then #fful.gb "place ";obj(cn,XX)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
#fful.gb "color ";projectfore$
#fful.gb "backcolor ";projectback$
case 6 'bmpbutton
if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr)
#fful.gb "box ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
case 7 ' graphicbox
#fful.gb "backcolor white"
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
#fful.gb "backcolor ";projectback$
case 8 'radiobutton
#fful.gb "backcolor ";projectback$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
'radiobutton text is always black
#fful.gb "color black"
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
#fful.gb "color ";projectfore$
case 9 'checkbox
#fful.gb "backcolor ";projectback$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
'checkbox text is always black
#fful.gb "color black"
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
#fful.gb "color ";projectfore$
case 10 'groupbox
#fful.gb "backcolor ";projectback$
'groupbox is an outline
#fful.gb "box ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
'group box text is always black
#fful.gb "color black"
'groupbox text is offset
if action=0 then #fful.gb "place ";obj(cn,XX)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex)
#fful.gb "color ";projectfore$
case 11 ' texteditor
#fful.gb "backcolor ";projecttecl$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 12 'menu
'pin to top left
obj(cn,XX)=10 : obj(cn,Y)=-8 : obj(cn,W)=100 : obj(cn,H)=10
#fful.gb "backcolor ";projectback$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
#fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 21 'tecolor
projecttecl$=obj$(cn,Bak)
case 22 'tbcolor
projecttbcl$=obj$(cn,Bak)
case 23 'lbcolor
projectlbcl$=obj$(cn,Bak)
case 24 'cbcolor
projectcbcl$=obj$(cn,Bak)
'41,42,43,44,45 and 50 51 ignored ie back/fore w/h open and font objects
end select
return
[prev]
file$="preview.bas"
gosub [writeit]
wait
[write]
projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas"
filedialog "Save .bas",projectfile$,file$
file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit]
if file$<>"" then
open file$ for output as #op
'the header
#op " 'Project ";projecttitl$
if val(left$(time$(), 2)) > 11 then mer$ = "pm" else mer$ = "am"
#op " 'Created with FFNotSoLite v";ver$;" ";date$();" at ";time$();" ";mer$
#op " nomainwin"
if projectback$<>"white" or projectfore$<>"black" then
#op " 'Set BackgroundColor$ and ForegroundColor$ of project"
#op " BackgroundColor$=";chr$(34);projectback$;chr$(34)
#op " ForegroundColor$=";chr$(34);projectfore$;chr$(34)
#op ""
end if
if code = 1 then
#op " 'Create arrays needed for controls listbox,combobox"
for n= 1 to obj
if obj(n,TT)=3 or obj(n,TT)=4 then
#op " dim ";obj$(n,Ress);"10)"
#op " for n = 1 to 10"
#op " ";obj$(n,Ress);"n)= str$(n)"
#op " next"
end if
next
end if
#op " 'Create controls and open window"
#op " WindowWidth = ";projectw
#op " WindowHeight = ";projecth
#op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)"
#op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)"
if menuset then
#op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Open";chr$(34);", [dummy], ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Save As";chr$(34);", [dummy],";chr$(34);"&Load";chr$(34);", [dummy], ";chr$(34);"&Exit";chr$(34);", [dummy]"
if textEd > 0 then
#op " menu ";projectform$;", ";chr$(34);"Edit";chr$(34)
end if
#op " menu ";projectform$;", ";chr$(34);"&Tools";chr$(34);", ";chr$(34);"Preferences";chr$(34);", [dummy] "
#op " menu ";projectform$;", ";chr$(34);"&Options";chr$(34);", ";chr$(34);"Fonts";chr$(34);", [dummy], ";chr$(34);"Colors";chr$(34);", [dummy]"
#op " menu ";projectform$;", ";chr$(34);"&Help";chr$(34);", ";chr$(34);"About";chr$(34);", [dummy]";", ";chr$(34);"Help";chr$(34);", [dummy]"
end if
for n=1 to obj
select case obj(n,TT)
case 1 'statictext
#op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,XX);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H)
case 2 'textbox
#op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 3 'list box
#op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ress);",[";obj$(n,Ctr);"Selected],";obj(n,XX)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H)
case 4 'combobox
#op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ress);",[";obj$(n,Ctr);"Selected],";obj(n,XX)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H)
case 5 'button
#op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"Clicked], UL, ";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 6 'bmpbutton
#op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ress);chr$(34);",[";obj$(n,Ctr);"Clicked], UL, ";obj(n,XX);",";obj(n,Y)
case 7 'graphicbox
#op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 8 'radiobutton
#op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Ress);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 9 'checkbox
#op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Ress);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 10 'group box
#op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,XX);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H)
case 11 'texteditor
#op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 22 'tbcolor
#op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 23 'lbcolor
#op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 24 'cbcolor
#op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 21 'tecolor
#op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
end select
next
#op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$
if instr(projectwind$, "text") then
#op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34)
else
#op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34)
end if
#op ""
if code = 1 then
#op " 'Set any listboxes to singleclick and display the first item on the list for all listboxes and comboboxes"
for n= 1 to obj
if obj(n,TT)=4 then
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34)
end if
if obj(n,TT)=3 then
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1, singleclickselect";chr$(34)
end if
next
#op " 'apply any control specific fonts"
end if
for n= 1 to obj
if obj(n,TT)<>0 and obj$(n,Fon)<>"" then
if obj(n,TT)=1 or obj(n,TT)=2 or obj(n,TT)=5 or obj(n,TT)=10 or obj(n,TT)=11 then
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34)
end if
if obj(n,TT)=3 or obj(n,TT)=4 or obj(n,TT)=7 or obj(n,TT)=8 or obj(n,TT)=9 then
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34)
end if
[remDot]
end if
next
#op " 'Your code here. eg: Declare variables and globals, goto/gosub/call subs and invoke functions, etc etc"
#op ""
#op " wait"
#op ""
#op " 'Create the required handlers for each control"
for n=1 to obj
select case obj(n,TT)
case 3 'listbox
#op " [";obj$(n,Ctr);"Selected]"
#op " 'Your handler code here, read the control with"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? Selected$";chr$(34)
#op " wait"
#op ""
case 4 'combobox
#op " [";obj$(n,Ctr);"Selected]"
#op " 'Your handler code here, read the control with"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? Selected$";chr$(34)
#op " wait"
#op ""
case 5 'button
#op " [";obj$(n,Ctr);"Clicked]"
#op " 'Your handler code here"
#op " wait"
#op ""
case 6 'bmpbutton
#op " [";obj$(n,Ctr);"Clicked]"
#op " 'Your handler code here"
#op " wait"
#op ""
case 8 'radiobutton
#op " [";obj$(n,Ctr);"Set]"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34)
#op " 'Your handler code here"
#op " wait"
#op ""
case 9 'checkbox
#op " [";obj$(n,Ctr);"Checked]"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34)
#op " 'Your handler code here"
#op " wait"
#op ""
#op " [";obj$(n,Ctr);"Unchecked]"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34)
#op " 'Your handler code here"
#op " wait"
#op ""
end select
next
#op " [quit]"
#op " 'Add code for any actions to take while shutting down. eg:backup settings to a file"
#op " close ";projectform$
#op " end"
#op " "
#op " 'Subs and Functions go below this line"
#op "'########################################################"
#op " "
close #op
if code <> 1 then run chr$(34);LBpath$;"\";LBexe$;chr$(34);" -R -A ";DefaultDir$;"\";file$
if code = 1 then run chr$(34);LBpath$;"\";LBexe$;chr$(34);" -A ";DefaultDir$;"\";file$
[done]
end if
code = 0
return
[saveas]
projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu"
filedialog "Save As...",projectname$,file$
if file$<>"" then
open file$ for output as #op
projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1)
#fful.path projectfile$
'the form name #xxxx
#prop.tbform "!contents? t$"
if t$<>projectform$ then
projectform$=t$
dim hnd$(10)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "select ";projectform$
end if
'the form/windo title text
#prop.tbtitl "!contents? t$"
if t$<>projecttitl$ then projecttitl$=t$
#op projectfile$
#op projectwind$
#op projectform$
#op projecttitl$
#op projectfont$
#op projectback$
#op projectfore$
#op projectctrh
#op projectgrid
#op projectw
#op projecth
for n=1 to obj
if obj(n,TT)<>0 then
#op obj(n,XX);",";
#op obj(n,Y);",";
#op obj(n,W);",";
#op obj(n,H);",";
#op obj(n,TT);",";
#op obj(n,TH)
#op obj$(n,Ctr)
#op obj$(n,Tex)
#op obj$(n,Ress)
#op obj$(n,Fon)
#op obj$(n,Bak)
end if
next
close #op
gosub [propertyupdate]
redim hnd$(30)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "selectindex 1"
end if
return
[load]
filedialog "Open Project...","*.ffu",file$
[loadit]
if file$<>"" then
projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1)
#fful.path projectfile$
open file$ for input as #ses
input #ses, projectfile$
input #ses, projectwind$
input #ses, projectform$
input #ses, projecttitl$
input #ses, projectfont$
if projectfont$="" then projectfont$="Consolas 9"
#fful.gb "font ";projectfont$
input #ses, projectback$
input #ses, projectfore$
input #ses, c$
input #ses, g$
input #ses, w$
input #ses, h$
projectctrh=val(c$)
projectgrid=val(g$)
grid=projectgrid
projectw=val(w$)
projecth=val(h$)
#prop.cbwind "select ";projectwind$
redim hnd$(30)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "selectindex 1"
#fful.grid "select ";grid
#fful.w "select ";projectw
#fful.h "select ";projecth
gosub [drawgrid]
obj=0
while eof(#ses) = 0
obj=obj+1
line input #ses, l$
obj(obj,XX)=val(word$(l$,1,","))
obj(obj,Y)=val(word$(l$,2,","))
obj(obj,W)=val(word$(l$,3,","))
obj(obj,H)=val(word$(l$,4,","))
obj(obj,TT)=val(word$(l$,5,","))
obj(obj,TH)=val(word$(l$,6,","))
line input #ses, obj$(obj,Ctr)
line input #ses, obj$(obj,Tex)
line input #ses, obj$(obj,Ress)
line input #ses, obj$(obj,Fon)
line input #ses, obj$(obj,Bak)
if obj(obj,TT)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Ress)
if obj(obj,TT)=12 then menuset=1
if obj(obj,TT)=11 then textEd = textEd + 1
wend
close #ses
gosub [propertyupdate]
#prop "hide"
#prop "show"
end if
return
[import]
filedialog "Open .bas...","*.bas",file$
[importit]
if file$<>"" then
'check size
open file$ for input as #bas
maxln=0
while eof(#bas)=0
line input #bas, wln$
maxln=maxln+1
wend
close #bas
'add margin for split lines
dim bas$(maxln+1000,4)'an array of code lines and line numbers
'set up progress bar
#prog.gb1 "down ; fill white ; backcolor cyan"
#prog "show"
projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1)
gosub [new]
'set grid to 1 and invisible so controls stay where they import from initially
'grid=1
'gridvisible=0
gosub [drawgrid]
#fful.path projectfile$
'create objects for only those lines defining controls we are interested in
wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox "
wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu
wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ "
wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty "
wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ font "
ln=1
bln=1
open file$ for input as #bas
while eof(#bas)=0
line input #bas, wln$
'update progress bar
#prog.gb1 "cls ; place 0 0 ; boxfilled ";100/maxln*ln;" 25"
'ignore 'or rem lines
if left$(lower$(trim$(wln$)),1)="'" or left$(lower$(trim$(wln$)),4)="rem " then
bas$(ln,1)=str$(ln)
bas$(ln,2)=trim$(wln$)
ln=ln+1
else
'break into multiple lines if ":" found outside quotes
pos=1
ln$=""
while pos<=len(wln$)
c$=mid$(wln$,pos,1)
dd$ = mid$(win$,pos,2)
if c$=chr$(34) then
if quote=0 then quote=1 else quote=0
end if
if c$=":" and quote=0 or c$=":" and right$(dd$,1) = "\" then
gosub [line]
ln$=""
pos=pos+1
else
ln$=ln$+c$
pos=pos+1
end if
wend
gosub [line]
bln=bln+1
end if
wend
basln=ln-1
close #bas
redim win$(30,10)'an array of forms within .bas
redim hnd$(30)'an array of form names for handle combobox
wh=1
for ln=1 to basln
if bas$(ln,3)="#" then
if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1)
if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1)
if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1)
if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1)
'if instr(lower$(bas$(ln,2)),"open",1)>0 then
if lower$(word$(bas$(ln,2),1)) = "open" and left$(word$(bas$(ln,2),2, " as "),1) = "#" then
if instr(lower$(bas$(ln,2)),"window",1)>0 or instr(lower$(bas$(ln,2)),"dialog",1)>0 or instr(lower$(bas$(ln,2)),"graphic",1)>0 then
win$(wh,10)=bas$(ln,1)
n$=word$(bas$(ln,2),2,chr$(34))
hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1))
'find last "for" in command line
i=1
while i
oi=i
i=instr(lower$(bas$(ln,2))," for ",i+1)
wend
wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi)
wt$=word$(wt$,2)
win$(wh,1)=hn$ 'handle #fful etc
win$(wh,2)=n$ 'title
win$(wh,3)=w$ 'width
win$(wh,4)=h$ 'height
win$(wh,5)=wt$ 'windowtype
hnd$(wh)=hn$ 'for combobox
wh=wh+1
end if
end if
end if
next
#fful.hand "reload"
#fful.hand "selectindex 1"
wh=1
gosub [loadwindow]
end if
return
[line]
bas$(ln,1)=str$(ln)
bas$(ln,2)=trim$(ln$)
w$=lower$(word$(ln$,1))
if instr(w$,"=",1)>1 then w$=word$(w$,1,"=")
if len(w$)>3 then
w1$=" "+w$+" "
w2$=" "+w$+"="
if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 or instr(lower$(ln$),"font ",1)>0 then bas$(ln,3)="#"
end if
ln=ln+1
return
[hand]
#fful.hand "selectionindex? wh"
gosub [loadwindow]
wait
[loadwindow]
redim obj(300,6) 'x,y,width/height,type,textheight
redim obj$(300,7) 'name,text content,resource,font
obj=1
menuset=0
textEd = 0
projectback$="white"
TextboxColor$="white"
ListboxColor$="white"
ComboboxColor$="white"
TexteditorColor$="white"
projectfore$="black"
projectw=val(win$(wh,3))
if projectw=0 then projectw=320
projecth=val(win$(wh,4))
if projecth=0 then projecth=360
projecttitl$=win$(wh,2)
projectwind$=win$(wh,5)
projectform$=win$(wh,1)
tbc$=""
lbc$=""
cbc$=""
tec$=""
gosub [propertyupdate]
#fful.w "!";str$(projectw)
#fful.h "!";str$(projecth)
'find controls and create obj() array for form we are interested in
for ln=1 to basln
'update progress bar
#prog.gb1 "cls ; place 0 0 ; boxfilled ";100+100/maxln*ln;" 25"
if bas$(ln,3)="#" then
'reset obj pointer
bas$(ln,4)=""
'create objects to control color only check lines after previous open statement up to our open statement
if bas$(ln,1)>win$(wh-1,10) and bas$(ln,1)<=win$(wh,10) then
if instr(bas$(ln,2),"TextboxColor$",1)>0 then obj(obj,TT)=22 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bass)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1
if instr(bas$(ln,2),"ListboxColor$",1)>0 then obj(obj,TT)=23 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bass)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1
if instr(bas$(ln,2),"ComboboxColor$",1)>0 then obj(obj,TT)=24 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bass)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1
if instr(bas$(ln,2),"TexteditorColor$",1)>0 then obj(obj,TT)=21 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bass)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1
end if
for wc=1 to 12
if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for
next
if wc<=11 then
obj$(obj,Bass)=bas$(ln,1)
bas$(ln,4)=str$(obj)
l$=bas$(ln,2)
ll$="" 'remove spaces leaving only , separation but keep "" text untouched
inString=0
for i=1 to len(l$)
c$=mid$(l$,i,1)
select case
case c$=chr$(34)
inString=1-inString
case (inString=0) and c$=" "
c$=""
end select
ll$=ll$+c$
next
'insert missing comma if missing
if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1)
if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1)
obj(obj,TT)=wc 'type
obj(obj,TH)=projectctrh
'get the .ctrl name
obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1)
'for un-named controls
if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj
'get the text
if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc)
'get the array or bmp file name
if wc=3 or wc=4 or wc=6 then obj$(obj,Ress)=word$(ll$,2,",")
if wc=8 or wc=9 then obj$(obj,Ress)=word$(ll$,3,",")+","+word$(ll$,4,",")
'get rid of ""
if wc=6 and left$(obj$(obj,Ress),1)=chr$(34) then obj$(obj,Ress)=mid$(obj$(obj,Ress),2,len(obj$(obj,Ress))-2)
'array() -> array(
if (wc=3 or wc=4) and right$(obj$(obj,Ress),1)=")" then obj$(obj,Ress)=left$(obj$(obj,Ress), len(obj$(obj,Ress))-1)
i=1
while word$(ll$,i,",")<>""
i=i+1
wend
i=i-4
if wc=6 or wc=5 then
'buttons and bmpbuttons can have xy, wh is optional and they have XX corners
if i=3 then
obj(obj,XX)=val(word$(ll$,i+2,","))'x
obj(obj,Y)=val(word$(ll$,i+3,","))'y
if wc=5 then
'we need to find a way to calculate width and height if not given
#fful.gb "stringwidth? ";"A";" width"
obj(obj,W)=width*len(obj$(obj,Tex))+10
obj(obj,H)=projectctrh
end if
if wc=6 then
'we need a way to set bmp w and h
on error goto [dummybmp]
open obj$(obj,Ress) for input as #bmp
'the bmpfileheader
bmp$ = Input$(#bmp,lof(#bmp))
if mid$(bmp$,1,2) ="BM" then 'always BM
obj(obj,W)=value(mid$(bmp$,19,4))'width
obj(obj,H)=value(mid$(bmp$,23,4))'height
obj$(obj,Tex)="bmp"
end if
loadbmp obj$(obj,Ctr),obj$(obj,Ress)
close #bmp
goto [passdummy]
[dummybmp]
obj(obj,W)=25
obj(obj,H)=25
obj$(obj,Tex)="bmp"
loadbmp obj$(obj,Ctr),"path.bmp"
[passdummy]
end if
else
obj(obj,XX)=val(word$(ll$,i,","))'x
obj(obj,Y)=val(word$(ll$,i+1,","))'y
obj(obj,W)=val(word$(ll$,i+2,","))'w
obj(obj,H)=val(word$(ll$,i+3,","))'h
end if
if upper$(word$(ll$,4,","))="LR" then
obj(obj,XX)=projectw-obj(obj,XX)-obj(obj,W)'x
obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y
end if
if upper$(word$(ll$,4,","))="LL" then
'obj(obj,XX)=projectw-obj(obj,XX)-obj(obj,W)'x
obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y
end if
if upper$(word$(ll$,4,","))="UR" then
obj(obj,XX)=projectw-obj(obj,XX)-obj(obj,W)'x
'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y
end if
else
'write to .bas tweaks listbox and combobox controls to line up properly
'so we need to untweak them now
obj(obj,XX)=val(word$(ll$,i,","))'x
obj(obj,Y)=val(word$(ll$,i+1,","))'y
if wc=1 then obj(obj,Y)=obj(obj,Y)-5
if wc=10 then obj(obj,Y)=obj(obj,Y)+5
if wc=3 or wc=4 then obj(obj,XX)=obj(obj,XX)-1
obj(obj,W)=val(word$(ll$,i+2,","))'w
if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2
obj(obj,H)=val(word$(ll$,i+3,","))'h
end if
obj=obj+1
end if
end if
next
'now find font commands listed after the open statement referring to the #form
'#form.ctrl !font fontname
'if so add a new font object
for ln = 1 to basln
if bas$(ln,3)="#" then
lln$=lower$(bas$(ln,2))
if (instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font ",1)>0) or (instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font ",1)>0) then
f$=right$(lln$,len(lln$)-instr(lln$,"font",1)-4)
if instr(f$,";",1)=0 then
obj$(obj,Fon)=f$
obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1)
obj$(obj,Ctr)=word$(word$(lln$,1),2,".")
if instr(lln$,"!font",1)>0 then obj(obj,TT)=51 else obj(obj,TT)=50
obj$(obj,Bass)=str$(ln)
bas$(ln,4)=str$(obj)
'find the visible object and store the font change
for n=1 to obj
if obj$(n,Ctr)=obj$(obj,Ctr) then
obj$(n,Fon)=obj$(obj,Fon)
#fful.gb "font ";obj$(obj,Fon)
#fful.gb "place 100 100 ;\Q\Q"
#fful.gb "posxy xp yp"
obj(n,TH)=(yp-100)/2+7
exit for
end if
next
obj=obj+1
end if
end if
end if
next
if win$(wh,6)<>"" then
bas$(val(win$(wh,6)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,6)
obj(obj,TT)=41
obj=obj+1
'backgroundcolor
end if
if win$(wh,7)<>"" then
bas$(val(win$(wh,7)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,7)
obj(obj,TT)=42
obj=obj+1
'foregroundcolor
end if
if win$(wh,8)<>"" then
bas$(val(win$(wh,8)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,8)
obj(obj,TT)=43
obj=obj+1
'windowwidth
end if
if win$(wh,9)<>"" then
bas$(val(win$(wh,9)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,9)
obj(obj,TT)=44
obj=obj+1
n=n+1
'windowheight
end if
if win$(wh,10)<>"" then
bas$(val(win$(wh,10)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,10)
obj(obj,TT)=45
obj=obj+1
'open statement
end if
obj=obj-1
gosub [drawgrid]
gosub [drawall]
#prog "hide"
#prop "hide"
#prop "show"
show=1
return
[export]
'all previously imported lines will be deleted and replaced by the obj( lines
'deletelist$ remembers the original imported line numbers in line number order
if file$<>"" and right$(file$,3)="bas" then
open file$ for output as #bas
'open "export.bas" for output as #bas
for ln=1 to basln
'find any object associated with this line
found=0
for l=1 to obj
if bas$(ln,1)=obj$(l,Bass) then
found=1
'have we got to the open command line yet
if obj(l,TT)=45 then
'write all new lines prior to 45 (controls)
for m=1 to obj
if obj$(m,Bass)="" and obj(m,TT)<45 and obj(m,TT)<>0 then
n=m
gosub [exportline]
end if
next
'write 45 (open line)
n=l
gosub [exportline]
'write all new lines after 45 (open) ie (fonts)
'apply any control specific fonts"
for m= 1 to obj
if obj(m,TT)<>0 and obj$(m,Fon)<>"" then
if obj(m,TT)=1 or obj(m,TT)=2 or obj(m,TT)=5 or obj(m,TT)=10 or obj(m,TT)=11 then
#bas " ";projectform$;".";obj$(m,Ctr);" ";chr$(34);"!font ";obj$(m,Fon);chr$(34)
end if
if obj(m,TT)=3 or obj(m,TT)=4 or obj(m,TT)=7 or obj(m,TT)=8 or obj(m,TT)=9 then
#bas " ";projectform$;".";obj$(m,Ctr);" ";chr$(34);"font ";obj$(m,Fon);chr$(34)
end if
end if
next
end if
'edit or erase existing line
if obj(l,TT)=0 then
else
if obj(l,TT)<>45 then
n=l
gosub [exportline]
end if
end if
end if
next
if found=0 then #bas " ";bas$(ln,2)
next
close #bas
end if
'now reload amended .bas file
gosub [importit]
return
[exportline]
select case obj(n,TT)
'handle the visible controls
case 1 'statictext
#bas " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,XX);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H)
case 2 'textbox
#bas " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 3 'list box
#bas " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ress);",[";obj$(n,Ctr);"Selected],";obj(n,XX)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H)
case 4 'combobox
#bas " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ress);",[";obj$(n,Ctr);"Selected],";obj(n,XX)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H)
case 5 'button
#bas " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"Clicked], UL, ";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 6 'bmpbutton
#bas " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ress);chr$(34);",[";obj$(n,Ctr);"Clicked], UL, ";obj(n,XX);",";obj(n,Y)
case 7 'graphicbox
#bas " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 8 'radiobutton
#bas " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Ress);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 9 'checkbox
#bas " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Ress);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 10 'group box
#bas " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,XX);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H)
case 11 'texteditor
#bas " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export
case 22 'textboxcolor
#bas " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 23 'listboxcolor
#bas " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 24 'comboboxcolor
#bas " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 21 'texteditorcolor
#bas " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
' handle the window code
case 41'backgroundcolor
#bas " BackgroundColor$=";chr$(34);projectback$;chr$(34)
case 42'foregroundcolor
#bas " ForegroundColor$=";chr$(34);projectfore$;chr$(34)
case 43'windowidth
#bas " WindowWidth=";projectw
case 44'windowheight
#bas " WindowHeight=";projecth
case 45'open
#bas " Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$
'handle font changes
case 50 'font
if obj$(n,Ctr) = "" and projectform$ <> "" and projectfont$ <> "" then
#bas " ";projectform$;" ";chr$(34);"font ";projectfont$;chr$(34)
goto [delDot]
end if
#bas " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34)
[delDot]
case 51 '!font
#bas " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34)
end select
return
[new]
redim obj(300,6) 'x,y,width/height,type,textheight
redim obj$(300,7) 'name,text content,resource,font
obj=0
menuset=0
textEd = 0
projectw=600
projecth=400
projectback$="white"
projectfore$="black"
projectctrc$="white"
projecttitl$="Untitled"
projectform$="#1"
'if import <> 1 then projectfile$="Untitled.bas"
projectwind$="window_nf"
#prop.cbwind "select window_nf"
redim hnd$(30)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "selectindex 1"
#fful.w "select ";projectw
#fful.h "select ";projecth
gosub [propertyupdate]
gosub [drawgrid]
gosub [drawall]
#prop "hide"
#prop "show"
show=1
return
[propertyupdate]
#prop.tbfile projectfile$
#prop.cbwind "select ";projectwind$
#prop.tbtitl projecttitl$
#prop.tbform projectform$
#prop.tbctrl ""
#prop.tbtext ""
#prop.tbreso ""
#prop.tbxywh projectw;"x";projecth
#prop.tbfont projectfont$
#prop.tbcolo projectfore$;"/";projectback$
return
[resize]
'#fful.tool "select Add New"
#fful.form "select File"
if wh=0 then wh=1
#fful.hand "selectindex ";wh
#fful.grid "select Set Grid"
#fful.font "select Set Font"
#fful.color "select Set Color"
#fful.w "select ";projectw
#fful.h "select ";projecth
gosub [drawall]
wait
[formsize]
#fful.w "contents? w$"
#fful.h "contents? h$"
wf=val(w$)
hf=val(h$)
if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait
projectw=wf
projecth=hf
insertx=grid
inserty=grid
gosub [drawgrid]
#fful.gb "setfocus"
gosub [drawall]
wait
[grid]
'resize the grid spacing according to user choice, default is 10
#fful.grid "contents? g$"
select case g$
case "Invisible"
gridvisible=0
grid=1
case "Visible"
gridvisible=1
case else
grid=val(g$)
if grid = 1 then gridvisible = 0
if grid > 2 then gridvisible = 1
end select
gosub [drawgrid]
gosub [drawall]
#fful.gridsize grid
#fful.gb "setfocus"
wait
[drawgrid]
projectgrid=grid
#fful.gb "cls; fill lightgray"
if grid > 0 and gridvisible = 1 then
#fful.gb "color ";gridcolor$
' Grid - Draw vertical lines
if menuset = 0 and textEd = 0 then
#fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25
for xs = 0 to projectw step grid
' Grid - Draw horizontal lines
#fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-25
next xs
for ys = 0 to projecth-25 step grid
#fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys
next ys
#fful.gb "color ";bordercolor$
#fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25
#fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25
#fful.gb "line "; 0; " "; 0; " "; projectw; " "; 0
#fful.gb "line ";0;" "; 0;" "; 0; " ";projecth-25
end if
'adjust grid when menu, or texeditor control is selected - revert if menu and texeditor deleted /no longer used.,
if menuset = 1 or textEd > 0 then
#fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50
#fful.gb "color ";gridcolor$
for xs = 0 to projectw step grid
#fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-50
next xs
for ys = 0 to projecth-50 step grid
#fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys
next ys
#fful.gb "color ";bordercolor$
#fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50
#fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50
#fful.gb "line "; 0; " "; 0; " "; 0; " "; projecth-50
#fful.gb "line ";0;" "; 0;" "; projectw; " ";0
end if
end if
[nogrid]
if grid < 2 or gridvisible = 0 then
if textEd =0 and menuset = 0 then
#fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25
#fful.gb "color ";crosshair$
#fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-25
#fful.gb "line "; 0; " "; ((projecth)/2)-12; " "; projectw; " "; ((projecth)/2)-12
#fful.gb "color ";bordercolor$
#fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25
#fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25
#fful.gb "line "; 0; " "; 0; " "; projectw; " "; 0
#fful.gb "line ";0;" "; 0;" "; 0; " ";projecth-25
end if
if textEd > 0 or menuset = 1 then
#fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50
#fful.gb "color ";crosshair$
#fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-50
#fful.gb "line "; 0; " "; (projecth-50)/2; " "; projectw; " "; (projecth-50)/2
#fful.gb "color ";bordercolor$
#fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50
#fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50
#fful.gb "line "; 0; " "; 0; " "; 0; " "; projecth-50
#fful.gb "line ";0;" "; 0;" "; projectw; " ";0
end if
end if
#fful.gb "flush bak"
#fful.grid "select 0"
#fful.grid "!Set Grid"
return
[font]
#fful.font "contents? f$"
if f$="Project Font" then
fontdialog projectfont$,f$
if f$<>"" then
projectfont$=f$
#fful.gb "font ";projectfont$
#fful.gb "place 100 100 ;\Q\Q"
#fful.gb "posxy xp yp"
projectctrh=(yp-100)/2+7
ctrf$=projectfont$
ctrh=projectctrh
end if
end if
if f$="Control Font" then
fontdialog projectfont$,f$
if f$<>"" then
ctrf$=f$
#fful.gb "font ";ctrf$
#fful.gb "place 100 100 ;\Q\Q"
#fful.gb "posxy xp yp"
ctrh=(yp-100)/2+7
end if
if selected then
obj$(selected,4)=ctrf$ 'font
obj(selected,6)=ctrh 'text height
end if
'for single line text controls auto adjust w and h
if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then
obj(selected,4)=ctrh
#fful.gb "stringwidth? ";"A";" width"
obj(selected,3)=width*len(obj$(selected,2))+10
end if
end if
if f$="ResetControl" then
ctrf$=projectfont$
ctrh=projectctrh
if selected then
obj$(selected,4)=ctrf$
obj(selected,6)=ctrh
end if
'for single line text controls auto adjust w and h
if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then
#fful.gb "font ";ctrf$
obj(selected,4)=ctrh
#fful.gb "stringwidth? ";"A";" width"
obj(selected,3)=width*len(obj$(selected,2))+10
end if
end if
#fful.font "select Set Font"
gosub [drawall]
#fful.gb "setfocus"
wait
[color]
#fful.color "contents? c$"
select case c$
case "Control Back"
gosub [colorpick]
if cp$<>"" then
if selected then 'insert color change event ahead of control
if obj(selected,TT)=2 then ct=22 : projecttbcl$=cp$
if obj(selected,TT)=3 then ct=23 : projectlbcl$=cp$
if obj(selected,TT)=4 then ct=24 : projectcbcl$=cp$
if obj(selected,TT)=11 then ct=21 : projecttecl$=cp$
for n=obj+1 to selected+1 step -1
obj(n,XX)=obj(n-1,XX)
obj(n,Y)=obj(n-1,Y)
obj(n,W)=obj(n-1,W)
obj(n,H)=obj(n-1,H)
obj(n,TT)=obj(n-1,TT)
obj(n,TH)=obj(n-1,TH)
obj$(n,Ctr)=obj$(n-1,Ctr)
obj$(n,Tex)=obj$(n-1,Tex)
obj$(n,Ress)=obj$(n-1,Ress)
obj$(n,Fon)=obj$(n-1,Fon)
obj$(n,Bak)=obj$(n-1,Bak)
obj$(n,Bass)=obj$(n-1,Bass)
next
obj(selected,TT)=ct
obj$(selected,Tex)="Color!"
obj$(selected,Bak)=cp$
'obj$(selected,Bass)="XX"
'remove any previous color change statement
if selected>=2 then
if obj(selected-1,TT)=ct then obj(selected-1,TT)=0
end if
obj=obj+1
end if
end if
case "Project Back"
gosub [colorpick]
if cp$<>"" then projectback$=cp$
if cp$<>"" then ctrc$=cp$
gosub [drawgrid]
case "Project Fore"
gosub [colorpick]
if cp$<>"" then projectfore$=cp$
case "Grid Color"
gosub [colorpick]
if cp$<>"" then gridcolor$=cp$
gosub [drawgrid]
case "Border Color"
gosub [colorpick]
if cp$<>"" then bordercolor$=cp$
case "CrossHair"
gosub [colorpick]
if cp$<>"" then crosshair$=cp$
end select
#fful.color "select Set Color"
gosub [drawgrid]
gosub [drawall]
#fful.gb "setfocus"
wait
[windowtype]
#prop.cbwind "contents? projectwind$"
wait
[colorpick]
WindowWidth=230
WindowHeight=225
UpperLeftX = insertx
UpperLeftY = inserty
graphicbox #pick.gb,25,10,170,170
open "Color Pick" for dialog_nf_modal as #pick
#pick "font Consolas 9"
#pick "trapclose [quitpick]"
#pick.gb "down ; fill white ; flush"
cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white "
c=1
for yc=1 to 160 step 40
for xc= 1 to 160 step 40
#pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40
c=c+1
if c>15 then c=15
next
next
#pick.gb "when leftButtonDown [pick]"
wait
[pick]
xp=int(MouseX/40)
yp=int(MouseY/40)
c=xp+yp*4+1
cp$=word$(cl$,c)
[quitpick]
close #pick
return
[cthelp]
run "notepad help.txt"
wait
[code]
code = 1
goto [prev]
'control buttons
[bttnSTTX] i=1 : gosub [drawTool] : wait
[bttnTXBX] i=2 : gosub [drawTool] : wait : wait
[bttnLSTBX] i=3 : gosub [drawTool] : wait
[bttnCMBOBX] i=4 : gosub [drawTool] : wait
[bttnBTTN] i=5 : gosub [drawTool] : wait
[bttnBMPBTTN] i=6 : gosub [drawTool] : wait
[bttnGRPHCBX] i=7 : gosub [drawTool] : wait
[bttnRDBTTN] i=8 : gosub [drawTool] : wait
[bttnCHKBX] i=9 : gosub [drawTool] : wait
[bttnGRPBX] i=10 : gosub [drawTool] : wait
[bttnTXTEDTR] i=11 : gosub [drawTool] : wait
[bttnMNU] i=12 : gosub [drawTool] : wait
[negbarrier]
if negbar = 1 then
negbar = 0
#fful.negbarrier "Barrier -"
else
negbar = 1
#fful.negbarrier "No Barrier -"
end if
wait
[barrier]
if barrier = 1 then
barrier = 0
#fful.barrier "Barrier +"
else
barrier = 1
#fful.barrier "No Barrier +"
end if
wait
[block]
wait
[quitfful]
'save away current session to lastsession.ffu
open "lastsession.ffu" for output as #ses
#ses projectfile$
#ses projectwind$
#ses projectform$
#ses projecttitl$
#ses projectfont$
#ses projectback$
#ses projectfore$
#ses projectctrh
#ses projectgrid
#ses projectw
#ses projecth
for n=1 to obj
if obj(n,TT)<>0 then
#ses obj(n,XX);",";
#ses obj(n,Y);",";
#ses obj(n,W);",";
#ses obj(n,H);",";
#ses obj(n,TT);",";
#ses obj(n,TH)
#ses obj$(n,Ctr)
#ses obj$(n,Tex)
#ses obj$(n,Ress)
#ses obj$(n,Fon)
#ses obj$(n,Bak)
end if
next
close #ses
close #prop
close #prog
close #fful
fastGuiOpen = 0
#codeTank.fastgui "!enable"
wait
function replace$( text$ , this$, tothis$ )
while 1
if instr(text$, this$) then
f = instr(text$, this$)
lenght=len(this$)
text$ = mid$(text$,1,f-1);_
tothis$;mid$(text$,f+lenght)
else
exit while
end if
wend
replace$=text$
end function
sub pleasewait
global pleasewaitOpen
WindowWidth = 150 : WindowHeight = 150
UpperLeftX=int((DisplayWidth-WindowWidth)/2)'-100
UpperLeftY=int((DisplayHeight-WindowHeight)/2)'-500
statictext #pleasewait.text, "Please Wait", 30, 20, 100, 20
statictext #pleasewait.text2, "This Can", 40, 50, 100, 20
statictext #pleasewait.text3, "Take a While", 25, 80, 100, 20
button #pleasewait.fake, "", [quit.pleasewait], ul, 0, 0, 0, 0
Open "untiltled" for dialog_popup as #pleasewait
#pleasewait "trapclose [quit.pleasewait]"
#pleasewait "font arial 12 bold"
pleasewaitOpen = 1
end sub
sub writeAutoSave
global autoSave$
autoSave$ = "autoSave.vbs"
open autoSave$ for output as #1
#1 "Set WshShell = WScript.CreateObject(";q$;"WScript.Shell";q$;")"
#1, "Do While Not WshShell.AppActivate(";q$;"Save *.TKN File As...";q$;")"
#1, "Loop"
#1, "Wscript.Sleep(500)"
#1, "WshShell.SendKeys ";q$;"{ENTER}";q$
#1, "Do While Not WshShell.AppActivate(";q$;"Information";q$;")"
#1, "Loop"
#1, "Wscript.Sleep(500)"
#1, "WshShell.SendKeys ";q$;"{ENTER}";q$
#1, "Wscript.Sleep(500)"
#1, "WshShell.AppActivate(";q$;"pleasewait";q$;")"
close #1
end sub
'function to retrieve Users Home Path (thanks to Brandon Parker)
Function GetSpecialFolder$(CSIDL)
S.OK = NULL
GetSpecialFolder$ = "Operation Failed"
pszPath$ = Space$(_MAX_PATH);chr$(0)
CallDLL #shell32, "SHGetFolderPathA", _NULL As ulong, _ 'hWnd is RESERVED
CSIDL As long, _ 'CSIDL value
_NULL As ulong, _ 'hToken is set to NULL to check the current token
0 As ulong, _ 'dwFlags is set to NULL to represent SHGFP_TYPE_CURRENT
pszPath$ As ptr, _ 'pszPath is where the path string will be stored upon return
ret As long
If (ret = S.OK) Then GetSpecialFolder$ = Trim$(pszPath$)
End Function
'edit date$() return for use in filenames
sub fixdate
global fixeddate$
fixDate$ = Date$() 'set up a date format that works with a filename(remove the /)
fix1$ =word$(fixDate$, 1, " ") ' = Month,
fix2$ = word$(fixDate$, 2, " ") ' = Month
fix2$ = left$(fix2$, len(fix2$)-1) ' = Number of day
fix3$ = word$(fixDate$, 3 ," ") ' = Year - 4 digits
fix3$ = right$(fix3$, 2) ' = Year - 2 digits
fixeddate$ = fix1$;"-";fix2$;"-";fix3$ ' = Month-NumberOfDay-Year
end sub
'edit Time$() return for use in filenames
sub fixtime
global fixedtime$
fixTime$ = Time$() 'set up a time format that works with a filename(remove the /)
fix1$ = word$(fixTime$, 1, ":")' - remove the "." 's
fix2$ = word$(fixTime$, 2 ,":")
fixedtime$ = "-";fix1$;"-";fix2$;"_"' ' add dashes -
end sub
sub resetRadioOptions
dictionary$ = "" : keyCount = 0 : lastKey$ = "" : selectedKey$ = ""
call readDictionary
call loadKeys
#codeTank.value, "!origin 0, 0 "
#codeTank.keys "select 0"
end sub
'function for checking file existence
function fileExists(path$, filename$)
dim info$(0, 0)
files path$, filename$, info$()
fileExists = val(info$(0, 0)) 'non zero is true
end function
'function for checking folder existence
function pathExists(path$)
pathExists = (mkdir(path$)=183)
end function
[textEdMirror]
if textedMOpen = 1 then #textedM.edMirror "!setfocus" : wait
WindowWidth = 700
WindowHeight = 500
texteditor #textedM.edMirror, 20, 20, 640, 400
button #textedM.incFont, "&+", [incEdFont], UL, 220, 0, 20, 23
button #textedM.decFont, "&-", [decEdFont], UL, 400, 0, 20, 23
button #textedM.mirror, "&ScratchPad", [scratch], UL, 250, 0, 140, 23
open "TextEditor Mirror" for Window as #textedM
#textedM "trapclose [quit.textedM]"
#codeTank.value "!contents? code$"
#textedM.edMirror code$
#textedM "Font Arial 12"
EdMirFont = 12
#textedM.edMirror, "!setfocus"
#textedM.edMirror "!origin 0 0"
textedMOpen = 1
#textedM.edMirror "!autoresize"
if selectedKey$ = "" then [setCatScratch]
wait
[scratch]
#codeTank.savedprojects "reset"
#textedM.edMirror "!contents? code$"
#codeTank.value "!cls"
#codeTank.value code$
call saveValue
mir = 1 : gosub [deleteOrig]
mir = 0
[setCatScratch]
newKey$ = selectedKey$
if categorie$ = "" or selectedKey$ = "" then
categorie$ = "ScratchPad" : selectedKey$ = "Scratch"
end if
call setValueByName newKey$, ""
call loadKeys
open categorie$ for append as #1
#1 chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134)+selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 code$
close #1
call resetRadioOptions
call readDictionary
call loadKeys
#codeTank.value "!cls"
categorie$ = "ScratchPad"
selectedKey$ = "Scratch"
#textedM.edMirror "!cls"
#textedM.edMirror, "!setfocus"
#textedM.edMirror, "!origin 0 0"
wait
[incEdFont]
EdMirFont = EdMirFont + 1
#textedM.edMirror "!font Arial ";EdMirFont
wait
[decEdFont]
EdMirFont = EdMirFont - 1
#textedM.edMirror "!font Arial ";EdMirFont
wait
[quit.pleaseWait]
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
wait
[quit.textedM]
call saveValue
#textedM.edMirror "!contents? code$"
close #textedM : textedMOpen = 0
#codeTank.value "!cls"
#codeTank.value code$
#codeTank.value "!origin 0 0"
mir = 1 : gosub [deleteOrig]
mir = 0
call setValueByName newKey$, ""
call loadKeys
#codeTank.keys "select "; newKey$
if categorie$ = "" then
categorie$ = "ScratchPad" : selectedKey$ = "Scratch"
end if
open categorie$ for append as #1
#1 chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134)+selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 code$
close #1
call resetRadioOptions
call readDictionary
call loadKeys
#codeTank.value "!cls"
#codeTank.keys "select 0"
wait
'quit program
[quit.codeTank]
if textedMOpen = 1 then
text$ = "Quiting will close the Editor Mirror"+chr$(13)+chr$(13)
text$ = text$+"Quit Anyway?"+chr$(13)
a$ = custcon$(text$)
if answer$ <> "Yes" then wait
end if
call saveValue
gosub [cleanUp]
if pickOpen = 1 then close #pick : pickOpen = 0
if fastcodeOpen = 1 then close #fastcode : fastcodeOpen = 0
if propOpen = 1 then close #prop : propOpen = 0
if progOpen = 1 then close #prog : progOpen = 0
if resultsOpen = 1 then close #results : resultsOpen = 0
if mainListOpen = 1 then close #codeTankList : mainListOpen = 0
if fastGuiOpen = 1 then close #fful : fastGuiOpen = 0
if textedMOpen = 1 then close #textedM : textedMOpen = 0
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
if codetankOpen = 1 then close #codeTank : codetankOpen = 0
if customconfirmOpen = 1 then close #customconfirm : customconfirmOpen = 0
end
'sub to create pauses in program
sub pause mil
t=time$("ms")+mil
while time$("ms")<t
scan
wend
end sub
'sub to save current Dictionary Listings and text in texeditor
sub saveValue 'if the value is changed, save it
if lastKey$ <> "" then
#codeTank.value "!modified? modified$";
if modified$ = "true" then
#codeTank.value "!contents? saveThisValue$";
call setValueByName lastKey$, saveThisValue$
call collectGarbage
call writeDictionary
end if
end if
end sub
'function to get selected Listing
function getKeys$(delimiter$)
global keyCount
pointer = 1
while pointer <> 0
'get the next key
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), pointer)
if pointer then
keyPointer = pointer + 9
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), pointer)
key$ = mid$(dictionary$, keyPointer, pointer - keyPointer)
if instr(keyList$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)) = 0 then
getKeys$ = getKeys$ + key$ + delimiter$
keyList$ = keyList$ + chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$
keyCount = keyCount + 1
end if
end if
wend
end function
'sub to write each Listing to corresponding file
sub writeDictionary
if categorie$ = "" then categorie$ = "ScratchPad"
if categorie$ = "ScratchPad" then
open DefaultDir$;"\";categorie$ for append as #writeDict
#writeDict date$();time$()
goto [writeit]
end if
open DefaultDir$;"\";categorie$ for output as #writeDict
[writeit]
#writeDict, dictionary$
close #writeDict
end sub
'sub to read each Listing from corresponding file
sub readDictionary
if fileExists(DefaultDir$, categorie$) <> 0 then
open categorie$ for input as #readDict
length = lof(#readDict)
dictionary$ = input$(#readDict, length)
close #readDict
else
end if
end sub
'sub to cleanup any mess in the dictionary text
sub collectGarbage
pointer = 1
while pointer > 0
'get the next key
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), pointer)
if pointer then
keyPointer = pointer + 9
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), pointer)
key$ = mid$(dictionary$, keyPointer, pointer - keyPointer)
if instr(keyList$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)) = 0 then
value$ = getValue$(key$)
newDictionary$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134) + value$ + newDictionary$
keyList$ = keyList$ + chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
end if
end if
wend
dictionary$ = newDictionary$
end sub
sub setValueByName key$, value$
dictionary$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134);key$;chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)+value$+dictionary$
end sub
'function to get info from selected Listing
function getValue$(key$)
getValue$ = chr$(0)
keyPosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134)+key$+chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134))
if keyPosition > 0 then
keyPosition = keyPosition + 9 'skip over key tag
valuePosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), keyPosition)
if valuePosition > 0 then
valuePosition = valuePosition + 11 'skip over value tag
endPosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), valuePosition)
if endPosition > 0 then
getValue$ = mid$(dictionary$, valuePosition, endPosition - valuePosition)
else
getValue$ = mid$(dictionary$, valuePosition)
end if
end if
end if
end function
'sub to load selected categorie List
sub loadKeys
keyList$ = getKeys$(chr$(134);chr$(165);chr$(134))
redim keys$(keyCount)
for item = 1 to keyCount
keys$(item-1) = word$(keyList$, item, chr$(134);chr$(165);chr$(134))
next item
sort keys$(), 0, keyCount
#codeTank.keys "reload"
keyCount = 0
end sub
'function to separate filename from full path to file
function GetFilename$(fileName$)
i = len(fileName$)
while mid$(fileName$, i, 1) <> "\" and mid$(fileName$, i, 1) <> ""
i = i-1
wend
GetFilename$ = mid$(fileName$, i+1)
end function
'function to delete entire folder (including sub folders and files)
function delete$(folder$)
run "cmd.exe /c rd /s /q ";q$;folder$;q$, HIDE
end function
'function makes customized confirmation window
function custcon$(text$)
global text$, customconfirmOpen, a$, answer$, fault
WindowWidth = 540 : WindowHeight = 300
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
statictext #customconfirm.header "Notice to User", 190, 10, 130, 30
statictext #customconfirm.text text$, 40, 60, 490, 120
button #customconfirm.default "&OK", [confirmYes], ul, 220, 200, 80, 35
button #customconfirm.yes "&Yes", [confirmYes], ul, 100, 200, 120, 35
button #customconfirm.no "&No", [confirmNo], ul, 320, 200, 120, 35
open "Confirmation Required" for dialog_modal as #customconfirm
#customconfirm "trapclose [confirmNo]"
#customconfirm "font arial 12"
customconfirmOpen = 1
#customconfirm.default "!hide"
wait
[confirmNo]
answer$ = "No"
if customconfirmOpen = 1 then close #customconfirm : customconfirmOpen = 0
goto [endFunction]
[confirmYes]
answer$ = "Yes"
if customconfirmOpen = 1 then close #customconfirm : customconfirmOpen = 0
[endFunction]
end function
FUNCTION FN.Screen(BYREF Szx, BYREF Szy)
Szx = DisplayWidth
Szy = DisplayHeight
FN.Display = Szx * Szy
END FUNCTION
FUNCTION FN.PercentScreen(PercentX, PercentY, BYREF Szx, BYREF Szy)
Szx = INT(DisplayWidth * PercentX)
Szy = INT(DisplayHeight * PercentY)
FN.PercentScreen = Szx * Szy
END FUNCTION
FUNCTION FN.ScreenCenter(BYREF Cx, BYREF Cy)
Cx = INT(DisplayWidth * 0.5)
Cy = INT(DisplayHeight * 0.5)
FN.ScreenCenter = Cx * Cy
END FUNCTION
FUNCTION FN.SetWinPos(PosX, PosY)
UpperLeftX = PosX
UpperLeftY = PosY
FN.SetWinPos = PosX * PosY
END FUNCTION
FUNCTION FN.SetWinSize(Szx, Szy)
WindowWidth = Szx
WindowHeight = Szy
FN.SetWinSize = Szx * Szy
END FUNCTION
sub resized handle$
TxbUx = 100 '<--- location and size of text box
TxbUy = 50
Txbsx = 100
Txbsy = 25
Txbsx = WindowWidth - TxbUx - Txbsx '<--- resize text box
#codeTank.numLines, "!LOCATE ";WindowWidth-130;" "; 50;" ";120;" "; 25
#codeTank.filePath, "!LOCATE ";TxbUx;" ";TxbUy;" ";Txbsx-30;" ";Txbsy
#codeTank.keys, "LOCATE ";100;" ";75;" ";340;" ";WindowHeight-600+60+270
#codeTank, "REFRESH"
end sub
'sub to make folder dialog window
sub browser caption$
dim info$(0, 0)
dim folderInfo$(0, 0)
WindowWidth = 700
WindowHeight = 500
UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
gosub [FolderDlgGetDrives]
statictext #folderdlg.selection, "Selection >> ", 40, 505, 95, 15
statictext #folderdlg.caption, caption$, 150, 20, 525, 35
listbox #folderdlg.filelist, fileList$(, [fileSelect], 350, 50, 320, 310
listbox #folderdlg.list, FolderList$(, [FolderDlgSelect], 15, 50, 320, 310
button #folderdlg.default, "OK", [FolderDlgOk], UL, 220, 410, 75, 25
button #folderdlg.back, "< < <", [FolderDlgBack], UL, 10, 10, 60, 30
button #folderdlg.C, "Cancel", [FolderDlgCancel], UL, 395, 410, 75, 25
button #folderdlg.plusfont, "+", [plusFont], UL, 75, 10, 30, 30
button #folderdlg.minusfont, "-", [minusFont], UL, 110, 10, 30, 30
textbox #folderdlg.text, 15, 360, 655, 25
BackgroundColor$ = "lightgray"
open "Liberty Basic File Browser" for dialog_modal as #folderdlg
#folderdlg, "trapclose [FolderDlgCancel]"
#folderdlg.text, "Selected (Drive \ Folder \ File) Path Appears Here"
#folderdlg, "font Arial 12 bold"
#folderdlg.filelist, "singleclickselect"
#folderdlg.list, "singleclickselect"
fontsize = 12
wait
[minusFont]
fontsize = fontsize - 1
#folderdlg.list, "font arial ";fontsize;" bold"
#folderdlg.filelist, "font arial ";fontsize;" bold"
wait
[plusFont]
fontsize = fontsize + 1
#folderdlg.list, "font arial ";fontsize;" bold"
#folderdlg.filelist, "font arial ";fontsize;" bold"
wait
[FolderDlgSelect]
#folderdlg.list, "selection? temp$"
if temp$ <> "" then
level = level+1
folder$ = folder$; temp$; "\"
#folderdlg.text, folder$
gosub [FolderDlgGetDir]
#folderdlg.list, "reload"
#folderdlg.list, "select 0"
#folderdlg.default "!setfocus"
end if
wait
[FolderDlgBack]
if level > 0 then
level = level-1
if level = 0 then
folder$ = ""
gosub [FolderDlgGetDrives]
else
i = len(folder$)-1
while mid$(folder$, i, 1) <> "\" and mid$(folder$, i, 1) <> ""
i = i-1
wend
folder$ = left$(folder$, i)
gosub [FolderDlgGetDir]
end if
#folderdlg.text, folder$
fileList$(0) = " F I L E S"
#folderdlg.list, "reload"
#folderdlg.filelist, "reload"
end if
wait
[FolderDlgGetDrives]
c = 1
while word$(Drives$, c) <> ""
c = c+1
wend
redim FolderList$(c)
FolderList$(0) = " D R I V E S"
for i = 1 to c
FolderList$(i) = word$(Drives$, i)
next i
redim fileList$(0)
return
[FolderDlgGetDir]
files folder$, info$(
s = val(info$(0,0))
tt = val(info$(0,1))
redim FolderList$(tt)
FolderList$(0) = " F O L D E R S"
for i = 1 to tt
FolderList$(i) = info$(i+s, 1)
next i
[filesBack]
files folder$, "*.*", folderInfo$()
numFiles = val(folderInfo$(0, 0))
redim fileList$(numFiles)
for x = 1 to numFiles
filename$ = folderInfo$(x, 0)
fileList$(x) = filename$
next x
fileList$(0) = " F I L E S"
sort fileList$(), 0 , numFiles
#folderdlg.filelist, "reload"
return
[fileSelect]
#folderdlg.filelist "selection? file$"
#folderdlg.text, folder$;file$
wait
[FolderDlgOk]
#folderdlg.text, "!contents? FolderDialog$"
If right$(FolderDialog$,1) = "\" then
if right$(FolderDialog$, 2) = ":\" then [goAround]
FolderDialog$ = left$(FolderDialog$, len(FolderDialog$) - 1)
else
[goAround]
notice "The Selection was Not a Folder" : close #folderdlg : wait
end if
[FolderDlgCancel]
close #folderdlg
end sub
sub quit fast$
close #fastcode
fastcodeOpen = 1
end sub
'sub to generate the window code and copy to clipboard, and texeditor
sub dummy fast$
global toPrint$
select case
case fast$ = "#fastcode.button1"
#fastcode.txt1 "!contents? txt$"
#fastcode.txt2 "!contents? theName$"
#fastcode.r1 "value? result$"
if result$="set" then
itag$="["
otag$="]"
closingCode$= "[quit]";chr$(13);_
" close ";txt$;chr$(13);_
" end"
else
closingCode$ = "Sub quit fast$";chr$(13);_
" close #fast$" ;chr$(13);_
" end";chr$(13);_
"End Sub"
end if
#fastcode.combo "selection? sel$"
if instr(sel$,"popup") then
includeButton$= "button ";txt$;".button1 ";chr$(34);_
"&X";chr$(34);", "; itag$;"quit";otag$;", ul, 610, 5, 25, 20"
end if
toPrint$ = "nomainwin";chr$(13);"WindowWidth = 640";chr$(13);"WindowHeight = 480";chr$(13);_
"UpperLeftX=int((DisplayWidth-WindowWidth)/2)";chr$(13);_
"UpperLeftY=int((DisplayHeight-WindowHeight)/2)";chr$(13);_
includeButton$;chr$(13);_
"Open ";chr$(34);theName$;chr$(34);" for ";sel$; " as ";txt$;chr$(13);_
" ";txt$;" "; chr$(34); "trapclose ";itag$;"quit";otag$; chr$(34);chr$(13);_
"wait";chr$(13);chr$(13);_
closingCode$
#fastcode.ed "!cls"
#fastcode.ed toPrint$
#fastcode.ed "!selectall"
#fastcode.ed "!copy"
#fastcode.ed "!paste"
#fastcode.ed "!origin 0 0"
end select
end sub
function getsize$(l$)
'what if it is a variable?
v$=""
pos=1
n$=mid$(l$,pos,1)
while instr("1234567890",n$,1)=0 and pos<len(l$)
pos=pos+1
n$=mid$(l$,pos,1)
wend
while n$>="0" and n$<="9" and pos<=len(l$)
v$=v$+n$
pos=pos+1
n$=mid$(l$,pos,1)
wend
getsize$=v$
end function
function getcolor$(l$)
if l$="palegray" then l$="lightgray"
'what if it is a variable?
cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black "
for c= 1 to 15
if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for
next
if getcolor$="" then getcolor$="white"
end function
function value(x$)
select case len(x$)
case 1
value = asc(x$)
case 2
value=asc(mid$(x$,1,1))
value=value+(asc(mid$(x$,2,1))*256)
case 3
value=asc(mid$(x$,1,1))
value=value+(asc(mid$(x$,2,1))*256)
value=value+(asc(mid$(x$,3,1))*65536)
case 4
value=asc(mid$(x$,1,1))
value=value+(asc(mid$(x$,2,1))*256)
value=value+(asc(mid$(x$,3,1))*65536)
value=value+(asc(mid$(x$,4,1))*16777216)
end select
end function
'subroutine for selections of combo boxes
sub asciiSelected asciiList$
#codeTank.asciiList, "selection? asciiChoice$"
#codeTank.filePath asciiChoice$
#codeTank.fake "!cls"
#codeTank.fake asciiChoice$
#codeTank.fake "!selectall"
#codeTank.fake "!copy"
#codeTank.asciiList, "! ASCII Codes"
end sub
sub getAscii
dim asciiList$(250)
y = 7
asciiList$(0)= " Controls"
asciiList$(1) = " chr$(0) = (nul) ";chr$(0)
asciiList$(2) = " chr$(27) = (escape) ";chr$(27)
asciiList$(3) = " chr$(32) = (space) ";chr$(32)
asciiList$(4) = " chr$(13) = (enter) ";chr$(13)
asciiList$(5) = " Printables"
asciiList$(6) = " chr$(32)= (space) ";chr$(32)
for x = 33 to 255
asciiList$(y) = " chr$(";x;") = ";chr$(x)
y = y + 1
next x
#codeTank.asciiList, "reload"
#codeTank.asciiList, "! ASCII Codes"
end sub
sub lbreservedwordSelected lbReservedwordList$
#codeTank.lbreservedwordsList, "selection? lbreserved$"
#codeTank.filePath lbreserved$
#codeTank.fake "!cls"
#codeTank.fake lbreserved$
#codeTank.fake "!selectall"
#codeTank.fake "!copy"
#codeTank.lbreservedwordsList "select 0"
#codeTank.lbreservedwordsList "! Reserved Words"
end sub
sub getlbreservedwords
global lbReservedWords$
dim lbreservedwordsList$(250)
for x = 0 to 250
filename$ = word$(lbReservedWords$, x ,",")
lbreservedwordsList$(x) = filename$
next x
sort lbreservedwordsList$(), 1 ,250
#codeTank.lbreservedwordsList, "reload"
#codeTank.lbreservedwordsList "! Reserved Words"
end sub
[LBB_EXE]
global fname0$
LBB$ = DefaultDir$;"\LBB.exe"
filedialog "Open a Liberty Basic Source File (.bas) ", "*.bas", fname$
if fname$ = "" then wait
cursor hourglass
fname0$ = GetFilename$(fname$)
open fname$ for input as #1
open DefaultDir$;"\EXE\";fname0$ for output as #2
temp$ = input$(#1, lof(#1))
#2 temp$
close #1
close #2
call writeAutoSaveLBB
run "wscript ";autoSaveLBB$
run LBB$;" -C -M -A ";DefaultDir$;"\EXE\";fname0$
fname0$ = left$(fname0$, len(fname0$)-4)
fname1$ = fname0$;".exe"
call fixdate
call fixtime
while fileExists(DefaultDir$;"\EXE", fname1$) = 0
scan
x=x+1
if x = 40000 then exit while
wend
call pause 6000
fullname$ = DefaultDir$;"\EXE\";fname0$;"_";fixeddate$;fixedtime$;".exe"
if fileExists(DefaultDir$;"\EXE", fname1$) then
name DefaultDir$;"\EXE\";fname1$ as fullname$
end if
if fileExists(DefaultDir$;"\EXE", fname0$;".bas") then
name DefaultDir$;"\EXE\";fname0$;".bas" as DefaultDir$;"\EXE\";fname0$;"_";fixeddate$;fixedtime$;".bas"
end if
cursor normal
print x
x=0
wait
sub writeAutoSaveLBB
q$ = chr$(34)
global autoSaveLBB$, fname0$, fname$
autoSaveLBB$ = "autoSaveLBB.vbs"
open autoSaveLBB$ for output as #1
#1 "Set WshShell = WScript.CreateObject(";q$;"WScript.Shell";q$;")"
#1, "Do While Not WshShell.AppActivate(";q$;"Save standalone executable";q$;")"
#1, "Loop"
#1, "WshShell.AppActivate(";q$;"Save standalone executable";q$;")"
#1, "WshShell.SendKeys ";q$;"{ENTER}";q$
#1, "Wscript.Sleep(8000)"
#1, "WshShell.AppActivate(";q$;"LB Booster";q$;")"
#1, "WshShell.SendKeys ";q$;"{ENTER}";q$
#1 "Set WshShell = nothing"
close #1
end sub
Please, for Peace sake, ask any questions you have regarding CodeTankPlus - HERE - at Code-Share. Thank you. Please post feedback to help improve CodeTankPlus |
|
|
|
Post by Admin on Sept 22, 2023 22:31:45 GMT
An updated version is available.
CodeTankPlus v1.8.1
Changes
- Automation is now one button, and the page that comes up to add 'password', version#, date\time etc, now has a checkbox to select whether IEXPRESS creates the EXE file, or LB Booster.
All options are now available for LB Booster EXE files, as well as those made by IEXPRESS.
-Now, when an EXE file gets created, the code is added to a 'Title' in the 'MyProjects' categorie with the same name as the selected .bas file(without the .bas extension), and will act as though it was created as a 'MyProject' with all the options available, same as any "MyProjects" created using the [New From File] button.
'CodeTank v1.8.1F - For Liberty Basic v4.5.1 and (Pro)
'created by xxgeek Sept 2023
'This app uses "Dictionary" code, written by Carl Gundel, at it's core
'This app also uses FastCode written by cundo - a member of the JustBasic Forums
'This app also uses a Help search engine originally created by cundo - (orig name = JB Search)
'This app also uses a version of FFUL(FreeFormUltraLite) written by Rod - Admin at both JB and LB Forums
' All edited to suit this app
'Purposes -
' (1) To create reservoir(s) of code, subs, functions, scripts and example programs with ability to share_
'_ with others each category file, to merge with their own reservoir(s).
' (2) To automate the collection of support dll and sll files along with TKN file creation and renaming_
'_ of the run451.exe, and to automate the creation of EXE files with 3 differing methods
' (3) To create dated\timestamped backups of each .bas file, and a .tkn backup file of each .bas_
'_ file to 'Revert' back if\when needed.
'Use alt +
' Char Button
' c = [copy] - copies selected code in editor
' d = [Delete] - deletes a selected listing, and offers to delete it's project files as well
' e = [Create Single &EXE File] - creates a single EXE file from a selected BAS file
' f = [New From File] - user selects the file to add to the listing using filedialog
' g = [Merge File] - merge a file of a particular 'categorie' with another , possibly downloaded file
' l = [Edit in LB IDE] - opens selected code in LB IDE
' m = [Mirror Editor] - opens a window with a full screen editor mirroring the existing one.
' n = [New (Copy\Paste)] - Create a 'New' listing manually (not from a file)
' p = [paste] - pastes code into editor at location of I-Beam
' r = [RUN] - runs selected listing
' s = [Select All] - selects all the text in the texteditor
' s = [Scratch] button - on the Mirror window
' t = [Update TKN] - updates the TKN file of a selected listing (MyProjects, and MyPrograms ONLY)
' u = [cut] - cuts selected text from editor
' v = [Revert to Backup] - Overwrites the files of a selected listing with a selected backup
' + = Increase Font Size [+]
' - = Decrease Font Size [-]
'WARNING - Save to a folder of it's own, it creates files, and folders when used.
' Please Note:
' When selecting a .bas file to create a New Project, or Program.......
' Make sure the .bas file is a known good one, and runs/starts ok in the LB IDE
' If the .bas file cannot pass the compiler's check, it can cause havoc with the automation'
' process, and probably crash CodeTank.
'When RUNing any files be aware that the file you are running 'MAY' be the culprit if a problem arises.
'The LB IDE may stay open, along with a mainwin, and the user must close both manually.
'For help using CodeTank visit the Liberty Basic forums
' @ https://libertybasiccom.proboards.com/
'on error goto [abort]
'nomainwin
gosub [initiate]
[start]
dim searchList$(500), info$(0,0), oneOf$(2500), mainList$(500) 'declare some variables
global LBpath$, helpFilePath$, fname$
helpFilePath$ = LBpath$;"\lb4help\LibertyBASIC_4_web"
helpFileMenu$ = "amber_menu.htm"
'dim arrays for key$ and info$
dim key$(1000)
dim info$(500, 500)
global toPrint$
res = mkdir("EXE")
'declare variables
q$ = chr$(34)
codeTank$ = "#codeTank"
LBruntime$ = "run451.exe"
lbReservedWords$ = " AND, APPEND, AS, BEEP, BMPBUTTON, BMPSAVE, BUTTON, BYREF, CALL, CALLDLL, CALLFN, CASE, CHECKBOX, CLOSE, CLS, COLORDIALOG, COMBOBOX, CONFIRM, CURSOR, DATA, DIALOG, DIM, DLL, DO, DUMP, DWORD, ELSE, END, ERROR, EXIT, FIELD, FILEDIALOG, FILES, FONTDIALOG, FOR, FUNCTION, GET, GETTRIM, GLOBAL, GOSUB, GOTO, GRAPHICBOX, GRAPHICS, GROUPBOX, IF, INPUT, INPUTCSV, KILL, LET, LINE, LISTBOX, LOADBMP, LONG, LOOP, LP, PRINT, MAINWIN, MAPHANDLE, MENU, NAME, NEXT, NOMAINWIN, NOTICE, ON, ONCOMERROR, OR, OPEN, OUTPUT, PASSWORD, PLAYMIDI, PLAYWAVE, POPUPMENU, PRINT, PRINTERDIALOG, PROMPT, PUT, PTR, RADIOBUTTON, RANDOM, RANDOMIZE, READ, READJOYSTICK, REDIM, REM, RESTORE, RESUME, RETURN, RUN, SCAN, SELECT, SHORT, SORT, STATICTEXT, STOP, STOPMIDI, STRUCT, SUB, TEXT, TEXTBOX, TEXTEDITOR, THEN, TIMER, TITLEBAR, TRACE, ULONG, UNLOADBMP, UNTIL, USHORT, VOID, WAIT, WINDOW, WEND, WHILE, XOR, ABS(, ACS(, AFTER$(, AFTERLAST$(, ASC(, ASN(, ATN(, CHR$(, COS(, DATE$(, DECHEX$(, EOF(, HBMP(, HEXDEC(, HTTPGET$(, HWND(, INP(, INPUT$(, INPUTTO$(, INSTR(, INT(, LEFT$(, LEN(, LOF(, LOG(, LOWER$(, MAX(, MIDIPOS(, MID$(, MIN(, MKDIR(, NOT(EXP(, HEXDEC(, INPUT$(, INPUTTO$(, INSTR(, INT(, LEFT$(, LEN(, LOF(, LOG(, LOWER$(, MAX(, MIDIPOS(, MID$(, MIN(, MKDIR(, NOT(, REMCHAR$(, REPLSTR$(, RIGHT$(, RMDIR(, RND(, SIN(, SPACE$(, SQR(, STR$(, TAB(, TAN(, TIME$(, TRIM$(, TXCOUNT(, UPPER$(, UPTO$(, USING(, VAL(, WINSTRING(, WORD$(, BackgroundColor$, ComboboxColor$, CommandLine$, DefaultDir$, DisplayHeight, DisplayWidth, Drives$, Err, Err$, ForegroundColor$, Joy1x, Joy1y, Joy1z, Joy1button1, Joy1button2, Joy2x, Joy2y, Joy2z, Joy2button1, Joy2button2, ListboxColor$, Platform$, PrintCollate, PrintCopies, PrinterFont$, PrinterName$, TextboxColor$, TexteditorColor$, Version$, WindowHeight, WindowWidth, UpperLeftX, UpperLeftY"
DllList$="vbas31w.sll vgui31w.sll voflr31w.sll vthk31w.dll vtk1631w.dll vtk3231w.dll vvm31w.dll vvmt31w.dll"
savedProjects$ = "savedProjects"
MyProjects$ = "MyProjects"
MyBackups$ = "MyBackups"
programs$ = "Programs"
vbs$ = "VBS-Scripts"
cmd$ = "CMD-Scripts"
examples$ = "Examples"
snippets$ = "Snippets"
lbExamples$ = "LB-Examples"
lbBakFiles$ = "LB-BAK-Files"
subroutines$ = "Subroutines"
functions$ = "Functions"
mainFontsize = 10
project = 1
WinWide = 1000 '1000
WinHigh = 600
UserMonitorResx = 1000 '800
UserMonitorResy = 600 '600
IF UserMonitorResx < WinWide THEN
Diff = WinWide - UserMonitorResx
WinWide = WinWide - Diff
END IF
IF UserMonitorResy < WinHigh THEN
Diff = WinHigh - UserMonitorResy
WinHigh = WinHigh - Diff
END IF
RetVal = FN.ScreenCenter(Cx, Cy) '<--- get screen center
RetVal = FN.SetWinPos(Cx - INT(WinWide / 2), Cy - INT(WinHigh / 2)) '<--- set window pos
RetVal = FN.SetWinSize(WinWide, WinHigh) '<--- set window size
UpperLeftX= int((DisplayWidth-WindowWidth)/2)-70
UpperLeftY= int((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "lightgray"
menu #codeTank, "File" , "Open Liberty Basic", [openlb], "Open a File in Liberty Basic", [openlbFile], "Exit", [quit.codeTank]
menu #codeTank, "Edit"
menu #codeTank, "Browse" , "My Projects", [projectsDir], ".EXE Files", [EXEDir], ".TKN Files", [tknDir], ".BAS Files", [basFiles],"DefaultDir$", [defaultDir],"LB Code Examples", [lbexamplesDir]
menu #codeTank, "Help" , "Liberty Basic Forums", [forumlink], "Help", [codeTankHelp], "About", [about]
texteditor #codeTank.value, 440, 75, 545, 425
hscroll$ = "#codeTank.keys"
stylebits #hscroll$, _WS_HSCROLL, 0, 0, 0
listbox #codeTank.keys, keys$(), [keySelected], 100, 75, 340, 270
'category radio buttons
radiobutton #codeTank.savedprojects, "MyProjects", [projs], resetHandler, 5, 90, 95, 20
radiobutton #codeTank.programs, "MyPrograms", [progs], resetHandler, 5, 110, 95, 20
radiobutton #codeTank.backups, "MyBackups", [mybackups], resetHandler, 5, 140, 95, 20
radiobutton #codeTank.examples, "Examples", [exams], resetHandler, 5, 170, 80, 20
radiobutton #codeTank.snippets, "Snippets", [snipps], resetHandler, 5, 190, 95, 20
radiobutton #codeTank.subroutines, "Subroutines", [subroutines], resetHandler, 5, 210, 95, 20
radiobutton #codeTank.functions, "Functions", [functions], resetHandler, 5, 230, 95, 20
radiobutton #codeTank.VBS, "VBS-Scripts", [vbs], resetHandler, 5, 250, 95, 20
radiobutton #codeTank.CMD, "CMD-Scripts", [cmd], resetHandler, 5, 270, 95, 20
radiobutton #codeTank.lbexamples, "LB-Examples", [lbCodeExamples], resetHandler, 5, 305, 95, 20
radiobutton #codeTank.lbbakfiles, "LB-BakFiles", [lbbakfiles], resetHandler, 5, 325, 95, 20
radiobutton #codeTank.folderChoice, "Any Folder", [folderChoice], resetHandler, 5, 355, 95, 20
'Event buttons etc
wh=WinHigh-100
button #codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1)), [newKey], LL, 270, wh-365, 165, 25
button #codeTank.fromFile, "New from &File", [makeproject], LL, 105, wh-365, 155, 25
button #codeTank.remakeproject, "Update &TKN File", [remakeproject], LL, 105, wh-415, 155, 25
button #codeTank.runlb, "Edit Item in &Liberty Basic", [edit_In_LB_IDE], LL, 105, wh-390, 155, 25
button #codeTank.merge, "Mer&ge Shared File ";categorie$, [mergeFile], LL, 270, wh-415, 165, 25
button #codeTank.runListing, "&Run", [runKey], LL, 270, wh-390, 165, 25
button #codeTank.revert, "Re&vert to Backup", [revert], LL, 105, wh-440, 155, 25
button #codeTank.deleteListing, " &Delete ", [deleteKey], LL, 270, wh-440, 165, 25
button #codeTank.exe, "BAS<2>&EXE (Automated)", [GUI], LL, 185, wh-520, 165, 30
button #codeTank.IEXP_man, "IEXPRESS Manually", [IEXP_man], LL, 105, wh-465, 155, 25
button #codeTank.lbbEX_man, "LB Booster Manually", [lbbEX_man], LL, 270, wh-465, 165, 25
button #codeTank.lbbFileEdit, "Edit File in LB Booster", [lbbEdit], LL, 270, wh-490, 165, 25
button #codeTank.lbbSelEdit, "Edit Item in LB Booster", [lbbSelEdit], LL, 105, wh-490, 155, 25
button #codeTank.incFont, "&+", [incFont], UL, 25, 390, 20, 23
button #codeTank.decFont, "&-", [decFont], UL, 50, 390, 20, 23
button #codeTank.mirror, "&Mirror Editor", [textEdMirror], UL, 5, 425, 95, 25
button #codeTank.cut, "C&ut", [cut], LL, 560, wh-520, 65, 20
button #codeTank.copy, "&Copy", [copy], LL, 630, wh-520, 65, 20
button #codeTank.selectAll, "Select &All", [selectall], LL, 700, wh-520, 85, 20
button #codeTank.paste, "&Paste", [paste], LL, 790, wh-520, 85, 20
button #codeTank.fastwindows, "&Fast Windows", [fastcode], ul, 5, 460, 95, 25
button #codeTank.fastgui, "&Fast GUI's", [fastGui], UL, 5, 495, 90, 25
textbox #codeTank.filePath, 100, 50, WinWide-235, 25
statictext #codeTank.categories, "Categories", 20, 60, 80, 15
combobox #codeTank.asciiList, asciiList$(), asciiSelected , 320, 2, 150, 12
combobox #codeTank.lbreservedwordsList, lbreservedwordsList$(), lbreservedwordSelected , 475, 2, 170, 10
textbox #codeTank.tb 175, 27, 120, 23
statictext #codeTank.searchFor, "Search For", 105, 30, 65, 15
textbox #codeTank.numLines, 860, 50, 120, 25
button #codeTank.searchlb, "&Search | IN >", [startSearching], UL, 325, 27, 120, 23
button #codeTank.incFont, "&+", [incFontSearch], UL, 710, 27, 25, 23
button #codeTank.decFont, "&-", [decFontSearch], UL, 740, 27, 25, 23
button #codeTank.contents, "&LB Help Menu", [Contents], UL, 770, 27, 100, 25
button #codeTank.help, "?", [searchhelp], UL, 300, 27, 20, 23
checkbox #codeTank.lbhelp, "Help", [lbHelp], [nolbHelp], 455, 30, 45, 15
checkbox #codeTank.lbexamples, "Examples Code ", [lbexamples], [nolbexamples], 510, 30, 110, 15
checkbox #codeTank.cbank, "CodeTank", [cbank], [nocbank], 625, 30, 80, 15
texteditor #codeTank.fake, 0, 0, 0, 0
open "CodeTank Plus v1.8.1F" for window as #codeTank
#codeTank.addListing "!disable"
#codeTank.deleteListing "!disable"
#codeTank.remakeproject "!disable"
#codeTank.runListing "!disable"
#codeTank.runlb "!disable"
#codeTank.fromFile "!disable"
#codeTank.merge "!disable"
#codeTank.revert "!disable"
#codeTank "trapclose [quit.codeTank]"
#codeTank "font Arial ";mainFontsize
call getlbreservedwords
call getAscii
#codeTank.keys "singleclickselect"
#codeTank.value "!autoresize"
#codeTank "resizehandler resized"
#codeTank.lbhelp "set"
lbHelp = 1
codetankOpen = 1
categorie$ = "ScratchPad"
open "ScratchPad" for append as #1 : #1 date$();time$() : close #1
wait
'[abort]
'Notice "An Error Has Occured";chr$(13);"Error #";Err;" ";chr$(13);Err$;" ";chr$(13);"CodeTank will need to Shutdown"
'goto [quit.codeTank]
[selectall]
#codeTank.value "!selectall"
wait
[cut]
#codeTank.value "!cut"
wait
[copy]
#codeTank.value "!copy"
wait
[paste]
#codeTank.value "!paste"
wait
[IEXP_man]
run "IEXPRESS"
wait
[lbbEX_man]
filedialog "Open a Liberty Basic Source File (.bas) ", "*.bas", fname$
if fname$ = "" then wait
if fileExists(DefaultDir$,"LBB.exe") then run DefaultDir$;"\LBB.exe -C -M -A ";fname$
wait
[lbbEdit]
filedialog "Open a Liberty Basic Source File (.bas) ", "*.bas", fname$
if fname$ = "" then wait
if fileExists(DefaultDir$,"LBB.exe") then run DefaultDir$;"\LBB.exe ";fname$
wait
[lbbSelEdit]
if selectedKey$ = "" then notice "Select an item from a list, try again" : wait
#codeTank.value, "!contents? valueNow$";
open "untitled.bas" for output as #1
#1 "WARNING - To Preserve the Integrity of the CodeTank File(s) and the Liberty Basic Files(s)"
#1 "THIS CODE IS ACTUALLY a COPY OF ";selectedKey$;".bas Named -> 'untitled.bas' "
#1 "'Remember to 'Save As' a name of your Choice if/when done editing"
#1 ""
#1 valueNow$
close #1
tempfile$ = DefaultDir$;"\untitled.bas"
run DefaultDir$;"\LBB.exe ";q$;tempfile$;q$
#codeTank.filePath "cls" : #codeTank.filePath "Editing ";tempfile$;" in Liberty Basic Editor"
#codeTank.keys "select 0"
wait
[singleEXE]
' Use at your own risk - Author accepts NO liabilities
'########################################################################################
' IMPORTANT
' before running this code - save this code to a file named b2e.bas - (in a folder of it's own)
' If you do not wish to have commandline support, which copies the files of this app, along
' _with creating folders and new files, in the Users Home dir, you can delete or uncomment
' _the following 3 lines of code in the top 1st block of code..
'if not(fileExists(DefaultDir$, "b2e.exe")) then
'command = 1 : firstRun = 1 : project = 1 : fname$ = DefaultDir$;"\b2e.bas" : goto [checklbpath]
'end if
'If you do the above, disregard deleting the folder after first run, it will be needed.
'You can run the .bas from there, or create the TKN file, and run it from there.
'########################################################################################
'BAS2EXE Version v1.8.9c For Windows 10 (possibly XP, 7, 8 and 11) - try it and let me know
' Date Introduced to Public = Jan 29 2023
' Title - BAS2EXE v1.8.9c (with CommandLine support)
' Author - xxgeek, a member of the Libertybasiccom.proboards.com/ forums
' {Purpose} - To automate bas file to exe file (self extracting exe) making creation quick and easy while
' storing dated copies (users choice), of every selected bas file, the created tkn, and the created exe (self extracting)
' exe file containing the dll files, sll files, lbrun2.exe(renamed to same name as .bas file selected)
' Along with that there is a project folder created holding the same files as the exe that gets updated
' if and when the same bas file is selected, Note, the dated files are in their appropriate folders, EXE, TKN, and BAS
' NOTE -They will be overwritten if the same .bas file is selected on the same day within one minute
' The options are user generated by selecting the appropriate checkboxes (GUI)
' Or by Using the appropriate switches (Command Mode)
'GUI MODE
' Place this bas file in it's own folder as it will create some folders and temp files as well as the above
' IMPORTANT > Name this file b2e.bas (or it won't work)
' After first run, delete the folder, including the folders created, and the b2e.bas file
'_ they are no longer needed as this app copies it's files to the users home dir
' There will be a shortcut on the desktop created, use this to open BAS2EXE from now on.
' Note - The Home dir is used in order to make the command line work properly
' Choose 32bit exe or 64`bit exe - defaults to 64 bit if no selection made
' Option to password the EXE file - Check off the checkbox, [Select File] and enter a password when prompted.
' When bas2exe opens a filedialog to choose a bas file choose a bas file that is a
' _good working bas file (or there will be trouble with the compiler)
' Add a version number and or Date/Time stamp the EXE filename
' View the Menu after EXE file creation
'The "Save tkn" file dialog and the Information "saved as" dialog close automatically and save the tkn file to where it is needed.
' If you keep the project folders you will have a "project" folder with each saved project which
'_ includes the dll, sll files and lbrun2.exe(renamed), the selected .bas file and the tkn file.
'The EXE File is saved to the EXE folder in the same folder as this program is located.
' _unless otherwise specified for eg: when using the (CommandLine) and not the GUI (no GUI option for destination - v4.5.1.0 maybe )
' Next Window is to choose to Run the EXE or view the EXE Files Created by this Program
'_ or Make a New EXE
' Note - For standalone bas files only with no dependent files or folders - at this time (Maybe Version 2, we''ll see)
' If the .bas file you select runs in the lb IDE when RUN, the EXE will be made. If there are programming
'_ runtime errors your EXE could still crash at some point (Not BAS2EXE's fault)
' If it won't run in the lb IDE there will be an error reported by the lb compiler when this app attempts to
'_ make the tkn file, and the lb window that opens showing the code for the selected bas file will stay opened
'_, close it manually.
'IMPORTANT INFORMATION
' This new version has CommandLine support, meaning it works from a command prompt.
' or it can be used in code projects with the Run command as well.
'COMMAND MODE
' Syntax for commandline:
' If using the EXE
' b2e -sourceFilePath\file.bas -destinationPath /bas /dt /kp /pw /r /s /tkn /v'number' /bit'number'
' or b2e.exe -sourceFilePath\file.bas -destinationPath /bas /dt /kp /pw /r /s /tkn /v'number' /bit'number'
' If using the TKN in code
' b2e.tkn -sourceFilePath\file.bas -destinationPath /bas /dt /kp /pw /r /s /tkn /v'number' /bit'number'
' if destinationPath is ommtted the default destinationPath is DefaultDir$\EXE
' If sourcePath\file.bas is ommitted BAS2EXE defaults to opening in GUI mode
' If no switches used, all switches defaults are false, 0 or "", except for the bit64 default
' Switches MUST be separated with a 'space'
' Switches are Optional
' Liberty typing b2e by itself BAS2EXE defaults to opening in GUI mode
'Switches
' /bas - saves a dated backup of the selected bas file
' /bit32 - creates a 32 bit exe file
' /bit64 - creates a 64 bit exe file (Defaults to 64bit EXE file if no swtich used)
' /dt - appends date/time to the created exe filename.
' /kp - saves the Project Folder (tkn, renamed lbrun2.exe dll and sll files) Created anyway - they are needed for the EXE file.
' /o - opens windows explorer with the created EXE file selected
' /pw - Prompts user for a password to open the created EXE file (If used the EXE file won't run without it, so save the password somewhere safe.)
' /q - Stops the "Please Wait" activity window from appearing while in command mode.
' /r - Runs the New EXE file after it is created
' /s - shows the Post Creation EXE Menu Window (GUI) to (View / Run / MakeNew - EXE file)
' /tkn - saves a dated backup of the tkn file.
' /v'number' - appends the EXE filename with a version number or text
' (No Spaces) examples: /v4.5.1.51 /v.001 /v123.Any_thing Note: The "v" is not included.
' If you want a v in your EXE filename then you must add one eg: /vv4.5.1 /vvTest123 etc
' Here are some examples of commandline use.
' eg: b2e (alone this opens the GUI)
' b2e -sourceFilePath\file.bas (Creates a single exe file in DefaultDir$\EXE) no project folder, no backups, no appended date/time, or version etc
' b2e -sourceFilePath\file.bas -f:\MyStuff\MyEXEcollection Creates a single 64bit EXE file in f:\MyStuff\MyEXEcollection
' b2e -sourceFilePath\file.bas /bas /bit32 /dt /kp /pw /q /r /s /tkn /vv1.0 (Creates a single 32bit exe file in DefaultDir$\EXE)
' _ including all the optional swtches
' Switches can be in ANY order as long as they preceed the -path(s)
' if -sourceFilePath\file.bas is a lone .bas file with no path, BAS2EXE assumes the file is in the DefaultDir$
' The dashes before the path(S) ARE necessaary
' the spaces between the switches ARE necessary
' Please NOTE - About the app and it's limitations
' This app uses a built in Windows app named IEXPRESS to create the EXE file by way of a SED(Self Extracting Dirctive) file.
' This app write the SED file, then IEXPRESS reads, and executes the instructions in it to create the EXE file.
' IEXPRESS has limits.
' It won't copy a folder, so for now this app can only create EXE files with the necessary runtime support files
' That means (for now anyway) the files needed to work (dll's, sll's tkn renamed lbrun2.exe and the bas file if user wants it.)
' If your .bas file uses any support files from the DefaultDir$ or sub folders of DefaultDir$ such as
' _bmp, txt, etc, they won't be in the EXE file when created.
' The app is great for testing, or for apps that need no support files (other than the lb dlls/slls the tkn and renamed lbrun2.exe )
' _and if your .bas doesn't create any files needed the next time it is opened.
' When an EXE that is created by IEXPRESS executes, it is unpacked in the users temp folder, into a folder
' _named IXP001.tmp, or the number can vary on each persons PC. IXP001......IXP00n (depends on other temp apps I guess)
' These temp folders get deleted when the app is finished doing it's thing as is closed.
' That means if your app saves any data to files in DefaultDir$, or copies any files\folders to DefaultDir$, they get deleted too.
' If the interest is there, and I get some feedback on this app I'll work on a version 2.
' Version 2 will have support for adding extra folders and files to the EXE
' It will also get around the temp folder issue. I have that part working already.
' It may also have an option to batch create the EXE files.
' By having .bas files in a folder, and executing a loop to create one after the other.
' Other suggestions are welcome
' If you use this, please take the time to give some feedback so I know what's up,
' Any issues, don't hesitate to report them
' This App is actually part of a larger app, and the defaults are set 'as is' to accomodate the larger app.
' I didn't want to re-write the whole thing for the 1 person that 'may' use it.
' This app is free to use, edit, and/or distibute. Feel free to make it work the way you want it to.
' New Version v1.8.9
' added ini file to hold Users lb install dir path when detected to be other than default
' added checkbox to allow showing created exe file in Windows Explorer when complete
' added onerror notice, and restart of BAS2EXE
' hardened some more
'New Version 1.9.0c
' changed method of auto[enter] of TKN creation "save as" dialog, and "Information" notice
' changed file verification loops of created exe file and tkn file to allow escape from loop after a set time
' _ to avoid infinite looping with BAS2EXE running invisible, forcing user to use taskmanager to close
' _ when/if exe file or tkn file is NOT created for whatever reason
' added detection of spaces in filename. IEXPRESS will not create a file with spaces in the name of the
' _source file - BAS2EXE will give Notice, then close when Notice closes.
' Tested on files up to 11000 lines - User may need to increase the 2 largest pauses if files have
' _ 11000+ lines of code (look for 'call pause 1500') - 2 of them
[TOP]
if mainOpen = 1 then close #main : mainOpen = 0
command = 0 : s = 0 : openDest = 0 : runEXE = 0 : p = 0 : q = 0 : show = 0
tkn = 0 : bas = 0 : r = 0 : ve$ = "" : ve = 0 : project = 0 : dt = 0 : fname$ = ""
exeDest$ = "" : selectedpath$ = "" : fixeddate$ = "" : fixedtime$ = "" : exe$ = ""
q$ = chr$(34)
if CommandLine$ <> "" then
if not(instr(CommandLine$, ".bas")) then [GUI]
sourc3$ = word$(CommandLine$, 3)
sourc2$ = word$(CommandLine$, 2)
sourc1$ = word$(CommandLine$, 1)
sourc = 1
if instr(sourc1$, ".bas") then fname$ = word$(CommandLine$, 1) : goto [getDest]
sourc = 2
if instr(sourc2$, ".bas") then fname$ = word$(CommandLine$, 2) : goto [getDest]
sourc = 3
if instr(sourc3$, ".bas") then fname$ = word$(CommandLine$, 3)
[getDest]
fname$ = trim$(fname$)
if right$(fname$, 1) = chr$(34) then fname$ = left$(fname$, len(fname$)-1)
if left$(fname$, 1) = chr$(34) then fname$ = right$(fname$, len(fname$)-1)
if left$(fname$ ,1) = "-" then fname$ = right$(fname$, len(fname$)-1)
if left$(fname$ ,1) = "\" then fname$ = right$(fname$, len(fname$)-1)
fname$ = trim$(fname$)
if left$(fname$ ,1) = "\" then fname$ = right$(fname$, len(fname$)-1)
if not(instr(fname$, ":\")) and instr(fname$, ".bas") then fname$ = DefaultDir$;"\";fname$
dest$ = word$(CommandLine$, 2)
if instr(dest$, ":\") and sourc = 1 then exeDest$ = word$(CommandLine$, 2) : goto [gotDest]
dest$ = word$(CommandLine$, 3)
if instr(dest$, ":\") and sourc = 2 then exeDest$ = word$(CommandLine$, 3) : goto [gotDest]
dest$ = word$(CommandLine$, 4)
if instr(dest$, ":\") and sourc = 3 then exeDest$ = word$(CommandLine$, 4) : goto [gotDest]
exeDest$ = DefaultDir$;"\EXE"
[gotDest]
if left$(exeDest$ , 1) = "-" then exeDest$ = right$(exeDest$, len(exeDest$)-1)
if right$(exeDest$, 1) = chr$(34) then exeDest$ = left$(exeDest$, len(exeDest$)-1)
if left$(exeDest$, 1) = chr$(34) then exeDest$ = right$(exeDest$, len(exeDest$)-1)
if left$(exeDest$ , 1) = "-" then exeDest$ = right$(exeDest$, len(exeDest$)-1)
if instr(CommandLine$, "/bas") then bas = 1 'creates a dated backup of the user selected .BAS file in DefaultDir$\BAS
if instr(CommandLine$, "/dt") then dt = 1 'appends the date and time to the EXE file
if instr(CommandLine$, "/kp") then project = 1 'keep the project folder (temp project folder gets deleted by default in command mode)
if instr(CommandLine$, "/o") then openDest = 1 'opens windows explorer to the created EXE file when done
if instr(CommandLine$, "/pw") then p = 1 'password - adds password to bas file - if chosen, the EXE file won't run without it.
if instr(CommandLine$, "/q") then quiet = 1 'no "please wait" window will appear
if instr(CommandLine$, "/r") then runEXE = 1 'Run the newly created exe file.
if instr(CommandLine$, "/s") then show = 1 'show final options window (defaults to not show in command mode)
if instr(CommandLine$, "/tkn") then tkn = 1 'creates a dated backup of the user selected TKN file in DefaultDir$\TKN
if instr(CommandLine$, "/v") then 'ALL CommandLine options default to false, '0' , "", unless switch options are utilized
ve = 1 ' appends a version number to the EXE filename - defaults to false - 0
ve$ = word$(CommandLine$, 2 , "/v") : ve$ = word$(ve$, 1)
end if
bit = 64
if instr(CommandLine$, "/bit") then
bit$ = word$(CommandLine$, 2 , "/bit") : bit$ = word$(bit$, 1) : bit = val(bit$)
end if
command = 1 : goto [noGUI]
end if
[GUI]
exeDest$ = ""
titlebar$ = "BAS2EXE v1.9.0c"
[noGUI]
if command = 1 then [commandPath]
' setup a Window for User to Select a .bas File, to select options for the EXE file.
WindowWidth = 600
WindowHeight = 450
UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "lightgray"
ForegroundColor$ = "black"
'add some text ,some buttons, and checkboxes to the Window
statictext #pick.exe, "EXE File", 35, 30, 95, 30
statictext #pick.head, "BAS<2>EXE v1.9.0c", 250, 25, 190, 30
statictext #pick.temp, "Project Files", 425, 100, 195, 30
statictext #pick.datedtext, "Dated Backups", 225, 100, 185, 30
statictext #pick.info, "Select a working Liberty Basic Source Code File (.bas)", 50, 270, 590, 30
button #pick.default, "Select File", [defaultClick],UL 140, 340, 135, 35
button #pick.lbforums, "Visit the Liberty Basic Forums @ https://Libertybasiccom.proboards.com/", [forumLink],UL 0, 395, 595, 25
checkbox #pick.opendest, "Show EXE File When Completed", [OpenDest], [noOpenDest], 20, 210, 250, 20
checkbox #pick.bit32, "32 Bit", [bit32], [nobit32], 20, 65, 50, 20
checkbox #pick.bit64, "64 Bit", [bit64], [nobit64], 75, 65, 50, 20
checkbox #pick.password, "Add a Password", [yespass], [nopass], 20, 90, 140, 20
checkbox #pick.appDT, "Append Date/Time", [appDT], [noappDT], 20, 115, 140, 20
checkbox #pick.appversion, "Append Version Number", [appVersion], [noappVersion], 20, 140, 140, 20
checkbox #pick.project, "Keep Project Dir", [project], [noproject], 430, 135, 160, 20
checkbox #pick.TKN, "SaveTKN File", [noTKN], [yesTKN], 250, 135, 140, 20
checkbox #pick.BAS,"Save BAS File", [noBAS], [yesBAS], 250, 160, 140, 20
checkbox #pick.LBB,"Use LB Booster Instead of IEXPRESS", [yesLBB], [noLBB], 20, 235, 330, 20
checkbox #pick.ShowOptionsMenu,"Show Post Creation Options Menu", [yesShow], [noShow], 20, 190, 190, 20
checkbox #pick.batch,"Select Folder for Batch EXE Creation", [yaBatch], [noBatch], 50, 310, 190, 20
button #pick.32, "Cancel", [cancel],UL 320, 340, 135, 35
statictext #pick.versionText, "Version #", 40, 170, 50, 20
textbox #pick.ve, 90, 165, 85, 20
'open the Window, and set some Fonts for each statictext, and buttons
open "BAS2EXE v1.9.0c (CommandLine Support)" for window_nf as #pick : pickOpen = 1
#pick, "trapclose [cancel]"
#pick.LBB "font Arial_bold"
#pick.exe, "!font Arial_bold"
#pick.temp, "!font Arial_bold"
#pick.datedtext, "!font Arial_bold"
#pick.info, "!font Arial_bold"
#pick.head "!font Arial_bold"
#pick.bit64, "set"
#pick.project, "set"
#pick.TKN "set"
#pick.BAS "set"
#pick.appDT "set"
#pick.versionText "!hide"
#pick.ve "!hide"
#pick.default, "!setfocus"
pickOpen = 1
project = 1
tkn = 1
bas = 1
bit = 64
dt = 1
wait
'Create exe files for all bas files in selected folder
[yaBatch]
#pick.info, "Select a Folder with 'Working' Source Files (.bas)"
#pick.default "Select Folder"
batch = 1
wait
[noBatch]
#pick.info, "Select a working Liberty Basic Source Code File (.bas)"
#pick.default "Select File"
batch = 0
wait
[yesLBB]
#pick.LBB "set"
LBB =1
wait
[noLBB]
#pick.LBB "reset"
LBB = 0
wait
[OpenDest]
#pick.opendest "set"
openDest = 1
wait
[noOpenDest]
#pick.opendest "reset"
openDest = 0
wait
[yesShow]
show = 1
wait
[noShow]
show = 0
wait
[project]
project = 1
wait
[noproject]
project = 0
wait
[yesTKN]
tkn = 0
wait
[noTKN]
tkn = 1
wait
[yesBAS]
bas=0
wait
[noBAS]
bas = 1
wait
' passworded exe is true(user selected)
[yespass]
p = 1
wait
'passworded exe is false, default
[nopass]
p = 0
wait
'make 32 bit exe = true(user selected)
[bit32]
bit=32
#pick.bit64, "reset" : #pick.bit64 "hide"
wait
'make 64 bit exe, default
[bit64]
bit=64
#pick.bit32, "reset" : #pick.bit32 "hide"
wait
[nobit32]
bit=64
#pick.bit64, "show" : #pick.bit32 "hide"
wait
[nobit64]
bit=32
#pick.bit32, "show" : #pick.bit64 "hide"
wait
'append date/time to backed up tkn, and bas files - defaults to true
[appDT]
dt = 1
wait
[noappDT]
dt = 0
wait
[appVersion]
#pick.versionText "!show"
#pick.ve "!show" : #pick.ve "!setfocus"
ve = 1
wait
[noappVersion]
#pick.ve ""
#pick.versionText "!hide"
#pick.ve "!hide"
ve = 0
wait
[forumLink]
run "explorer https://Libertybasiccom.proboards.com"
wait
[defaultClick]
if ve = 1 then #pick.ve "!contents? ve$"
If ve$ <> "" then ve$ = "-";ve$
[commandPath]
'close the opening window for Selecting bas file
if pickOpen = 1 then close #pick : pickOpen = 0
'define some variables
supportFileList$="run451.exe vbas31w.sll vgui31w.sll voflr31w.sll vthk31w.dll vtk1631w.dll vtk3231w.dll vvm31w.dll vvmt31w.dll"
'projects$ = "b2eProjects"
projects$ = "savedProjects"
'make sure the support files exist
fileCount = 0
while 1
fileCount = fileCount + 1
runtimeSupportFile$ = word$(supportFileList$, fileCount)
if runtimeSupportFile$ = "" then exit while
if fileExists(LBpath$,runtimeSupportFile$) = 0 then notice "File doesn't Exist";chr$(13);LBpath$;"\";runtimeSupportFile$;chr$(13);"BAS2EXE will now Close" : end
wend
if command = 1 then [commandByPass]
' Use the filedialog function to allow user to select a source file (.bas)
[filediag]
global FolderDialog$
caption$ = "Select a Folder with Known Good .bas Files"
if batch = 1 then
call browser caption$
batchDir$ = FolderDialog$
if FolderDialog$ = "" then batch = 0 : wait
gosub [getBatchDir]
goto [commandByPass]
end if
fname$ = ""
filedialog "Open a Liberty Basic Source File (.bas) ", "*.bas", fname$
if fname$ = "" then wait
[commandByPass]
if batchFileCount = 0 then batchFileCount = 1 : batchFiles$(numRuns) = fname$
for numRuns = 0 to batchFileCount
if batch = 1 then numRuns = 1
fname$=batchFiles$(numRuns)
if batch = 0 then numRuns = 1
if fname$ = "" then notice "No fname$" : wait
if batch=1 then fname$ = FolderDialog$;"\";fname$
print "numRuns = ";numRuns
print "batchFiles$(numRuns+1) = ";batchFiles$(numRuns)
print "fname$ = ";fname$
print "batch = ";batch
if p = 1 then
Prompt "TYPE a PASSWORD"+chr$(13)+ "Password For Your EXE File is? : (no spaces)";passwerd$
if passwerd$ = "" then p = 0 : notice "BAS2EXE will continue, without placing a password on the EXE file created"
end if
'Separate path from selected filename, and extension from selected filename
for var1 = len(fname$) to 1 step -1
if mid$(fname$, var1, 1) = "\" then var2 = var1 -1 : var3 = var2 - ((len(fname$))) : exit for
next var1
var3 = abs(var3)
orig$ = left$(fname$, var2)
fname0$ = right$(fname$, var3 -1)
for var4 = len(fname0$) to 1 step -1
if mid$(fname0$, var4, 1) = "." then var5 = var4 -1 : var6 = var5 - ((len(fname0$))) : exit for
next var4
var6 = abs(var6)
fnamenobas$ = left$(fname0$, var5)
for x = 1 to len(fnamenobas$)
spaceCheck$ = mid$(fnamenobas$, x, 1)
if spaceCheck$ = " " then notice "No Spaces Allowed in File Name"+chr$(13)+"Space found in Selected Filename. Cannot Create EXE File."+chr$(13)+"BAS2EXE will now Close" : end
next x
' fname$ = Full Path of User Selected .bas file (including the filename.bas)
' fname0$ = Name of the Selected .bas File Only - eg ; filename.bas
' fnamenobas$ = Name of the Selected .bas File (without the .bas) - eg: filename
[add2List]
add2List = 1
'add to MyProject file and add title to MyProjects list for ALL EXE file creations.
categorie$ = "MyProjects"
selectedKey$ = fnamenobas$
gosub [deleteOrig]
[deleteReturn]
open categorie$ for append as #1
#1 chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
open fname$ for input as #2
#1 input$(#2, lof(#2))
close #1 : close #2
lastKey$ = ""
call readDictionary
call loadKeys
call saveValue
call collectGarbage
call resetRadioOptions
#codeTank.keys "select 0"
#codeTank.savedprojects "set"
add2List = 0
[begin2]
'define Destpath1$ as lb Projects\Current Project Folder
DestPath$=DefaultDir$ 'Where this file is RUN from
DestPathU$ = DestPath$;"\";projects$ 'Projects Folder
DestPath1$=DestPathU$;"\";fnamenobas$ 'Current Project Folder
'Make Folders for Liberty Basic Projects, EXE files, TKN files, BAS files, SED files and Current Projects
res = mkdir(DestPathU$) 'projects dir
res = mkdir(DestPath1$) 'new project dir = name of selected bas file (no .bas) in Projects Dir
res =mkdir(DefaultDir$;"\";"EXE") 'exe files saved here
res = mkdir(DefaultDir$;"\";"TKN") 'tkn files saved here
res= mkdir(DefaultDir$;"\";"BAS") 'selected bas file saved here (includes password code if exe was passworded)
'make sure Folders were actually created
if pathExists(DestPathU$) = 0 then notice "Projects folder was NOT Created in ";DestPath$ : end
if pathExists(DestPath1$) = 0 then notice "New Folder ";fnamenobas$;" was NOT Created in ";DestPath1$ : end
if pathExists(DefaultDir$;"\";"TKN") = 0 then notice "TKN Folder was NOT Created in ";DestPath$ : end
if pathExists(DefaultDir$;"\";"BAS") = 0 then notice "BAS Folder was NOT Created in ";DestPath$ : end
if pathExists(DefaultDir$;"\";"EXE") = 0 then notice "EXE Folder was NOT Created in ";DestPath$ : end
'copy selected bas file to Projects\current project folder
q$= chr$(34)
open fname$ for input as #fname
fnameTemp$="tempBas.bas"
open fnameTemp$ for output as #2
'add a password prompt to the begining of the temp bas file(to be added to the exe)
if p=0 then [nopasswerd] '
#2, "prompt ";q$;"Enter the Password to Run";q$;";";"passwerd$"
#2, "if passwerd$ <> ";q$;passwerd$;q$;" then end"
[nopasswerd]
#2, input$(#fname, lof(#fname));
close #fname
close #2
'copy temp.bas file to current project folder
open fnameTemp$ for input as #fnameTemp
open DestPath1$;"\";fname0$ for output as #1
#1, input$(#fnameTemp, lof(#fnameTemp));
close #1
close #fnameTemp
if fileExists(DefaultDir$, fnameTemp$) then kill fnameTemp$
'check if the current project .bas file was copied to new dir
if fileExists(DestPath1$,fname0$) = 0 then notice fname0$; " Was not copied to ";DestPath1$;" BAS2EXE will now close" : end
'activity message to user - please wait message
if quiet = 0 then call pleasewait
'Copy the needed DLL and SLL files from Liberty Basic dir to projects\projectname Dir
w$ = ""
i = 0
while 1
i = i + 1
w$=word$(supportFileList$, i)
if w$="" then exit while
from$=LBpath$;"\";w$
to$=DestPath1$;"\";w$
if fileExists(DestPath1$,w$) then [noneed]
open from$ for input as #file
open to$ for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
[noneed]
wend
'remove existing lbrun2.exe from new project before creating new one
if fileExists(DestPath1$, LBruntime$) then kill DestPath1$;"\"; LBruntime$
'copy lbrun2.exe to current project Folder
open LBpath$;"\";LBruntime$ for input as #file
open DestPath1$;"\";LBruntime$ for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
'Liberty Basic can't create\rename a file that exists, so if it does already exist - kill it (delete it)
if fileExists(DestPath1$, fnamenobas$ + ".exe") <> 0 then kill DestPath1$;"\";fnamenobas$ + ".exe"
'rename lbrun2.exe to name of User Selected .bas File - .bas +.exe
name DestPath1$;"\";LBruntime$ as DestPath1$;"\";fnamenobas$ + ".exe"
'check new exe (renamed lbrun2.exe) file for existence in current project Folder )
if fileExists(DestPath1$,fnamenobas$;".exe") = 0 then notice "lbrun2.exe not copied or renamed - EXITING Program": end
'remove any existing exe from projectdir - of same name as bas file selected only if created on same date at same time
if fileExists(DestPath$;"\EXE",fnamenobas$;".exe") then kill DestPath$;"\EXE\";fnamenobas$;".exe"
if command = 1 and fileExists(exeDest$,fnamenobas$;".exe") then kill exeDest$;"\"; fnamenobas$;".exe"
'check for old tkn existence, delete it if it exists
if fileExists(DestPath1$,fnamenobas$;".tkn") then kill DestPath1$;"\";fnamenobas$;".tkn"
gosub [makeSED]
'verify sed file existence before proceeding
do
scan
loop until fileExists(DestPath$,fnamenobas$;".sed")
call writeAutoSave
'loop until autoSave$ File is verified
while fileExists(DefaultDir$, autoSave$) = 0 : scan : wend
'#######################################################################
'run the script to close the "save" dialog, and the follow up notice of creation automatically
run "wscript ";autoSave$
'#######################################################################
'Create the TKN file in Projects\current project folder.
run LBpath$;"\";LBexe$;" -T -A ";DestPath1$;"\";fname0$
'#######################################################################
'loop until TKN File is verified saved
do
countTime = countTime + 1
call pause 500
if countTime > 50 then exit do '- In case of unreported error - EXE file verification loop exit
scan
loop until fileExists(DestPath1$, fnamenobas$;".tkn")
call pause 2500
call fixtime : call fixdate ' append date/time to backup .bas and .tkn filename
'copy selected .bas file to BAS dir and date it
if bas = 1 then
open fname$ for input as #file
open DefaultDir$;"\BAS\";fnamenobas$;ve$;fixeddate$;fixedtime$;".bas" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
end if
' copy TKN file to TKN dir, and append date\time to it's name
if tkn = 1 and fileExists(DestPath1$, fnamenobas$;".tkn") <> 0 then
open DestPath1$;"\";fnamenobas$;".tkn" for input as #file
open DefaultDir$;"\TKN\";fnamenobas$;ve$;fixeddate$;fixedtime$;".tkn" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
end if
'fixeddate$ = "" : fixedtime$ = ""
'First Run setup in User Home Dir for CommandLine use
if command = 1 and firstRun = 1 then
run "cmd.exe /c xcopy ";DestPath1$;" ";upath$;" /e /s /c /h /i /y", hide
call pause 1000
run upath$;"\b2e.exe"
end if
if firstRun = 1 then close #pleasewait : end
[LBB_CHOSEN]
if LBB = 1 then goto [LBB_EXE]
'Check if iexpress.exe is installed (a built in Windows Install Maker = Self Extracting exe File)
[makeexe]
'makes 64 bit exe
if bit=32 then [do32bit]
'run iexpress commandline using the sed file created (sort of like an ini file)
express64$ = "C:\Windows\System32"
if fileExists(express64$,"iexpress.exe") then
run "iexpress /N /q ";sedfile$ : goto [verifyEXE]
else
noie = 1 : goto [quit.main]
end if
'makes 32 bit exe
[do32bit]
express32$ = "C:\Windows\SysWOW64"
if fileExists(express32$,"iexpress.exe") then
run "iexpress /N /q ";sedfile$
else
noie = 2 : goto [quit.main]
end if
[LBB_RETURN]
call pause 500
'verify the exe file was created - loop until it exists
[verifyEXE]
if command = 1 then
do
countTime = countTime + 1
call pause 500
if countTime > 50 then exit do '- In case of unreported error - EXE file verification loop exit
scan
loop until fileExists(exeDest$, exe$)
end if
if command = 0 then
do
countTime = countTime + 1
call pause 500
if countTime > 50 then exit do '- In case of unreported error - EXE file verification loop exit
scan
loop until fileExists(DefaultDir$;"\EXE\", exe$)
end if
call pause 1500
'if dt = 1 then call fixdate : call fixtime
' append version, date, time to filename if selected
if command = 1 then
if fileExists(exeDest$, fnamenobas$;".exe") then
exefilename$ = fnamenobas$;ve$;fixeddate$;fixedtime$;".exe"
name exeDest$;"\";fnamenobas$;".exe" as exeDest$;"\";exefilename$
end if
end if
if command <> 1 then
if fileExists(DefaultDir$;"\EXE", fnamenobas$;".exe") then
exefilename$ = fnamenobas$;ve$;fixeddate$;fixedtime$;".exe"
name DefaultDir$;"\EXE\";fnamenobas$;".exe" as DefaultDir$;"\EXE\";exefilename$
end if
end if
if runEXE = 1 and command = 1 and fileExists(exeDest$, exefilename$) then run exeDest$;"\";exefilename$
[main]
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
'create a window with options to view created files or run the new exe file.
WindowWidth = 400
WindowHeight = 320
UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "darkgray"
ForegroundColor$ = "black"
button #main.default, "Make New Single EXE File (GUI Mode)", [rerun],UL 90, 200, 220, 40
button #main.run, "Run the Created EXE File", [progrun],UL 125, 150, 150, 40
button #main.browseT, "View TKN Files", [browseT],UL 125, 15, 150, 25
button #main.browseB "View BAS Files", [browseB],UL 125, 45, 150, 25
button #main.browseE, "View EXE Files", [browseE],UL 125, 75, 150, 25
button #main.browseP, "View Projects", [browseP],UL 125, 105, 150, 25
button #main.lbforums, "For more Information > Click Here to Visit the Liberty Basic Forums", [forumLink], UL 0, 270, 400, 20
open "View Files\ Run Created EXE \ Make New EXE" for window_nf as #main
#main, "trapclose [quit.main]"
mainOpen = 1
if show <> 1 then close #main : mainOpen = 0
if command = 0 and openDest = 1 then
run "cmd.exe /c explorer /select, ";q$;DefaultDir$;"\EXE\";exefilename$;q$, hide
openDest = 0
if mainOpen = 0 then [quit.main]
end if
if command = 1 and openDest = 1 then
run "cmd.exe /c start explorer.exe /select, ";q$;exeDest$;"\";exefilename$;q$, hide
openDest = 0
if mainOpen = 0 then [quit.main]
end if
cursor normal
next numRuns
batch=0 : batchFileCount = 0
gosub [cleanUp]
if batch = 1 then [quit.main]
if mainOpen=1 then
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
wait
else
goto [quit.main]
end if
'Make another EXE file
[rerun]
if command = 1 then CommandLine$ = "" : exeDest$ = "" : fname$ = "" : command = 0
goto [TOP]
'open Windows explorer to the EXE Files
[browseE]
if command = 1 and exeDest$ <> "" then run "explorer.exe ";exeDest$
if command = 0 then run "explorer.exe ";DefaultDir$;"\EXE"
wait
'open Windows explorer to the backup TKN Files Files
[browseT]
run "explorer.exe ";DefaultDir$;"\TKN"
wait
'open Windows explorer to the backup BAS Files
[browseB]
run "explorer.exe ";DefaultDir$;"\BAS"
wait
'open Windows explorer to the Projects Dir
[browseP]
run "explorer.exe ";DefaultDir$;"\";projects$
wait
'Run the new CommandLine created exe file chosen
[progrun]
if command = 1 then
run exeDest$;"\";exefilename$
end if
if command = 0 then
run DestPath$;"\EXE\";exefilename$
end if
wait
[getBatchDir]
dim Info$(1, 1)
files batchDir$, Info$()
batchFileCount = val(Info$(0, 0))
dim batchFiles$(batchFileCount+1)
for x = 1 to batchFileCount
filename$ = Info$(x, 0)
if right$(filename$, 4) <> ".bas" then [noThanks]
batchFiles$(x) = filename$
print batchFiles$(x)
[noThanks]
next x
return
[makeSED]
'can't write text to files that include quotes, so use the characters so they will print without syntax errors
sedfile$=fnamenobas$;".sed"
open sedfile$ for output as #sed
#sed "[Version]"
#sed "Class=IEXPRESS"
#sed "SEDVersion=3"
#sed "[Options]"
#sed "PackagePurpose=InstallApp"
#sed "ShowInstallProgramWindow=1"
#sed "HideExtractAnimation=1"
#sed "UseLongFileName=1"
#sed "InsideCompressed=0"
#sed "CAB_FixedSize=0"
#sed "CAB_ResvCodeSigning=0"
#sed "RebootMode=N"
#sed "InstallPrompt=%InstallPrompt%"
#sed "DisplayLicense=%DisplayLicense%"
#sed "FinishMessage=%FinishMessage%"
#sed "TargetName=%TargetName%"
#sed "FriendlyName=%FriendlyName%"
#sed "AppLaunched=%AppLaunched%"
#sed "PostInstallCmd=%PostInstallCmd%"
#sed "AdminQuietInstCmd=%AdminQuietInstCmd%"
#sed "UserQuietInstCmd=%UserQuietInstCmd%"
#sed "SourceFiles=SourceFiles"
#sed "[Strings]"
#sed "InstallPrompt="
#sed "DisplayLicense="
#sed "FinishMessage="
exe$=fnamenobas$;".exe"
if command = 1 and exeDest$ <> "" then
#sed "TargetName=";q$;exeDest$;"\";exe$;q$
else
#sed "TargetName=";q$;DefaultDir$;"\EXE\";exe$;q$
end if
#sed "FriendlyName=";q$;fnamenobas$;q$
#sed "AppLaunched=";q$;exe$;q$
#sed "PostInstallCmd=<None>"
#sed "AdminQuietInstCmd="
#sed "UserQuietInstCmd="
#sed "FILE0=";q$;exe$;q$
sedtkn$=fnamenobas$;".tkn"
#sed "FILE1=";q$;sedtkn$;q$
sll1$="vbas31w.sll"
sll2$="vgui31w.sll"
sll3$="voflr31w.sll"
dll1$="vthk31w.dll"
dll2$="vtk1631w.dll"
dll3$="vtk3231w.dll"
dll4$="vvm31w.dll"
dll5$="vvmt31w.dll"
#sed "FILE2=";q$;sll1$;q$
#sed "FILE3=";q$;sll2$;q$
#sed "FILE4=";q$;sll3$;q$
#sed "FILE5=";q$;dll1$;q$
#sed "FILE6=";q$;dll2$;q$
#sed "FILE7=";q$;dll3$;q$
#sed "FILE8=";q$;dll4$;q$
#sed "FILE9=";q$;dll5$;q$
#sed "[SourceFiles]"
#sed "SourceFiles0=";q$;DestPath1$;q$
#sed "[SourceFiles0]"
#sed "%FILE0%="
#sed "%FILE1%="
#sed "%FILE2%="
#sed "%FILE3%="
#sed "%FILE4%="
#sed "%FILE5%="
#sed "%FILE6%="
#sed "%FILE7%="
#sed "%FILE8%="
#sed "%FILE9%="
close #sed
return
[cleanUp]
if fileExists(DefaultDir$, fnameTemp$) then kill fnameTemp$
if fileExists(DefaultDir$,"temp.txt") then kill "temp.txt"
if fileExists(DefaultDir$, "FolderDialog.vbs") then kill "FolderDialog.vbs"
if fileExists(DefaultDir$, autoSave$) then kill autoSave$
if fileExists(DefaultDir$,desktopShortcut$) then kill desktopShortcut$
'if user chose to, - delete the current project dir and files (copied bas file, tkn file, sll,dll, run451.exe(renamed file)
if project = 0 then
if fileExists(DestPath1$, "vbas31w.sll") then kill DestPath1$;"\";"vbas31w.sll"
if fileExists(DestPath1$, "vgui31w.sll") then kill DestPath1$;"\";"vgui31w.sll"
if fileExists(DestPath1$, "voflr31w.sll") then kill DestPath1$;"\";"voflr31w.sll"
if fileExists(DestPath1$, "vtk1631w.dll") then kill DestPath1$;"\";"vtk1631w.dll"
if fileExists(DestPath1$, "vthk31w.dll") then kill DestPath1$;"\";"vthk31w.dll"
if fileExists(DestPath1$, "vtk3231w.dll") then kill DestPath1$;"\";"vtk3231w.dll"
if fileExists(DestPath1$, "vvm31w.dll") then kill DestPath1$;"\";"vvm31w.dll"
if fileExists(DestPath1$, "vvmt31w.dll") then kill DestPath1$;"\";"vvmt31w.dll"
if fileExists(DestPath1$, exe$) then kill DestPath1$;"\";exe$
if fileExists(DestPath1$, fnamenobas$;".tkn") then kill DestPath1$;"\";fnamenobas$;".tkn"
if fileExists(DestPath1$, fnamenobas$;".bas") then kill DestPath1$;"\";fnamenobas$;".bas"
if pathExists(DestPath1$) then deldir = rmdir(DestPath1$)
end if
if fileExists(DefaultDir$, fnamenobas$;".sed") then kill DefaultDir$;"\";fnamenobas$;".sed"
if noie = 1 then notice "64Bit Version of IEXPRESS not installed"+chr$(13)+" No EXE File Created - BAS2EXE closing."
if noie = 2 then notice "32Bit Version of IEXPRESS not installed"+chr$(13)+" No EXE File Created - BAS2EXE closing."
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
run "cmd.exe /c del ";DefaultDir$;"\*.INF", HIDE
run "cmd.exe /c del ";DefaultDir$;"\*.vbs", HIDE
run "cmd.exe /c del ";DefaultDir$;"\*.sed", HIDE
run "cmd.exe /c del ";DefaultDir$;"\EXE\*.RPT", HIDE
run "cmd.exe /c del ";DefaultDir$;"\EXE\*.CAB", HIDE
run "cmd.exe /c del ";DefaultDir$;"\EXE\*.DDF", HIDE
if pickOpen = 1 then close #pick : pickOpen = 0
if fileExists(DefaultDir$;"\EXE", "~";fnamenobas$;".CAB") <> 0 then kill DefaultDir$;"\EXE\~";fnamenobas$;".CAB"
if fileExists(DefaultDir$;"\EXE", "~";fnamenobas$;".DDF") <> 0 then kill DefaultDir$;"\EXE\~";fnamenobas$;".DDF"
if fileExists(DefaultDir$;"\EXE", "~";fnamenobas$;".RPT") <> 0 then kill DefaultDir$;"\EXE\~";fnamenobas$;".RPT"
if fileExists(DefaultDir$;"\EXE", "~";fnamenobas$;"_LAYOUT.INF") <> 0 then kill DefaultDir$;"\EXE\~";fnamenobas$;"_LAYOUT.INF"
return
[quit.main]
if command = 0 and openDest = 1 then run "cmd.exe /c explorer /select, ";q$;DefaultDir$;"\EXE\";exefilename$;q$, hide
gosub [cleanUp]
if command = 1 and fileExists(exeDest$, exefilename$) = 0 then notice "No EXE Created"+chr$(13)+"EXE file was NOT created"+chr$(13)+"Check Selected File 'name' for Spaces"
cursor normal
if command = 0 and fileExists(DefaultDir$;"\EXE\", exefilename$) = 0 then notice chr$(13)+"EXE file was NOT created"+chr$(13)+"Check Selected File 'name' for Spaces"
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
if mainOpen = 1 then close #main : mainOpen = 0
wait
[quit.pleasewait]
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
wait
[cancel]
close #pick : pickOpen = 0
wait
[newKey] 'ask the user for a name for the new listing
call saveValue
newKey$ = ""
if len(left$(categorie$, (len(categorie$) - 1))) < 4 then [notPlural]
prompt "Enter a Name (or Title) for the New " + left$(categorie$,(len(categorie$)-1)); newKey$
if newKey$ <> "" then [continue] else wait
[notPlural]
prompt "Enter a Name (or Title) for the New "+categorie$+" Script"; newKey$
if newKey$ = "" then wait
'if user selects 'New From File' instead of New (copy/paste) to add new Project, or new Program
[continue]
if newKey$ <> "" then
call setValueByName newKey$, ""
call loadKeys
#codeTank.keys "select "; newKey$
#codeTank.value "!cls";
call collectGarbage
call writeDictionary
lastKey$ = newKey$
end if
if tkn = 2 or tkn = 4 then
open fname$ for input as #1
open categorie$ for append as #2
#2 input$(#1, lof(#1));
close #1
close #2
gosub [cleanUp]
tkn = 0
end if
call saveValue
call readDictionary
call loadKeys
#codeTank.keys "select 0"
#codeTank.value "!setfocus"
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
wait
[keySelected]
call saveValue
#codeTank.keys "selection? selectedKey$"
if categorie$ = anyFolder$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";anyFolder$;" Section - ";selectedKey$
if categorie$ = examples$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";examples$;" Section - ";selectedKey$
if categorie$ = snippets$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";snippets$;" Section - ";selectedKey$
if categorie$ = cmd$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";cmd$;" Section - ";selectedKey$
if categorie$ = vbs$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";vbs$;" Section - ";selectedKey$
if categorie$ = subroutines$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";subroutines$;" Section - ";selectedKey$
if categorie$ = functions$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";functions$;" Section - ";selectedKey$
if categorie$ = MyProjects$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";MyProjects$;" Section - ";selectedKey$
if categorie$ = programs$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";programs$;" Section - ";selectedKey$
if categorie$ = lbExamples$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";lbExamples$;" File - ";uAppPath$;"\";selectedKey$;".bas"
#codeTank.value "!cls"
open uAppPath$;"\";selectedKey$;".bas" for input as #1
#codeTank.value, "!contents #1";
close #1
#codeTank.value, "!origin 0, 0"
#codeTank.value, "!lines numLines$"
#codeTank.numLines "# of Lines = ";numLines$
wait
end if
if categorie$ = lbBakFiles$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";lbBakFiles$;" File - ";uAppPath$;"\bak\";selectedKey$;".bak"
#codeTank.value "!cls"
open uAppPath$;"\bak\";selectedKey$;".bak" for input as #1
#codeTank.value, "!contents #1";
close #1
#codeTank.value, "!origin 0, 0"
#codeTank.value, "!lines numLines$"
#codeTank.numLines "# of Lines = ";numLines$
wait
end if
if categorie$ = anyFolder$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";folderChoice$;" File - ";folderpath$;"\";selectedKey$;".bas"
#codeTank.value "!cls"
open folderpath$;"\";selectedKey$;".bas" for input as #1
#codeTank.value, "!contents #1";
close #1
#codeTank.value "!origin 0 0"
#codeTank.value, "!lines numLines$"
#codeTank.numLines "# of Lines = ";numLines$
wait
end if
selectedValue$ = getValue$(selectedKey$)
#codeTank.value "!contents selectedValue$";
lastKey$ = selectedKey$
#codeTank.value, "!origin 0 0"
#codeTank.value, "!lines numLines$"
#codeTank.numLines "# of Lines = ";numLines$
wait
[deleteKey]
'delete a Listing
gosub [deleteNow]
wait
[deleteNow]
#codeTank.keys "selection? selectedKey$"
if selectedKey$ = "" then notice "Select an item from list, try again" : cursor normal : wait
[deleteOrig]
cursor hourglass
call pleasewait : pleasewaitOpen = 1
#codeTank.filePath "cls" : #codeTank.filePath "Erasing ";selectedKey$;" code from - ";categorie$
#codeTank.value, "!selectall"
#codeTank.value, "!cut"
#pleasewait.fake "!setfocus"
call saveValue
if categorie$ = "" then
categorie$ = "ScratchPad" : selectedKey$ = "Scratch"
open categorie$ for append as #1
#1 chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 Pad$
close #1
end if
open categorie$ for binary as #1
tempfile$ = "tempfile"
open tempfile$ for output as #2
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
while eof(#1) = 0
line input #1, line$
if line$ = word1$ then [dontSave]
#2, line$
[dontSave]
wend
close #1
close #2
if fileExists(DefaultDir$, categorie$) then kill DefaultDir$;"\";categorie$
name tempfile$ as categorie$
lastKey$ = ""
call readDictionary
call loadKeys
call saveValue
#codeTank.keys "select 0"
if pleasewaitOpen = 1 then pleasewaitOpen = 0 : close #pleasewait
if add2List = 1 then
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
cursor normal
goto [deleteReturn]
end if
cursor normal
if pathExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$) <> 0 and mir = 0 then
folder$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$
text$ = "Title: "+selectedKey$+chr$(13)+" Has been Deleted"+chr$(13)+chr$(13)+"Do you wish to delete the project folder as well?"
a$ = custcon$(text$)
if answer$ <> "Yes" then wait
a$ = delete$(folder$)
end if
return
'run selected MyProjects, or MyPrograms
[runKey]
if selectedKey$ = "" then notice "Select an item from list, try again" : wait
text$ = "Warning "+chr$(13)+"RUNing this Code May Leave an IDE Window"+chr$(13)+"and or"+chr$(13)+"Leave Mainwin Open when it Closes";chr$(13)+"It May Not Open at all, or it May Just Flash Open and Close"+chr$(13)+"Run it Anyway ?"
if categorie$ = lbBakFiles$ then
runFile$ = uAppPath$;"\bak\";selectedKey$;".bak"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(code$,"trapclose",1) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
temp$ = DefaultDir$;"\untitled.bas"
open temp$ for output as #1
#codeTank.value "!contents? code$"
#1 ""
#1 " 'This Code is a Copy of - ";q$;selectedKey$;".bak";q$
#1 ""
#1 code$
close #1
run LBpath$;"\";LBexe$;" -R -A ";temp$
wait
end if
if categorie$ = MyBackups$ then
runFile$ = DefaultDir$;"\BAS\";selectedKey$;".bas"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(lower$(code$),lower$("trapclose")) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
temp$ = DefaultDir$;"\untitled.bas"
open temp$ for output as #1
#codeTank.value "!contents? code$"
#1 ""
#1 " 'This Code is a Copy of - ";q$;selectedKey$;".bas";q$
#1 ""
#1 code$
close #1
run LBpath$;"\";LBexe$;" -R -A ";temp$
wait
end if
if categorie$ = anyFolder$ then
runFile$ = FolderDialog$;"\";selectedKey$;".bas"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(lower$(code$),lower$("trapclose")) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
temp$ = DefaultDir$;"\untitled.bas"
open temp$ for output as #1
#codeTank.value "!contents? code$"
#1 ""
#1 " 'This Code is a Copy of - ";q$;selectedKey$;".bas";q$
#1 ""
#1 code$
close #1
run LBpath$;"\";LBexe$;" -R -A ";temp$
wait
end if
if categorie$ = lbExamples$ then
runFile$ = uAppPath$;"\";selectedKey$;".bas"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(lower$(code$),lower$("trapclose")) = 0 or instr(lower$(code$),lower$("'nomainwin")) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
run LBpath$;"\";LBexe$;" -R -A ";runFile$
wait
end if
if categorie$ = programs$ and fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".tkn") <> 0 then
runFile$ = savedProjects$;"\";selectedKey$;"\";selectedKey$;".tkn"
#codeTank.filePath "cls" : #codeTank.filePath "Running - ";DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".tkn"
run runFile$
wait
end if
if categorie$ = MyProjects$ or categorie$ = programs$ and fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".exe") <> 0 then
runFile$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".exe"
#codeTank.filePath "cls" : #codeTank.filePath "Running - ";DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".exe"
run runFile$
wait
end if
if categorie$ = MyProjects$ or categorie$ = programs$ and fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".bas") = 0 then
notice "Cannot be RUN"+chr$(13)+"This Title was Created Manually"+chr$(13)+selectedKey$+chr$(13)_
+" Not created using 'New from File'"+chr$(13)+chr$(13)_
+"Edit with Liberty Basic and save it as the 'Same Name..bas"+chr$(13)+"Select Radio Button "+categorie$+chr$(13)+"Select Button [New from File]"+chr$(13)_
+"Select the .bas file you just saved."+chr$(13)+" It will be available to RUN from then on"
end if
#codeTank.value "!cls"
#codeTank.keys "select 0"
wait
'open selected listing in just Basic IDE
[edit_In_LB_IDE]
if selectedKey$ = "" then notice "Select an item from a list, try again" : wait
#codeTank.value, "!contents? valueNow$";
open "untitled.bas" for output as #1
#1 "WARNING - To Preserve the Integrity of the CodeTank File(s) and the Liberty Basic Files(s)"
#1 "THIS CODE IS ACTUALLY a COPY OF ";selectedKey$;".bas Named -> 'untitled.bas' "
#1 "'Remember to 'Save As' a name of your Choice if/when done editing"
#1 ""
#1 valueNow$
close #1
tempfile$ = DefaultDir$;"\untitled.bas"
run LBpath$;"\";LBexe$;" ";q$;tempfile$;q$
#codeTank.filePath "cls" : #codeTank.filePath "Editing ";tempfile$;" in Liberty Basic Editor"
#codeTank.keys "select 0"
wait
[mergeFile]
filedialog "Select a ";categorie$ ;" file to merge ",DefaultDir$, mergefile$
if mergefile$ = "" then wait
a$ = GetFilename$(mergefile$)
if a$ <> categorie$ then
answer$ = "yes"
prompt " Categories Don't Match "+chr$(13)+" Merge Anyway?" ; answer$
if answer$ <> "yes" then wait
end if
open mergefile$ for input as #1
line input #1, dataline$ : close #1
mergeCheck$ = chr$(134)+chr$(165)+chr$(134)
if left$(dataline$, 3) <> mergeCheck$ then notice "Merge with ";categorie$+" Issue"+chr$(13)+chr$(13)+"Unable to Merge File named "+chr$(13)+a$+chr$(13)+"The formatting of file "+a$+" is incompatible" : wait
call pleasewait : cursor hourglass
open mergefile$ for input as #1
open DefaultDir$;"\";categorie$ for append as #2
#2 input$(#1, lof(#1));
close #2 : close #1
call readDictionary
call collectGarbage
call writeDictionary
call loadKeys
close #pleasewait
cursor normal
#codeTank.keys "select 0"
wait
[codeTankHelp]
notice "codeTank is curently in development, For Help, please visit the LB forums";chr$(13);chr$(13);"@ https://libertybasiccom.proboards.com/"
wait
[about]
notice "codeTank is curently in development. Please Visit ";chr$(13);chr$(13);"https://libertybasiccom.proboards.com/"
wait
[revert]
revert = 1
'Work starts here
#codeTank.keys "selection? name$"
if name$ = "" then notice "Select an item from list, try again" : wait
filedialog "Open a 'KNOWN WORKING' Source File (.bas) ", DefaultDir$;"\BAS\*";selectedKey$;"*.bas", fname$
if fname$ = "" then wait
open fname$ for input as #1
fnamenobas$ = word$(fname$, 2, "--") : fnamenobas$ = left$(fnamenobas$, len(fnamenobas$) - 4)
open DefaultDir$;"\";savedProjects$;"\";fnamenobas$;"\";fnamenobas$;".bas" for output as #2
#2 input$(#1, lof(#1)) : close #1 : close #2
goto [remakeproject]
wait
[openlb]
run LBpath$;"\";LBexe$
wait
'top menu "Open File in LB IDE"
[openlbFile]
filedialog "Open \ Select a Liberty Basic Source File (.bas) ", upath$; "\*.bas", openFilename$
if openFilename$ = "" then wait
#codeTank.filePath "cls" : #codeTank.filePath "File Opened in Liberty Basic - ";openFilename$
run LBpath$;"\";LBexe$;" ";openFilename$
wait
[basFiles]
run "explorer.exe ";q$;DefaultDir$;"\";"BAS";q$
wait
'open the following in Windows Explorer
[projectsDir]
run "explorer.exe ";q$;DefaultDir$;"\";"savedProjects";q$
wait
[EXEDir]
a$ = DefaultDir$;"\EXE"
run "explorer.exe ";q$;a$;q$
wait
[tknDir]
a$ = DefaultDir$;"\TKN"
run "explorer.exe ";q$;a$;q$
wait
[lbexamplesDir]
if pathExists(uAppPath$) <> 0 then
run "explorer.exe ";q$;uAppPath$;q$
else
if pathExists(uAppPath$) <> 0 then run "explorer.exe ";uAppPath$
end if
wait
[defaultDir]
run "explorer.exe ";q$;DefaultDir$;q$
wait
'radio button selections from MyProjects to Help
[projs]
#codeTank.runListing, "!enable"
#codeTank.remakeproject, "!enable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!enable"
#codeTank.merge "!enable"
#codeTank.merge "!enable"
#codeTank.revert, "!enable"
call saveValue
#codeTank.value, "!cls"
categorie$ = MyProjects$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
category$ = right$(category$,7)
#codeTank.addListing, "&New ";category$;" (Copy/Paste)"
#codeTank.fromFile, "&New ";category$;" (From File)"
wait
[progs]
#codeTank.runListing, "!enable"
#codeTank.remakeproject, "!enable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!enable"
#codeTank.merge, "!enable"
#codeTank.revert, "!enable"
call saveValue
#codeTank.value, "!cls"
categorie$ = programs$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.keys "singleclickselect"
#codeTank.addListing, "&New ";category$;" (Copy/Paste)"
#codeTank.fromFile, "&New ";category$;" (From File)"
wait
[exams]
#codeTank.runListing, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = examples$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1))
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.addListing, "&New ";category$
wait
[snipps]
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.runListing, "!disable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = snippets$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1))
wait
[subroutines]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = subroutines$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.addListing, "&New ";category$
wait
[functions]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = functions$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1))
category$= left$(categorie$, (len(categorie$) - 1))
wait
[vbs]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = vbs$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, len(categorie$)-1)
category$ = categorie$
wait
[cmd]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = cmd$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, len(categorie$)-1)
category$ = categorie$
wait
[lbCodeExamples]
if fileExists(DefaultDir$, lbExamples$) <> 0 then kill DefaultDir$;"\";lbExamples$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = lbExamples$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
dim folderInfo$(1, 1)
files uAppPath$, folderInfo$()
numExamps = val(folderInfo$(0, 0))
dim lbExamplesList$(numExamps)
open lbExamples$ for append as #1
x = 0
[skipp]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : wait
filename$ = folderInfo$(x, 0)
if right$(filename$, 3) <> "bas" then [skipp]
lbExamplesList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = lbExamplesList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skipp]
[lbbakfiles]
if fileExists(DefaultDir$, lbBakFiles$) <> 0 then kill DefaultDir$;"\"; lbBakFiles$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = lbBakFiles$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
dim folderInfo$(1, 1)
files uAppPath$;"\bak\", info$()
numExamps = val(info$(0, 0))
dim lbBakFilesList$(numExamps)
open lbBakFiles$ for append as #1
x = 0
[skipit]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : wait
filename$ = info$(x, 0)
if right$(filename$, 3) <> "bak" then [skipit]
lbBakFilesList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = lbBakFilesList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skipit]
[mybackups]
if fileExists(DefaultDir$, MyBackups$) <> 0 then kill DefaultDir$;"\";MyBackups$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = MyBackups$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
gettingMybackupFiles = 1
dim folderInfo$(1, 1)
files DefaultDir$;"\";"BAS", folderInfo$()
numExamps = val(folderInfo$(0, 0))
dim MyBackupsList$(numExamps)
a$=DefaultDir$;"\";categorie$
open DefaultDir$;"\";categorie$ for append as #1
x = 0
[skiphere]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : wait
filename$ = folderInfo$(x, 0)
if right$(filename$, 3) <> "bas" then [skiphere]
MyBackupsList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = MyBackupsList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skiphere]
[folderChoice]
folderChoice$ = "folderChoice.txt"
if fileExists(DefaultDir$, folderChoice$) <> 0 then kill DefaultDir$;"\";folderChoice$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
caption$ = "Navigate to, and Select YOUR Liberty Basic (or Pro) Install Dir"
call browser (caption$)
if right$(FolderDialog$,1) = "\" then FolderDialog$ = left$(FolderDialog$, len(FolderDialog$)-1)
if FolderDialog$ = "" then notice "No Folder Selected" : wait
if len(FolderDialog$) = 2 then notice "Drive ";left$(FolderDialog$, 2);" Selected - You MUST Select a Folder" : goto [folderChoice]
folderpath$ = FolderDialog$
#codeTank.value, "!cls"
categorie$ = folderChoice$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
redim folderInfo$(1, 1)
files folderpath$, folderInfo$()
numExamps = val(folderInfo$(0, 0))
redim folderList$(numExamps)
open folderChoice$ for append as #1
x = 0
[skipnow]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : categorie$ = anyFolder$ : wait
filename$ = folderInfo$(x, 0)
if right$(filename$, 3) <> "bas" then [skipnow]
folderList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = folderList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skipnow]
[forumlink]
run "explorer.exe https://libertybasiccom.proboards.com/"
wait
'resize window font - sets all fonts equal
[incFont]
mainFontsize = mainFontsize + 1
#codeTank.value "!font Arial ";mainFontsize
#codeTank.keys "font Arial ";mainFontsize
wait
[decFont]
mainFontsize = mainFontsize - 1
#codeTank.value "!font Arial ";mainFontsize
#codeTank.keys "font Arial ";mainFontsize
wait
'create a project and tkn file and add it to the MyProjects List
[makeproject]
call saveValue
#codeTank.filePath "cls" : #codeTank.filePath "Creating Project ";DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas"
tkn = 2
if categorie$ <> MyProjects$ then tkn = 4
goto [defaultclick]
[remakeproject]
call saveValue
if selectedKey$ = "" then notice "Select an item from list, try again" : wait
tempCat$=categorie$
if fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$,selectedKey$;".bas") = 0 then
notice "Cannot be Updated - Title was Created Manually"+chr$(13)+selectedKey$+chr$(13)_
+" Wasn't created using a File"+chr$(13)+chr$(13)_
+"Edit with Liberty Basic and save it using the SAME NAME.bas."+chr$(13)+"Select Radio Button My"+categorie$+chr$(13)+"Select Button [New "+left$(categorie$, len(categorie$)-1);" from File]"+chr$(13)_
+"Select the appropriate .bas file."+chr$(13)+" In Future it Will be Available for Updating"
#codeTank.keys "select 0"
#codeTank.value "!cls"
categorie$ = tempCat$
else
fname$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas"
end if
categorie$ = tempCat$
#codeTank.value "!contents? code$"
open fname$ for input as #1
code$ = input$(#1,lof(#1))
close #1
open DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas" for output as #1
#1 code$
close #1
tkn = 4
if revert = 1 then fname$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas"
#codeTank.filePath "cls" : #codeTank.filePath "Updating ";fname$
if tkn = 4 then [makeTKN]
[defaultclick]
'Checking all paths and file locations for existence (dll's, sll's, lbasic.exe, and lbrun2.exe)
res=fileExists(LBpath$, LBexe$)
if res then a = a + 1 else notice LBexe$;" Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,LBruntime$)
if res then a = a + 1 else notice LBrun$;" Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vbas31w.sll")
if res then a = a + 1 else notice " vbas31w.sll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vgui31w.sll")
if res then a = a + 1 else notice " vgui31w.sll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"voflr31w.sll")
if res then a = a + 1 else notice " voflr31w.sll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vthk31w.dll")
if res then a = a + 1 else notice " vthk31w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vtk1631w.dll")
if res then a = a + 1 else notice " vtk1631w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vtk3231w.dll")
if res then a = a + 1 else notice " vtk3231w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vvm31w.dll")
if res then a = a + 1 else notice " vvm31w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vvmt31w.dll")
if res then a = a + 1 else notice " vvmt31w.dll Does not exist in ";LBpath$;" Closing Program": goto [quit.codeTank]
' Use the filedialog function to allow user to select a source file (.bas)
[fileDiag]
'open file dialog to choose a .bas file for exe conversion, "*.bas;*.bak",.txt
filedialog "Open a 'KNOWN WORKING' Source File (.bas) ", DefaultDir$, fname$
if fname$ = "" then wait
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$;" Creating tkn file for - ";fname$
[makeTKN]
call pleasewait : pleasewaitOpen = 1
#pleasewait.fake "!setfocus"
'Separate path from selected filename, and extension from selected filename
for var1 = len(fname$) to 1 step -1
if mid$(fname$, var1, 1) = "\" then var2 = var1 -1 : var3 = var2 - ((len(fname$))) : exit for
next var1
var3 = abs(var3)
orig$ = left$(fname$, var2)
fname0$ = right$(fname$, var3 -1)
'finish separating filename from extension
for var4 = len(fname0$) to 1 step -1
if mid$(fname0$, var4, 1) = "." then var5 = var4 -1 : var6 = var5 - ((len(fname0$))) : exit for
next var4
var6 = abs(var6)
fnamenobas$ = left$(fname0$, var5)
' fname$ = Full Path of User Selected .bas file (including the filename.bas)
' fname0$ = Name of the Selected .bas File Only - eg ; filename.bas
' fnamenobas$ = Name of the Selected .bas File (without the .bas) - eg: filename
[begin]
'define Destpath1$ as LB Projects\Current Project Folder
DestPath$=DefaultDir$ 'Where this file is RUN from
DestPathU$ = DestPath$;"\";savedProjects$ 'Projects Folder
DestPath1$=DestPathU$;"\";fnamenobas$ 'Current created Project Folder
'Make Folders for Liberty Basic Projects, EXE files, TKN files, BAS files, SED files and Current Projects
res = mkdir(DestPathU$) 'projects dir
res = mkdir(DestPath1$) 'new project dir = name of selected bas file (no .bas) in Projects Dir
res = mkdir(DefaultDir$;"\";"TKN") 'tkn files saved here
res= mkdir(DefaultDir$;"\";"BAS") 'selected bas file saved here (includes password code if exe was passworded)
'make sure Folders were actually created
res=pathExists(DestPathU$)
if res then a=a+1 else notice "savedProjects folder was NOT Created in ";DestPath$;" codeTank Closing" : goto [quit.codeTank]
if res then a=a+1 else notice "New Folder ";fnamenobas$;" was NOT Created in ";DestPath1$;" codeTank Closing" : goto [quit.codeTank]
tknFolder$=DefaultDir$;"\";"TKN"
res=pathExists(tknFolder$)
if res then a=a+1 else notice "TKN Folder was NOT Created in ";DestPath$;" codeTank Closing" : goto [quit.codeTank]
basFolder$=DefaultDir$;"\";"BAS"
res=pathExists(basFolder$)
if res then a=a+1 else notice "BAS Folder was NOT Created in ";DestPath$;" codeTank Closing" : goto [quit.codeTank]
'copy selected bas file to Projects\current project folder
open fname$ for input as #1
data$ = input$(#1,lof(#1)) : close #1
open DestPath1$;"\";fname0$ for output as #2
#2 data$
close #2
'check if the current project .bas file was copied to new dir
if fileExists(DestPath1$,fname0$) = 0 then notice fname0$; " Was not copied to ";DestPath1$;" codeTank Closing" : goto [quit.codeTank]
if tkn = 4 then [tknOnly] 'bypass for Categorie Programs and Updates - tkn and bas file only needed
'Copy the needed DLL and SLL files from Liberty Basic dir to projects\projectname Dir
i = 0
while 1
i = i + 1
runtimeSupportFile$=word$(DllList$,i)
if runtimeSupportFile$ ="" then exit while
sourceFile$=LBpath$;"\";runtimeSupportFile$
destinationFile$=DestPath1$;"\";runtimeSupportFile$
'don't copy runtime files if they already exists
if fileExists(DestPath1$, runtimeSupportFile$) <> 0 then [fileExists]
open sourceFile$ for input as #file
open destinationFile$ for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
[fileExists]
wend
'verify dll's and sll's were copied to new project folder
res=fileExists(DestPath1$,"vbas31w.sll")
if res then a = a + 1 else notice " vbas31w.sll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vgui31w.sll")
if res then a = a + 1 else notice " vgui31w.sll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"voflr31w.sll")
if res then a = a + 1 else notice " voflr31w.sll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vthk31w.dll")
if res then a = a + 1 else notice " vthk31w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vtk1631w.dll")
if res then a = a + 1 else notice " vtk1631w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vtk3231w.dll")
if res then a = a + 1 else notice " vtk3231w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vvm31w.dll")
if res then a = a + 1 else notice " vvm31w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vvmt31w.dll")
if res then a = a + 1 else notice " vvmt31w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
'remove any left over existing lbrun2.exe from new project before creating new one
'Liberty Basic can't create\rename a file that exists, so if it does already exist - kill it (delete it)
if fileExists(DestPath1$, LBruntime$) <> 0 then kill DestPath1$;"\"; LBruntime$
'copy lbrun2.exe to Current Project Folder
open LBpath$;"\";LBruntime$ for input as #file
open DestPath1$;"\";fnamenobas$;".exe" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
'check new exe (renamed lbrun2.exe) file for existence in current project Folder )
if fileExists(DestPath1$,fnamenobas$;".exe") = 0 then notice "lbrun2.exe not copied or renamed - EXITING Program": goto [quit.codeTank]
[tknOnly]
'call fixtime
'call fixdate
'copy selected .bas file to BAS dir and date it
open DestPath1$;"\";fname0$ for input as #file
open DestPath$;"\BAS\";fixeddate$;fixedtime$;"-";fnamenobas$;".bas" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
'remove any existing tkn of same name in TKN dir
if fileExists(DestPath1$, fnamenobas$;".tkn") <> 0 then kill DestPath1$;"\";fnamenobas$;".tkn"
'write/run the script to close the "save" dialog, and the follow up "information" notice of creation automatically
call writeAutoSave
'loop until autoSave$ File is verified
while fileExists(DefaultDir$, autoSave$) = 0 : scan : wend
run "wscript ";autoSave$
'#######################################################################
'Create the TKN file in Projects\current project folder.
RUN q$;LBpath$;"\";LBexe$;q$;" -T -A ";DestPath1$;"\";fname0$
'loop until TKN File is verified
while www = 0
if fileExists(DestPath1$,fnamenobas$;".tkn") <> 0 then exit while
scan
wend
call pause 3500
'copy TKN$ file to TKN dir, and date it
open DestPath1$;"\";fnamenobas$;".tkn" for input as #file
open DefaultDir$;"\TKN\";fixeddate$;fixedtime$;"-";fnamenobas$;".tkn" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
if fileExists (DefaultDir$;"\TKN", fixeddate$;fixedtime$;"-";fnamenobas$;".tkn") = 0 then notice fixeddate$;fixedtime$;"-";fnamenobas$;".tkn";" was NOT created in ";DefaultDir$;"\TKN" : wait
[continueOn]
'check what tkn value =, and continue to create the 'new key'
if tkn = 2 or tkn = 4 then newKey$ = fnamenobas$
goto [continue]
[initiate]
global selectedKey$, lastKey$, categorie$, FolderDialog$, dictionary$, q$, codetankOpen, fixeddate$, fixedtime$, folder$, lastKey$
'global 'selectedKey$, fixeddate$, fixedtime$, project, fnamenobas$, DestPath$, DestPath1$, JBexe$,_
'LBpath$, keyCount, q$, lastKey$, selectedpath$, upath$, folder$, folderpath$
'First we need the users home path
CSIDL.PROFILE = 40
upath$ = GetSpecialFolder$(CSIDL.PROFILE)
if fileExists(DefaultDir$, "codetank.ini") then
open DefaultDir$;"\codetank.ini" for input as #1
line input #1, LBpath$ : close #1
if fileExists(LBpath$, "liberty.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic v4.5.1"
LBexe$ = "liberty.exe"
end if
if fileExists(LBpath$, "lbpro.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic Pro v4.5.1"
LBexe$ = "lbpro.exe"
end if
goto [check]
end if
if fileExists(upath$;"\AppData\Roaming\Liberty Basic Pro v4.5.1", "freeform404.bas") then
uAppPath$ = upath$;"\AppData\Roaming\Liberty Basic Pro v4.5.1"
LBpath$ = "c:\Program Files (x86)\Liberty Basic Pro v4.5.1"
if fileExists(LBpath$, "lbpro.exe") then
LBexe$ = "lbpro.exe"
goto [check]
end if
end if
if fileExists(upath$;"\Application Data\Liberty Basic v4.5.1", "freeform450.bas") then
uAppPath$ = upath$;"\Application Data\Liberty Basic v4.5.1"
LBpath$ = "c:\Program Files (x86)\Liberty Basic v4.5.1"
if fileExists(LBpath$, "liberty.exe") then
LBexe$ = "liberty.exe"
end if
end if
[check]
text$ = chr$(13)+" Liberty Basic v4.5.1 was not installed to the default Install folder."+chr$(13)+chr$(13)+"Would you like to Browse to and Select your Liberty Basic 4.5.1"+chr$(13)+"(or Pro)"+chr$(13)+"Install Folder"
'if Liberty Basic v4.5.1 is NOT installed to it's Default Install Dir, get Path from User using folder dialog
if fileExists(LBpath$, LBexe$) <> 0 then [start] else a$ = custcon$(text$)
if answer$ <> "Yes" then end
caption$ = "Navigate to, and Select YOUR Liberty Basic v4.5.1 (or Pro) Install Dir"
call browser, caption$
if right$(FolderDialog$, 1) = "\" then FolderDialog$ = left$(FolderDialog$, len(FolderDialog$)-1)
if FolderDialog$ = "" then notice "Liberty Basic v4.5.1 must be installed to continue" : end
LBpath$ = FolderDialog$
open "codetank.ini" for output as #1
#1 LBpath$ : close #1
if fileExists(LBpath$, "liberty.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic v4.5.1"
LBexe$ = "liberty.exe"
end if
if fileExists(LBpath$, "lbpro.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic Pro v4.5.1"
LBexe$ = "lbpro.exe"
end if
return
'FastCode written by cundo, a member of the Liberty Basic / Just Basic Forums
'edited by xxgeek to suit this app
[fastcode]
dim windowTypes$(19)
windowTypes$(0)= "":windowTypes$(1)= "dialog":windowTypes$(2)= "dialog_fs":windowTypes$(3)= "dialog_nf":windowTypes$(4)= "dialog_nf_fs"
windowTypes$(5)= "dialog_ns_modal":windowTypes$(6)= "dialog_modal":windowTypes$(7)= "dialog_popup":windowTypes$(8)= "graphics"
windowTypes$(9)= "graphics_fs":windowTypes$(10) = "graphics_nf":windowTypes$(11)= "graphics_nsb":windowTypes$(12)= "graphics_nsb_nf"
windowTypes$(13)= "text":windowTypes$(14)= "text_fs":windowTypes$(15)= "text_nsb":windowTypes$(16)= "text_nsb_ins":windowTypes$(17)= "window"
windowTypes$(18)= "window_nf":windowTypes$(19)= "window_popup"
WindowWidth = 430:WindowHeight = 470
UpperLeftX= int((DisplayWidth-WindowWidth)/2)
UpperLeftY= int((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "lightgray"
ForegroundColor$ = "black"
texteditor #fastcode.ed, 8, 130, 400, 200
statictext #fastcode.fastcode, "Create Window Code", 135, 5, 165, 20
statictext #fastcode.st1, "< Name && Handle >", 150, 25, 128, 20
statictext #fastcode.st1, "Window Type", 50, 55, 90, 20
textbox #fastcode.txt1, 290, 20, 115, 20
textbox #fastcode.txt2, 20, 20, 115, 20
combobox #fastcode.combo, windowTypes$(, dummy, 145, 50, 140, 20
checkbox #fastcode.r1, "Use Labels instead of Subs", dummy, dummy, 8, 90, 222, 20
button #fastcode.button1, "&Generate Code ^ + > Copy to Clipboard", dummy, ul, 70, 340, 270, 25
button #fastcode.preview, "Preview", [preview], ul, 160, 375, 75, 25
open "FastCode by cundo" for window as #fastcode
#fastcode "trapclose [quit.fastcode]"
#fastcode "font arial 10 Bold"
#fastcode.txt1 "#main"
#fastcode.txt2 "untiltled"
#fastcode.combo "selectindex 17"
fastcodeOpen = 1
#codeTank.fastwindows "!disable"
#fastcode.r1 "set"
wait
[preview]
temp$ = "temp.bas"
open temp$ for output as #1
#fastcode.ed "!contents? code$"
#1 code$
close #1
run LBpath$;"\";LBexe$;" -A ";DefaultDir$;"\";temp$
wait
[quit.fastcode]
close #fastcode
fastcodeOpen = 0
#codeTank.fastwindows "!enable"
wait
'The [Search] button was pressed, or after searching/changing font size etc, the program was directed back here.
[search]
#codeTank.tb "!enable" : #codeTank.tb "!selectall"
done = 0
count = 0
#results.default "!setfocus"'
wait
[startSearching]
#codeTank.tb "!disable"
redim searchList$(10)
if resultsOpen = 0 then gosub [results]
#codeTank.tb "!contents? searchFor$"
if searchFor$ = "" then [search]
searchList$(0) = " "
searchList$(1) = " "
searchList$(2) = " Searching the Liberty Basic v4.5.1 Files"
searchList$(3) = " "
searchList$(4) = " For Files containing ";upper$(searchFor$)
searchList$(5) = " "
searchList$(6) = " "
searchList$(7) = " "
searchList$(8) = " "
searchList$(9) = " P L E A S E W A I T"
#results.listbox2 "reload"
searchFor$=trim$(searchFor$)
count = 3
cursor hourglass
redim searchList$(2600)
redim oneOf$(2500)
#results.listbox2 "setfocus"
'search lb help files
if lbHelp = 1 then
files helpFilePath$;"\html", info$()
numFiles = val(info$(0,0 ))
for i = 1 to numFiles
fileToOpen$ = info$(i, 0)
open helpFilePath$;"\html\"; fileToOpen$ for input as #2
contents$ = input$(#2, lof(#2)) : close #2
if instr(lower$(contents$), lower$(searchFor$)) then
x = 1
if lower$(searchFor$) = "and" then oneOf$(count) = "H_AND" : count = count + 1
if lower$(searchFor$) = "not" then oneOf$(count) = "H_NOT" : count = count + 1
if lower$(searchFor$) = "xor" then oneOf$(count) = "H_XOR" : count = count + 1
if lower$(searchFor$) = "or" then oneOf$(count) = "H_OR" : count = count + 1
listName$ = helpFilePath$;"\html\"; fileToOpen$
open listName$ for input as #1 : isOpen = 1
while not(eof(#1))
scan
line input #1, name$
if x = 5 and lower$(left$(name$, 7)) = lower$("<TITLE>") then
name3$ = mid$(name$, 8, len(name$)-15) : if right$(name3$, 4) = "Etc." then name3$ = left$(name3$, len(name3$) - 1)
oneOf$(count) = "H_";name3$ : count = count + 1
end if'
if x = 8 and left$(lower$(name$), 7) = lower$("<TITLE>") then
name5$ = mid$(name$, 8, len(name$)-15)
oneOf$(count) = "H_";name5$ : count = count + 1
end if
if x = 12 and left$(name$ , 5) = "<P><A" then
name8$ = word$(name$, 2, "</A><B>") : name8$ = left$(name8$, len(name8$)-8)
oneOf$(count) = "H_";name8$ : count = count + 1
end if
if x = 14 and left$(name$ , 3) = "<P>" then
name7$ = mid$(name$, 4, len(name$)-7)
oneOf$(count) = "H_";name7$ : count = count + 1
end if
if x = 15 and right$(name$, 8) = "</B></P>" then
name11$ =word$(name$, 2, "B>") : name11$ = left$(name11$, len(name11$)-2)
oneOf$(count) = "H_";name11$ : count = count + 1
exit while
end if
x = x + 1
wend
if isOpen = 1 then close #1 : isOpen = 0
end if
next i
end if
'Search the LB Code Examples Files
if lbexamples = 1 then
files uAppPath$, "*.bas", info$()
numFiles = val(info$(0,0 ))
for i = 1 to numFiles
fileToOpen$ = info$(i, 0)
open uAppPath$;"\";fileToOpen$ for input as #2
contents$ = input$(#2, lof(#2)) : close #2
if instr(lower$(contents$), lower$(searchFor$)) then
name$ = upper$(fileToOpen$)
name20$ = left$(name$, len(name$)-4)
oneOf$(count) = "CE_";name20$ : count = count + 1
end if
next i
end if
'Search the CodeBank saved .bas files
if codeTank = 1 then
files DefaultDir$;"\BAS", "*.bas", info$()
numFiles = val(info$(0,0 ))
for i = 1 to numFiles
fileToOpen$ = info$(i, 0)
open "BAS";"\";fileToOpen$ for input as #2
contents$ = input$(#2, lof(#2)) : close #2
if instr(lower$(contents$), lower$(searchFor$)) then
name$ = upper$(fileToOpen$)
name20$ = left$(name$, len(name$)-4)
oneOf$(count) = "CB_";name20$ : count = count + 1
end if
next i
end if
'if no search results found
if count < 4 then
#results.listbox2 "reload"
searchList$(0) = " "
searchList$(1) = " "
searchList$(2) = " "
searchList$(3) = " Nothing found for: ";upper$(searchFor$)
searchList$(4) = " "
searchList$(5) = " "
searchList$(6) = " "
searchList$(7) = " Try Adding more Categories "
searchList$(8) = " "
searchList$(9) = " To the Search Engine"
searchList$(10) = " "
searchList$(11) = " Using the CheckBoxes"
searchList$(12) = " "
searchList$(13) = " To Visit the Liberty Basic Forums"
searchList$(14) = " "
searchList$(15) = " Click the Link Below"
searchList$(16) = " "
searchList$(17) = " https://libertybasiccom.proboards.com/"
searchList$(18) = " "
searchList$(19) = " "
searchList$(20) = " "
#results.listbox2 "reload"
cursor normal
end if
'sort the list of possible results
sort oneOf$(), 0, count
dim b$(count+1)
happened$="|"
K = 0
'filter out the false Titles (Due to differences in html help pages source code - Title not on same line in all files)
for i = 0 to count
name$ = oneOf$(i)
if right$(name$, 1) = ">" or right$(name$, 6) = "window" or left$(name$, 5) = "H_ame" or right$(name$, 8) = "position"_
or left$(name$, 5) = "H_GCO" or right$(name$, 1) = ":" or left$(name$, 3) = "H_<" _
or left$(name$, 3) = "H_"+chr$(39) or right$(name$, 1) = "." or right$(name$, 1) = " " or right$(name$, 8) = "[branch]"_
or right$(name$, 3) = "] )" or right$(name$, 3) = "] ]" or right$(name$, 6) = "items)" or name$ = "H_WHILE...WEND"_
or right$(name$, 5) = "size)" or right$(name$, 1) = ";" or right$(name$, 5) = "LEN=n" or right$(name$, 7) = "number)" _
or right$(name$, 7) = "#handle" or right$(name$, 4) = "varN" or right$(name$, 4) = "...)" or right$(name$, 2) = "];" _
or right$(name$, 1) = "v" or right$(name$, 8) = "fontSpec" or right$(name$, 7) = "expr2 )" or right$(name$, 2) = "))"_
or right$(name$, 12) = "variableName" or right$(name$, 4) = "num2"or right$(name$, 5) = ".bmp"+chr$(34)_
or right$(name$, 2) = chr$(34)+")" or right$(name$, 4) = "var"+chr$(36) or right$(name$, 4) = ",n])"_
or right$(name$, 4) = "expr" or right$(name$, 4) = "num2" or right$(name$, 9) = chr$(34)+"refresh"+chr$(34)_
or right$(name$, 3) = "g])" or right$(name$, 6) = "Label]" or right$(name$, 8) = "#handle)" or right$(name$, 9) = "String$ )"_
or right$(name$, 11) = "Expression)" or right$(name$, 10) = "expression" or right$(name$, 9) = "[number])"_
or right$(name$, 7) = "struct)" or right$(name$, 7) = "comment" or right$(name$, 12) = "recordNumber"_
or right$(name$, 5) = "size)" or right$(name$, 6) = "follow" or right$(name$, 6) = "mode ]" or right$(name$, 8) = "number )" or name$ = "H_TRACE number"_
or right$(name$, 8) = "[column]" or right$(name$, 10) = "#handle, n" or right$(name$, 2) = " 1" or right$((left$(name$, 7)), 5) = chr$(34)+"Font"_
or right$(name$, 9) = "{LEN = n}" or right$(name$, 5) = "Expr2" or right$(name$, 6) = "length"or left$(name$, 9) = "H_Install"_
or right$(name$, 10) = "#newHandle" or right$(name$, 12) = "columns rows" or right$(name$, 5) = "Expr$"_
or left$(name$, 4) = "var =" or right$(name$, 6) = "xpr2 )" or left$(name$, 3) = "H_(" or right$(name$, 6) = chr$(34)+"name"+chr$(34) _
or right$(name$, 4) = "#h )" or right$(name$, 9) = "#handle )" or right$(name$, 1) = "?" or right$(name$, 1) = "."_
or name$ = "H_DO LOOP" or name$ = "H_FOR...NEXT" or name$ = "H_Winstring" or right$(name$, 8) = "value"+chr$(34)+" )"_
or right$(name$,1) = "?" or right$(name$,3) = "c$)" or right$(name$,8) = "Keywords" or name$ ="H_Boolean Evaluations"_
or left$(name$, 3) = "H_&" or name$ = "H_" or name$= "H_var = MIDIPOS( )" or name$ = "H_TRACE ( number )"_
or name$ = "H_StartupDir" or name$ = "H_EVAL" or name$ = "H_EVAL$" or right$(name$, 4) = "face" or left$(name$, 10) = "H_The Liberty"_
or name$ = "H_REPLSTR" or name$ = "H_UPPER$(s)" or right$(name$,8) = "[END IF]" or name$ = "H_LOWER$(s$)" then
oneOf$(i) = ""
end if
'remove any duplicates from search list (Thanks to tsh73)
'if instr(oneOf$(i), "Liberty") then oneOf$(i) = replace$(name$, "Liberty", "Liberty")
if lower$(nameLast$) = lower$(name$) then oneOf$(i) = ""
if instr(happened$, "|";oneOf$(i);"|")=0 then
happened$=happened$;oneOf$(i);"|"
K=K+1: b$(K)=oneOf$(i)
end if
nameLast$ = name$
next i
'Create final list of search results
for x = 0 to K
if lower$(word$(b$(x), 2, "_")) = lower$(searchFor$) then match$ = b$(x)
if instr(lower$(b$(x)), lower$(searchFor$)) _
and lower$(mid$(b$(x), 3, len(searchFor$))) = lower$(searchFor$)_
or lower$(mid$(b$(x), 4, len(searchFor$))) = lower$(searchFor$) then_
searchList$(u+7) = b$(x) : u = u+1
next x
for t = 0 to K
if instr(lower$(b$(t)), lower$(searchFor$)) then
if lower$(mid$(b$(t), 3, len(searchFor$))) <> lower$(searchFor$)_
and lower$(mid$(b$(t), 4, len(searchFor$))) <> lower$(searchFor$) then
searchList$(u+v+16) = b$(t) : v = v+1
end if
end if
next t
for a = 0 to K
if not(instr(lower$(b$(a)), lower$(searchFor$))) then_
searchList$(u+v+ww+23) = b$(a) : ww = ww+1
next a
'manage the headers
searchList$(0) = " Search Results"
searchList$(1) = " "
searchList$(2) = " ";u+v;" Titles Containing ";q$;upper$(searchFor$);q$
if u+v <> 0 then searchList$(3) = " "
if u+v = 0 then searchList$(2) = " No Titles Found for ";q$;upper$(searchFor$);q$';" Found"
searchList$(4) = " "
if u <> 0 and v<>0 then searchList$(5) = " ";u;" Top Picks For ";q$;upper$(searchFor$);q$
searchList$(u+11) =" "
if v <> 0 and v<>u+v then searchList$(u+13) = " ";v;" Remaining Titles "'
if v <> 0 then searchList$(u+14) =" "
if v <> 0 then searchList$(v+u+19) = " "
if ww-2 <> 0 then searchList$(v+u+20) = " ";ww-3;" Other Pages Containing ";upper$(searchFor$)
if u+v = 0 then searchList$(1) = " ";ww-2;" Pages Containing ";upper$(searchFor$)
searchList$(v+u+21) = " "
searchList$(v+u+ww+22) = " "
searchList$(v+u+ww+23) = " If you need more information "
searchList$(v+u+ww+24) = " on "
searchList$(v+u+ww+25) = " Liberty Basic v4.5.1 Coding "
searchList$(v+u+ww+26) = " "
searchList$(v+u+ww+27) = " Please Visit"
searchList$(v+u+ww+28) = " "
searchList$(v+u+ww+29) = " The Liberty Basic Forums by"
searchList$(v+u+ww+30) = " "
searchList$(v+u+ww+31) = " Clicking the link Below"
searchList$(v+u+ww+32) = " "
searchList$(v+u+ww+33) = " https://libertybasiccom.proboards.com/"
searchList$(v+u+ww+34) = " "
searchList$(v+u+ww+35) = " "
searchList$(v+u+ww+36) = " "
searchList$(v+u+ww+37) = " "
if match$ <> "" then searchList$(4) = " 1 Match "
#results.listbox2 "reload" : #results.default "!setfocus"
'finished displaying results - reset variables - cursor back to normal
[doneSearching]
u = 0 : v = 0 : ww = 0 : match$ = "" : count = 0
#codeTank.tb "!enable"
#codeTank.tb "!selectall"
#codeTank.tb "!setfocus"
#results.listbox2 "setfocus"
cursor normal
wait
'One of the Help Search results was Selected - Open the Help File in user's default browser
[openFile]
if lbHelp = 1 then
#results.listbox2 "selection? selectionH$"
selectionH$ = trim$(selectionH$)
if selection$ = " https://libertybasiccom.proboards.com/" then_
selection$ = right$(selection$, len(selection$)-1) : run "explorer ";selection$ : wait
selectionH$ = right$(selectionH$, len(selectionH$) - 2)
if selectionH$ = "XOR" or selectionH$ = "AND" or selectionH$ = "NOT" or selectionH$ = "OR" then
run "explorer.exe ";helpFilePath$;"\html\libe0azy.htm" : wait
end if
files helpFilePath$;"\html", info$()
numFiles = val(info$(0,0 ))
for i = 1 to numFiles
fileToOpen$ = info$(i, 0)
open helpFilePath$;"\html\";fileToOpen$ for input as #3
contents$ = input$(#3, lof(#3)) : close #3
if instr(lower$(contents$), lower$("<title>";selectionH$;"</TITLE>")) then
if fileToOpen$ = "idecode451.html" then fileToOpen$ = "libe0ze8.htm"
if fileExists("", "htmlviewer.exe") <> 0 then
run "htmlviewer.exe ";helpFilePath$;"\html\";fileToOpen$ : done = 1 : wait
else
run "explorer.exe ";helpFilePath$;"\html\";fileToOpen$ : done = 1 : wait
if instr(lower$(contents$), lower$("</A><B>";selectionH$;"</B></P>")) then
if fileExists("", "htmlviewer.exe") <> 0 then
run "htmlviewer.exe ";helpFilePath$;"\html\";fileToOpen$ : done = 1 : wait
else
run "explorer.exe ";helpFilePath$;"\html\";fileToOpen$ : done = 1 : wait
end if
end if
end if
end if
next i
end if
'a Code Example file was selected
if lbexamples = 1 then
#results.listbox2 "selection? selectionCE$"
selectionCE$ = right$(selectionCE$, len(selectionCE$) - 3)
if fileExists(uAppPath$, selectionCE$;".bas") then
run LBpath$;"\";LBexe$;" ";uAppPath$;"\";selectionCE$;".bas" : wait
end if
end if
'a Code Bank .bas file backup was selected
if codeTank = 1 then
#results.listbox2 "selection? selectionCB$"
selectionCB$ = right$(selectionCB$, len(selectionCB$) - 3)
if fileExists(DefaultDir$;"\BAS", selectionCB$;".bas") then
run LBpath$;"\";LBexe$;" ";DefaultDir$;"\BAS\";selectionCB$;".bas" : wait
end if
end if
'if the link to the Liberty basic Forums is clicked (link at bottom of search results)
#results.listbox2 "selection? selection$"
if selection$ = " https://libertybasiccom.proboards.com/" then_
selection$ = right$(selection$, len(selection$)-1) : run "explorer ";selection$ : wait
wait
'a selection was made from the Help Menu list
[mainList]
#codeTankList.listbox1 "selection? h$"
fileToOpen$= word$( h$,2,chr$(0))
fileToOpen$=replace$( fileToOpen$ , "/", "\" )
if fileExists(DefaultDir$, "htmlviewer.exe") <> 0 then run "htmlviewer.exe ";helpFilePath$; "\"; fileToOpen$_
else_
if fileExists(helpFilePath$, fileToOpen$) <> 0 then run "explorer.exe ";helpFilePath$; "\"; fileToOpen$
wait
'show results
[results]
if resultsOpen = 1 then return
WindowWidth = 255 : WindowHeight = 600
UpperLeftX=int((DisplayWidth-WindowWidth)/2) + 600
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
listbox #results.listbox2, searchList$(, [openFile], 0, 0, 256, 600
button #results.default, "", [startSearching], UL, 0, 0, 0, 0
Open "LB HELP SEARCH RESULTS" for dialog as #results
resultsOpen = 1
#results "trapclose [quitResults]"
#results.listbox2 "reload"
#results.listbox2 "singleclickselect"
if fontsize <> 0 then fontsize = fontsize else fontsize = 9
#results.listbox2 "font Arial_bold 0 ";fontsize+6
#results.listbox2 "setfocus"
return
'show LB Help Menu - button
[Contents]
if mainListOpen = 1 then #codeTankList.default "!setfocus" : #codeTank.tb "!setfocus" : wait
open helpFilePath$; "\"; helpFileMenu$ for input as #1
txt$ = input$(#1, lof(#1))
close #1
'Load the "Contents" menu list array
lowerTxt$= lower$(txt$)
while 1
scan
startAt = c+1
a = instr(lowerTxt$, "href",startAt)
b = instr(lowerTxt$, ">",a+1)
c = instr(lowerTxt$, "</a>",b+1)
if a=0 or b=0 or c= 0 then exit while
hrefA= instr(lowerTxt$,chr$(34),a+1)
hrefB= instr(lowerTxt$,chr$(34),hrefA+1)
idx = idx +1
mainList$(idx)= trim$(mid$(txt$,b+1,c-b-1));chr$(0);_
trim$(mid$(txt$,hrefA+1,hrefB-hrefA-1))
wend
WindowWidth = 255 : WindowHeight = 600
UpperLeftX=int((DisplayWidth-WindowWidth)/2 + 600)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
listbox #codeTankList.listbox1, mainList$(, [mainList], 0, 0, 256, 600
button #codeTankList.default, "&GO", [search], UL, 0, 0, 0, 0
Open "Liberty Basic v4.5.1 Help Menu" for dialog as #codeTankList
mainListOpen = 1
#codeTankList "trapclose [quitMainList]"
#codeTankList.listbox1 "singleclickselect"
#codeTankList.listbox1 "reload"
if fontsize <> 0 then fontsize = fontsize else fontsize = 9
#codeTankList.listbox1 "font Arial_bold 0 ";fontsize+6
idx = 0
#codeTankList.listbox1 "setfocus"
'if resultsOpen = 1 then #codeTank.tb "!setfocus"
wait
'resize window font - sets all Listbox fonts equal
[incFontSearch]
fontsize = fontsize + 1
if resultsOpen = 1 then #results.listbox2 "font Arial_bold 0 ";fontsize+6
if mainListOpen = 1 then #codeTankList.listbox1 "font Arial 0 ";fontsize+6
if resultsOpen = 1 then #results.default "!setfocus"
wait
[decFontSearch]
fontsize = fontsize - 1
if resultsOpen = 1 then #results.listbox2 "font Arial_bold 0 ";fontsize+6
if mainListOpen = 1 then #codeTankList.listbox1 "font Arial 0 ";fontsize+6
if resultsOpen = 1 then #results.default "!setfocus"
wait
'set and reset checkboxes for search categories
[lbHelp] lbHelp = 1
if resultsOpen = 1 then #results.default "!setfocus"
wait
[nolbHelp] lbHelp = 0
if resultsOpen = 1 then #results.default "!setfocus"
wait
[lbexamples] lbexamples = 1
if resultsOpen = 1 then #results.default "!setfocus"
wait
[nolbexamples] lbexamples = 0
if resultsOpen = 1 then #results.default "!setfocus"
wait
[cbank] codeTank = 1
if resultsOpen = 1 then #results.default "!setfocus"
wait
[nocbank] codeTank = 0
if resultsOpen = 1 then #results.default "!setfocus"
wait
'The [?] or 'help' button for this program was pressed
[searchhelp]
if helpOpen = 1 then wait
notice " Tiny LB-Search Help File";_
CHR$(13);CHR$(13);_
"Type your Search Word ( no char minimum ), and hit [Search In >]";_
" If your text doesn't appear at any time, just hit [Enter] and start typing agin";_
CHR$(13);_
CHR$(13);_
"Search results are marked to indicate the category they represent";_
CHR$(13);_
CHR$(13);" CHECKBOXES and CATEGORIES: ";_
CHR$(13);_
"H= LB Help, CE= LB Code Examples, CT = CodeTank Files";_
CHR$(13);_
CHR$(13);_
"Results marked H open help pages in your default browser";_
CHR$(13);_
"C stands for Code - Results marked CE, and CT open in Liberty Basic";_
CHR$(13);CHR$(13);_
CHR$(13);CHR$(13);_
"Alt + F4 closes the open window with focus";_
" unless another window is clicked on";_
CHR$(13);CHR$(13);_
"Use + or - to Adjust Font Size - Fontsize changes on all Lists, opened or not";_
CHR$(13);CHR$(13);_
CHR$(13);CHR$(13);" ADDING TO the Liberty BASIC RUN MENU";_
CHR$(13);CHR$(13);_
"How to ADD this to the Liberty BASIC menu Run > for easy access.";_
CHR$(13);_
"1) To Make the TKN file : Top Menu > Run > Make *.tkn File.";_
" Use any name for the file when the -File 'Save As'- window opens";_
" Remember the File Location, and Name of the File.";_
CHR$(13);_
"2) In Liberty Basic click the menu item: Setup > External Programs";_
CHR$(13);_
"3) Click on New , type a name that suits the app, eg: LB_Help_Search";_
" This name will appear in LB's Menu as Run > NameYouChose ";_
CHR$(13);_
"4) Click on Create Item.";_
CHR$(13);_
"5) Click the Browse Button, then navigate to the .tkn File created in step 1.";_
CHR$(13);_
"6) Liberty BASIC will inform you changes take effect after restarting Liberty Basic."
helpOpen = 1
wait
'close Help List
[quitMainList]
if resultsOpen = 1 then close #results : resultsOpen = 0
close #codeTankList : mainListOpen = 0
wait
'close results List
[quitResults]
close #results : resultsOpen = 0
wait
[fastGui]
'Title FFUltra v2.x author = Rod
'version FFNSL_vxx2.0
'edited by xxgeek
fastGuiOpen = 1
ver$="xx2.0"
'nomainwin
dim info$(10,10)
dim form$(10)
form$(1)="Restore"
form$(2)="New"
form$(3)="Save .ffu"
form$(4)="Load .ffu"
form$(5)="-----------"
form$(6)="Write .bas"
form$(7)="Import .bas"
form$(8)="Export .bas"
form$(9)="File"
dim hnd$(30)
hnd$(1)="#1"
dim grid$(20)
grid$(1)="1"
grid$(2)="3"
g=3
for n= 5 to 30 step 5
grid$(g)=str$(n)
g=g+1
next
grid$(g)="Invisible"
grid$(g+1)="Visible"
grid$(g+2)="Set Grid"
grid=10
gridvisible=1
gridcolor$="buttonface"
projectctrh=25
ctrh=25
dim color$(10)
color$(1)="Control Back"
color$(2)="Project Back"
color$(3)="Project Fore"
color$(4)="Grid Color"
color$(5)="Border Color"
color$(6)="CrossHair"
color$(7)="Set Color"
projectback$="white"
projectfore$="black"
dim font$(10)
font$(1)="Control Font"
font$(2)="ResetControl"
font$(3)="Project Font"
font$(4)="Set Font"'default is Consolas 9"
dim wind$(20)'window type names
wind$(1)="window"
wind$(2)="window_nf"
wind$(3)="window_popup"
wind$(4)="dialog"
wind$(5)="dialog_modal"
wind$(6)="dialog_nf"
wind$(7)="dialog_nf_modal"
wind$(8)="dialog_fs"
wind$(9)="dialog_nf_fs"
wind$(10)="dialog_popup"
wind$(11)="graphics"
wind$(12)="graphics_fs"
wind$(13)="graphics_fs_nsb"
wind$(14)="graphics_nsb"
wind$(15)="graphics_nf_nsb"
wind$(16)="text"
wind$(17)="text_fs"
wind$(18)="text_nsb"
wind$(19)="text_nsb_ins"
dim v$(2000)
for n= 100 to 2000 step 20
v$(n)=str$(n)
next
dim obj(200,6) 'x,y,width/height,type,textheight
XX=1
Y=2
W=3
H=4
TT=5
TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline
Ctr=1
Tex=2
Ress=3
Fon=4
Bak=5
Bass=7
'set default starting position
projectfile$="Untitled.bas"
projectwind$="window_nf"
projecttitl$="Untitled"
projectform$="#1"
projectctrl$=""
projecttext$=""
projectreso$=""
projectfont$="Consolas 9"
projectback$="white"
projectfore$="black"
projecttbcl$="white"
projectlbcl$="white"
projectcbcl$="white"
projecttecl$="white"
gridcolor$="buttonface"
bordercolor$ = "darkgray" 'border of grid dimension limits of x,y
crosshair$ = gridcolor$ 'crosshair available in grid = 0 or grid = 1
barrier = 1 'barrier - form dimension limit - when tracking / resizing controls
negbar = 1 'negative barrier - less than zero - when tracking / resizing controls
projectctrh=25
projectgrid=10
projectw=600
projecth=400
insertx=grid
inserty=grid*2
'open a small progress bar window and hide it
WindowWidth=230
WindowHeight=60
UpperLeftX=(DisplayWidth-230)/2
UpperLeftY=(DisplayHeight-350)/2
graphicbox #prog.gb1,10,0,200,25
open "Import" for window_nf as #prog
#prog "font Consolas 9"
#prog "hide"
progOpen = 1
'open a small properties window and hide it
WindowWidth=230
WindowHeight=260
UpperLeftX=(DisplayWidth)/2+420
UpperLeftY=(DisplayHeight-180)/2
statictext #prop.st1 "File",5,10,30,25
textbox #prop.tbfile,45,5,150,25
statictext #prop.st2 "Wind",5,32,30,25
combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25
statictext #prop.st3 "Titl",5,54,30,25
textbox #prop.tbtitl,45,49,150,25
statictext #prop.st4 "Form",5,76,30,25
textbox #prop.tbform,45,71,150,25
statictext #prop.st5 "Ctrl",5,98,30,25
textbox #prop.tbctrl,45,93,150,25
statictext #prop.st6 "Text",5,120,30,25
textbox #prop.tbtext,45,115,150,25
statictext #prop.st7 "Reso",5,142,30,25
textbox #prop.tbreso,45,137,150,25
statictext #prop.st8 "xywh",5,164,30,25
textbox #prop.tbxywh,45,159,150,25
statictext #prop.st9 "Font",5,186,30,25
textbox #prop.tbfont,45,181,150,25
statictext #prop.st10 "Colo",5,208,30,25
textbox #prop.tbcolo,45,203,150,25
open "Properties" for window_nf as #prop
#prop "font Consolas 9"
#prop "trapclose [show]"
#prop.cbwind "select window_nf"
#prop.tbfile "!disable"
#prop.tbxywh "!disable"
#prop.tbfont "!disable"
#prop.tbcolo "!disable"
gosub [propertyupdate]
#prop "hide"
propOpen = 1
'open the main form window
'this window is resizable, the graphicox will resize but the
'client area, which is a drawn representation of the window
'will only change size if you change the project w/h dimensions
WindowWidth=862
WindowHeight=600 'gb is offset by 25
UpperLeftX=(DisplayWidth-WindowWidth)/2
UpperLeftY=(DisplayHeight-WindowHeight)/2
combobox #fful.fastfunctionsList,fastfunctionsList$(),fastfunctionSelected,680,2,140,25
combobox #fful.form,form$(,[form],5,2,85,30
combobox #fful.hand,hnd$(,[hand],91,2,85,30
button #fful.code,"Co&de",[code],UL,177,0,43,25
button #fful.gui,"G&UI",[prev],UL,222,0,40,25
combobox #fful.w,v$(,[formsize],265,2,55,30
combobox #fful.h,v$(,[formsize],321,2,55,30
combobox #fful.grid,grid$(,[grid],375,2,90,30
statictext #fful.gridsize "10",470,7,15,15
combobox #fful.color,color$(,[color],490,2,90,30
combobox #fful.font,font$(,[font],585,2,90,30
button #fful.barrier,"No Barrier &+",[barrier],UL,850,0,100,20
button #fful.help,"&?",[help],UL,820,0,25,25
button #fful.negbarrier,"No Barrier &-",[negbarrier],UL,850,22,100,20
statictext #fful.corner, "UpperLeft",960,12,75,15
statictext #fful.cornertext, " Corner >",960,25,85,15
statictext #fful.Xco, "x 0" ,1045,2,65,20
statictext #fful.Yco, "y 0",1045,24,65,20
button #fful.mnu,"&Menu",[bttnMNU],UL,5,25,45,20
button #fful.button,"&Button",[bttnBTTN],UL,50,25,55,20
button #fful.textbox,"&Textbox",[bttnTXBX],UL,105,25,65,20
button #fful.lstbx,"&Listbox",[bttnLSTBX],UL,170,25,65,20
button #fful.cmbobx,"&Combobox",[bttnCMBOBX],UL,235,25,65,20
button #fful.statictext,"&Statictext",[bttnSTTX],UL,300,25,80,20
button #fful.bmpbttn,"BM&Pbutton",[bttnBMPBTTN],UL,380,25,75,20
button #fful.grphcbx,"&Graphicbox",[bttnGRPHCBX],UL,455,25,80,20
button #fful.rdiobttn,"&Radiobutton",[bttnRDBTTN],UL,535,25,85,20
button #fful.chckbx,"Chec&kbox",[bttnCHKBX],UL,620,25,70,20
button #fful.grpbx,"Groupbo&x",[bttnGRPBX],UL,690,25,70,20
button #fful.txtedtr,"Text&editor",[bttnTXTEDTR],UL,760,25,85,20
graphicbox #fful.gb,5,45,830,510
textbox #fful.path,1115,0,200,20
combobox #fful.blocks,block$(,[block],1115,22,200,30
open ver$;" Form Preview Form Dimensions Grid - Size Colors Fonts Add Subs\Functions Help Form Limits (X,Y) Coordinates" for window as #fful
#fful "trapclose [quitfful]"
#fful "font Consolas 9 "
#fful.Xco "!font Consolas 11 "
#fful.Yco "!font Consolas 11 "
#fful "resizehandler [resize]"
#fful.hand "selectindex 1"
#fful.grid "select Set Grid"
#fful.color "select Set Color"
#fful.font "select Set Font"
#fful.w "select ";projectw
#fful.h "select ";projecth
#fful.gb "autoresize"
#fful.gb "vertscrollbar on 0 ";projectw
#fful.gb "horizscrollbar on 0 ";projecth
#fful.gb "font ";projectfont$
#fful.gb "down"
#fful.path "File - untitled.ffu"
#fful.form "!File"
block$(1) = " ! COMING SOON ! "
#fful.blocks "reload"
#fful.blocks "!Add Code Blocks/Snippets"
#fful.fastfunctionsList "!Subs / Functions"
fastfunctionsList$(1) = " ! COMING SOON ! "
#fful.fastfunctionsList "reload"
gosub [drawgrid]
gosub [drawall]
#fful.gb "when rightButtonDown [show]"
#fful.gb "when leftButtonDown [select]"
#fful.gb "when characterInput [keys]"
'load subs and functions combobox
#fful.gb "setfocus"
#prop "show"
show=1
fastGuiOpen = 1
#codeTank.fastgui "!disable"
wait
[show]
if show then
#prop "hide"
show=0
else
#prop "show"
show=1
end if
wait
'the user clicked on the form design window
'either to chose a control or to deselect a control
[select]
xs=MouseX
ys=MouseY
'hide property window if it is open
if show then
#prop "hide"
show=0
end if
'before we move on update the currently selected control from properties
'get the project data and only the editable contents of controls
if selected=0 then
'the form name #xxxx
#prop.tbform "!contents? t$"
if t$<>projectform$ then
projectform$=t$
dim hnd$(10)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "select ";projectform$
end if
'the form/window title text
#prop.tbtitl "!contents? t$"
if t$<>projecttitl$ then projecttitl$=t$
end if
#prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$
#prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$
#prop.tbreso "!contents? t$" : obj$(selected,Ress)=t$
'find the object selected by user
selected=0
action=1 ' 1=move 2=expand - bmps dont expand
for cn=obj to 1 step -1
if xs>obj(cn,XX) and xs<(obj(cn,XX)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then
if xs>obj(cn,XX)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2
if obj(cn,TT)=6 then action=1
selected=cn
exit for
end if
next
if selected=0 then
gosub [propertyupdate]
action=0
end if
if selected>0 and action=1 then
#fful.gb "when leftButtonMove [track]"
#fful.gb "when leftButtonUp [stop]"
offsetX=xs-obj(selected,XX)
offsetY=ys-obj(selected,Y)
end if
if selected>0 and obj(selected,TT)<>6 and action=2 then 'dont resize bmp
#fful.gb "when leftButtonMove [tracksize]"
#fful.gb "when leftButtonUp [stopsize]"
offsetX=xs-(obj(selected,XX)+obj(selected,W))
offsetY=ys-(obj(selected,Y)+obj(selected,H))
end if
if selected>0 then
gosub [drawit]
else
insertx=int((xs+(grid/2))/grid)*grid
inserty=int((ys+(grid/2))/grid)*grid
gosub [drawall]
end if
wait
'moving controls on form
[track]
#fful.corner "UpperLeft"
#fful.gb "rule xor"
gosub [drawit]
xt=int((MouseX-offsetX+(grid/2))/grid)*grid
if negbar then
if xt<1 then xt=0
end if
if xt+obj(selected,W)>projectw and barrier then xt=projectw-obj(selected,W)
obj(selected,XX)=xt
yt=int((MouseY-offsetY+(grid/2))/grid)*grid
if menuset = 0 and textEd = 0 then
if negbar then
if yt<0 then yt=0
end if
if yt+obj(selected,H)>projecth-25 and barrier then yt=projecth-obj(selected,H)-25
obj(selected,Y)=yt
end if
if menuset = 1 or textEd > 0 then
if negbar then
if yt < 0 then yt =0
end if
if yt+obj(selected,H)>projecth-50 and barrier then yt=projecth-obj(selected,H)-50
obj(selected,Y)=yt
end if
#fful.Xco "x ";str$(xt)
#fful.Yco "y ";str$(yt)
gosub [drawit]
wait
'when user stops moving mouse or lifts left button
[stop]
#fful.gb "when leftButtonMove"
#fful.gb "when leftButtonUp"
action=0
#fful.gb "rule over"
gosub [drawall]
wait
'resizing controls on form
[tracksize]
#fful.corner "BottomRight" 'print to window #fful for x,y coordinates
#fful.gb "rule xor"
gosub [drawit]
xs=int((MouseX-offsetX+(grid/2))/grid)*grid
if xs>projectw and barrier then xs=projectw
if xs<obj(selected,XX) then xs=obj(selected,XX)+grid
ys=int((MouseY-offsetY+(grid/2))/grid)*grid
if ys>projecth and barrier then ys=projecth
if ys<obj(selected,Y)+ctrh and barrier then ys=obj(selected,Y)+ctrh
obj(selected,W)=xs-obj(selected,XX)'
'form workspace changes when menu, or textEditor added/removed
if menuset = 1 or textEd > 0 then obj(selected,H)=ys-obj(selected,Y)-50'height
if menuset = 0 and textEd = 0 then obj(selected,H)=ys-obj(selected,Y)-25'height
#fful.Xco "x ";xs : #fful.Yco "y ";ys
gosub [drawit]
wait
[stopsize]
#fful.gb "when leftButtonMove"
#fful.gb "when leftButtonUp"
action=0
#fful.gb "rule over"
gosub [drawall]
wait
'user uses keys to copy/paste or delete controls
[keys]
k1=asc(right$(Inkey$,1))
k2=asc(left$(Inkey$,1))
if k1=46 then 'delete selected
if obj(selected,TT)=12 then menuset=0
if obj(selected,TT)=11 then textEd = textEd - 1
obj(selected,TT)=0
selected=0
gosub [drawgrid]
gosub [drawall]
end if
if k1=3 then 'copy control
cpy(1)=obj(selected,XX) 'x
cpy(2)=obj(selected,Y) 'y
cpy(3)=obj(selected,W) 'w
cpy(4)=obj(selected,H) 'h
cpy(5)=obj(selected,TT) 'type
cpy(6)=obj(selected,TH) 'textheight
cpy$(1)=obj$(selected,Ctr)'name
cpy$(2)=obj$(selected,Tex)'text content
cpy$(3)=obj$(selected,Ress)'resource array or file path
cpy$(4)=obj$(selected,Fon)'ctrl specific font or ""
cpy$(5)=obj$(selected,Bak)'ctrl specific backcolor
end if
if k1=22 then 'paste control
if cpy(5)<>0 then
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
inserty=inserty+cpy(4)+grid
obj(obj,W)=cpy(3)
obj(obj,H)=cpy(4)
obj(obj,TT)=cpy(5)
obj(obj,TH)=cpy(6)
obj$(obj,Ctr)=left$(cpy$(1),2);obj
obj$(obj,Tex)=cpy$(2)
obj$(obj,Ress)=cpy$(3)
if obj(obj,TT)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Ress)
if obj(selected,TT)=11 then textEd = textEd + 1 : gosub [drawgrid] 'keep track of # of texteditors
obj$(obj,Fon)=cpy$(4)
obj$(obj,Bak)=cpy$(5)
selected=obj
gosub [drawall]
end if
end if
#fful.gb "setfocus"
wait
'[tool]
'#fful.tool "selectionindex? i"
[drawTool]
cpy(5)=0
select case i
case 1 'statictext
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=130
obj(obj,H)=ctrh
obj(obj,TT)=1
obj$(obj,Ctr)="sttctxt";obj
obj$(obj,Tex)="StaticText ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectback$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 2 'textbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=140
obj(obj,H)=ctrh
obj(obj,TT)=2
obj$(obj,Ctr)="txtbx";obj
obj$(obj,Tex)="TextBox ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projecttbcl$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 3 'listbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=120
obj(obj,H)=ctrh*5
obj(obj,TT)=3
obj$(obj,Ctr)="lstbx";obj
obj$(obj,Tex)="ListBox ";obj;"\item2\item3\item4\item5"
obj$(obj,Ress)=obj$(obj,Ctr);"$("
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectlbcl$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 4 'combobox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=120
obj(obj,H)=ctrh
obj(obj,TT)=4
obj$(obj,Ctr)="cmbbx";obj
obj$(obj,Tex)="ComboBox ";obj;"\item2\item3\item4\item5"
obj$(obj,Ress)=obj$(obj,Ctr);"$("
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectcbcl$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 5 'button
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=90
obj(obj,H)=ctrh
obj(obj,TT)=5
obj$(obj,Ctr)="btn";obj
obj$(obj,Tex)="Button ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)="white"
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 6 'bmp button
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=50
obj(obj,H)=50
obj(obj,TT)=6
obj$(obj,Ctr)="bmpbtn";obj
filedialog "Choose an image","*.bmp",file$
if file$<>"" then
file$=right$(file$,len(file$)-len(DefaultDir$)-1)
open file$ for input as #bmp
'the bmpfileheader
bmp$ = Input$(#bmp,lof(#bmp))
if mid$(bmp$,1,2) ="BM" then 'always BM
obj(obj,W)=value(mid$(bmp$,19,4))'width
obj(obj,H)=value(mid$(bmp$,23,4))'height
obj$(obj,Ress)=file$
obj$(obj,Tex)="bmp"
loadbmp obj$(obj,Ctr),file$
close #bmp
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
else
obj(obj,TT)=0
close #bmp
obj=obj-1
end if
else
obj(obj,TT)=0
obj=obj-1
end if
case 7 'graphicbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=90
obj(obj,H)=90
obj(obj,TT)=7
obj$(obj,Ctr)="grphcbx";obj
obj$(obj,Tex)="GraphicBox ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=100
obj(obj,H)=ctrh
obj(obj,TT)=8
obj$(obj,Ctr)="rdbtn";obj
obj$(obj,Tex)="RadioButton ";obj
obj$(obj,Ress)="[";obj$(obj,Ctr);"Set],[";obj$(obj,Ctr);"Reset]"
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 9 'checkbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=90
obj(obj,H)=ctrh
obj(obj,TT)=9
obj$(obj,Ctr)="chkbx";obj
obj$(obj,Tex)="CheckBox ";obj
obj$(obj,Ress)="[";obj$(obj,Ctr);"Checked],[";obj$(obj,Ctr);"Unchecked]"
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectback$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=110
obj(obj,H)=110
obj(obj,TT)=10
obj$(obj,Ctr)="grpbx";obj
obj$(obj,Tex)="GroupBox ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectback$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor
obj=obj+1
textEd = textEd + 1 : gosub [drawgrid]
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=150
obj(obj,H)=100
obj(obj,TT)=11
obj$(obj,Ctr)="txtedtr";obj
obj$(obj,Tex)="TextEditor ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projecttecl$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu
if menuset=0 then
obj=obj+1
obj(obj,XX)=0
obj(obj,Y)=0
obj(obj,W)=100
obj(obj,H)=10
obj(obj,TT)=12
obj$(obj,Ctr)="mn";obj
obj$(obj,Tex)=" Menu Added ";obj
menuset=1
end if
end select
selected=obj
gosub [drawall]
'#fful.tool "select Add New"
#fful.gb "setfocus"
wait
[form]
#fful.form "selectionindex? i"
select case i
case 1 'restore
#fful.path "lastsession.ffu"
file$ = "lastsession.ffu"
gosub [loadit]
#fful.path "lastsession.ffu"
case 2 'new
if import <> 1 then #fful.path "Untitled.bas"
gosub [new]
case 3 'save as
gosub [saveas]
case 4 'load
gosub [load]
case 6 'write
gosub [write]
#fful.path file$
case 7 'import
import = 1
gosub [import]
import = 0
case 8 'export
gosub [export]
end select
#fful.form "select File"
gosub [drawall]
#fful.gb "setfocus"
wait
[drawall]
#fful.gb "discard ; redraw bak"
ocn=cn
projecttbcl$="white"
projectlbcl$="white"
projectcbcl$="white"
projecttecl$="white"
for cn=1 to obj
gosub [drawit]
next
cn=ocn
#fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10
#fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10
#fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20
#fful.gb "setfocus"
return
[drawit]
'redraws control cn
'set the color for the drawn object and action taking place
if cn=selected then
#fful.gb "color red" 'action 1 or 2
if action=2 then #fful.gb "color green"
else
#fful.gb "color ";projectfore$
end if
'set the font for the drawn object
if obj$(cn,Fon)="" then
#fful.gb "font ";projectfont$
ch=projectctrh
if obj(cn,H)<ch then obj(cn,H)=ch
else
#fful.gb "font ";obj$(cn,Fon)
ch=obj(cn,TH)
if obj(cn,H)<ch then obj(cn,H)=ch
end if
'update the properties textboxes for selected control
if cn=selected then
#prop.tbctrl obj$(cn,Ctr) 'ctrlname
#prop.tbtext obj$(cn,Tex) 'text
#prop.tbreso obj$(cn,Ress) 'resource
#prop.tbxywh obj(cn,XX);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh
if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height
#prop.tbcolo obj$(cn,Bak)
end if
#fful.gb "place ";obj(cn,XX);" ";obj(cn,Y)
if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?"
select case obj(cn,TT)
case 1 'statictext
#fful.gb "backcolor ";projectback$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
#fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 2 'textbox
#fful.gb "backcolor ";projecttbcl$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 3 'listbox
#fful.gb "backcolor ";projectlbcl$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 4 'combobox
#fful.gb "backcolor ";projectcbcl$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 5 'button
#fful.gb "backcolor white"
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
'buttons are always black on white
#fful.gb "color black"
'centre button text
#fful.gb "stringwidth? ";"A";" width"
xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2
if action=0 then #fful.gb "place ";obj(cn,XX)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
#fful.gb "color ";projectfore$
#fful.gb "backcolor ";projectback$
case 6 'bmpbutton
if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr)
#fful.gb "box ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
case 7 ' graphicbox
#fful.gb "backcolor white"
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
#fful.gb "backcolor ";projectback$
case 8 'radiobutton
#fful.gb "backcolor ";projectback$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
'radiobutton text is always black
#fful.gb "color black"
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
#fful.gb "color ";projectfore$
case 9 'checkbox
#fful.gb "backcolor ";projectback$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
'checkbox text is always black
#fful.gb "color black"
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
#fful.gb "color ";projectfore$
case 10 'groupbox
#fful.gb "backcolor ";projectback$
'groupbox is an outline
#fful.gb "box ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
'group box text is always black
#fful.gb "color black"
'groupbox text is offset
if action=0 then #fful.gb "place ";obj(cn,XX)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex)
#fful.gb "color ";projectfore$
case 11 ' texteditor
#fful.gb "backcolor ";projecttecl$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 12 'menu
'pin to top left
obj(cn,XX)=10 : obj(cn,Y)=-8 : obj(cn,W)=100 : obj(cn,H)=10
#fful.gb "backcolor ";projectback$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
#fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 21 'tecolor
projecttecl$=obj$(cn,Bak)
case 22 'tbcolor
projecttbcl$=obj$(cn,Bak)
case 23 'lbcolor
projectlbcl$=obj$(cn,Bak)
case 24 'cbcolor
projectcbcl$=obj$(cn,Bak)
'41,42,43,44,45 and 50 51 ignored ie back/fore w/h open and font objects
end select
return
[prev]
file$="preview.bas"
gosub [writeit]
wait
[write]
projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas"
filedialog "Save .bas",projectfile$,file$
file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit]
if file$<>"" then
open file$ for output as #op
'the header
#op " 'Project ";projecttitl$
if val(left$(time$(), 2)) > 11 then mer$ = "pm" else mer$ = "am"
#op " 'Created with FFNotSoLite v";ver$;" ";date$();" at ";time$();" ";mer$
#op " nomainwin"
if projectback$<>"white" or projectfore$<>"black" then
#op " 'Set BackgroundColor$ and ForegroundColor$ of project"
#op " BackgroundColor$=";chr$(34);projectback$;chr$(34)
#op " ForegroundColor$=";chr$(34);projectfore$;chr$(34)
#op ""
end if
if code = 1 then
#op " 'Create arrays needed for controls listbox,combobox"
for n= 1 to obj
if obj(n,TT)=3 or obj(n,TT)=4 then
#op " dim ";obj$(n,Ress);"10)"
#op " for n = 1 to 10"
#op " ";obj$(n,Ress);"n)= str$(n)"
#op " next"
end if
next
end if
#op " 'Create controls and open window"
#op " WindowWidth = ";projectw
#op " WindowHeight = ";projecth
#op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)"
#op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)"
if menuset then
#op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Open";chr$(34);", [dummy], ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Save As";chr$(34);", [dummy],";chr$(34);"&Load";chr$(34);", [dummy], ";chr$(34);"&Exit";chr$(34);", [dummy]"
if textEd > 0 then
#op " menu ";projectform$;", ";chr$(34);"Edit";chr$(34)
end if
#op " menu ";projectform$;", ";chr$(34);"&Tools";chr$(34);", ";chr$(34);"Preferences";chr$(34);", [dummy] "
#op " menu ";projectform$;", ";chr$(34);"&Options";chr$(34);", ";chr$(34);"Fonts";chr$(34);", [dummy], ";chr$(34);"Colors";chr$(34);", [dummy]"
#op " menu ";projectform$;", ";chr$(34);"&Help";chr$(34);", ";chr$(34);"About";chr$(34);", [dummy]";", ";chr$(34);"Help";chr$(34);", [dummy]"
end if
for n=1 to obj
select case obj(n,TT)
case 1 'statictext
#op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,XX);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H)
case 2 'textbox
#op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 3 'list box
#op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ress);",[";obj$(n,Ctr);"Selected],";obj(n,XX)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H)
case 4 'combobox
#op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ress);",[";obj$(n,Ctr);"Selected],";obj(n,XX)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H)
case 5 'button
#op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"Clicked], UL, ";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 6 'bmpbutton
#op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ress);chr$(34);",[";obj$(n,Ctr);"Clicked], UL, ";obj(n,XX);",";obj(n,Y)
case 7 'graphicbox
#op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 8 'radiobutton
#op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Ress);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 9 'checkbox
#op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Ress);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 10 'group box
#op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,XX);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H)
case 11 'texteditor
#op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 22 'tbcolor
#op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 23 'lbcolor
#op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 24 'cbcolor
#op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 21 'tecolor
#op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
end select
next
#op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$
if instr(projectwind$, "text") then
#op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34)
else
#op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34)
end if
#op ""
if code = 1 then
#op " 'Set any listboxes to singleclick and display the first item on the list for all listboxes and comboboxes"
for n= 1 to obj
if obj(n,TT)=4 then
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34)
end if
if obj(n,TT)=3 then
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1, singleclickselect";chr$(34)
end if
next
#op " 'apply any control specific fonts"
end if
for n= 1 to obj
if obj(n,TT)<>0 and obj$(n,Fon)<>"" then
if obj(n,TT)=1 or obj(n,TT)=2 or obj(n,TT)=5 or obj(n,TT)=10 or obj(n,TT)=11 then
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34)
end if
if obj(n,TT)=3 or obj(n,TT)=4 or obj(n,TT)=7 or obj(n,TT)=8 or obj(n,TT)=9 then
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34)
end if
[remDot]
end if
next
#op " 'Your code here. eg: Declare variables and globals, goto/gosub/call subs and invoke functions, etc etc"
#op ""
#op " wait"
#op ""
#op " 'Create the required handlers for each control"
for n=1 to obj
select case obj(n,TT)
case 3 'listbox
#op " [";obj$(n,Ctr);"Selected]"
#op " 'Your handler code here, read the control with"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? Selected$";chr$(34)
#op " wait"
#op ""
case 4 'combobox
#op " [";obj$(n,Ctr);"Selected]"
#op " 'Your handler code here, read the control with"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? Selected$";chr$(34)
#op " wait"
#op ""
case 5 'button
#op " [";obj$(n,Ctr);"Clicked]"
#op " 'Your handler code here"
#op " wait"
#op ""
case 6 'bmpbutton
#op " [";obj$(n,Ctr);"Clicked]"
#op " 'Your handler code here"
#op " wait"
#op ""
case 8 'radiobutton
#op " [";obj$(n,Ctr);"Set]"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34)
#op " 'Your handler code here"
#op " wait"
#op ""
case 9 'checkbox
#op " [";obj$(n,Ctr);"Checked]"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34)
#op " 'Your handler code here"
#op " wait"
#op ""
#op " [";obj$(n,Ctr);"Unchecked]"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34)
#op " 'Your handler code here"
#op " wait"
#op ""
end select
next
#op " [quit]"
#op " 'Add code for any actions to take while shutting down. eg:backup settings to a file"
#op " close ";projectform$
#op " end"
#op " "
#op " 'Subs and Functions go below this line"
#op "'########################################################"
#op " "
close #op
if code <> 1 then run chr$(34);LBpath$;"\";LBexe$;chr$(34);" -R -A ";DefaultDir$;"\";file$
if code = 1 then run chr$(34);LBpath$;"\";LBexe$;chr$(34);" -A ";DefaultDir$;"\";file$
[done]
end if
code = 0
return
[saveas]
projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu"
filedialog "Save As...",projectname$,file$
if file$<>"" then
open file$ for output as #op
projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1)
#fful.path projectfile$
'the form name #xxxx
#prop.tbform "!contents? t$"
if t$<>projectform$ then
projectform$=t$
dim hnd$(10)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "select ";projectform$
end if
'the form/windo title text
#prop.tbtitl "!contents? t$"
if t$<>projecttitl$ then projecttitl$=t$
#op projectfile$
#op projectwind$
#op projectform$
#op projecttitl$
#op projectfont$
#op projectback$
#op projectfore$
#op projectctrh
#op projectgrid
#op projectw
#op projecth
for n=1 to obj
if obj(n,TT)<>0 then
#op obj(n,XX);",";
#op obj(n,Y);",";
#op obj(n,W);",";
#op obj(n,H);",";
#op obj(n,TT);",";
#op obj(n,TH)
#op obj$(n,Ctr)
#op obj$(n,Tex)
#op obj$(n,Ress)
#op obj$(n,Fon)
#op obj$(n,Bak)
end if
next
close #op
gosub [propertyupdate]
redim hnd$(30)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "selectindex 1"
end if
return
[load]
filedialog "Open Project...","*.ffu",file$
[loadit]
if file$<>"" then
projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1)
#fful.path projectfile$
open file$ for input as #ses
input #ses, projectfile$
input #ses, projectwind$
input #ses, projectform$
input #ses, projecttitl$
input #ses, projectfont$
if projectfont$="" then projectfont$="Consolas 9"
#fful.gb "font ";projectfont$
input #ses, projectback$
input #ses, projectfore$
input #ses, c$
input #ses, g$
input #ses, w$
input #ses, h$
projectctrh=val(c$)
projectgrid=val(g$)
grid=projectgrid
projectw=val(w$)
projecth=val(h$)
#prop.cbwind "select ";projectwind$
redim hnd$(30)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "selectindex 1"
#fful.grid "select ";grid
#fful.w "select ";projectw
#fful.h "select ";projecth
gosub [drawgrid]
obj=0
while eof(#ses) = 0
obj=obj+1
line input #ses, l$
obj(obj,XX)=val(word$(l$,1,","))
obj(obj,Y)=val(word$(l$,2,","))
obj(obj,W)=val(word$(l$,3,","))
obj(obj,H)=val(word$(l$,4,","))
obj(obj,TT)=val(word$(l$,5,","))
obj(obj,TH)=val(word$(l$,6,","))
line input #ses, obj$(obj,Ctr)
line input #ses, obj$(obj,Tex)
line input #ses, obj$(obj,Ress)
line input #ses, obj$(obj,Fon)
line input #ses, obj$(obj,Bak)
if obj(obj,TT)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Ress)
if obj(obj,TT)=12 then menuset=1
if obj(obj,TT)=11 then textEd = textEd + 1
wend
close #ses
gosub [propertyupdate]
#prop "hide"
#prop "show"
end if
return
[import]
filedialog "Open .bas...","*.bas",file$
[importit]
if file$<>"" then
'check size
open file$ for input as #bas
maxln=0
while eof(#bas)=0
line input #bas, wln$
maxln=maxln+1
wend
close #bas
'add margin for split lines
dim bas$(maxln+1000,4)'an array of code lines and line numbers
'set up progress bar
#prog.gb1 "down ; fill white ; backcolor cyan"
#prog "show"
projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1)
gosub [new]
'set grid to 1 and invisible so controls stay where they import from initially
'grid=1
'gridvisible=0
gosub [drawgrid]
#fful.path projectfile$
'create objects for only those lines defining controls we are interested in
wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox "
wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu
wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ "
wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty "
wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ font "
ln=1
bln=1
open file$ for input as #bas
while eof(#bas)=0
line input #bas, wln$
'update progress bar
#prog.gb1 "cls ; place 0 0 ; boxfilled ";100/maxln*ln;" 25"
'ignore 'or rem lines
if left$(lower$(trim$(wln$)),1)="'" or left$(lower$(trim$(wln$)),4)="rem " then
bas$(ln,1)=str$(ln)
bas$(ln,2)=trim$(wln$)
ln=ln+1
else
'break into multiple lines if ":" found outside quotes
pos=1
ln$=""
while pos<=len(wln$)
c$=mid$(wln$,pos,1)
dd$ = mid$(win$,pos,2)
if c$=chr$(34) then
if quote=0 then quote=1 else quote=0
end if
if c$=":" and quote=0 or c$=":" and right$(dd$,1) = "\" then
gosub [line]
ln$=""
pos=pos+1
else
ln$=ln$+c$
pos=pos+1
end if
wend
gosub [line]
bln=bln+1
end if
wend
basln=ln-1
close #bas
redim win$(30,10)'an array of forms within .bas
redim hnd$(30)'an array of form names for handle combobox
wh=1
for ln=1 to basln
if bas$(ln,3)="#" then
if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1)
if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1)
if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1)
if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1)
'if instr(lower$(bas$(ln,2)),"open",1)>0 then
if lower$(word$(bas$(ln,2),1)) = "open" and left$(word$(bas$(ln,2),2, " as "),1) = "#" then
if instr(lower$(bas$(ln,2)),"window",1)>0 or instr(lower$(bas$(ln,2)),"dialog",1)>0 or instr(lower$(bas$(ln,2)),"graphic",1)>0 then
win$(wh,10)=bas$(ln,1)
n$=word$(bas$(ln,2),2,chr$(34))
hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1))
'find last "for" in command line
i=1
while i
oi=i
i=instr(lower$(bas$(ln,2))," for ",i+1)
wend
wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi)
wt$=word$(wt$,2)
win$(wh,1)=hn$ 'handle #fful etc
win$(wh,2)=n$ 'title
win$(wh,3)=w$ 'width
win$(wh,4)=h$ 'height
win$(wh,5)=wt$ 'windowtype
hnd$(wh)=hn$ 'for combobox
wh=wh+1
end if
end if
end if
next
#fful.hand "reload"
#fful.hand "selectindex 1"
wh=1
gosub [loadwindow]
end if
return
[line]
bas$(ln,1)=str$(ln)
bas$(ln,2)=trim$(ln$)
w$=lower$(word$(ln$,1))
if instr(w$,"=",1)>1 then w$=word$(w$,1,"=")
if len(w$)>3 then
w1$=" "+w$+" "
w2$=" "+w$+"="
if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 or instr(lower$(ln$),"font ",1)>0 then bas$(ln,3)="#"
end if
ln=ln+1
return
[hand]
#fful.hand "selectionindex? wh"
gosub [loadwindow]
wait
[loadwindow]
redim obj(300,6) 'x,y,width/height,type,textheight
redim obj$(300,7) 'name,text content,resource,font
obj=1
menuset=0
textEd = 0
projectback$="white"
TextboxColor$="white"
ListboxColor$="white"
ComboboxColor$="white"
TexteditorColor$="white"
projectfore$="black"
projectw=val(win$(wh,3))
if projectw=0 then projectw=320
projecth=val(win$(wh,4))
if projecth=0 then projecth=360
projecttitl$=win$(wh,2)
projectwind$=win$(wh,5)
projectform$=win$(wh,1)
tbc$=""
lbc$=""
cbc$=""
tec$=""
gosub [propertyupdate]
#fful.w "!";str$(projectw)
#fful.h "!";str$(projecth)
'find controls and create obj() array for form we are interested in
for ln=1 to basln
'update progress bar
#prog.gb1 "cls ; place 0 0 ; boxfilled ";100+100/maxln*ln;" 25"
if bas$(ln,3)="#" then
'reset obj pointer
bas$(ln,4)=""
'create objects to control color only check lines after previous open statement up to our open statement
if bas$(ln,1)>win$(wh-1,10) and bas$(ln,1)<=win$(wh,10) then
if instr(bas$(ln,2),"TextboxColor$",1)>0 then obj(obj,TT)=22 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bass)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1
if instr(bas$(ln,2),"ListboxColor$",1)>0 then obj(obj,TT)=23 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bass)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1
if instr(bas$(ln,2),"ComboboxColor$",1)>0 then obj(obj,TT)=24 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bass)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1
if instr(bas$(ln,2),"TexteditorColor$",1)>0 then obj(obj,TT)=21 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bass)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1
end if
for wc=1 to 12
if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for
next
if wc<=11 then
obj$(obj,Bass)=bas$(ln,1)
bas$(ln,4)=str$(obj)
l$=bas$(ln,2)
ll$="" 'remove spaces leaving only , separation but keep "" text untouched
inString=0
for i=1 to len(l$)
c$=mid$(l$,i,1)
select case
case c$=chr$(34)
inString=1-inString
case (inString=0) and c$=" "
c$=""
end select
ll$=ll$+c$
next
'insert missing comma if missing
if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1)
if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1)
obj(obj,TT)=wc 'type
obj(obj,TH)=projectctrh
'get the .ctrl name
obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1)
'for un-named controls
if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj
'get the text
if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc)
'get the array or bmp file name
if wc=3 or wc=4 or wc=6 then obj$(obj,Ress)=word$(ll$,2,",")
if wc=8 or wc=9 then obj$(obj,Ress)=word$(ll$,3,",")+","+word$(ll$,4,",")
'get rid of ""
if wc=6 and left$(obj$(obj,Ress),1)=chr$(34) then obj$(obj,Ress)=mid$(obj$(obj,Ress),2,len(obj$(obj,Ress))-2)
'array() -> array(
if (wc=3 or wc=4) and right$(obj$(obj,Ress),1)=")" then obj$(obj,Ress)=left$(obj$(obj,Ress), len(obj$(obj,Ress))-1)
i=1
while word$(ll$,i,",")<>""
i=i+1
wend
i=i-4
if wc=6 or wc=5 then
'buttons and bmpbuttons can have xy, wh is optional and they have XX corners
if i=3 then
obj(obj,XX)=val(word$(ll$,i+2,","))'x
obj(obj,Y)=val(word$(ll$,i+3,","))'y
if wc=5 then
'we need to find a way to calculate width and height if not given
#fful.gb "stringwidth? ";"A";" width"
obj(obj,W)=width*len(obj$(obj,Tex))+10
obj(obj,H)=projectctrh
end if
if wc=6 then
'we need a way to set bmp w and h
on error goto [dummybmp]
open obj$(obj,Ress) for input as #bmp
'the bmpfileheader
bmp$ = Input$(#bmp,lof(#bmp))
if mid$(bmp$,1,2) ="BM" then 'always BM
obj(obj,W)=value(mid$(bmp$,19,4))'width
obj(obj,H)=value(mid$(bmp$,23,4))'height
obj$(obj,Tex)="bmp"
end if
loadbmp obj$(obj,Ctr),obj$(obj,Ress)
close #bmp
goto [passdummy]
[dummybmp]
obj(obj,W)=25
obj(obj,H)=25
obj$(obj,Tex)="bmp"
loadbmp obj$(obj,Ctr),"path.bmp"
[passdummy]
end if
else
obj(obj,XX)=val(word$(ll$,i,","))'x
obj(obj,Y)=val(word$(ll$,i+1,","))'y
obj(obj,W)=val(word$(ll$,i+2,","))'w
obj(obj,H)=val(word$(ll$,i+3,","))'h
end if
if upper$(word$(ll$,4,","))="LR" then
obj(obj,XX)=projectw-obj(obj,XX)-obj(obj,W)'x
obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y
end if
if upper$(word$(ll$,4,","))="LL" then
'obj(obj,XX)=projectw-obj(obj,XX)-obj(obj,W)'x
obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y
end if
if upper$(word$(ll$,4,","))="UR" then
obj(obj,XX)=projectw-obj(obj,XX)-obj(obj,W)'x
'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y
end if
else
'write to .bas tweaks listbox and combobox controls to line up properly
'so we need to untweak them now
obj(obj,XX)=val(word$(ll$,i,","))'x
obj(obj,Y)=val(word$(ll$,i+1,","))'y
if wc=1 then obj(obj,Y)=obj(obj,Y)-5
if wc=10 then obj(obj,Y)=obj(obj,Y)+5
if wc=3 or wc=4 then obj(obj,XX)=obj(obj,XX)-1
obj(obj,W)=val(word$(ll$,i+2,","))'w
if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2
obj(obj,H)=val(word$(ll$,i+3,","))'h
end if
obj=obj+1
end if
end if
next
'now find font commands listed after the open statement referring to the #form
'#form.ctrl !font fontname
'if so add a new font object
for ln = 1 to basln
if bas$(ln,3)="#" then
lln$=lower$(bas$(ln,2))
if (instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font ",1)>0) or (instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font ",1)>0) then
f$=right$(lln$,len(lln$)-instr(lln$,"font",1)-4)
if instr(f$,";",1)=0 then
obj$(obj,Fon)=f$
obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1)
obj$(obj,Ctr)=word$(word$(lln$,1),2,".")
if instr(lln$,"!font",1)>0 then obj(obj,TT)=51 else obj(obj,TT)=50
obj$(obj,Bass)=str$(ln)
bas$(ln,4)=str$(obj)
'find the visible object and store the font change
for n=1 to obj
if obj$(n,Ctr)=obj$(obj,Ctr) then
obj$(n,Fon)=obj$(obj,Fon)
#fful.gb "font ";obj$(obj,Fon)
#fful.gb "place 100 100 ;\Q\Q"
#fful.gb "posxy xp yp"
obj(n,TH)=(yp-100)/2+7
exit for
end if
next
obj=obj+1
end if
end if
end if
next
if win$(wh,6)<>"" then
bas$(val(win$(wh,6)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,6)
obj(obj,TT)=41
obj=obj+1
'backgroundcolor
end if
if win$(wh,7)<>"" then
bas$(val(win$(wh,7)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,7)
obj(obj,TT)=42
obj=obj+1
'foregroundcolor
end if
if win$(wh,8)<>"" then
bas$(val(win$(wh,8)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,8)
obj(obj,TT)=43
obj=obj+1
'windowwidth
end if
if win$(wh,9)<>"" then
bas$(val(win$(wh,9)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,9)
obj(obj,TT)=44
obj=obj+1
n=n+1
'windowheight
end if
if win$(wh,10)<>"" then
bas$(val(win$(wh,10)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,10)
obj(obj,TT)=45
obj=obj+1
'open statement
end if
obj=obj-1
gosub [drawgrid]
gosub [drawall]
#prog "hide"
#prop "hide"
#prop "show"
show=1
return
[export]
'all previously imported lines will be deleted and replaced by the obj( lines
'deletelist$ remembers the original imported line numbers in line number order
if file$<>"" and right$(file$,3)="bas" then
open file$ for output as #bas
'open "export.bas" for output as #bas
for ln=1 to basln
'find any object associated with this line
found=0
for l=1 to obj
if bas$(ln,1)=obj$(l,Bass) then
found=1
'have we got to the open command line yet
if obj(l,TT)=45 then
'write all new lines prior to 45 (controls)
for m=1 to obj
if obj$(m,Bass)="" and obj(m,TT)<45 and obj(m,TT)<>0 then
n=m
gosub [exportline]
end if
next
'write 45 (open line)
n=l
gosub [exportline]
'write all new lines after 45 (open) ie (fonts)
'apply any control specific fonts"
for m= 1 to obj
if obj(m,TT)<>0 and obj$(m,Fon)<>"" then
if obj(m,TT)=1 or obj(m,TT)=2 or obj(m,TT)=5 or obj(m,TT)=10 or obj(m,TT)=11 then
#bas " ";projectform$;".";obj$(m,Ctr);" ";chr$(34);"!font ";obj$(m,Fon);chr$(34)
end if
if obj(m,TT)=3 or obj(m,TT)=4 or obj(m,TT)=7 or obj(m,TT)=8 or obj(m,TT)=9 then
#bas " ";projectform$;".";obj$(m,Ctr);" ";chr$(34);"font ";obj$(m,Fon);chr$(34)
end if
end if
next
end if
'edit or erase existing line
if obj(l,TT)=0 then
else
if obj(l,TT)<>45 then
n=l
gosub [exportline]
end if
end if
end if
next
if found=0 then #bas " ";bas$(ln,2)
next
close #bas
end if
'now reload amended .bas file
gosub [importit]
return
[exportline]
select case obj(n,TT)
'handle the visible controls
case 1 'statictext
#bas " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,XX);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H)
case 2 'textbox
#bas " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 3 'list box
#bas " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ress);",[";obj$(n,Ctr);"Selected],";obj(n,XX)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H)
case 4 'combobox
#bas " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ress);",[";obj$(n,Ctr);"Selected],";obj(n,XX)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H)
case 5 'button
#bas " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"Clicked], UL, ";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 6 'bmpbutton
#bas " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ress);chr$(34);",[";obj$(n,Ctr);"Clicked], UL, ";obj(n,XX);",";obj(n,Y)
case 7 'graphicbox
#bas " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 8 'radiobutton
#bas " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Ress);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 9 'checkbox
#bas " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Ress);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 10 'group box
#bas " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,XX);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H)
case 11 'texteditor
#bas " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export
case 22 'textboxcolor
#bas " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 23 'listboxcolor
#bas " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 24 'comboboxcolor
#bas " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 21 'texteditorcolor
#bas " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
' handle the window code
case 41'backgroundcolor
#bas " BackgroundColor$=";chr$(34);projectback$;chr$(34)
case 42'foregroundcolor
#bas " ForegroundColor$=";chr$(34);projectfore$;chr$(34)
case 43'windowidth
#bas " WindowWidth=";projectw
case 44'windowheight
#bas " WindowHeight=";projecth
case 45'open
#bas " Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$
'handle font changes
case 50 'font
if obj$(n,Ctr) = "" and projectform$ <> "" and projectfont$ <> "" then
#bas " ";projectform$;" ";chr$(34);"font ";projectfont$;chr$(34)
goto [delDot]
end if
#bas " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34)
[delDot]
case 51 '!font
#bas " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34)
end select
return
[new]
redim obj(300,6) 'x,y,width/height,type,textheight
redim obj$(300,7) 'name,text content,resource,font
obj=0
menuset=0
textEd = 0
projectw=600
projecth=400
projectback$="white"
projectfore$="black"
projectctrc$="white"
projecttitl$="Untitled"
projectform$="#1"
'if import <> 1 then projectfile$="Untitled.bas"
projectwind$="window_nf"
#prop.cbwind "select window_nf"
redim hnd$(30)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "selectindex 1"
#fful.w "select ";projectw
#fful.h "select ";projecth
gosub [propertyupdate]
gosub [drawgrid]
gosub [drawall]
#prop "hide"
#prop "show"
show=1
return
[propertyupdate]
#prop.tbfile projectfile$
#prop.cbwind "select ";projectwind$
#prop.tbtitl projecttitl$
#prop.tbform projectform$
#prop.tbctrl ""
#prop.tbtext ""
#prop.tbreso ""
#prop.tbxywh projectw;"x";projecth
#prop.tbfont projectfont$
#prop.tbcolo projectfore$;"/";projectback$
return
[resize]
'#fful.tool "select Add New"
#fful.form "select File"
if wh=0 then wh=1
#fful.hand "selectindex ";wh
#fful.grid "select Set Grid"
#fful.font "select Set Font"
#fful.color "select Set Color"
#fful.w "select ";projectw
#fful.h "select ";projecth
gosub [drawall]
wait
[formsize]
#fful.w "contents? w$"
#fful.h "contents? h$"
wf=val(w$)
hf=val(h$)
if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait
projectw=wf
projecth=hf
insertx=grid
inserty=grid
gosub [drawgrid]
#fful.gb "setfocus"
gosub [drawall]
wait
[grid]
'resize the grid spacing according to user choice, default is 10
#fful.grid "contents? g$"
select case g$
case "Invisible"
gridvisible=0
grid=1
case "Visible"
gridvisible=1
case else
grid=val(g$)
if grid = 1 then gridvisible = 0
if grid > 2 then gridvisible = 1
end select
gosub [drawgrid]
gosub [drawall]
#fful.gridsize grid
#fful.gb "setfocus"
wait
[drawgrid]
projectgrid=grid
#fful.gb "cls; fill lightgray"
if grid > 0 and gridvisible = 1 then
#fful.gb "color ";gridcolor$
' Grid - Draw vertical lines
if menuset = 0 and textEd = 0 then
#fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25
for xs = 0 to projectw step grid
' Grid - Draw horizontal lines
#fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-25
next xs
for ys = 0 to projecth-25 step grid
#fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys
next ys
#fful.gb "color ";bordercolor$
#fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25
#fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25
#fful.gb "line "; 0; " "; 0; " "; projectw; " "; 0
#fful.gb "line ";0;" "; 0;" "; 0; " ";projecth-25
end if
'adjust grid when menu, or texeditor control is selected - revert if menu and texeditor deleted /no longer used.,
if menuset = 1 or textEd > 0 then
#fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50
#fful.gb "color ";gridcolor$
for xs = 0 to projectw step grid
#fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-50
next xs
for ys = 0 to projecth-50 step grid
#fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys
next ys
#fful.gb "color ";bordercolor$
#fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50
#fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50
#fful.gb "line "; 0; " "; 0; " "; 0; " "; projecth-50
#fful.gb "line ";0;" "; 0;" "; projectw; " ";0
end if
end if
[nogrid]
if grid < 2 or gridvisible = 0 then
if textEd =0 and menuset = 0 then
#fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25
#fful.gb "color ";crosshair$
#fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-25
#fful.gb "line "; 0; " "; ((projecth)/2)-12; " "; projectw; " "; ((projecth)/2)-12
#fful.gb "color ";bordercolor$
#fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25
#fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25
#fful.gb "line "; 0; " "; 0; " "; projectw; " "; 0
#fful.gb "line ";0;" "; 0;" "; 0; " ";projecth-25
end if
if textEd > 0 or menuset = 1 then
#fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50
#fful.gb "color ";crosshair$
#fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-50
#fful.gb "line "; 0; " "; (projecth-50)/2; " "; projectw; " "; (projecth-50)/2
#fful.gb "color ";bordercolor$
#fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50
#fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50
#fful.gb "line "; 0; " "; 0; " "; 0; " "; projecth-50
#fful.gb "line ";0;" "; 0;" "; projectw; " ";0
end if
end if
#fful.gb "flush bak"
#fful.grid "select 0"
#fful.grid "!Set Grid"
return
[font]
#fful.font "contents? f$"
if f$="Project Font" then
fontdialog projectfont$,f$
if f$<>"" then
projectfont$=f$
#fful.gb "font ";projectfont$
#fful.gb "place 100 100 ;\Q\Q"
#fful.gb "posxy xp yp"
projectctrh=(yp-100)/2+7
ctrf$=projectfont$
ctrh=projectctrh
end if
end if
if f$="Control Font" then
fontdialog projectfont$,f$
if f$<>"" then
ctrf$=f$
#fful.gb "font ";ctrf$
#fful.gb "place 100 100 ;\Q\Q"
#fful.gb "posxy xp yp"
ctrh=(yp-100)/2+7
end if
if selected then
obj$(selected,4)=ctrf$ 'font
obj(selected,6)=ctrh 'text height
end if
'for single line text controls auto adjust w and h
if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then
obj(selected,4)=ctrh
#fful.gb "stringwidth? ";"A";" width"
obj(selected,3)=width*len(obj$(selected,2))+10
end if
end if
if f$="ResetControl" then
ctrf$=projectfont$
ctrh=projectctrh
if selected then
obj$(selected,4)=ctrf$
obj(selected,6)=ctrh
end if
'for single line text controls auto adjust w and h
if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then
#fful.gb "font ";ctrf$
obj(selected,4)=ctrh
#fful.gb "stringwidth? ";"A";" width"
obj(selected,3)=width*len(obj$(selected,2))+10
end if
end if
#fful.font "select Set Font"
gosub [drawall]
#fful.gb "setfocus"
wait
[color]
#fful.color "contents? c$"
select case c$
case "Control Back"
gosub [colorpick]
if cp$<>"" then
if selected then 'insert color change event ahead of control
if obj(selected,TT)=2 then ct=22 : projecttbcl$=cp$
if obj(selected,TT)=3 then ct=23 : projectlbcl$=cp$
if obj(selected,TT)=4 then ct=24 : projectcbcl$=cp$
if obj(selected,TT)=11 then ct=21 : projecttecl$=cp$
for n=obj+1 to selected+1 step -1
obj(n,XX)=obj(n-1,XX)
obj(n,Y)=obj(n-1,Y)
obj(n,W)=obj(n-1,W)
obj(n,H)=obj(n-1,H)
obj(n,TT)=obj(n-1,TT)
obj(n,TH)=obj(n-1,TH)
obj$(n,Ctr)=obj$(n-1,Ctr)
obj$(n,Tex)=obj$(n-1,Tex)
obj$(n,Ress)=obj$(n-1,Ress)
obj$(n,Fon)=obj$(n-1,Fon)
obj$(n,Bak)=obj$(n-1,Bak)
obj$(n,Bass)=obj$(n-1,Bass)
next
obj(selected,TT)=ct
obj$(selected,Tex)="Color!"
obj$(selected,Bak)=cp$
'obj$(selected,Bass)="XX"
'remove any previous color change statement
if selected>=2 then
if obj(selected-1,TT)=ct then obj(selected-1,TT)=0
end if
obj=obj+1
end if
end if
case "Project Back"
gosub [colorpick]
if cp$<>"" then projectback$=cp$
if cp$<>"" then ctrc$=cp$
gosub [drawgrid]
case "Project Fore"
gosub [colorpick]
if cp$<>"" then projectfore$=cp$
case "Grid Color"
gosub [colorpick]
if cp$<>"" then gridcolor$=cp$
gosub [drawgrid]
case "Border Color"
gosub [colorpick]
if cp$<>"" then bordercolor$=cp$
case "CrossHair"
gosub [colorpick]
if cp$<>"" then crosshair$=cp$
end select
#fful.color "select Set Color"
gosub [drawgrid]
gosub [drawall]
#fful.gb "setfocus"
wait
[windowtype]
#prop.cbwind "contents? projectwind$"
wait
[colorpick]
WindowWidth=230
WindowHeight=225
UpperLeftX = insertx
UpperLeftY = inserty
graphicbox #pick.gb,25,10,170,170
open "Color Pick" for dialog_nf_modal as #pick
#pick "font Consolas 9"
#pick "trapclose [quitpick]"
#pick.gb "down ; fill white ; flush"
cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white "
c=1
for yc=1 to 160 step 40
for xc= 1 to 160 step 40
#pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40
c=c+1
if c>15 then c=15
next
next
#pick.gb "when leftButtonDown [pick]"
wait
[pick]
xp=int(MouseX/40)
yp=int(MouseY/40)
c=xp+yp*4+1
cp$=word$(cl$,c)
[quitpick]
close #pick
return
[cthelp]
run "notepad help.txt"
wait
[code]
code = 1
goto [prev]
'control buttons
[bttnSTTX] i=1 : gosub [drawTool] : wait
[bttnTXBX] i=2 : gosub [drawTool] : wait : wait
[bttnLSTBX] i=3 : gosub [drawTool] : wait
[bttnCMBOBX] i=4 : gosub [drawTool] : wait
[bttnBTTN] i=5 : gosub [drawTool] : wait
[bttnBMPBTTN] i=6 : gosub [drawTool] : wait
[bttnGRPHCBX] i=7 : gosub [drawTool] : wait
[bttnRDBTTN] i=8 : gosub [drawTool] : wait
[bttnCHKBX] i=9 : gosub [drawTool] : wait
[bttnGRPBX] i=10 : gosub [drawTool] : wait
[bttnTXTEDTR] i=11 : gosub [drawTool] : wait
[bttnMNU] i=12 : gosub [drawTool] : wait
[negbarrier]
if negbar = 1 then
negbar = 0
#fful.negbarrier "Barrier -"
else
negbar = 1
#fful.negbarrier "No Barrier -"
end if
wait
[barrier]
if barrier = 1 then
barrier = 0
#fful.barrier "Barrier +"
else
barrier = 1
#fful.barrier "No Barrier +"
end if
wait
[block]
wait
[quitfful]
'save away current session to lastsession.ffu
open "lastsession.ffu" for output as #ses
#ses projectfile$
#ses projectwind$
#ses projectform$
#ses projecttitl$
#ses projectfont$
#ses projectback$
#ses projectfore$
#ses projectctrh
#ses projectgrid
#ses projectw
#ses projecth
for n=1 to obj
if obj(n,TT)<>0 then
#ses obj(n,XX);",";
#ses obj(n,Y);",";
#ses obj(n,W);",";
#ses obj(n,H);",";
#ses obj(n,TT);",";
#ses obj(n,TH)
#ses obj$(n,Ctr)
#ses obj$(n,Tex)
#ses obj$(n,Ress)
#ses obj$(n,Fon)
#ses obj$(n,Bak)
end if
next
close #ses
close #prop
close #prog
close #fful
fastGuiOpen = 0
#codeTank.fastgui "!enable"
wait
function replace$( text$ , this$, tothis$ )
while 1
if instr(text$, this$) then
f = instr(text$, this$)
lenght=len(this$)
text$ = mid$(text$,1,f-1);_
tothis$;mid$(text$,f+lenght)
else
exit while
end if
wend
replace$=text$
end function
sub pleasewait
global pleasewaitOpen
WindowWidth = 150 : WindowHeight = 170
UpperLeftX=int((DisplayWidth-WindowWidth)/2)'-100
UpperLeftY=int((DisplayHeight-WindowHeight)/2)'-500
statictext #pleasewait.text, "Please Wait", 30, 20, 100, 20
statictext #pleasewait.text2, "This Can Take", 40, 50, 100, 20
statictext #pleasewait.text3, " Take Up to", 25, 80, 100, 20
statictext #pleasewait.text4, "25 Secs / File", 20, 110, 110, 20
button #pleasewait.fake, "", [quit.pleasewait], ul, 0, 0, 0, 0
Open "untiltled" for dialog_popup as #pleasewait
#pleasewait "trapclose [quit.pleasewait]"
#pleasewait "font arial 12 bold"
pleasewaitOpen = 1
end sub
sub writeAutoSave
global autoSave$
autoSave$ = "autoSave.vbs"
open autoSave$ for output as #1
#1 "Set WshShell = WScript.CreateObject(";q$;"WScript.Shell";q$;")"
#1, "Do While Not WshShell.AppActivate(";q$;"Save *.TKN File As...";q$;")"
#1, "Loop"
#1, "Wscript.Sleep(500)"
#1, "WshShell.SendKeys ";q$;"{ENTER}";q$
#1, "Do While Not WshShell.AppActivate(";q$;"Information";q$;")"
#1, "Loop"
#1, "Wscript.Sleep(500)"
#1, "WshShell.SendKeys ";q$;"{ENTER}";q$
#1, "Wscript.Sleep(500)"
#1, "WshShell.AppActivate(";q$;"pleasewait";q$;")"
close #1
end sub
'function to retrieve Users Home Path (thanks to Brandon Parker)
Function GetSpecialFolder$(CSIDL)
S.OK = NULL
GetSpecialFolder$ = "Operation Failed"
pszPath$ = Space$(_MAX_PATH);chr$(0)
CallDLL #shell32, "SHGetFolderPathA", _NULL As ulong, _ 'hWnd is RESERVED
CSIDL As long, _ 'CSIDL value
_NULL As ulong, _ 'hToken is set to NULL to check the current token
0 As ulong, _ 'dwFlags is set to NULL to represent SHGFP_TYPE_CURRENT
pszPath$ As ptr, _ 'pszPath is where the path string will be stored upon return
ret As long
If (ret = S.OK) Then GetSpecialFolder$ = Trim$(pszPath$)
End Function
'edit date$() return for use in filenames
sub fixdate
global fixeddate$
fixDate$ = Date$() 'set up a date format that works with a filename(remove the /)
fix1$ =word$(fixDate$, 1, " ") ' = Month,
fix2$ = word$(fixDate$, 2, " ") ' = Month
fix2$ = left$(fix2$, len(fix2$)-1) ' = Number of day
fix3$ = word$(fixDate$, 3 ," ") ' = Year - 4 digits
fix3$ = right$(fix3$, 2) ' = Year - 2 digits
fixeddate$ = fix1$;"-";fix2$;"-";fix3$ ' = Month-NumberOfDay-Year
end sub
'edit Time$() return for use in filenames
sub fixtime
global fixedtime$
fixTime$ = Time$() 'set up a time format that works with a filename(remove the /)
fix1$ = word$(fixTime$, 1, ":")' - remove the "." 's
fix2$ = word$(fixTime$, 2 ,":")
fixedtime$ = "-";fix1$;"-";fix2$;"_"' ' add dashes -
end sub
sub resetRadioOptions
dictionary$ = "" : keyCount = 0 : lastKey$ = "" : selectedKey$ = ""
call readDictionary
call loadKeys
#codeTank.value, "!origin 0, 0 "
#codeTank.keys "select 0"
end sub
'function for checking file existence
function fileExists(path$, filename$)
dim info$(0, 0)
files path$, filename$, info$()
fileExists = val(info$(0, 0)) 'non zero is true
end function
'function for checking folder existence
function pathExists(path$)
pathExists = (mkdir(path$)=183)
end function
[textEdMirror]
if textedMOpen = 1 then #textedM.edMirror "!setfocus" : wait
WindowWidth = 700
WindowHeight = 500
texteditor #textedM.edMirror, 20, 20, 640, 400
button #textedM.incFont, "&+", [incEdFont], UL, 220, 0, 20, 23
button #textedM.decFont, "&-", [decEdFont], UL, 400, 0, 20, 23
button #textedM.mirror, "&ScratchPad", [scratch], UL, 250, 0, 140, 23
open "TextEditor Mirror" for Window as #textedM
#textedM "trapclose [quit.textedM]"
#codeTank.value "!contents? code$"
#textedM.edMirror code$
#textedM "Font Arial 12"
EdMirFont = 12
#textedM.edMirror, "!setfocus"
#textedM.edMirror "!origin 0 0"
textedMOpen = 1
#textedM.edMirror "!autoresize"
if selectedKey$ = "" then [setCatScratch]
wait
[scratch]
#codeTank.savedprojects "reset"
#textedM.edMirror "!contents? code$"
#codeTank.value "!cls"
#codeTank.value code$
call saveValue
mir = 1 : gosub [deleteOrig]
mir = 0
[setCatScratch]
newKey$ = selectedKey$
if categorie$ = "" or selectedKey$ = "" then
categorie$ = "ScratchPad" : selectedKey$ = "Scratch"
end if
call setValueByName newKey$, ""
call loadKeys
open categorie$ for append as #1
#1 chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134)+selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 code$
close #1
call resetRadioOptions
call readDictionary
call loadKeys
#codeTank.value "!cls"
categorie$ = "ScratchPad"
selectedKey$ = "Scratch"
#textedM.edMirror "!cls"
#textedM.edMirror, "!setfocus"
#textedM.edMirror, "!origin 0 0"
wait
[incEdFont]
EdMirFont = EdMirFont + 1
#textedM.edMirror "!font Arial ";EdMirFont
wait
[decEdFont]
EdMirFont = EdMirFont - 1
#textedM.edMirror "!font Arial ";EdMirFont
wait
[quit.pleaseWait]
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
wait
[quit.textedM]
call saveValue
#textedM.edMirror "!contents? code$"
close #textedM : textedMOpen = 0
#codeTank.value "!cls"
#codeTank.value code$
#codeTank.value "!origin 0 0"
mir = 1 : gosub [deleteOrig]
mir = 0
call setValueByName newKey$, ""
call loadKeys
#codeTank.keys "select "; newKey$
if categorie$ = "" then
categorie$ = "ScratchPad" : selectedKey$ = "Scratch"
end if
open categorie$ for append as #1
#1 chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134)+selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 code$
close #1
call resetRadioOptions
call readDictionary
call loadKeys
#codeTank.value "!cls"
#codeTank.keys "select 0"
wait
'quit program
[quit.codeTank]
if textedMOpen = 1 then
text$ = "Quiting will close the Editor Mirror"+chr$(13)+chr$(13)
text$ = text$+"Quit Anyway?"+chr$(13)
a$ = custcon$(text$)
if answer$ <> "Yes" then wait
end if
call saveValue
gosub [cleanUp]
if pickOpen = 1 then close #pick : pickOpen = 0
if fastcodeOpen = 1 then close #fastcode : fastcodeOpen = 0
if propOpen = 1 then close #prop : propOpen = 0
if progOpen = 1 then close #prog : progOpen = 0
if resultsOpen = 1 then close #results : resultsOpen = 0
if mainListOpen = 1 then close #codeTankList : mainListOpen = 0
if fastGuiOpen = 1 then close #fful : fastGuiOpen = 0
if textedMOpen = 1 then close #textedM : textedMOpen = 0
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
if codetankOpen = 1 then close #codeTank : codetankOpen = 0
if customconfirmOpen = 1 then close #customconfirm : customconfirmOpen = 0
end
'sub to create pauses in program
sub pause mil
t=time$("ms")+mil
while time$("ms")<t
scan
wend
end sub
'sub to save current Dictionary Listings and text in texeditor
sub saveValue 'if the value is changed, save it
if lastKey$ <> "" then
#codeTank.value "!modified? modified$";
if modified$ = "true" then
#codeTank.value "!contents? saveThisValue$";
call setValueByName lastKey$, saveThisValue$
call collectGarbage
call writeDictionary
end if
end if
end sub
'function to get selected Listing
function getKeys$(delimiter$)
global keyCount
pointer = 1
while pointer <> 0
'get the next key
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), pointer)
if pointer then
keyPointer = pointer + 9
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), pointer)
key$ = mid$(dictionary$, keyPointer, pointer - keyPointer)
if instr(keyList$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)) = 0 then
getKeys$ = getKeys$ + key$ + delimiter$
keyList$ = keyList$ + chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$
keyCount = keyCount + 1
end if
end if
wend
end function
'sub to write each Listing to corresponding file
sub writeDictionary
if categorie$ = "" then categorie$ = "ScratchPad"
if categorie$ = "ScratchPad" then
open DefaultDir$;"\";categorie$ for append as #writeDict
#writeDict date$();time$()
goto [writeit]
end if
open DefaultDir$;"\";categorie$ for output as #writeDict
[writeit]
#writeDict, dictionary$
close #writeDict
end sub
'sub to read each Listing from corresponding file
sub readDictionary
if fileExists(DefaultDir$, categorie$) <> 0 then
open categorie$ for input as #readDict
length = lof(#readDict)
dictionary$ = input$(#readDict, length)
close #readDict
else
end if
end sub
'sub to cleanup any mess in the dictionary text
sub collectGarbage
pointer = 1
while pointer > 0
'get the next key
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), pointer)
if pointer then
keyPointer = pointer + 9
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), pointer)
key$ = mid$(dictionary$, keyPointer, pointer - keyPointer)
if instr(keyList$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)) = 0 then
value$ = getValue$(key$)
newDictionary$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134) + value$ + newDictionary$
keyList$ = keyList$ + chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
end if
end if
wend
dictionary$ = newDictionary$
end sub
sub setValueByName key$, value$
dictionary$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134);key$;chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)+value$+dictionary$
end sub
'function to get info from selected Listing
function getValue$(key$)
getValue$ = chr$(0)
keyPosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134)+key$+chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134))
if keyPosition > 0 then
keyPosition = keyPosition + 9 'skip over key tag
valuePosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), keyPosition)
if valuePosition > 0 then
valuePosition = valuePosition + 11 'skip over value tag
endPosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), valuePosition)
if endPosition > 0 then
getValue$ = mid$(dictionary$, valuePosition, endPosition - valuePosition)
else
getValue$ = mid$(dictionary$, valuePosition)
end if
end if
end if
end function
'sub to load selected categorie List
sub loadKeys
keyList$ = getKeys$(chr$(134);chr$(165);chr$(134))
redim keys$(keyCount)
for item = 1 to keyCount
keys$(item-1) = word$(keyList$, item, chr$(134);chr$(165);chr$(134))
next item
sort keys$(), 0, keyCount
#codeTank.keys "reload"
keyCount = 0
end sub
'function to separate filename from full path to file
function GetFilename$(fileName$)
i = len(fileName$)
while mid$(fileName$, i, 1) <> "\" and mid$(fileName$, i, 1) <> ""
i = i-1
wend
GetFilename$ = mid$(fileName$, i+1)
end function
'function to delete entire folder (including sub folders and files)
function delete$(folder$)
run "cmd.exe /c rd /s /q ";q$;folder$;q$, HIDE
end function
'function makes customized confirmation window
function custcon$(text$)
global text$, customconfirmOpen, a$, answer$, fault
WindowWidth = 540 : WindowHeight = 300
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
statictext #customconfirm.header "Notice to User", 190, 10, 130, 30
statictext #customconfirm.text text$, 40, 60, 490, 120
button #customconfirm.default "&OK", [confirmYes], ul, 220, 200, 80, 35
button #customconfirm.yes "&Yes", [confirmYes], ul, 100, 200, 120, 35
button #customconfirm.no "&No", [confirmNo], ul, 320, 200, 120, 35
open "Confirmation Required" for dialog_modal as #customconfirm
#customconfirm "trapclose [confirmNo]"
#customconfirm "font arial 12"
customconfirmOpen = 1
#customconfirm.default "!hide"
wait
[confirmNo]
answer$ = "No"
if customconfirmOpen = 1 then close #customconfirm : customconfirmOpen = 0
goto [endFunction]
[confirmYes]
answer$ = "Yes"
if customconfirmOpen = 1 then close #customconfirm : customconfirmOpen = 0
[endFunction]
end function
FUNCTION FN.Screen(BYREF Szx, BYREF Szy)
Szx = DisplayWidth
Szy = DisplayHeight
FN.Display = Szx * Szy
END FUNCTION
FUNCTION FN.PercentScreen(PercentX, PercentY, BYREF Szx, BYREF Szy)
Szx = INT(DisplayWidth * PercentX)
Szy = INT(DisplayHeight * PercentY)
FN.PercentScreen = Szx * Szy
END FUNCTION
FUNCTION FN.ScreenCenter(BYREF Cx, BYREF Cy)
Cx = INT(DisplayWidth * 0.5)
Cy = INT(DisplayHeight * 0.5)
FN.ScreenCenter = Cx * Cy
END FUNCTION
FUNCTION FN.SetWinPos(PosX, PosY)
UpperLeftX = PosX
UpperLeftY = PosY
FN.SetWinPos = PosX * PosY
END FUNCTION
FUNCTION FN.SetWinSize(Szx, Szy)
WindowWidth = Szx
WindowHeight = Szy
FN.SetWinSize = Szx * Szy
END FUNCTION
sub resized handle$
TxbUx = 100 '<--- location and size of text box
TxbUy = 50
Txbsx = 100
Txbsy = 25
Txbsx = WindowWidth - TxbUx - Txbsx '<--- resize text box
#codeTank.numLines, "!LOCATE ";WindowWidth-130;" "; 50;" ";120;" "; 25
#codeTank.filePath, "!LOCATE ";TxbUx;" ";TxbUy;" ";Txbsx-30;" ";Txbsy
#codeTank.keys, "LOCATE ";100;" ";75;" ";340;" ";WindowHeight-600+60+270
#codeTank, "REFRESH"
end sub
'sub to make folder dialog window
sub browser caption$
dim info$(0, 0)
dim folderInfo$(0, 0)
WindowWidth = 700
WindowHeight = 500
UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
gosub [FolderDlgGetDrives]
statictext #folderdlg.selection, "Selection >> ", 40, 505, 95, 15
statictext #folderdlg.caption, caption$, 150, 20, 525, 35
listbox #folderdlg.filelist, fileList$(, [fileSelect], 350, 50, 320, 310
listbox #folderdlg.list, FolderList$(, [FolderDlgSelect], 15, 50, 320, 310
button #folderdlg.default, "OK", [FolderDlgOk], UL, 220, 410, 75, 25
button #folderdlg.back, "< < <", [FolderDlgBack], UL, 10, 10, 60, 30
button #folderdlg.C, "Cancel", [FolderDlgCancel], UL, 395, 410, 75, 25
button #folderdlg.plusfont, "+", [plusFont], UL, 75, 10, 30, 30
button #folderdlg.minusfont, "-", [minusFont], UL, 110, 10, 30, 30
textbox #folderdlg.text, 15, 360, 655, 25
BackgroundColor$ = "lightgray"
open "Liberty Basic File Browser" for dialog_modal as #folderdlg
#folderdlg, "trapclose [FolderDlgCancel]"
#folderdlg.text, "Selected (Drive \ Folder \ File) Path Appears Here"
#folderdlg, "font Arial 12 bold"
#folderdlg.filelist, "singleclickselect"
#folderdlg.list, "singleclickselect"
fontsize = 12
wait
[minusFont]
fontsize = fontsize - 1
#folderdlg.list, "font arial ";fontsize;" bold"
#folderdlg.filelist, "font arial ";fontsize;" bold"
wait
[plusFont]
fontsize = fontsize + 1
#folderdlg.list, "font arial ";fontsize;" bold"
#folderdlg.filelist, "font arial ";fontsize;" bold"
wait
[FolderDlgSelect]
#folderdlg.list, "selection? temp$"
if temp$ <> "" then
level = level+1
folder$ = folder$; temp$; "\"
#folderdlg.text, folder$
gosub [FolderDlgGetDir]
#folderdlg.list, "reload"
#folderdlg.list, "select 0"
#folderdlg.default "!setfocus"
end if
wait
[FolderDlgBack]
if level > 0 then
level = level-1
if level = 0 then
folder$ = ""
gosub [FolderDlgGetDrives]
else
i = len(folder$)-1
while mid$(folder$, i, 1) <> "\" and mid$(folder$, i, 1) <> ""
i = i-1
wend
folder$ = left$(folder$, i)
gosub [FolderDlgGetDir]
end if
#folderdlg.text, folder$
fileList$(0) = " F I L E S"
#folderdlg.list, "reload"
#folderdlg.filelist, "reload"
end if
wait
[FolderDlgGetDrives]
c = 1
while word$(Drives$, c) <> ""
c = c+1
wend
redim FolderList$(c)
FolderList$(0) = " D R I V E S"
for i = 1 to c
FolderList$(i) = word$(Drives$, i)
next i
redim fileList$(0)
return
[FolderDlgGetDir]
files folder$, info$(
s = val(info$(0,0))
tt = val(info$(0,1))
redim FolderList$(tt)
FolderList$(0) = " F O L D E R S"
for i = 1 to tt
FolderList$(i) = info$(i+s, 1)
next i
[filesBack]
files folder$, "*.*", folderInfo$()
numFiles = val(folderInfo$(0, 0))
redim fileList$(numFiles)
for x = 1 to numFiles
filename$ = folderInfo$(x, 0)
fileList$(x) = filename$
next x
fileList$(0) = " F I L E S"
sort fileList$(), 0 , numFiles
#folderdlg.filelist, "reload"
return
[fileSelect]
#folderdlg.filelist "selection? file$"
#folderdlg.text, folder$;file$
wait
[FolderDlgOk]
#folderdlg.text, "!contents? FolderDialog$"
If right$(FolderDialog$,1) = "\" then
if right$(FolderDialog$, 2) = ":\" then [goAround]
FolderDialog$ = left$(FolderDialog$, len(FolderDialog$) - 1)
else
[goAround]
notice "The Selection was Not a Folder" : close #folderdlg : wait
end if
[FolderDlgCancel]
close #folderdlg
end sub
sub quit fast$
close #fastcode
fastcodeOpen = 1
end sub
'sub to generate the window code and copy to clipboard, and texeditor
sub dummy fast$
global toPrint$
select case
case fast$ = "#fastcode.button1"
#fastcode.txt1 "!contents? txt$"
#fastcode.txt2 "!contents? theName$"
#fastcode.r1 "value? result$"
if result$="set" then
itag$="["
otag$="]"
closingCode$= "[quit]";chr$(13);_
" close ";txt$;chr$(13);_
" end"
else
closingCode$ = "Sub quit fast$";chr$(13);_
" close #fast$" ;chr$(13);_
" end";chr$(13);_
"End Sub"
end if
#fastcode.combo "selection? sel$"
if instr(sel$,"popup") then
includeButton$= "button ";txt$;".button1 ";chr$(34);_
"&X";chr$(34);", "; itag$;"quit";otag$;", ul, 610, 5, 25, 20"
end if
toPrint$ = "nomainwin";chr$(13);"WindowWidth = 640";chr$(13);"WindowHeight = 480";chr$(13);_
"UpperLeftX=int((DisplayWidth-WindowWidth)/2)";chr$(13);_
"UpperLeftY=int((DisplayHeight-WindowHeight)/2)";chr$(13);_
includeButton$;chr$(13);_
"Open ";chr$(34);theName$;chr$(34);" for ";sel$; " as ";txt$;chr$(13);_
" ";txt$;" "; chr$(34); "trapclose ";itag$;"quit";otag$; chr$(34);chr$(13);_
"wait";chr$(13);chr$(13);_
closingCode$
#fastcode.ed "!cls"
#fastcode.ed toPrint$
#fastcode.ed "!selectall"
#fastcode.ed "!copy"
#fastcode.ed "!paste"
#fastcode.ed "!origin 0 0"
end select
end sub
function getsize$(l$)
'what if it is a variable?
v$=""
pos=1
n$=mid$(l$,pos,1)
while instr("1234567890",n$,1)=0 and pos<len(l$)
pos=pos+1
n$=mid$(l$,pos,1)
wend
while n$>="0" and n$<="9" and pos<=len(l$)
v$=v$+n$
pos=pos+1
n$=mid$(l$,pos,1)
wend
getsize$=v$
end function
function getcolor$(l$)
if l$="palegray" then l$="lightgray"
'what if it is a variable?
cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black "
for c= 1 to 15
if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for
next
if getcolor$="" then getcolor$="white"
end function
function value(x$)
select case len(x$)
case 1
value = asc(x$)
case 2
value=asc(mid$(x$,1,1))
value=value+(asc(mid$(x$,2,1))*256)
case 3
value=asc(mid$(x$,1,1))
value=value+(asc(mid$(x$,2,1))*256)
value=value+(asc(mid$(x$,3,1))*65536)
case 4
value=asc(mid$(x$,1,1))
value=value+(asc(mid$(x$,2,1))*256)
value=value+(asc(mid$(x$,3,1))*65536)
value=value+(asc(mid$(x$,4,1))*16777216)
end select
end function
'subroutine for selections of combo boxes
sub asciiSelected asciiList$
#codeTank.asciiList, "selection? asciiChoice$"
#codeTank.filePath asciiChoice$
#codeTank.fake "!cls"
#codeTank.fake asciiChoice$
#codeTank.fake "!selectall"
#codeTank.fake "!copy"
#codeTank.asciiList, "! ASCII Codes"
end sub
sub getAscii
dim asciiList$(250)
y = 7
asciiList$(0)= " Controls"
asciiList$(1) = " chr$(0) = (nul) ";chr$(0)
asciiList$(2) = " chr$(27) = (escape) ";chr$(27)
asciiList$(3) = " chr$(32) = (space) ";chr$(32)
asciiList$(4) = " chr$(13) = (enter) ";chr$(13)
asciiList$(5) = " Printables"
asciiList$(6) = " chr$(32)= (space) ";chr$(32)
for x = 33 to 255
asciiList$(y) = " chr$(";x;") = ";chr$(x)
y = y + 1
next x
#codeTank.asciiList, "reload"
#codeTank.asciiList, "! ASCII Codes"
end sub
sub lbreservedwordSelected lbReservedwordList$
#codeTank.lbreservedwordsList, "selection? lbreserved$"
#codeTank.filePath lbreserved$
#codeTank.fake "!cls"
#codeTank.fake lbreserved$
#codeTank.fake "!selectall"
#codeTank.fake "!copy"
#codeTank.lbreservedwordsList "select 0"
#codeTank.lbreservedwordsList "! Reserved Words"
end sub
sub getlbreservedwords
global lbReservedWords$
dim lbreservedwordsList$(250)
for x = 0 to 250
filename$ = word$(lbReservedWords$, x ,",")
lbreservedwordsList$(x) = filename$
next x
sort lbreservedwordsList$(), 1 ,250
#codeTank.lbreservedwordsList, "reload"
#codeTank.lbreservedwordsList "! Reserved Words"
end sub
[LBB_EXE]
LBB = 0
LBB$ = DefaultDir$;"\LBB.exe"
cursor hourglass
fname0$ = GetFilename$(fname$)
open DestPath1$;"\";fname0$ for input as #1
open DefaultDir$;"\EXE\";fname0$ for output as #2
temp$ = input$(#1, lof(#1))
#2 temp$
close #1
close #2
call writeAutoSaveLBB
run "wscript ";autoSaveLBB$
run LBB$;" -C -M -A ";DefaultDir$;"\EXE\";fname0$
fname1$ = fnamenobas$;".exe"
while fileExists(DefaultDir$;"\EXE", fname1$) = 0
scan
wend
call pause 10000
fullname$ = DefaultDir$;"\EXE\";fnamenobas$;ve$;"_";fixeddate$;fixedtime$;".exe"
if fileExists(DefaultDir$;"\EXE", fname1$) then
name DefaultDir$;"\EXE\";fname1$ as fullname$
end if
if fileExists(DefaultDir$;"\EXE", fnamenobas$;".bas") then
name DefaultDir$;"\EXE\";fnamenobas$;".bas" as DefaultDir$;"\EXE\";fnamenobas$;ve$;"_";fixeddate$;fixedtime$;".bas"
end if
print x
x=0
goto [LBB_RETURN]
return
sub writeAutoSaveLBB
global fullname$
q$ = chr$(34)
global autoSaveLBB$, fname1$, fname$, fnamenobas$
autoSaveLBB$ = "autoSaveLBB.vbs"
open autoSaveLBB$ for output as #1
dir$ = DefaultDir$;"\EXE"
#1 "Set FSO = CreateObject(";q$;"Scripting.FileSystemObject";q$;")"
#1 "Set objFolder = FSO.GetFolder(";q$;dir$;q$;")"
#1 "Set objFiles = objFolder.Files "
#1 "Set WshShell = WScript.CreateObject(";q$;"WScript.Shell";q$;")"
#1 "Do While Not WshShell.AppActivate(";q$;"Save standalone executable";q$;")"
#1 "Loop"
#1 "WshShell.AppActivate(";q$;"Save standalone executable";q$;")"
#1 "WshShell.SendKeys ";q$;"{ENTER}";q$
#1 "For i=0 to objFiles.Count"
#1 "If FSO.FileExists(";q$;"EXE\";fnamenobas$;".exe";q$;") Then exit for"
#1 "Next"
#1, "Do While Not WshShell.AppActivate(";q$;"LB Booster";q$;")"
#1 "Loop"
#1 "Wscript.Sleep(10000)"
#1 "WshShell.AppActivate(";q$;"LB Booster";q$;")"
#1 "Wscript.Sleep(300)"
#1 "WshShell.SendKeys ";q$;"{ENTER}";q$
#1 "Set WshShell = nothing"
#1 "Set FSO = nothing"
#1 "Set objFolder = nothing"
#1 "Set objFiles = nothing"
close #1
end sub
|
|
|
|
Post by Admin on Sept 25, 2023 14:17:03 GMT
Another update to CodeTankPlus is available.
Fixes a few issues that went unnoticed in the previous version.
Batch creations of exe files working.
CodeTankPlus v1.8.3
'CodeTank v1.8.3F - For Liberty Basic v4.5.1 and (Pro)
'created by xxgeek Aug 2023
'This app uses "Dictionary" code, written by Carl Gundel, at it's core
'This app also uses FastCode written by cundo - a member of the JustBasic Forums
'This app also uses a Help search engine originally created by cundo - (orig name = JB Search)
'This app also uses a version of FFUL(FreeFormUltraLite) written by Rod - Admin at both JB and LB Forums
' All edited to suit this app
'Purposes -
' (1) To create reservoir(s) of code, subs, functions, scripts and example programs with ability to share_
'_ with others each category file, to merge with their own reservoir(s).
' (2) To automate the collection of support dll and sll files along with TKN file creation and renaming_
'_ of the run451.exe, and to automate the creation of EXE files with 3 differing methods
' (3) To create dated\timestamped backups of each .bas file, and a .tkn backup file of each .bas_
'_ file to 'Revert' back if\when needed.
'Use alt +
' Char Button
' c = [copy] - copies selected code in editor
' d = [Delete] - deletes a selected listing, and offers to delete it's project files as well
' e = [Create Single &EXE File] - creates a single EXE file from a selected BAS file
' f = [New From File] - user selects the file to add to the listing using filedialog
' g = [Merge File] - merge a file of a particular 'categorie' with another , possibly downloaded file
' l = [Edit in LB IDE] - opens selected code in LB IDE
' m = [Mirror Editor] - opens a window with a full screen editor mirroring the existing one.
' n = [New (Copy\Paste)] - Create a 'New' listing manually (not from a file)
' p = [paste] - pastes code into editor at location of I-Beam
' r = [RUN] - runs selected listing
' s = [Select All] - selects all the text in the texteditor
' s = [Scratch] button - on the Mirror window
' t = [Update TKN] - updates the TKN file of a selected listing (MyProjects, and MyPrograms ONLY)
' u = [cut] - cuts selected text from editor
' v = [Revert to Backup] - Overwrites the files of a selected listing with a selected backup
' + = Increase Font Size [+]
' - = Decrease Font Size [-]
'WARNING - Save to a folder of it's own, it creates files, and folders when used.
' Please Note:
' When selecting a .bas file to create a New Project, or Program.......
' Make sure the .bas file is a known good one, and runs/starts ok in the LB IDE
' If the .bas file cannot pass the compiler's check, it can cause havoc with the automation'
' process, and probably crash CodeTank.
'When RUNing any files be aware that the file you are running 'MAY' be the culprit if a problem arises.
'The LB IDE may stay open, along with a mainwin, and the user must close both manually.
'For help using CodeTank visit the Liberty Basic forums
' @ https://libertybasiccom.proboards.com/
'on error goto [abort]
nomainwin
gosub [initiate]
[start]
dim searchList$(500), info$(0,0), oneOf$(2500), mainList$(500) 'declare some variables
global LBpath$, helpFilePath$, fname$
helpFilePath$ = LBpath$;"\lb4help\LibertyBASIC_4_web"
helpFileMenu$ = "amber_menu.htm"
'dim arrays for key$ and info$
dim key$(1000)
dim info$(500, 500)
global toPrint$
res = mkdir("EXE")
'declare variables
q$ = chr$(34)
codeTank$ = "#codeTank"
LBruntime$ = "run451.exe"
lbReservedWords$ = " AND, APPEND, AS, BEEP, BMPBUTTON, BMPSAVE, BUTTON, BYREF, CALL, CALLDLL, CALLFN, CASE, CHECKBOX, CLOSE, CLS, COLORDIALOG, COMBOBOX, CONFIRM, CURSOR, DATA, DIALOG, DIM, DLL, DO, DUMP, DWORD, ELSE, END, ERROR, EXIT, FIELD, FILEDIALOG, FILES, FONTDIALOG, FOR, FUNCTION, GET, GETTRIM, GLOBAL, GOSUB, GOTO, GRAPHICBOX, GRAPHICS, GROUPBOX, IF, INPUT, INPUTCSV, KILL, LET, LINE, LISTBOX, LOADBMP, LONG, LOOP, LP, PRINT, MAINWIN, MAPHANDLE, MENU, NAME, NEXT, NOMAINWIN, NOTICE, ON, ONCOMERROR, OR, OPEN, OUTPUT, PASSWORD, PLAYMIDI, PLAYWAVE, POPUPMENU, PRINT, PRINTERDIALOG, PROMPT, PUT, PTR, RADIOBUTTON, RANDOM, RANDOMIZE, READ, READJOYSTICK, REDIM, REM, RESTORE, RESUME, RETURN, RUN, SCAN, SELECT, SHORT, SORT, STATICTEXT, STOP, STOPMIDI, STRUCT, SUB, TEXT, TEXTBOX, TEXTEDITOR, THEN, TIMER, TITLEBAR, TRACE, ULONG, UNLOADBMP, UNTIL, USHORT, VOID, WAIT, WINDOW, WEND, WHILE, XOR, ABS(, ACS(, AFTER$(, AFTERLAST$(, ASC(, ASN(, ATN(, CHR$(, COS(, DATE$(, DECHEX$(, EOF(, HBMP(, HEXDEC(, HTTPGET$(, HWND(, INP(, INPUT$(, INPUTTO$(, INSTR(, INT(, LEFT$(, LEN(, LOF(, LOG(, LOWER$(, MAX(, MIDIPOS(, MID$(, MIN(, MKDIR(, NOT(EXP(, HEXDEC(, INPUT$(, INPUTTO$(, INSTR(, INT(, LEFT$(, LEN(, LOF(, LOG(, LOWER$(, MAX(, MIDIPOS(, MID$(, MIN(, MKDIR(, NOT(, REMCHAR$(, REPLSTR$(, RIGHT$(, RMDIR(, RND(, SIN(, SPACE$(, SQR(, STR$(, TAB(, TAN(, TIME$(, TRIM$(, TXCOUNT(, UPPER$(, UPTO$(, USING(, VAL(, WINSTRING(, WORD$(, BackgroundColor$, ComboboxColor$, CommandLine$, DefaultDir$, DisplayHeight, DisplayWidth, Drives$, Err, Err$, ForegroundColor$, Joy1x, Joy1y, Joy1z, Joy1button1, Joy1button2, Joy2x, Joy2y, Joy2z, Joy2button1, Joy2button2, ListboxColor$, Platform$, PrintCollate, PrintCopies, PrinterFont$, PrinterName$, TextboxColor$, TexteditorColor$, Version$, WindowHeight, WindowWidth, UpperLeftX, UpperLeftY"
DllList$="vbas31w.sll vgui31w.sll voflr31w.sll vthk31w.dll vtk1631w.dll vtk3231w.dll vvm31w.dll vvmt31w.dll"
savedProjects$ = "savedProjects"
MyProjects$ = "MyProjects"
MyBackups$ = "MyBackups"
programs$ = "Programs"
vbs$ = "VBS-Scripts"
cmd$ = "CMD-Scripts"
examples$ = "Examples"
snippets$ = "Snippets"
lbExamples$ = "LB-Examples"
lbBakFiles$ = "LB-BAK-Files"
subroutines$ = "Subroutines"
functions$ = "Functions"
mainFontsize = 10
project = 1
WinWide = 1000 '1000
WinHigh = 600
UserMonitorResx = 1000 '800
UserMonitorResy = 600 '600
IF UserMonitorResx < WinWide THEN
Diff = WinWide - UserMonitorResx
WinWide = WinWide - Diff
END IF
IF UserMonitorResy < WinHigh THEN
Diff = WinHigh - UserMonitorResy
WinHigh = WinHigh - Diff
END IF
RetVal = FN.ScreenCenter(Cx, Cy) '<--- get screen center
RetVal = FN.SetWinPos(Cx - INT(WinWide / 2), Cy - INT(WinHigh / 2)) '<--- set window pos
RetVal = FN.SetWinSize(WinWide, WinHigh) '<--- set window size
UpperLeftX= int((DisplayWidth-WindowWidth)/2)-70
UpperLeftY= int((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "lightgray"
menu #codeTank, "File" , "Open Liberty Basic", [openlb], "Open a File in Liberty Basic", [openlbFile], "Exit", [quit.codeTank]
menu #codeTank, "Edit"
menu #codeTank, "Browse" , "My Projects", [projectsDir], ".EXE Files", [EXEDir], ".TKN Files", [tknDir], ".BAS Files", [basFiles],"DefaultDir$", [defaultDir],"LB Code Examples", [lbexamplesDir]
menu #codeTank, "Help" , "Liberty Basic Forums", [forumlink], "Help", [codeTankHelp], "About", [about]
texteditor #codeTank.value, 440, 75, 545, 425
stylebits #codeTank.keys, _WS_HSCROLL, 0, 0, 0
listbox #codeTank.keys, keys$(), [keySelected], 100, 75, 340, 270
'category radio buttons
radiobutton #codeTank.savedprojects, "MyProjects", [projs], resetHandler, 5, 90, 95, 20
radiobutton #codeTank.programs, "MyPrograms", [progs], resetHandler, 5, 110, 95, 20
radiobutton #codeTank.backups, "MyBackups", [mybackups], resetHandler, 5, 140, 95, 20
radiobutton #codeTank.examples, "Examples", [exams], resetHandler, 5, 170, 80, 20
radiobutton #codeTank.snippets, "Snippets", [snipps], resetHandler, 5, 190, 95, 20
radiobutton #codeTank.subroutines, "Subroutines", [subroutines], resetHandler, 5, 210, 95, 20
radiobutton #codeTank.functions, "Functions", [functions], resetHandler, 5, 230, 95, 20
radiobutton #codeTank.VBS, "VBS-Scripts", [vbs], resetHandler, 5, 250, 95, 20
radiobutton #codeTank.CMD, "CMD-Scripts", [cmd], resetHandler, 5, 270, 95, 20
radiobutton #codeTank.lbexamples, "LB-Examples", [lbCodeExamples], resetHandler, 5, 305, 95, 20
radiobutton #codeTank.lbbakfiles, "LB-BakFiles", [lbbakfiles], resetHandler, 5, 325, 95, 20
radiobutton #codeTank.folderChoice, "Any Folder", [folderChoice], resetHandler, 5, 355, 95, 20
'Event buttons etc
wh=WinHigh-100
button #codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1)), [newKey], LL, 270, wh-365, 165, 25
button #codeTank.fromFile, "New from &File", [makeproject], LL, 105, wh-365, 155, 25
button #codeTank.remakeproject, "Update &TKN File", [remakeproject], LL, 105, wh-415, 155, 25
button #codeTank.runlb, "Edit Item in &Liberty Basic", [edit_In_LB_IDE], LL, 105, wh-390, 155, 25
button #codeTank.merge, "Mer&ge Shared File ";categorie$, [mergeFile], LL, 270, wh-415, 165, 25
button #codeTank.runListing, "&Run", [runKey], LL, 270, wh-390, 165, 25
button #codeTank.revert, "Re&vert to Backup", [revert], LL, 105, wh-440, 155, 25
button #codeTank.deleteListing, " &Delete ", [deleteKey], LL, 270, wh-440, 165, 25
button #codeTank.exe, "BAS<2>&EXE (Automated)", [GUI], LL, 185, wh-520, 165, 30
button #codeTank.IEXP_man, "IEXPRESS Manually", [IEXP_man], LL, 105, wh-465, 155, 25
button #codeTank.lbbEX_man, "LB Booster Manually", [lbbEX_man], LL, 270, wh-465, 165, 25
button #codeTank.lbbFileEdit, "Edit File in LB Booster", [lbbEdit], LL, 270, wh-490, 165, 25
button #codeTank.lbbSelEdit, "Edit Item in LB Booster", [lbbSelEdit], LL, 105, wh-490, 155, 25
button #codeTank.incFont, "&+", [incFont], UL, 25, 390, 20, 23
button #codeTank.decFont, "&-", [decFont], UL, 50, 390, 20, 23
button #codeTank.mirror, "&Mirror Editor", [textEdMirror], UL, 5, 425, 95, 25
button #codeTank.cut, "C&ut", [cut], LL, 560, wh-520, 65, 20
button #codeTank.copy, "&Copy", [copy], LL, 630, wh-520, 65, 20
button #codeTank.selectAll, "Select &All", [selectall], LL, 700, wh-520, 85, 20
button #codeTank.paste, "&Paste", [paste], LL, 790, wh-520, 85, 20
button #codeTank.fastwindows, "&Fast Windows", [fastcode], ul, 5, 460, 95, 25
button #codeTank.fastgui, "&Fast GUI's", [fastGui], UL, 5, 495, 90, 25
textbox #codeTank.filePath, 100, 50, WinWide-235, 25
statictext #codeTank.categories, "Categories", 20, 60, 80, 15
combobox #codeTank.asciiList, asciiList$(), asciiSelected , 320, 2, 150, 12
combobox #codeTank.lbreservedwordsList, lbreservedwordsList$(), lbreservedwordSelected , 475, 2, 170, 10
textbox #codeTank.tb 175, 27, 120, 23
statictext #codeTank.searchFor, "Search For", 105, 30, 65, 15
textbox #codeTank.numLines, 860, 50, 120, 25
button #codeTank.searchlb, "&Search | IN >", [startSearching], UL, 325, 27, 120, 23
button #codeTank.incFont, "&+", [incFontSearch], UL, 710, 27, 25, 23
button #codeTank.decFont, "&-", [decFontSearch], UL, 740, 27, 25, 23
button #codeTank.contents, "&LB Help Menu", [Contents], UL, 770, 27, 100, 25
button #codeTank.help, "?", [searchhelp], UL, 300, 27, 20, 23
checkbox #codeTank.lbhelp, "Help", [lbHelp], [nolbHelp], 455, 30, 45, 15
checkbox #codeTank.lbexamples, "Examples Code ", [lbexamples], [nolbexamples], 510, 30, 110, 15
checkbox #codeTank.cbank, "CodeTank", [cbank], [nocbank], 625, 30, 80, 15
texteditor #codeTank.fake, 0, 0, 0, 0
open "CodeTank Plus v1.8.3F" for window as #codeTank
#codeTank.addListing "!disable"
#codeTank.deleteListing "!disable"
#codeTank.remakeproject "!disable"
#codeTank.runListing "!disable"
#codeTank.runlb "!disable"
#codeTank.fromFile "!disable"
#codeTank.merge "!disable"
#codeTank.revert "!disable"
#codeTank "trapclose [quit.codeTank]"
#codeTank "font Arial ";mainFontsize
call getlbreservedwords
call getAscii
#codeTank.keys "singleclickselect"
#codeTank.value "!autoresize"
#codeTank "resizehandler resized"
#codeTank.lbhelp "set"
lbHelp = 1
codetankOpen = 1
categorie$ = "ScratchPad"
open "ScratchPad" for append as #1 : #1 date$();time$() : close #1
wait
'[abort]
'Notice "An Error Has Occured";chr$(13);"Error #";Err;" ";chr$(13);Err$;" ";chr$(13);"CodeTank will need to Shutdown"
'goto [quit.codeTank]
[selectall]
#codeTank.value "!selectall"
wait
[cut]
#codeTank.value "!cut"
wait
[copy]
#codeTank.value "!copy"
wait
[paste]
#codeTank.value "!paste"
wait
[IEXP_man]
run "IEXPRESS"
wait
[lbbEX_man]
filedialog "Open a Liberty Basic Source File (.bas) ", "*.bas", fname$
if fname$ = "" then wait
if fileExists(DefaultDir$,"LBB.exe") then run DefaultDir$;"\LBB.exe -C -M -A ";fname$
wait
[lbbEdit]
filedialog "Open a Liberty Basic Source File (.bas) ", "*.bas", fname$
if fname$ = "" then wait
if fileExists(DefaultDir$,"LBB.exe") then run DefaultDir$;"\LBB.exe ";fname$
wait
[lbbSelEdit]
if selectedKey$ = "" then notice "Select an item from a list, try again" : wait
#codeTank.value, "!contents? valueNow$";
open "untitled.bas" for output as #1
#1 "WARNING - To Preserve the Integrity of the CodeTank File(s) and the Liberty Basic Files(s)"
#1 "THIS CODE IS ACTUALLY a COPY OF ";selectedKey$;".bas Named -> 'untitled.bas' "
#1 "'Remember to 'Save As' a name of your Choice if/when done editing"
#1 ""
#1 valueNow$
close #1
tempfile$ = DefaultDir$;"\untitled.bas"
run DefaultDir$;"\LBB.exe ";q$;tempfile$;q$
#codeTank.filePath "cls" : #codeTank.filePath "Editing ";tempfile$;" in Liberty Basic Editor"
#codeTank.keys "select 0"
wait
[singleEXE]
' Use at your own risk - Author accepts NO liabilities
'########################################################################################
' IMPORTANT
' before running this code - save this code to a file named b2e.bas - (in a folder of it's own)
' If you do not wish to have commandline support, which copies the files of this app, along
' _with creating folders and new files, in the Users Home dir, you can delete or uncomment
' _the following 3 lines of code in the top 1st block of code..
'if not(fileExists(DefaultDir$, "b2e.exe")) then
'command = 1 : firstRun = 1 : project = 1 : fname$ = DefaultDir$;"\b2e.bas" : goto [checklbpath]
'end if
'If you do the above, disregard deleting the folder after first run, it will be needed.
'You can run the .bas from there, or create the TKN file, and run it from there.
'########################################################################################
'BAS2EXE Version v1.8.9c For Windows 10 (possibly XP, 7, 8 and 11) - try it and let me know
' Date Introduced to Public = Jan 29 2023
' Title - BAS2EXE v1.8.9c (with CommandLine support)
' Author - xxgeek, a member of the Libertybasiccom.proboards.com/ forums
' {Purpose} - To automate bas file to exe file (self extracting exe) making creation quick and easy while
' storing dated copies (users choice), of every selected bas file, the created tkn, and the created exe (self extracting)
' exe file containing the dll files, sll files, lbrun2.exe(renamed to same name as .bas file selected)
' Along with that there is a project folder created holding the same files as the exe that gets updated
' if and when the same bas file is selected, Note, the dated files are in their appropriate folders, EXE, TKN, and BAS
' NOTE -They will be overwritten if the same .bas file is selected on the same day within one minute
' The options are user generated by selecting the appropriate checkboxes (GUI)
' Or by Using the appropriate switches (Command Mode)
'GUI MODE
' Place this bas file in it's own folder as it will create some folders and temp files as well as the above
' IMPORTANT > Name this file b2e.bas (or it won't work)
' After first run, delete the folder, including the folders created, and the b2e.bas file
'_ they are no longer needed as this app copies it's files to the users home dir
' There will be a shortcut on the desktop created, use this to open BAS2EXE from now on.
' Note - The Home dir is used in order to make the command line work properly
' Choose 32bit exe or 64`bit exe - defaults to 64 bit if no selection made
' Option to password the EXE file - Check off the checkbox, [Select File] and enter a password when prompted.
' When bas2exe opens a filedialog to choose a bas file choose a bas file that is a
' _good working bas file (or there will be trouble with the compiler)
' Add a version number and or Date/Time stamp the EXE filename
' View the Menu after EXE file creation
'The "Save tkn" file dialog and the Information "saved as" dialog close automatically and save the tkn file to where it is needed.
' If you keep the project folders you will have a "project" folder with each saved project which
'_ includes the dll, sll files and lbrun2.exe(renamed), the selected .bas file and the tkn file.
'The EXE File is saved to the EXE folder in the same folder as this program is located.
' _unless otherwise specified for eg: when using the (CommandLine) and not the GUI (no GUI option for destination - v4.5.1.0 maybe )
' Next Window is to choose to Run the EXE or view the EXE Files Created by this Program
'_ or Make a New EXE
' Note - For standalone bas files only with no dependent files or folders - at this time (Maybe Version 2, we''ll see)
' If the .bas file you select runs in the lb IDE when RUN, the EXE will be made. If there are programming
'_ runtime errors your EXE could still crash at some point (Not BAS2EXE's fault)
' If it won't run in the lb IDE there will be an error reported by the lb compiler when this app attempts to
'_ make the tkn file, and the lb window that opens showing the code for the selected bas file will stay opened
'_, close it manually.
'IMPORTANT INFORMATION
' This new version has CommandLine support, meaning it works from a command prompt.
' or it can be used in code projects with the Run command as well.
'COMMAND MODE
' Syntax for commandline:
' If using the EXE
' b2e -sourceFilePath\file.bas -destinationPath /bas /dt /kp /pw /r /s /tkn /v'number' /bit'number'
' or b2e.exe -sourceFilePath\file.bas -destinationPath /bas /dt /kp /pw /r /s /tkn /v'number' /bit'number'
' If using the TKN in code
' b2e.tkn -sourceFilePath\file.bas -destinationPath /bas /dt /kp /pw /r /s /tkn /v'number' /bit'number'
' if destinationPath is ommtted the default destinationPath is DefaultDir$\EXE
' If sourcePath\file.bas is ommitted BAS2EXE defaults to opening in GUI mode
' If no switches used, all switches defaults are false, 0 or "", except for the bit64 default
' Switches MUST be separated with a 'space'
' Switches are Optional
' Liberty typing b2e by itself BAS2EXE defaults to opening in GUI mode
'Switches
' /bas - saves a dated backup of the selected bas file
' /bit32 - creates a 32 bit exe file
' /bit64 - creates a 64 bit exe file (Defaults to 64bit EXE file if no swtich used)
' /dt - appends date/time to the created exe filename.
' /kp - saves the Project Folder (tkn, renamed lbrun2.exe dll and sll files) Created anyway - they are needed for the EXE file.
' /o - opens windows explorer with the created EXE file selected
' /pw - Prompts user for a password to open the created EXE file (If used the EXE file won't run without it, so save the password somewhere safe.)
' /q - Stops the "Please Wait" activity window from appearing while in command mode.
' /r - Runs the New EXE file after it is created
' /s - shows the Post Creation EXE Menu Window (GUI) to (View / Run / MakeNew - EXE file)
' /tkn - saves a dated backup of the tkn file.
' /v'number' - appends the EXE filename with a version number or text
' (No Spaces) examples: /v4.5.1.51 /v.001 /v123.Any_thing Note: The "v" is not included.
' If you want a v in your EXE filename then you must add one eg: /vv4.5.1 /vvTest123 etc
' Here are some examples of commandline use.
' eg: b2e (alone this opens the GUI)
' b2e -sourceFilePath\file.bas (Creates a single exe file in DefaultDir$\EXE) no project folder, no backups, no appended date/time, or version etc
' b2e -sourceFilePath\file.bas -f:\MyStuff\MyEXEcollection Creates a single 64bit EXE file in f:\MyStuff\MyEXEcollection
' b2e -sourceFilePath\file.bas /bas /bit32 /dt /kp /pw /q /r /s /tkn /vv1.0 (Creates a single 32bit exe file in DefaultDir$\EXE)
' _ including all the optional swtches
' Switches can be in ANY order as long as they preceed the -path(s)
' if -sourceFilePath\file.bas is a lone .bas file with no path, BAS2EXE assumes the file is in the DefaultDir$
' The dashes before the path(S) ARE necessaary
' the spaces between the switches ARE necessary
' Please NOTE - About the app and it's limitations
' This app uses a built in Windows app named IEXPRESS to create the EXE file by way of a SED(Self Extracting Dirctive) file.
' This app write the SED file, then IEXPRESS reads, and executes the instructions in it to create the EXE file.
' IEXPRESS has limits.
' It won't copy a folder, so for now this app can only create EXE files with the necessary runtime support files
' That means (for now anyway) the files needed to work (dll's, sll's tkn renamed lbrun2.exe and the bas file if user wants it.)
' If your .bas file uses any support files from the DefaultDir$ or sub folders of DefaultDir$ such as
' _bmp, txt, etc, they won't be in the EXE file when created.
' The app is great for testing, or for apps that need no support files (other than the lb dlls/slls the tkn and renamed lbrun2.exe )
' _and if your .bas doesn't create any files needed the next time it is opened.
' When an EXE that is created by IEXPRESS executes, it is unpacked in the users temp folder, into a folder
' _named IXP001.tmp, or the number can vary on each persons PC. IXP001......IXP00n (depends on other temp apps I guess)
' These temp folders get deleted when the app is finished doing it's thing as is closed.
' That means if your app saves any data to files in DefaultDir$, or copies any files\folders to DefaultDir$, they get deleted too.
' If the interest is there, and I get some feedback on this app I'll work on a version 2.
' Version 2 will have support for adding extra folders and files to the EXE
' It will also get around the temp folder issue. I have that part working already.
' It may also have an option to batch create the EXE files.
' By having .bas files in a folder, and executing a loop to create one after the other.
' Other suggestions are welcome
' If you use this, please take the time to give some feedback so I know what's up,
' Any issues, don't hesitate to report them
' This App is actually part of a larger app, and the defaults are set 'as is' to accomodate the larger app.
' I didn't want to re-write the whole thing for the 1 person that 'may' use it.
' This app is free to use, edit, and/or distibute. Feel free to make it work the way you want it to.
' New Version v1.8.9
' added ini file to hold Users lb install dir path when detected to be other than default
' added checkbox to allow showing created exe file in Windows Explorer when complete
' added onerror notice, and restart of BAS2EXE
' hardened some more
'New Version 1.9.0c
' changed method of auto[enter] of TKN creation "save as" dialog, and "Information" notice
' changed file verification loops of created exe file and tkn file to allow escape from loop after a set time
' _ to avoid infinite looping with BAS2EXE running invisible, forcing user to use taskmanager to close
' _ when/if exe file or tkn file is NOT created for whatever reason
' added detection of spaces in filename. IEXPRESS will not create a file with spaces in the name of the
' _source file - BAS2EXE will give Notice, then close when Notice closes.
' Tested on files up to 11000 lines - User may need to increase the 2 largest pauses if files have
' _ 11000+ lines of code (look for 'call pause 1500') - 2 of them
'New Version 1.9.1L
'specific to CodeTankPlus for Liberty Basic 4.5.1 and Pro
[TOP]
if mainOpen = 1 then close #main : mainOpen = 0
LBB = 0 : batch=0 : batchFileCount = 0
command = 0 : s = 0 : openDest = 0 : runEXE = 0 : p = 0 : q = 0 : show = 0
tkn = 0 : bas = 0 : r = 0 : ve$ = "" : ve = 0 : project = 0 : dt = 0 : fname$ = ""
exeDest$ = "" : selectedpath$ = "" : fixeddate$ = "" : fixedtime$ = "" : exe$ = ""
q$ = chr$(34)
if CommandLine$ <> "" then
if not(instr(CommandLine$, ".bas")) then [GUI]
sourc3$ = word$(CommandLine$, 3)
sourc2$ = word$(CommandLine$, 2)
sourc1$ = word$(CommandLine$, 1)
sourc = 1
if instr(sourc1$, ".bas") then fname$ = word$(CommandLine$, 1) : goto [getDest]
sourc = 2
if instr(sourc2$, ".bas") then fname$ = word$(CommandLine$, 2) : goto [getDest]
sourc = 3
if instr(sourc3$, ".bas") then fname$ = word$(CommandLine$, 3)
[getDest]
fname$ = trim$(fname$)
if right$(fname$, 1) = chr$(34) then fname$ = left$(fname$, len(fname$)-1)
if left$(fname$, 1) = chr$(34) then fname$ = right$(fname$, len(fname$)-1)
if left$(fname$ ,1) = "-" then fname$ = right$(fname$, len(fname$)-1)
if left$(fname$ ,1) = "\" then fname$ = right$(fname$, len(fname$)-1)
fname$ = trim$(fname$)
if left$(fname$ ,1) = "\" then fname$ = right$(fname$, len(fname$)-1)
if not(instr(fname$, ":\")) and instr(fname$, ".bas") then fname$ = DefaultDir$;"\";fname$
dest$ = word$(CommandLine$, 2)
if instr(dest$, ":\") and sourc = 1 then exeDest$ = word$(CommandLine$, 2) : goto [gotDest]
dest$ = word$(CommandLine$, 3)
if instr(dest$, ":\") and sourc = 2 then exeDest$ = word$(CommandLine$, 3) : goto [gotDest]
dest$ = word$(CommandLine$, 4)
if instr(dest$, ":\") and sourc = 3 then exeDest$ = word$(CommandLine$, 4) : goto [gotDest]
exeDest$ = DefaultDir$;"\EXE"
[gotDest]
if left$(exeDest$ , 1) = "-" then exeDest$ = right$(exeDest$, len(exeDest$)-1)
if right$(exeDest$, 1) = chr$(34) then exeDest$ = left$(exeDest$, len(exeDest$)-1)
if left$(exeDest$, 1) = chr$(34) then exeDest$ = right$(exeDest$, len(exeDest$)-1)
if left$(exeDest$ , 1) = "-" then exeDest$ = right$(exeDest$, len(exeDest$)-1)
if instr(CommandLine$, "/bas") then bas = 1 'creates a dated backup of the user selected .BAS file in DefaultDir$\BAS
if instr(CommandLine$, "/dt") then dt = 1 'appends the date and time to the EXE file
if instr(CommandLine$, "/kp") then project = 1 'keep the project folder (temp project folder gets deleted by default in command mode)
if instr(CommandLine$, "/o") then openDest = 1 'opens windows explorer to the created EXE file when done
if instr(CommandLine$, "/pw") then p = 1 'password - adds password to bas file - if chosen, the EXE file won't run without it.
if instr(CommandLine$, "/q") then quiet = 1 'no "please wait" window will appear
if instr(CommandLine$, "/r") then runEXE = 1 'Run the newly created exe file.
if instr(CommandLine$, "/s") then show = 1 'show final options window (defaults to not show in command mode)
if instr(CommandLine$, "/tkn") then tkn = 1 'creates a dated backup of the user selected TKN file in DefaultDir$\TKN
if instr(CommandLine$, "/v") then 'ALL CommandLine options default to false, '0' , "", unless switch options are utilized
ve = 1 ' appends a version number to the EXE filename - defaults to false - 0
ve$ = word$(CommandLine$, 2 , "/v") : ve$ = word$(ve$, 1)
end if
bit = 64
if instr(CommandLine$, "/bit") then
bit$ = word$(CommandLine$, 2 , "/bit") : bit$ = word$(bit$, 1) : bit = val(bit$)
end if
command = 1 : goto [noGUI]
end if
[GUI]
exeDest$ = ""
titlebar$ = "BAS2EXE v1.9.0c"
[noGUI]
if command = 1 then [commandPath]
' setup a Window for User to Select a .bas File, to select options for the EXE file.
WindowWidth = 600
WindowHeight = 450
UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "lightgray"
ForegroundColor$ = "black"
'add some text ,some buttons, and checkboxes to the Window
statictext #pick.exe, "EXE File", 35, 30, 95, 30
statictext #pick.head, "BAS<2>EXE v1.9.1L", 210, 25, 220, 30
statictext #pick.temp, "Project Files", 425, 100, 195, 30
statictext #pick.datedtext, "Dated Backups", 225, 100, 185, 30
statictext #pick.info, "Select a working Liberty Basic Source Code File (.bas)", 30, 275, 590, 30
button #pick.default, "Select File", [defaultClick],UL 140, 340, 135, 35
button #pick.lbforums, "Visit the Liberty Basic Forums @ https://Libertybasiccom.proboards.com/", [forumLink],UL 0, 395, 595, 25
checkbox #pick.opendest, "Show EXE File When Completed", [OpenDest], [noOpenDest], 20, 145, 250, 20
checkbox #pick.bit32, "32 Bit", [bit32], [nobit32], 20, 65, 50, 20
checkbox #pick.bit64, "64 Bit", [bit64], [nobit64], 75, 65, 50, 20
checkbox #pick.password, "Add a Password", [yespass], [nopass], 20, 85, 140, 20
checkbox #pick.appDT, "Append Date/Time", [appDT], [noappDT], 20, 105, 140, 20
checkbox #pick.appversion, "Append Version Number", [appVersion], [noappVersion], 20, 170, 140, 20
checkbox #pick.project, "Keep Project Dir", [project], [noproject], 430, 135, 160, 20
checkbox #pick.TKN, "SaveTKN File", [noTKN], [yesTKN], 250, 135, 140, 20
checkbox #pick.BAS,"Save BAS File", [noBAS], [yesBAS], 250, 160, 140, 20
checkbox #pick.LBB,"Use LB Booster Instead of IEXPRESS", [yesLBB], [noLBB], 20, 240, 400, 20
checkbox #pick.ShowOptionsMenu,"Show Post Creation Options Menu", [yesShow], [noShow], 20, 125, 180, 20
checkbox #pick.batch,"Select Folder for Batch EXE Creation", [yaBatch], [noBatch], 20, 310, 190, 20
button #pick.32, "Cancel", [cancel],UL 320, 340, 135, 35
statictext #pick.versionText, "Version #", 40, 200, 50, 20
textbox #pick.ve, 90, 195, 85, 20
'open the Window, and set some Fonts for each statictext, and buttons
open "BAS2EXE v1.9.0c (CommandLine Support)" for window_nf as #pick : pickOpen = 1
#pick, "trapclose [cancel]"
#pick.LBB "font Arial_bold"
#pick.exe, "!font Arial_bold"
#pick.temp, "!font Arial_bold"
#pick.datedtext, "!font Arial_bold"
#pick.info, "!font Arial_bold"
#pick.head "!font Arial_bold"
#pick.bit64, "set"
#pick.project, "set"
#pick.TKN "set"
#pick.BAS "set"
#pick.appDT "set"
#pick.versionText "!hide"
#pick.ve "!hide"
#pick.default, "!setfocus"
pickOpen = 1
project = 1
tkn = 1
bas = 1
bit = 64
dt = 1
wait
'Create exe files for all bas files in selected folder
[yaBatch]
#pick.info, "Select a Folder with 'Working' Source Files (.bas)"
#pick.default "Select Folder"
batch = 1
wait
[noBatch]
#pick.info, "Select a working Liberty Basic Source Code File (.bas)"
#pick.default "Select File"
batch = 0
wait
[yesLBB]
#pick.LBB "set"
LBB =1
wait
[noLBB]
#pick.LBB "reset"
LBB = 0
wait
[OpenDest]
#pick.opendest "set"
openDest = 1
wait
[noOpenDest]
#pick.opendest "reset"
openDest = 0
wait
[yesShow]
show = 1
wait
[noShow]
show = 0
wait
[project]
project = 1
wait
[noproject]
project = 0
wait
[yesTKN]
tkn = 0
wait
[noTKN]
tkn = 1
wait
[yesBAS]
bas=0
wait
[noBAS]
bas = 1
wait
' passworded exe is true(user selected)
[yespass]
p = 1
wait
'passworded exe is false, default
[nopass]
p = 0
wait
'make 32 bit exe = true(user selected)
[bit32]
bit=32
#pick.bit64, "reset" : #pick.bit64 "hide"
wait
'make 64 bit exe, default
[bit64]
bit=64
#pick.bit32, "reset" : #pick.bit32 "hide"
wait
[nobit32]
bit=64
#pick.bit64, "show" : #pick.bit32 "hide"
wait
[nobit64]
bit=32
#pick.bit32, "show" : #pick.bit64 "hide"
wait
'append date/time to backed up tkn, and bas files - defaults to true
[appDT]
dt = 1
wait
[noappDT]
dt = 0
wait
[appVersion]
#pick.versionText "!show"
#pick.ve "!show" : #pick.ve "!setfocus"
ve = 1
wait
[noappVersion]
#pick.ve ""
#pick.versionText "!hide"
#pick.ve "!hide"
ve = 0
wait
[forumLink]
run "explorer https://Libertybasiccom.proboards.com"
wait
[defaultClick]
if ve = 1 then #pick.ve "!contents? ve$"
If ve$ <> "" then ve$ = "-";ve$
[commandPath]
'close the opening window for Selecting bas file
if pickOpen = 1 then close #pick : pickOpen = 0
'define some variables
supportFileList$="run451.exe vbas31w.sll vgui31w.sll voflr31w.sll vthk31w.dll vtk1631w.dll vtk3231w.dll vvm31w.dll vvmt31w.dll"
'projects$ = "b2eProjects"
projects$ = "savedProjects"
'make sure the support files exist
fileCount = 0
while 1
fileCount = fileCount + 1
runtimeSupportFile$ = word$(supportFileList$, fileCount)
if runtimeSupportFile$ = "" then exit while
if fileExists(LBpath$,runtimeSupportFile$) = 0 then notice "File doesn't Exist";chr$(13);LBpath$;"\";runtimeSupportFile$;chr$(13);"BAS2EXE will now Close" : end
wend
if command = 1 then [commandByPass]
' Use the filedialog function to allow user to select a source file (.bas)
[filediag]
global FolderDialog$
caption$ = "Select a Folder with Known Good .bas Files"
if batch = 1 then
call browser caption$
batchDir$ = FolderDialog$
if FolderDialog$ = "" then batch = 0 : wait
gosub [getBatchDir]
goto [commandByPass]
end if
fname$ = ""
filedialog "Open a Liberty Basic Source File (.bas) ", "*.bas", fname$
if fname$ = "" then wait
[commandByPass]
if batchFileCount = 0 then
batchFileCount = 2
dim batchFiles$(batchFileCount)
batchFiles$(numRuns+1) = fname$
end if
for numRuns = 1 to batchFileCount
fname$=batchFiles$(numRuns)
if batch = 0 then numRuns = 1
if fname$ = "" then
LBB = 0 : batch=0 : batchFileCount = 0 : numRuns = 0
goto [TOP]
'notice "Finished" : wait
end if
if batch=1 then fname$ = FolderDialog$;"\";fname$
print "numRuns = ";numRuns
print "batchFiles$(numRuns+1) = ";batchFiles$(numRuns)
print "fname$ = ";fname$
print "batch = ";batch
if p = 1 then
Prompt "TYPE a PASSWORD"+chr$(13)+ "Password For Your EXE File is? : (no spaces)";passwerd$
if passwerd$ = "" then p = 0 : notice "BAS2EXE will continue, without placing a password on the EXE file created"
end if
'Separate path from selected filename, and extension from selected filename
for var1 = len(fname$) to 1 step -1
if mid$(fname$, var1, 1) = "\" then var2 = var1 -1 : var3 = var2 - ((len(fname$))) : exit for
next var1
var3 = abs(var3)
orig$ = left$(fname$, var2)
fname0$ = right$(fname$, var3 -1)
for var4 = len(fname0$) to 1 step -1
if mid$(fname0$, var4, 1) = "." then var5 = var4 -1 : var6 = var5 - ((len(fname0$))) : exit for
next var4
var6 = abs(var6)
fnamenobas$ = left$(fname0$, var5)
for x = 1 to len(fnamenobas$)
spaceCheck$ = mid$(fnamenobas$, x, 1)
if spaceCheck$ = " " then notice "No Spaces Allowed in File Name"+chr$(13)+"Space found in Selected Filename. Cannot Create EXE File."+chr$(13)+"BAS2EXE will now Close" : end
next x
' fname$ = Full Path of User Selected .bas file (including the filename.bas)
' fname0$ = Name of the Selected .bas File Only - eg ; filename.bas
' fnamenobas$ = Name of the Selected .bas File (without the .bas) - eg: filename
[add2List]
add2List = 1
'add to MyProject file and add title to MyProjects list for ALL EXE file creations.
categorie$ = "MyProjects"
selectedKey$ = fnamenobas$
gosub [deleteOrig]
[deleteReturn]
open categorie$ for append as #1
#1 chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
open fname$ for input as #2
#1 input$(#2, lof(#2))
close #1 : close #2
lastKey$ = ""
call readDictionary
call loadKeys
call saveValue
call collectGarbage
call resetRadioOptions
#codeTank.keys "select 0"
#codeTank.savedprojects "set"
add2List = 0
[begin2]
'define Destpath1$ as lb Projects\Current Project Folder
DestPath$=DefaultDir$ 'Where this file is RUN from
DestPathU$ = DestPath$;"\";projects$ 'Projects Folder
DestPath1$=DestPathU$;"\";fnamenobas$ 'Current Project Folder
'Make Folders for Liberty Basic Projects, EXE files, TKN files, BAS files, SED files and Current Projects
res = mkdir(DestPathU$) 'projects dir
res = mkdir(DestPath1$) 'new project dir = name of selected bas file (no .bas) in Projects Dir
res =mkdir(DefaultDir$;"\";"EXE") 'exe files saved here
res = mkdir(DefaultDir$;"\";"TKN") 'tkn files saved here
res= mkdir(DefaultDir$;"\";"BAS") 'selected bas file saved here (includes password code if exe was passworded)
'make sure Folders were actually created
if pathExists(DestPathU$) = 0 then notice "Projects folder was NOT Created in ";DestPath$ : end
if pathExists(DestPath1$) = 0 then notice "New Folder ";fnamenobas$;" was NOT Created in ";DestPath1$ : end
if pathExists(DefaultDir$;"\";"TKN") = 0 then notice "TKN Folder was NOT Created in ";DestPath$ : end
if pathExists(DefaultDir$;"\";"BAS") = 0 then notice "BAS Folder was NOT Created in ";DestPath$ : end
if pathExists(DefaultDir$;"\";"EXE") = 0 then notice "EXE Folder was NOT Created in ";DestPath$ : end
'copy selected bas file to Projects\current project folder
q$= chr$(34)
open fname$ for input as #fname
fnameTemp$="tempBas.bas"
open fnameTemp$ for output as #2
'add a password prompt to the begining of the temp bas file(to be added to the exe)
if p=0 then [nopasswerd] '
#2, "prompt ";q$;"Enter the Password to Run";q$;";";"passwerd$"
#2, "if passwerd$ <> ";q$;passwerd$;q$;" then end"
[nopasswerd]
#2, input$(#fname, lof(#fname));
close #fname
close #2
'copy temp.bas file to current project folder
open fnameTemp$ for input as #fnameTemp
open DestPath1$;"\";fname0$ for output as #1
#1, input$(#fnameTemp, lof(#fnameTemp));
close #1
close #fnameTemp
if fileExists(DefaultDir$, fnameTemp$) then kill fnameTemp$
'check if the current project .bas file was copied to new dir
if fileExists(DestPath1$,fname0$) = 0 then notice fname0$; " Was not copied to ";DestPath1$;" BAS2EXE will now close" : end
'activity message to user - please wait message
if quiet = 0 then call pleasewait
'Copy the needed DLL and SLL files from Liberty Basic dir to projects\projectname Dir
w$ = ""
i = 0
while 1
i = i + 1
w$=word$(supportFileList$, i)
if w$="" then exit while
from$=LBpath$;"\";w$
to$=DestPath1$;"\";w$
if fileExists(DestPath1$,w$) then [noneed]
open from$ for input as #file
open to$ for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
[noneed]
wend
'remove existing lbrun2.exe from new project before creating new one
if fileExists(DestPath1$, LBruntime$) then kill DestPath1$;"\"; LBruntime$
'copy lbrun2.exe to current project Folder
open LBpath$;"\";LBruntime$ for input as #file
open DestPath1$;"\";LBruntime$ for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
'Liberty Basic can't create\rename a file that exists, so if it does already exist - kill it (delete it)
if fileExists(DestPath1$, fnamenobas$ + ".exe") <> 0 then kill DestPath1$;"\";fnamenobas$ + ".exe"
'rename lbrun2.exe to name of User Selected .bas File - .bas +.exe
name DestPath1$;"\";LBruntime$ as DestPath1$;"\";fnamenobas$ + ".exe"
'check new exe (renamed lbrun2.exe) file for existence in current project Folder )
if fileExists(DestPath1$,fnamenobas$;".exe") = 0 then notice "lbrun2.exe not copied or renamed - EXITING Program": end
'remove any existing exe from projectdir - of same name as bas file selected only if created on same date at same time
if fileExists(DestPath$;"\EXE",fnamenobas$;".exe") then kill DestPath$;"\EXE\";fnamenobas$;".exe"
if command = 1 and fileExists(exeDest$,fnamenobas$;".exe") then kill exeDest$;"\"; fnamenobas$;".exe"
'check for old tkn existence, delete it if it exists
if fileExists(DestPath1$,fnamenobas$;".tkn") then kill DestPath1$;"\";fnamenobas$;".tkn"
gosub [makeSED]
'verify sed file existence before proceeding
do
scan
loop until fileExists(DestPath$,fnamenobas$;".sed")
call writeAutoSave
'loop until autoSave$ File is verified
while fileExists(DefaultDir$, autoSave$) = 0 : scan : wend
'#######################################################################
'run the script to close the "save" dialog, and the follow up notice of creation automatically
run "wscript ";autoSave$
'#######################################################################
'Create the TKN file in Projects\current project folder.
run LBpath$;"\";LBexe$;" -T -A ";DestPath1$;"\";fname0$
'#######################################################################
'loop until TKN File is verified saved
do
countTime = countTime + 1
call pause 500
if countTime > 50 then exit do '- In case of unreported error - EXE file verification loop exit
scan
loop until fileExists(DestPath1$, fnamenobas$;".tkn")
call pause 2500
call fixtime : call fixdate ' append date/time to backup .bas and .tkn filename
'copy selected .bas file to BAS dir and date it
if bas = 1 then
open fname$ for input as #file
open DefaultDir$;"\BAS\";fnamenobas$;ve$;fixeddate$;fixedtime$;".bas" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
end if
' copy TKN file to TKN dir, and append date\time to it's name
if tkn = 1 and fileExists(DestPath1$, fnamenobas$;".tkn") <> 0 then
open DestPath1$;"\";fnamenobas$;".tkn" for input as #file
open DefaultDir$;"\TKN\";fnamenobas$;ve$;fixeddate$;fixedtime$;".tkn" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
end if
'fixeddate$ = "" : fixedtime$ = ""
'First Run setup in User Home Dir for CommandLine use
if command = 1 and firstRun = 1 then
run "cmd.exe /c xcopy ";DestPath1$;" ";upath$;" /e /s /c /h /i /y", hide
call pause 1000
run upath$;"\b2e.exe"
end if
if firstRun = 1 then close #pleasewait : end
[LBB_CHOSEN]
if LBB = 1 then goto [LBB_EXE]
'Check if iexpress.exe is installed (a built in Windows Install Maker = Self Extracting exe File)
[makeexe]
'makes 64 bit exe
if bit=32 then [do32bit]
'run iexpress commandline using the sed file created (sort of like an ini file)
express64$ = "C:\Windows\System32"
if fileExists(express64$,"iexpress.exe") then
run "iexpress /N /q ";sedfile$ : goto [verifyEXE]
else
noie = 1 : goto [quit.main]
end if
'makes 32 bit exe
[do32bit]
express32$ = "C:\Windows\SysWOW64"
if fileExists(express32$,"iexpress.exe") then
run "iexpress /N /q ";sedfile$
else
noie = 2 : goto [quit.main]
end if
[LBB_RETURN]
call pause 500
'verify the exe file was created - loop until it exists
[verifyEXE]
if command = 1 then
do
countTime = countTime + 1
call pause 500
if countTime > 25 then exit do '- In case of unreported error - EXE file verification loop exit
scan
loop until fileExists(exeDest$, exe$)
end if
if command = 0 then
do
countTime = countTime + 1
call pause 500
if countTime > 25 then exit do '- In case of unreported error - EXE file verification loop exit
scan
loop until fileExists(DefaultDir$;"\EXE", fnamenobas$;ve$;fixeddate$;fixedtime$;".exe")
end if
call pause 1500
'if dt = 1 then call fixdate : call fixtime
' append version, date, time to filename if selected
if command = 1 then
if fileExists(exeDest$, fnamenobas$;".exe") then
exefilename$ = fnamenobas$;ve$;fixeddate$;fixedtime$;".exe"
name exeDest$;"\";fnamenobas$;".exe" as exeDest$;"\";exefilename$
end if
end if
if command <> 1 then
if fileExists(DefaultDir$;"\EXE", fnamenobas$;".exe") then
exefilename$ = fnamenobas$;ve$;fixeddate$;fixedtime$;".exe"
name DefaultDir$;"\EXE\";fnamenobas$;".exe" as DefaultDir$;"\EXE\";exefilename$
end if
end if
if runEXE = 1 and command = 1 and fileExists(exeDest$, exefilename$) then run exeDest$;"\";exefilename$
[main]
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
'create a window with options to view created files or run the new exe file.
WindowWidth = 400
WindowHeight = 320
UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "darkgray"
ForegroundColor$ = "black"
button #main.default, "Make New Single EXE File (GUI Mode)", [rerun],UL 90, 200, 220, 40
button #main.run, "Run the Created EXE File", [progrun],UL 125, 150, 150, 40
button #main.browseT, "View TKN Files", [browseT],UL 125, 15, 150, 25
button #main.browseB "View BAS Files", [browseB],UL 125, 45, 150, 25
button #main.browseE, "View EXE Files", [browseE],UL 125, 75, 150, 25
button #main.browseP, "View Projects", [browseP],UL 125, 105, 150, 25
button #main.lbforums, "For more Information > Click Here to Visit the Liberty Basic Forums", [forumLink], UL 0, 270, 400, 20
open "View Files\ Run Created EXE \ Make New EXE" for window_nf as #main
#main, "trapclose [quit.main]"
mainOpen = 1
if show <> 1 then close #main : mainOpen = 0
if command = 0 and openDest = 1 then
run "cmd.exe /c explorer /select, ";q$;DefaultDir$;"\EXE\";exefilename$;q$, hide
openDest = 0
if mainOpen = 0 then [quit.main]
end if
if command = 1 and openDest = 1 then
run "cmd.exe /c start explorer.exe /select, ";q$;exeDest$;"\";exefilename$;q$, hide
openDest = 0
if mainOpen = 0 then [quit.main]
end if
cursor normal
next numRuns
gosub [cleanUp]
if batch = 1 then [quit.main]
if mainOpen=1 then
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
wait
else
goto [quit.main]
end if
'Make another EXE file
[rerun]
if command = 1 then CommandLine$ = "" : exeDest$ = "" : fname$ = "" : command = 0
goto [TOP]
'open Windows explorer to the EXE Files
[browseE]
if command = 1 and exeDest$ <> "" then run "explorer.exe ";exeDest$
if command = 0 then run "explorer.exe ";DefaultDir$;"\EXE"
wait
'open Windows explorer to the backup TKN Files Files
[browseT]
run "explorer.exe ";DefaultDir$;"\TKN"
wait
'open Windows explorer to the backup BAS Files
[browseB]
run "explorer.exe ";DefaultDir$;"\BAS"
wait
'open Windows explorer to the Projects Dir
[browseP]
run "explorer.exe ";DefaultDir$;"\";projects$
wait
'Run the new CommandLine created exe file chosen
[progrun]
if command = 1 then
run exeDest$;"\";exefilename$
end if
if command = 0 then
run DestPath$;"\EXE\";exefilename$
end if
wait
[getBatchDir]
dim Info$(1, 1)
files batchDir$, Info$()
batchFileCount = val(Info$(0, 0))
dim batchFiles$(batchFileCount+1)
for x = 1 to batchFileCount
filename$ = Info$(x, 0)
if right$(filename$, 4) <> ".bas" then [noThanks]
batchFiles$(x) = filename$
print batchFiles$(x)
[noThanks]
next x
return
[makeSED]
'can't write text to files that include quotes, so use the characters so they will print without syntax errors
sedfile$=fnamenobas$;".sed"
open sedfile$ for output as #sed
#sed "[Version]"
#sed "Class=IEXPRESS"
#sed "SEDVersion=3"
#sed "[Options]"
#sed "PackagePurpose=InstallApp"
#sed "ShowInstallProgramWindow=1"
#sed "HideExtractAnimation=1"
#sed "UseLongFileName=1"
#sed "InsideCompressed=0"
#sed "CAB_FixedSize=0"
#sed "CAB_ResvCodeSigning=0"
#sed "RebootMode=N"
#sed "InstallPrompt=%InstallPrompt%"
#sed "DisplayLicense=%DisplayLicense%"
#sed "FinishMessage=%FinishMessage%"
#sed "TargetName=%TargetName%"
#sed "FriendlyName=%FriendlyName%"
#sed "AppLaunched=%AppLaunched%"
#sed "PostInstallCmd=%PostInstallCmd%"
#sed "AdminQuietInstCmd=%AdminQuietInstCmd%"
#sed "UserQuietInstCmd=%UserQuietInstCmd%"
#sed "SourceFiles=SourceFiles"
#sed "[Strings]"
#sed "InstallPrompt="
#sed "DisplayLicense="
#sed "FinishMessage="
exe$=fnamenobas$;".exe"
if command = 1 and exeDest$ <> "" then
#sed "TargetName=";q$;exeDest$;"\";exe$;q$
else
#sed "TargetName=";q$;DefaultDir$;"\EXE\";exe$;q$
end if
#sed "FriendlyName=";q$;fnamenobas$;q$
#sed "AppLaunched=";q$;exe$;q$
#sed "PostInstallCmd=<None>"
#sed "AdminQuietInstCmd="
#sed "UserQuietInstCmd="
#sed "FILE0=";q$;exe$;q$
sedtkn$=fnamenobas$;".tkn"
#sed "FILE1=";q$;sedtkn$;q$
sll1$="vbas31w.sll"
sll2$="vgui31w.sll"
sll3$="voflr31w.sll"
dll1$="vthk31w.dll"
dll2$="vtk1631w.dll"
dll3$="vtk3231w.dll"
dll4$="vvm31w.dll"
dll5$="vvmt31w.dll"
#sed "FILE2=";q$;sll1$;q$
#sed "FILE3=";q$;sll2$;q$
#sed "FILE4=";q$;sll3$;q$
#sed "FILE5=";q$;dll1$;q$
#sed "FILE6=";q$;dll2$;q$
#sed "FILE7=";q$;dll3$;q$
#sed "FILE8=";q$;dll4$;q$
#sed "FILE9=";q$;dll5$;q$
#sed "[SourceFiles]"
#sed "SourceFiles0=";q$;DestPath1$;q$
#sed "[SourceFiles0]"
#sed "%FILE0%="
#sed "%FILE1%="
#sed "%FILE2%="
#sed "%FILE3%="
#sed "%FILE4%="
#sed "%FILE5%="
#sed "%FILE6%="
#sed "%FILE7%="
#sed "%FILE8%="
#sed "%FILE9%="
close #sed
return
[cleanUp]
if fileExists(DefaultDir$, fnameTemp$) then kill fnameTemp$
if fileExists(DefaultDir$,"temp.txt") then kill "temp.txt"
if fileExists(DefaultDir$, "FolderDialog.vbs") then kill "FolderDialog.vbs"
if fileExists(DefaultDir$, autoSave$) then kill autoSave$
if fileExists(DefaultDir$,desktopShortcut$) then kill desktopShortcut$
'if user chose to, - delete the current project dir and files (copied bas file, tkn file, sll,dll, run451.exe(renamed file)
if project = 0 then
if fileExists(DestPath1$, "vbas31w.sll") then kill DestPath1$;"\";"vbas31w.sll"
if fileExists(DestPath1$, "vgui31w.sll") then kill DestPath1$;"\";"vgui31w.sll"
if fileExists(DestPath1$, "voflr31w.sll") then kill DestPath1$;"\";"voflr31w.sll"
if fileExists(DestPath1$, "vtk1631w.dll") then kill DestPath1$;"\";"vtk1631w.dll"
if fileExists(DestPath1$, "vthk31w.dll") then kill DestPath1$;"\";"vthk31w.dll"
if fileExists(DestPath1$, "vtk3231w.dll") then kill DestPath1$;"\";"vtk3231w.dll"
if fileExists(DestPath1$, "vvm31w.dll") then kill DestPath1$;"\";"vvm31w.dll"
if fileExists(DestPath1$, "vvmt31w.dll") then kill DestPath1$;"\";"vvmt31w.dll"
if fileExists(DestPath1$, exe$) then kill DestPath1$;"\";exe$
if fileExists(DestPath1$, fnamenobas$;".tkn") then kill DestPath1$;"\";fnamenobas$;".tkn"
if fileExists(DestPath1$, fnamenobas$;".bas") then kill DestPath1$;"\";fnamenobas$;".bas"
if pathExists(DestPath1$) then deldir = rmdir(DestPath1$)
end if
if fileExists(DefaultDir$, fnamenobas$;".sed") then kill DefaultDir$;"\";fnamenobas$;".sed"
if noie = 1 then notice "64Bit Version of IEXPRESS not installed"+chr$(13)+" No EXE File Created - BAS2EXE closing."
if noie = 2 then notice "32Bit Version of IEXPRESS not installed"+chr$(13)+" No EXE File Created - BAS2EXE closing."
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
run "cmd.exe /c del ";DefaultDir$;"\*.INF", HIDE
run "cmd.exe /c del ";DefaultDir$;"\*.vbs", HIDE
run "cmd.exe /c del ";DefaultDir$;"\*.sed", HIDE
run "cmd.exe /c del ";DefaultDir$;"\EXE\*.RPT", HIDE
run "cmd.exe /c del ";DefaultDir$;"\EXE\*.CAB", HIDE
run "cmd.exe /c del ";DefaultDir$;"\EXE\*.DDF", HIDE
if pickOpen = 1 then close #pick : pickOpen = 0
if fileExists(DefaultDir$;"\EXE", "~";fnamenobas$;".CAB") <> 0 then kill DefaultDir$;"\EXE\~";fnamenobas$;".CAB"
if fileExists(DefaultDir$;"\EXE", "~";fnamenobas$;".DDF") <> 0 then kill DefaultDir$;"\EXE\~";fnamenobas$;".DDF"
if fileExists(DefaultDir$;"\EXE", "~";fnamenobas$;".RPT") <> 0 then kill DefaultDir$;"\EXE\~";fnamenobas$;".RPT"
if fileExists(DefaultDir$;"\EXE", "~";fnamenobas$;"_LAYOUT.INF") <> 0 then kill DefaultDir$;"\EXE\~";fnamenobas$;"_LAYOUT.INF"
return
[quit.main]
if command = 0 and openDest = 1 then run "cmd.exe /c explorer /select, ";q$;DefaultDir$;"\EXE\";exefilename$;q$, hide
gosub [cleanUp]
if command = 1 and fileExists(exeDest$, exefilename$) = 0 then notice "No EXE Created"+chr$(13)+"EXE file was NOT created"+chr$(13)+"Check Selected File 'name' for Spaces"
cursor normal
'if command = 0 and fileExists(DefaultDir$;"\EXE", exefilename$) = 0 then
if command = 0 and fileExists(DefaultDir$;"\EXE",fnamenobas$;ve$;fixeddate$;fixedtime$;".exe") = 0 then
notice chr$(13)+"EXE file was NOT created"+chr$(13)+"Check Selected File 'name' for Spaces"
end if
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
if mainOpen = 1 then close #main : mainOpen = 0
wait
[quit.pleasewait]
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
wait
[cancel]
close #pick : pickOpen = 0
wait
[newKey] 'ask the user for a name for the new listing
call saveValue
newKey$ = ""
if len(left$(categorie$, (len(categorie$) - 1))) < 4 then [notPlural]
prompt "Enter a Name (or Title) for the New " + left$(categorie$,(len(categorie$)-1)); newKey$
if newKey$ <> "" then [continue] else wait
[notPlural]
prompt "Enter a Name (or Title) for the New "+categorie$+" Script"; newKey$
if newKey$ = "" then wait
'if user selects 'New From File' instead of New (copy/paste) to add new Project, or new Program
[continue]
if newKey$ <> "" then
call setValueByName newKey$, ""
call loadKeys
#codeTank.keys "select "; newKey$
#codeTank.value "!cls";
call collectGarbage
call writeDictionary
lastKey$ = newKey$
end if
if tkn = 2 or tkn = 4 then
open fname$ for input as #1
open categorie$ for append as #2
#2 input$(#1, lof(#1));
close #1
close #2
gosub [cleanUp]
tkn = 0
end if
call saveValue
call readDictionary
call loadKeys
#codeTank.keys "select 0"
#codeTank.value "!setfocus"
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
wait
[keySelected]
call saveValue
#codeTank.keys "selection? selectedKey$"
if categorie$ = anyFolder$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";anyFolder$;" Section - ";selectedKey$
if categorie$ = examples$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";examples$;" Section - ";selectedKey$
if categorie$ = snippets$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";snippets$;" Section - ";selectedKey$
if categorie$ = cmd$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";cmd$;" Section - ";selectedKey$
if categorie$ = vbs$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";vbs$;" Section - ";selectedKey$
if categorie$ = subroutines$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";subroutines$;" Section - ";selectedKey$
if categorie$ = functions$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";functions$;" Section - ";selectedKey$
if categorie$ = MyProjects$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";MyProjects$;" Section - ";selectedKey$
if categorie$ = programs$ then #codeTank.filePath "cls" : #codeTank.filePath "Reading List ";programs$;" Section - ";selectedKey$
if categorie$ = lbExamples$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";lbExamples$;" File - ";uAppPath$;"\";selectedKey$;".bas"
#codeTank.value "!cls"
open uAppPath$;"\";selectedKey$;".bas" for input as #1
#codeTank.value, "!contents #1";
close #1
#codeTank.value, "!origin 0, 0"
#codeTank.value, "!lines numLines$"
#codeTank.numLines "# of Lines = ";numLines$
wait
end if
if categorie$ = lbBakFiles$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";lbBakFiles$;" File - ";uAppPath$;"\bak\";selectedKey$;".bak"
#codeTank.value "!cls"
open uAppPath$;"\bak\";selectedKey$;".bak" for input as #1
#codeTank.value, "!contents #1";
close #1
#codeTank.value, "!origin 0, 0"
#codeTank.value, "!lines numLines$"
#codeTank.numLines "# of Lines = ";numLines$
wait
end if
if categorie$ = anyFolder$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";folderChoice$;" File - ";folderpath$;"\";selectedKey$;".bas"
#codeTank.value "!cls"
open folderpath$;"\";selectedKey$;".bas" for input as #1
#codeTank.value, "!contents #1";
close #1
#codeTank.value "!origin 0 0"
#codeTank.value, "!lines numLines$"
#codeTank.numLines "# of Lines = ";numLines$
wait
end if
if categorie$ = MyBackups$ then
#codeTank.filePath "cls" : #codeTank.filePath "Reading List ";MyBackups$;" File - ";DefaultDir$;"\BAS\";selectedKey$;".bas"
#codeTank.value "!cls"
open DefaultDir$;"\";"BAS\";selectedKey$;".bas" for input as #1
code$ = input$(#1, lof(#1))
close #1
#codeTank.value code$
#codeTank.value, "!origin 0 0"
wait
end if
selectedValue$ = getValue$(selectedKey$)
#codeTank.value "!contents selectedValue$";
lastKey$ = selectedKey$
#codeTank.value, "!origin 0 0"
#codeTank.value, "!lines numLines$"
#codeTank.numLines "# of Lines = ";numLines$
wait
[deleteKey]
'delete a Listing
gosub [deleteNow]
wait
[deleteNow]
#codeTank.keys "selection? selectedKey$"
if selectedKey$ = "" then notice "Select an item from list, try again" : cursor normal : wait
[deleteOrig]
cursor hourglass
call pleasewait : pleasewaitOpen = 1
#codeTank.filePath "cls" : #codeTank.filePath "Erasing ";selectedKey$;" code from - ";categorie$
#codeTank.value, "!selectall"
#codeTank.value, "!cut"
#pleasewait.fake "!setfocus"
call saveValue
if categorie$ = "" then
categorie$ = "ScratchPad" : selectedKey$ = "Scratch"
open categorie$ for append as #1
#1 chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 Pad$
close #1
end if
open categorie$ for binary as #1
tempfile$ = "tempfile"
open tempfile$ for output as #2
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
while eof(#1) = 0
line input #1, line$
if line$ = word1$ then [dontSave]
#2, line$
[dontSave]
wend
close #1
close #2
if fileExists(DefaultDir$, categorie$) then kill DefaultDir$;"\";categorie$
name tempfile$ as categorie$
lastKey$ = ""
call readDictionary
call loadKeys
call saveValue
#codeTank.keys "select 0"
if pleasewaitOpen = 1 then pleasewaitOpen = 0 : close #pleasewait
if add2List = 1 then
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
cursor normal
goto [deleteReturn]
end if
cursor normal
if pathExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$) <> 0 and mir = 0 then
folder$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$
text$ = "Title: "+selectedKey$+chr$(13)+" Has been Deleted"+chr$(13)+chr$(13)+"Do you wish to delete the project folder as well?"
a$ = custcon$(text$)
if answer$ <> "Yes" then wait
a$ = delete$(folder$)
end if
return
'run selected MyProjects, or MyPrograms
[runKey]
if selectedKey$ = "" then notice "Select an item from list, try again" : wait
text$ = "Warning "+chr$(13)+"RUNing this Code May Leave an IDE Window"+chr$(13)+"and or"+chr$(13)+"Leave Mainwin Open when it Closes";chr$(13)+"It May Not Open at all, or it May Just Flash Open and Close"+chr$(13)+"Run it Anyway ?"
if categorie$ = lbBakFiles$ then
runFile$ = uAppPath$;"\bak\";selectedKey$;".bak"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(code$,"trapclose",1) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
temp$ = DefaultDir$;"\untitled.bas"
open temp$ for output as #1
#codeTank.value "!contents? code$"
#1 ""
#1 " 'This Code is a Copy of - ";q$;selectedKey$;".bak";q$
#1 ""
#1 code$
close #1
run LBpath$;"\";LBexe$;" -R -A ";temp$
wait
end if
if categorie$ = MyBackups$ then
runFile$ = DefaultDir$;"\BAS\";selectedKey$;".bas"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(lower$(code$),lower$("trapclose")) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
temp$ = DefaultDir$;"\untitled.bas"
open temp$ for output as #1
#codeTank.value "!contents? code$"
#1 ""
#1 " 'This Code is a Copy of - ";q$;selectedKey$;".bas";q$
#1 ""
#1 code$
close #1
run LBpath$;"\";LBexe$;" -R -A ";temp$
wait
end if
if categorie$ = anyFolder$ then
runFile$ = FolderDialog$;"\";selectedKey$;".bas"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(lower$(code$),lower$("trapclose")) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
temp$ = DefaultDir$;"\untitled.bas"
open temp$ for output as #1
#codeTank.value "!contents? code$"
#1 ""
#1 " 'This Code is a Copy of - ";q$;selectedKey$;".bas";q$
#1 ""
#1 code$
close #1
run LBpath$;"\";LBexe$;" -R -A ";temp$
wait
end if
if categorie$ = lbExamples$ then
runFile$ = uAppPath$;"\";selectedKey$;".bas"
open runFile$ for input as #1
code$ = input$(#1,lof(#1))
close #1
if instr(lower$(code$),lower$("trapclose")) = 0 or instr(lower$(code$),lower$("'nomainwin")) = 0 then
a$ = custcon$(text$) : if answer$ <> "Yes" then wait
end if
run LBpath$;"\";LBexe$;" -R -A ";runFile$
wait
end if
if categorie$ = programs$ and fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".tkn") <> 0 then
runFile$ = savedProjects$;"\";selectedKey$;"\";selectedKey$;".tkn"
#codeTank.filePath "cls" : #codeTank.filePath "Running - ";DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".tkn"
run runFile$
wait
end if
if categorie$ = MyProjects$ or categorie$ = programs$ and fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".exe") <> 0 then
runFile$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".exe"
#codeTank.filePath "cls" : #codeTank.filePath "Running - ";DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".exe"
run runFile$
wait
end if
if categorie$ = MyProjects$ or categorie$ = programs$ and fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$, selectedKey$;".bas") = 0 then
notice "Cannot be RUN"+chr$(13)+"This Title was Created Manually"+chr$(13)+selectedKey$+chr$(13)_
+" Not created using 'New from File'"+chr$(13)+chr$(13)_
+"Edit with Liberty Basic and save it as the 'Same Name..bas"+chr$(13)+"Select Radio Button "+categorie$+chr$(13)+"Select Button [New from File]"+chr$(13)_
+"Select the .bas file you just saved."+chr$(13)+" It will be available to RUN from then on"
end if
#codeTank.value "!cls"
#codeTank.keys "select 0"
wait
'open selected listing in just Basic IDE
[edit_In_LB_IDE]
if selectedKey$ = "" then notice "Select an item from a list, try again" : wait
#codeTank.value, "!contents? valueNow$";
open "untitled.bas" for output as #1
#1 "WARNING - To Preserve the Integrity of the CodeTank File(s) and the Liberty Basic Files(s)"
#1 "THIS CODE IS ACTUALLY a COPY OF ";selectedKey$;".bas Named -> 'untitled.bas' "
#1 "'Remember to 'Save As' a name of your Choice if/when done editing"
#1 ""
#1 valueNow$
close #1
tempfile$ = DefaultDir$;"\untitled.bas"
run LBpath$;"\";LBexe$;" ";q$;tempfile$;q$
#codeTank.filePath "cls" : #codeTank.filePath "Editing ";tempfile$;" in Liberty Basic Editor"
#codeTank.keys "select 0"
wait
[mergeFile]
filedialog "Select a ";categorie$ ;" file to merge ",DefaultDir$, mergefile$
if mergefile$ = "" then wait
a$ = GetFilename$(mergefile$)
if a$ <> categorie$ then
answer$ = "yes"
prompt " Categories Don't Match "+chr$(13)+" Merge Anyway?" ; answer$
if answer$ <> "yes" then wait
end if
open mergefile$ for input as #1
line input #1, dataline$ : close #1
mergeCheck$ = chr$(134)+chr$(165)+chr$(134)
if left$(dataline$, 3) <> mergeCheck$ then notice "Merge with ";categorie$+" Issue"+chr$(13)+chr$(13)+"Unable to Merge File named "+chr$(13)+a$+chr$(13)+"The formatting of file "+a$+" is incompatible" : wait
call pleasewait : cursor hourglass
open mergefile$ for input as #1
open DefaultDir$;"\";categorie$ for append as #2
#2 input$(#1, lof(#1));
close #2 : close #1
call readDictionary
call collectGarbage
call writeDictionary
call loadKeys
close #pleasewait
cursor normal
#codeTank.keys "select 0"
wait
[codeTankHelp]
notice "codeTank is curently in development, For Help, please visit the LB forums";chr$(13);chr$(13);"@ https://libertybasiccom.proboards.com/"
wait
[about]
notice "codeTank is curently in development. Please Visit ";chr$(13);chr$(13);"https://libertybasiccom.proboards.com/"
wait
[revert]
revert = 1
'Work starts here
#codeTank.keys "selection? name$"
if name$ = "" then notice "Select an item from list, try again" : wait
filedialog "Open a 'KNOWN WORKING' Source File (.bas) ", DefaultDir$;"\BAS\*";selectedKey$;"*.bas", fname$
if fname$ = "" then wait
open fname$ for input as #1
fnamenobas$ = word$(fname$, 2, "--") : fnamenobas$ = left$(fnamenobas$, len(fnamenobas$) - 4)
open DefaultDir$;"\";savedProjects$;"\";fnamenobas$;"\";fnamenobas$;".bas" for output as #2
#2 input$(#1, lof(#1)) : close #1 : close #2
goto [remakeproject]
wait
[openlb]
run LBpath$;"\";LBexe$
wait
'top menu "Open File in LB IDE"
[openlbFile]
filedialog "Open \ Select a Liberty Basic Source File (.bas) ", upath$; "\*.bas", openFilename$
if openFilename$ = "" then wait
#codeTank.filePath "cls" : #codeTank.filePath "File Opened in Liberty Basic - ";openFilename$
run LBpath$;"\";LBexe$;" ";openFilename$
wait
[basFiles]
run "explorer.exe ";q$;DefaultDir$;"\";"BAS";q$
wait
'open the following in Windows Explorer
[projectsDir]
run "explorer.exe ";q$;DefaultDir$;"\";"savedProjects";q$
wait
[EXEDir]
a$ = DefaultDir$;"\EXE"
run "explorer.exe ";q$;a$;q$
wait
[tknDir]
a$ = DefaultDir$;"\TKN"
run "explorer.exe ";q$;a$;q$
wait
[lbexamplesDir]
if pathExists(uAppPath$) <> 0 then
run "explorer.exe ";q$;uAppPath$;q$
else
if pathExists(uAppPath$) <> 0 then run "explorer.exe ";uAppPath$
end if
wait
[defaultDir]
run "explorer.exe ";q$;DefaultDir$;q$
wait
'radio button selections from MyProjects to Help
[projs]
#codeTank.runListing, "!enable"
#codeTank.remakeproject, "!enable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!enable"
#codeTank.merge "!enable"
#codeTank.merge "!enable"
#codeTank.revert, "!enable"
call saveValue
#codeTank.value, "!cls"
categorie$ = MyProjects$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
category$ = right$(category$,7)
#codeTank.addListing, "&New ";category$;" (Copy/Paste)"
#codeTank.fromFile, "&New ";category$;" (From File)"
wait
[progs]
#codeTank.runListing, "!enable"
#codeTank.remakeproject, "!enable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!enable"
#codeTank.merge, "!enable"
#codeTank.revert, "!enable"
call saveValue
#codeTank.value, "!cls"
categorie$ = programs$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.keys "singleclickselect"
#codeTank.addListing, "&New ";category$;" (Copy/Paste)"
#codeTank.fromFile, "&New ";category$;" (From File)"
wait
[exams]
#codeTank.runListing, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = examples$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1))
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.addListing, "&New ";category$
wait
[snipps]
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.runListing, "!disable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = snippets$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1))
wait
[subroutines]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = subroutines$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
category$ = categorie$
category$= left$(category$, (len(category$) - 1))
#codeTank.addListing, "&New ";category$
wait
[functions]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = functions$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, (len(categorie$) - 1))
category$= left$(categorie$, (len(categorie$) - 1))
wait
[vbs]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.runlb, "!enable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = vbs$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, len(categorie$)-1)
category$ = categorie$
wait
[cmd]
#codeTank.runListing, "!disable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!enable"
#codeTank.deleteListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!enable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = cmd$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
#codeTank.addListing, "&New ";left$(categorie$, len(categorie$)-1)
category$ = categorie$
wait
[lbCodeExamples]
if fileExists(DefaultDir$, lbExamples$) <> 0 then kill DefaultDir$;"\";lbExamples$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = lbExamples$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
dim folderInfo$(1, 1)
files uAppPath$, folderInfo$()
numExamps = val(folderInfo$(0, 0))
dim lbExamplesList$(numExamps)
open lbExamples$ for append as #1
x = 0
[skipp]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : wait
filename$ = folderInfo$(x, 0)
if right$(filename$, 3) <> "bas" then [skipp]
lbExamplesList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = lbExamplesList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skipp]
[lbbakfiles]
if fileExists(DefaultDir$, lbBakFiles$) <> 0 then kill DefaultDir$;"\"; lbBakFiles$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = lbBakFiles$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
dim folderInfo$(1, 1)
files uAppPath$;"\bak\", info$()
numExamps = val(info$(0, 0))
dim lbBakFilesList$(numExamps)
open lbBakFiles$ for append as #1
x = 0
[skipit]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : wait
filename$ = info$(x, 0)
if right$(filename$, 3) <> "bak" then [skipit]
lbBakFilesList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = lbBakFilesList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skipit]
[mybackups]
if fileExists(DefaultDir$, MyBackups$) <> 0 then kill DefaultDir$;"\";MyBackups$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
#codeTank.value, "!cls"
categorie$ = MyBackups$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
gettingMybackupFiles = 1
dim folderInfo$(1, 1)
files DefaultDir$;"\";"BAS", folderInfo$()
numExamps = val(folderInfo$(0, 0))
dim MyBackupsList$(numExamps)
a$=DefaultDir$;"\";categorie$
open DefaultDir$;"\";categorie$ for append as #1
x = 0
[skiphere]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : wait
filename$ = folderInfo$(x, 0)
if right$(filename$, 3) <> "bas" then [skiphere]
MyBackupsList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = MyBackupsList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skiphere]
[folderChoice]
folderChoice$ = "folderChoice.txt"
if fileExists(DefaultDir$, folderChoice$) <> 0 then kill DefaultDir$;"\";folderChoice$
#codeTank.runListing, "!enable"
#codeTank.runlb, "!enable"
#codeTank.remakeproject, "!disable"
#codeTank.addListing, "!disable"
#codeTank.deleteListing, "!disable"
#codeTank.fromFile, "!disable"
#codeTank.merge, "!disable"
#codeTank.revert, "!disable"
call saveValue
caption$ = "Navigate to, and Select YOUR Liberty Basic (or Pro) Install Dir"
call browser (caption$)
if right$(FolderDialog$,1) = "\" then FolderDialog$ = left$(FolderDialog$, len(FolderDialog$)-1)
if FolderDialog$ = "" then notice "No Folder Selected" : wait
if len(FolderDialog$) = 2 then notice "Drive ";left$(FolderDialog$, 2);" Selected - You MUST Select a Folder" : goto [folderChoice]
folderpath$ = FolderDialog$
#codeTank.value, "!cls"
categorie$ = folderChoice$
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$
call resetRadioOptions
redim folderInfo$(1, 1)
files folderpath$, folderInfo$()
numExamps = val(folderInfo$(0, 0))
redim folderList$(numExamps)
open folderChoice$ for append as #1
x = 0
[skipnow]
x = x + 1
if x > numExamps then close #1 : call readDictionary : call loadKeys : categorie$ = anyFolder$ : wait
filename$ = folderInfo$(x, 0)
if right$(filename$, 3) <> "bas" then [skipnow]
folderList$(x) = left$(filename$, len(filename$) - 4)
newKey$ = folderList$(x)
word1$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + newKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 word1$
goto [skipnow]
[forumlink]
run "explorer.exe https://libertybasiccom.proboards.com/"
wait
'resize window font - sets all fonts equal
[incFont]
mainFontsize = mainFontsize + 1
#codeTank.value "!font Arial ";mainFontsize
#codeTank.keys "font Arial ";mainFontsize
wait
[decFont]
mainFontsize = mainFontsize - 1
#codeTank.value "!font Arial ";mainFontsize
#codeTank.keys "font Arial ";mainFontsize
wait
'create a project and tkn file and add it to the MyProjects List
[makeproject]
call saveValue
#codeTank.filePath "cls" : #codeTank.filePath "Creating Project ";DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas"
tkn = 2
if categorie$ <> MyProjects$ then tkn = 4
goto [defaultclick]
[remakeproject]
call saveValue
if selectedKey$ = "" then notice "Select an item from list, try again" : wait
tempCat$=categorie$
if fileExists(DefaultDir$;"\";savedProjects$;"\";selectedKey$,selectedKey$;".bas") = 0 then
notice "Cannot be Updated - Title was Created Manually"+chr$(13)+selectedKey$+chr$(13)_
+" Wasn't created using a File"+chr$(13)+chr$(13)_
+"Edit with Liberty Basic and save it using the SAME NAME.bas."+chr$(13)+"Select Radio Button My"+categorie$+chr$(13)+"Select Button [New "+left$(categorie$, len(categorie$)-1);" from File]"+chr$(13)_
+"Select the appropriate .bas file."+chr$(13)+" In Future it Will be Available for Updating"
#codeTank.keys "select 0"
#codeTank.value "!cls"
categorie$ = tempCat$
else
fname$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas"
end if
categorie$ = tempCat$
#codeTank.value "!contents? code$"
open fname$ for input as #1
code$ = input$(#1,lof(#1))
close #1
open DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas" for output as #1
#1 code$
close #1
tkn = 4
if revert = 1 then fname$ = DefaultDir$;"\";savedProjects$;"\";selectedKey$;"\";selectedKey$;".bas"
#codeTank.filePath "cls" : #codeTank.filePath "Updating ";fname$
if tkn = 4 then [makeTKN]
[defaultclick]
'Checking all paths and file locations for existence (dll's, sll's, lbasic.exe, and lbrun2.exe)
res=fileExists(LBpath$, LBexe$)
if res then a = a + 1 else notice LBexe$;" Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,LBruntime$)
if res then a = a + 1 else notice LBrun$;" Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vbas31w.sll")
if res then a = a + 1 else notice " vbas31w.sll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vgui31w.sll")
if res then a = a + 1 else notice " vgui31w.sll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"voflr31w.sll")
if res then a = a + 1 else notice " voflr31w.sll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vthk31w.dll")
if res then a = a + 1 else notice " vthk31w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vtk1631w.dll")
if res then a = a + 1 else notice " vtk1631w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vtk3231w.dll")
if res then a = a + 1 else notice " vtk3231w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vvm31w.dll")
if res then a = a + 1 else notice " vvm31w.dll Does not exist in ";LBpath$;" Closing Program" : goto [quit.codeTank]
res=fileExists(LBpath$,"vvmt31w.dll")
if res then a = a + 1 else notice " vvmt31w.dll Does not exist in ";LBpath$;" Closing Program": goto [quit.codeTank]
' Use the filedialog function to allow user to select a source file (.bas)
[fileDiag]
'open file dialog to choose a .bas file for exe conversion, "*.bas;*.bak",.txt
filedialog "Open a 'KNOWN WORKING' Source File (.bas) ", DefaultDir$, fname$
if fname$ = "" then wait
#codeTank.filePath "cls" : #codeTank.filePath "Reading - ";categorie$;" Creating tkn file for - ";fname$
[makeTKN]
call pleasewait : pleasewaitOpen = 1
#pleasewait.fake "!setfocus"
'Separate path from selected filename, and extension from selected filename
for var1 = len(fname$) to 1 step -1
if mid$(fname$, var1, 1) = "\" then var2 = var1 -1 : var3 = var2 - ((len(fname$))) : exit for
next var1
var3 = abs(var3)
orig$ = left$(fname$, var2)
fname0$ = right$(fname$, var3 -1)
'finish separating filename from extension
for var4 = len(fname0$) to 1 step -1
if mid$(fname0$, var4, 1) = "." then var5 = var4 -1 : var6 = var5 - ((len(fname0$))) : exit for
next var4
var6 = abs(var6)
fnamenobas$ = left$(fname0$, var5)
' fname$ = Full Path of User Selected .bas file (including the filename.bas)
' fname0$ = Name of the Selected .bas File Only - eg ; filename.bas
' fnamenobas$ = Name of the Selected .bas File (without the .bas) - eg: filename
[begin]
'define Destpath1$ as LB Projects\Current Project Folder
DestPath$=DefaultDir$ 'Where this file is RUN from
DestPathU$ = DestPath$;"\";savedProjects$ 'Projects Folder
DestPath1$=DestPathU$;"\";fnamenobas$ 'Current created Project Folder
'Make Folders for Liberty Basic Projects, EXE files, TKN files, BAS files, SED files and Current Projects
res = mkdir(DestPathU$) 'projects dir
res = mkdir(DestPath1$) 'new project dir = name of selected bas file (no .bas) in Projects Dir
res = mkdir(DefaultDir$;"\";"TKN") 'tkn files saved here
res= mkdir(DefaultDir$;"\";"BAS") 'selected bas file saved here (includes password code if exe was passworded)
'make sure Folders were actually created
res=pathExists(DestPathU$)
if res then a=a+1 else notice "savedProjects folder was NOT Created in ";DestPath$;" codeTank Closing" : goto [quit.codeTank]
if res then a=a+1 else notice "New Folder ";fnamenobas$;" was NOT Created in ";DestPath1$;" codeTank Closing" : goto [quit.codeTank]
tknFolder$=DefaultDir$;"\";"TKN"
res=pathExists(tknFolder$)
if res then a=a+1 else notice "TKN Folder was NOT Created in ";DestPath$;" codeTank Closing" : goto [quit.codeTank]
basFolder$=DefaultDir$;"\";"BAS"
res=pathExists(basFolder$)
if res then a=a+1 else notice "BAS Folder was NOT Created in ";DestPath$;" codeTank Closing" : goto [quit.codeTank]
'copy selected bas file to Projects\current project folder
open fname$ for input as #1
data$ = input$(#1,lof(#1)) : close #1
open DestPath1$;"\";fname0$ for output as #2
#2 data$
close #2
'check if the current project .bas file was copied to new dir
if fileExists(DestPath1$,fname0$) = 0 then notice fname0$; " Was not copied to ";DestPath1$;" codeTank Closing" : goto [quit.codeTank]
if tkn = 4 then [tknOnly] 'bypass for Categorie Programs and Updates - tkn and bas file only needed
'Copy the needed DLL and SLL files from Liberty Basic dir to projects\projectname Dir
i = 0
while 1
i = i + 1
runtimeSupportFile$=word$(DllList$,i)
if runtimeSupportFile$ ="" then exit while
sourceFile$=LBpath$;"\";runtimeSupportFile$
destinationFile$=DestPath1$;"\";runtimeSupportFile$
'don't copy runtime files if they already exists
if fileExists(DestPath1$, runtimeSupportFile$) <> 0 then [fileExists]
open sourceFile$ for input as #file
open destinationFile$ for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
[fileExists]
wend
'verify dll's and sll's were copied to new project folder
res=fileExists(DestPath1$,"vbas31w.sll")
if res then a = a + 1 else notice " vbas31w.sll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vgui31w.sll")
if res then a = a + 1 else notice " vgui31w.sll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"voflr31w.sll")
if res then a = a + 1 else notice " voflr31w.sll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vthk31w.dll")
if res then a = a + 1 else notice " vthk31w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vtk1631w.dll")
if res then a = a + 1 else notice " vtk1631w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vtk3231w.dll")
if res then a = a + 1 else notice " vtk3231w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vvm31w.dll")
if res then a = a + 1 else notice " vvm31w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
res=fileExists(DestPath1$,"vvmt31w.dll")
if res then a = a + 1 else notice " vvmt31w.dll Was not created in --> ";DestPath1$;" Closing Program" : goto [quit.codeTank]
'remove any left over existing lbrun2.exe from new project before creating new one
'Liberty Basic can't create\rename a file that exists, so if it does already exist - kill it (delete it)
if fileExists(DestPath1$, LBruntime$) <> 0 then kill DestPath1$;"\"; LBruntime$
'copy lbrun2.exe to Current Project Folder
open LBpath$;"\";LBruntime$ for input as #file
open DestPath1$;"\";fnamenobas$;".exe" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
'check new exe (renamed lbrun2.exe) file for existence in current project Folder )
if fileExists(DestPath1$,fnamenobas$;".exe") = 0 then notice "lbrun2.exe not copied or renamed - EXITING Program": goto [quit.codeTank]
[tknOnly]
'call fixtime
'call fixdate
'copy selected .bas file to BAS dir and date it
open DestPath1$;"\";fname0$ for input as #file
open DestPath$;"\BAS\";fixeddate$;fixedtime$;fnamenobas$;".bas" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
'remove any existing tkn of same name in TKN dir
if fileExists(DestPath1$, fnamenobas$;".tkn") <> 0 then kill DestPath1$;"\";fnamenobas$;".tkn"
'write/run the script to close the "save" dialog, and the follow up "information" notice of creation automatically
call writeAutoSave
'loop until autoSave$ File is verified
while fileExists(DefaultDir$, autoSave$) = 0 : scan : wend
run "wscript ";autoSave$
'#######################################################################
'Create the TKN file in Projects\current project folder.
RUN q$;LBpath$;"\";LBexe$;q$;" -T -A ";DestPath1$;"\";fname0$
'loop until TKN File is verified
while www = 0
if fileExists(DestPath1$,fnamenobas$;".tkn") <> 0 then exit while
scan
wend
call pause 3500
'copy TKN$ file to TKN dir, and date it
open DestPath1$;"\";fnamenobas$;".tkn" for input as #file
open DefaultDir$;"\TKN\";fixeddate$;fixedtime$;fnamenobas$;".tkn" for output as #1
#1 input$(#file, lof(#file));
close #file
close #1
if fileExists (DefaultDir$;"\TKN", fixeddate$;fixedtime$;fnamenobas$;".tkn") = 0 then notice fixeddate$;fixedtime$;fnamenobas$;".tkn";" was NOT created in ";DefaultDir$;"\TKN" : wait
[continueOn]
'check what tkn value =, and continue to create the 'new key'
if tkn = 2 or tkn = 4 then newKey$ = fnamenobas$
goto [continue]
[initiate]
global selectedKey$, lastKey$, categorie$, FolderDialog$, dictionary$, q$, codetankOpen, fixeddate$, fixedtime$, folder$, lastKey$
'global 'selectedKey$, fixeddate$, fixedtime$, project, fnamenobas$, DestPath$, DestPath1$, JBexe$,_
'LBpath$, keyCount, q$, lastKey$, selectedpath$, upath$, folder$, folderpath$
'First we need the users home path
CSIDL.PROFILE = 40
upath$ = GetSpecialFolder$(CSIDL.PROFILE)
if fileExists(DefaultDir$, "codetank.ini") then
open DefaultDir$;"\codetank.ini" for input as #1
line input #1, LBpath$ : close #1
if fileExists(LBpath$, "liberty.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic v4.5.1"
LBexe$ = "liberty.exe"
end if
if fileExists(LBpath$, "lbpro.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic Pro v4.5.1"
LBexe$ = "lbpro.exe"
end if
goto [check]
end if
if fileExists(upath$;"\AppData\Roaming\Liberty Basic Pro v4.5.1", "freeform404.bas") then
uAppPath$ = upath$;"\AppData\Roaming\Liberty Basic Pro v4.5.1"
LBpath$ = "c:\Program Files (x86)\Liberty Basic Pro v4.5.1"
if fileExists(LBpath$, "lbpro.exe") then
LBexe$ = "lbpro.exe"
goto [check]
end if
end if
if fileExists(upath$;"\Application Data\Liberty Basic v4.5.1", "freeform450.bas") then
uAppPath$ = upath$;"\Application Data\Liberty Basic v4.5.1"
LBpath$ = "c:\Program Files (x86)\Liberty Basic v4.5.1"
if fileExists(LBpath$, "liberty.exe") then
LBexe$ = "liberty.exe"
end if
end if
[check]
text$ = chr$(13)+" Liberty Basic v4.5.1 was not installed to the default Install folder."+chr$(13)+chr$(13)+"Would you like to Browse to and Select your Liberty Basic 4.5.1"+chr$(13)+"(or Pro)"+chr$(13)+"Install Folder"
'if Liberty Basic v4.5.1 is NOT installed to it's Default Install Dir, get Path from User using folder dialog
if fileExists(LBpath$, LBexe$) <> 0 then [start] else a$ = custcon$(text$)
if answer$ <> "Yes" then end
caption$ = "Navigate to, and Select YOUR Liberty Basic v4.5.1 (or Pro) Install Dir"
call browser, caption$
if right$(FolderDialog$, 1) = "\" then FolderDialog$ = left$(FolderDialog$, len(FolderDialog$)-1)
if FolderDialog$ = "" then notice "Liberty Basic v4.5.1 must be installed to continue" : end
LBpath$ = FolderDialog$
open "codetank.ini" for output as #1
#1 LBpath$ : close #1
if fileExists(LBpath$, "liberty.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic v4.5.1"
LBexe$ = "liberty.exe"
end if
if fileExists(LBpath$, "lbpro.exe") then
uAppPath$ = upath$;"\Application Data\Liberty Basic Pro v4.5.1"
LBexe$ = "lbpro.exe"
end if
return
'FastCode written by cundo, a member of the Liberty Basic / Just Basic Forums
'edited by xxgeek to suit this app
[fastcode]
dim windowTypes$(19)
windowTypes$(0)= "":windowTypes$(1)= "dialog":windowTypes$(2)= "dialog_fs":windowTypes$(3)= "dialog_nf":windowTypes$(4)= "dialog_nf_fs"
windowTypes$(5)= "dialog_ns_modal":windowTypes$(6)= "dialog_modal":windowTypes$(7)= "dialog_popup":windowTypes$(8)= "graphics"
windowTypes$(9)= "graphics_fs":windowTypes$(10) = "graphics_nf":windowTypes$(11)= "graphics_nsb":windowTypes$(12)= "graphics_nsb_nf"
windowTypes$(13)= "text":windowTypes$(14)= "text_fs":windowTypes$(15)= "text_nsb":windowTypes$(16)= "text_nsb_ins":windowTypes$(17)= "window"
windowTypes$(18)= "window_nf":windowTypes$(19)= "window_popup"
WindowWidth = 430:WindowHeight = 470
UpperLeftX= int((DisplayWidth-WindowWidth)/2)
UpperLeftY= int((DisplayHeight-WindowHeight)/2)
BackgroundColor$ = "lightgray"
ForegroundColor$ = "black"
texteditor #fastcode.ed, 8, 130, 400, 200
statictext #fastcode.fastcode, "Create Window Code", 135, 5, 165, 20
statictext #fastcode.st1, "< Name && Handle >", 150, 25, 128, 20
statictext #fastcode.st1, "Window Type", 50, 55, 90, 20
textbox #fastcode.txt1, 290, 20, 115, 20
textbox #fastcode.txt2, 20, 20, 115, 20
combobox #fastcode.combo, windowTypes$(, dummy, 145, 50, 140, 20
checkbox #fastcode.r1, "Use Labels instead of Subs", dummy, dummy, 8, 90, 222, 20
button #fastcode.button1, "&Generate Code ^ + > Copy to Clipboard", dummy, ul, 70, 340, 270, 25
button #fastcode.preview, "Preview", [preview], ul, 160, 375, 75, 25
open "FastCode by cundo" for window as #fastcode
#fastcode "trapclose [quit.fastcode]"
#fastcode "font arial 10 Bold"
#fastcode.txt1 "#main"
#fastcode.txt2 "untiltled"
#fastcode.combo "selectindex 17"
fastcodeOpen = 1
#codeTank.fastwindows "!disable"
#fastcode.r1 "set"
wait
[preview]
temp$ = "temp.bas"
open temp$ for output as #1
#fastcode.ed "!contents? code$"
#1 code$
close #1
run LBpath$;"\";LBexe$;" -A ";DefaultDir$;"\";temp$
wait
[quit.fastcode]
close #fastcode
fastcodeOpen = 0
#codeTank.fastwindows "!enable"
wait
'The [Search] button was pressed, or after searching/changing font size etc, the program was directed back here.
[search]
#codeTank.tb "!enable" : #codeTank.tb "!selectall"
done = 0
count = 0
#results.default "!setfocus"'
wait
[startSearching]
#codeTank.tb "!disable"
redim searchList$(10)
if resultsOpen = 0 then gosub [results]
#codeTank.tb "!contents? searchFor$"
if searchFor$ = "" then [search]
searchList$(0) = " "
searchList$(1) = " "
searchList$(2) = " Searching the Liberty Basic v4.5.1 Files"
searchList$(3) = " "
searchList$(4) = " For Files containing ";upper$(searchFor$)
searchList$(5) = " "
searchList$(6) = " "
searchList$(7) = " "
searchList$(8) = " "
searchList$(9) = " P L E A S E W A I T"
#results.listbox2 "reload"
searchFor$=trim$(searchFor$)
count = 3
cursor hourglass
redim searchList$(2600)
redim oneOf$(2500)
#results.listbox2 "setfocus"
'search lb help files
if lbHelp = 1 then
files helpFilePath$;"\html", info$()
numFiles = val(info$(0,0 ))
for i = 1 to numFiles
fileToOpen$ = info$(i, 0)
open helpFilePath$;"\html\"; fileToOpen$ for input as #2
contents$ = input$(#2, lof(#2)) : close #2
if instr(lower$(contents$), lower$(searchFor$)) then
x = 1
if lower$(searchFor$) = "and" then oneOf$(count) = "H_AND" : count = count + 1
if lower$(searchFor$) = "not" then oneOf$(count) = "H_NOT" : count = count + 1
if lower$(searchFor$) = "xor" then oneOf$(count) = "H_XOR" : count = count + 1
if lower$(searchFor$) = "or" then oneOf$(count) = "H_OR" : count = count + 1
listName$ = helpFilePath$;"\html\"; fileToOpen$
open listName$ for input as #1 : isOpen = 1
while not(eof(#1))
scan
line input #1, name$
if x = 5 and lower$(left$(name$, 7)) = lower$("<TITLE>") then
name3$ = mid$(name$, 8, len(name$)-15) : if right$(name3$, 4) = "Etc." then name3$ = left$(name3$, len(name3$) - 1)
oneOf$(count) = "H_";name3$ : count = count + 1
end if'
if x = 8 and left$(lower$(name$), 7) = lower$("<TITLE>") then
name5$ = mid$(name$, 8, len(name$)-15)
oneOf$(count) = "H_";name5$ : count = count + 1
end if
if x = 12 and left$(name$ , 5) = "<P><A" then
name8$ = word$(name$, 2, "</A><B>") : name8$ = left$(name8$, len(name8$)-8)
oneOf$(count) = "H_";name8$ : count = count + 1
end if
if x = 14 and left$(name$ , 3) = "<P>" then
name7$ = mid$(name$, 4, len(name$)-7)
oneOf$(count) = "H_";name7$ : count = count + 1
end if
if x = 15 and right$(name$, 8) = "</B></P>" then
name11$ =word$(name$, 2, "B>") : name11$ = left$(name11$, len(name11$)-2)
oneOf$(count) = "H_";name11$ : count = count + 1
exit while
end if
x = x + 1
wend
if isOpen = 1 then close #1 : isOpen = 0
end if
next i
end if
'Search the LB Code Examples Files
if lbexamples = 1 then
files uAppPath$, "*.bas", info$()
numFiles = val(info$(0,0 ))
for i = 1 to numFiles
fileToOpen$ = info$(i, 0)
open uAppPath$;"\";fileToOpen$ for input as #2
contents$ = input$(#2, lof(#2)) : close #2
if instr(lower$(contents$), lower$(searchFor$)) then
name$ = upper$(fileToOpen$)
name20$ = left$(name$, len(name$)-4)
oneOf$(count) = "CE_";name20$ : count = count + 1
end if
next i
end if
'Search the CodeBank saved .bas files
if codeTank = 1 then
files DefaultDir$;"\BAS", "*.bas", info$()
numFiles = val(info$(0,0 ))
for i = 1 to numFiles
fileToOpen$ = info$(i, 0)
open "BAS";"\";fileToOpen$ for input as #2
contents$ = input$(#2, lof(#2)) : close #2
if instr(lower$(contents$), lower$(searchFor$)) then
name$ = upper$(fileToOpen$)
name20$ = left$(name$, len(name$)-4)
oneOf$(count) = "CB_";name20$ : count = count + 1
end if
next i
end if
'if no search results found
if count < 4 then
#results.listbox2 "reload"
searchList$(0) = " "
searchList$(1) = " "
searchList$(2) = " "
searchList$(3) = " Nothing found for: ";upper$(searchFor$)
searchList$(4) = " "
searchList$(5) = " "
searchList$(6) = " "
searchList$(7) = " Try Adding more Categories "
searchList$(8) = " "
searchList$(9) = " To the Search Engine"
searchList$(10) = " "
searchList$(11) = " Using the CheckBoxes"
searchList$(12) = " "
searchList$(13) = " To Visit the Liberty Basic Forums"
searchList$(14) = " "
searchList$(15) = " Click the Link Below"
searchList$(16) = " "
searchList$(17) = " https://libertybasiccom.proboards.com/"
searchList$(18) = " "
searchList$(19) = " "
searchList$(20) = " "
#results.listbox2 "reload"
cursor normal
end if
'sort the list of possible results
sort oneOf$(), 0, count
dim b$(count+1)
happened$="|"
K = 0
'filter out the false Titles (Due to differences in html help pages source code - Title not on same line in all files)
for i = 0 to count
name$ = oneOf$(i)
if right$(name$, 1) = ">" or right$(name$, 6) = "window" or left$(name$, 5) = "H_ame" or right$(name$, 8) = "position"_
or left$(name$, 5) = "H_GCO" or right$(name$, 1) = ":" or left$(name$, 3) = "H_<" _
or left$(name$, 3) = "H_"+chr$(39) or right$(name$, 1) = "." or right$(name$, 1) = " " or right$(name$, 8) = "[branch]"_
or right$(name$, 3) = "] )" or right$(name$, 3) = "] ]" or right$(name$, 6) = "items)" or name$ = "H_WHILE...WEND"_
or right$(name$, 5) = "size)" or right$(name$, 1) = ";" or right$(name$, 5) = "LEN=n" or right$(name$, 7) = "number)" _
or right$(name$, 7) = "#handle" or right$(name$, 4) = "varN" or right$(name$, 4) = "...)" or right$(name$, 2) = "];" _
or right$(name$, 1) = "v" or right$(name$, 8) = "fontSpec" or right$(name$, 7) = "expr2 )" or right$(name$, 2) = "))"_
or right$(name$, 12) = "variableName" or right$(name$, 4) = "num2"or right$(name$, 5) = ".bmp"+chr$(34)_
or right$(name$, 2) = chr$(34)+")" or right$(name$, 4) = "var"+chr$(36) or right$(name$, 4) = ",n])"_
or right$(name$, 4) = "expr" or right$(name$, 4) = "num2" or right$(name$, 9) = chr$(34)+"refresh"+chr$(34)_
or right$(name$, 3) = "g])" or right$(name$, 6) = "Label]" or right$(name$, 8) = "#handle)" or right$(name$, 9) = "String$ )"_
or right$(name$, 11) = "Expression)" or right$(name$, 10) = "expression" or right$(name$, 9) = "[number])"_
or right$(name$, 7) = "struct)" or right$(name$, 7) = "comment" or right$(name$, 12) = "recordNumber"_
or right$(name$, 5) = "size)" or right$(name$, 6) = "follow" or right$(name$, 6) = "mode ]" or right$(name$, 8) = "number )" or name$ = "H_TRACE number"_
or right$(name$, 8) = "[column]" or right$(name$, 10) = "#handle, n" or right$(name$, 2) = " 1" or right$((left$(name$, 7)), 5) = chr$(34)+"Font"_
or right$(name$, 9) = "{LEN = n}" or right$(name$, 5) = "Expr2" or right$(name$, 6) = "length"or left$(name$, 9) = "H_Install"_
or right$(name$, 10) = "#newHandle" or right$(name$, 12) = "columns rows" or right$(name$, 5) = "Expr$"_
or left$(name$, 4) = "var =" or right$(name$, 6) = "xpr2 )" or left$(name$, 3) = "H_(" or right$(name$, 6) = chr$(34)+"name"+chr$(34) _
or right$(name$, 4) = "#h )" or right$(name$, 9) = "#handle )" or right$(name$, 1) = "?" or right$(name$, 1) = "."_
or name$ = "H_DO LOOP" or name$ = "H_FOR...NEXT" or name$ = "H_Winstring" or right$(name$, 8) = "value"+chr$(34)+" )"_
or right$(name$,1) = "?" or right$(name$,3) = "c$)" or right$(name$,8) = "Keywords" or name$ ="H_Boolean Evaluations"_
or left$(name$, 3) = "H_&" or name$ = "H_" or name$= "H_var = MIDIPOS( )" or name$ = "H_TRACE ( number )"_
or name$ = "H_StartupDir" or name$ = "H_EVAL" or name$ = "H_EVAL$" or right$(name$, 4) = "face" or left$(name$, 10) = "H_The Liberty"_
or name$ = "H_REPLSTR" or name$ = "H_UPPER$(s)" or right$(name$,8) = "[END IF]" or name$ = "H_LOWER$(s$)" then
oneOf$(i) = ""
end if
'remove any duplicates from search list (Thanks to tsh73)
'if instr(oneOf$(i), "Liberty") then oneOf$(i) = replace$(name$, "Liberty", "Liberty")
if lower$(nameLast$) = lower$(name$) then oneOf$(i) = ""
if instr(happened$, "|";oneOf$(i);"|")=0 then
happened$=happened$;oneOf$(i);"|"
K=K+1: b$(K)=oneOf$(i)
end if
nameLast$ = name$
next i
'Create final list of search results
for x = 0 to K
if lower$(word$(b$(x), 2, "_")) = lower$(searchFor$) then match$ = b$(x)
if instr(lower$(b$(x)), lower$(searchFor$)) _
and lower$(mid$(b$(x), 3, len(searchFor$))) = lower$(searchFor$)_
or lower$(mid$(b$(x), 4, len(searchFor$))) = lower$(searchFor$) then_
searchList$(u+7) = b$(x) : u = u+1
next x
for t = 0 to K
if instr(lower$(b$(t)), lower$(searchFor$)) then
if lower$(mid$(b$(t), 3, len(searchFor$))) <> lower$(searchFor$)_
and lower$(mid$(b$(t), 4, len(searchFor$))) <> lower$(searchFor$) then
searchList$(u+v+16) = b$(t) : v = v+1
end if
end if
next t
for a = 0 to K
if not(instr(lower$(b$(a)), lower$(searchFor$))) then_
searchList$(u+v+ww+23) = b$(a) : ww = ww+1
next a
'manage the headers
searchList$(0) = " Search Results"
searchList$(1) = " "
searchList$(2) = " ";u+v;" Titles Containing ";q$;upper$(searchFor$);q$
if u+v <> 0 then searchList$(3) = " "
if u+v = 0 then searchList$(2) = " No Titles Found for ";q$;upper$(searchFor$);q$';" Found"
searchList$(4) = " "
if u <> 0 and v<>0 then searchList$(5) = " ";u;" Top Picks For ";q$;upper$(searchFor$);q$
searchList$(u+11) =" "
if v <> 0 and v<>u+v then searchList$(u+13) = " ";v;" Remaining Titles "'
if v <> 0 then searchList$(u+14) =" "
if v <> 0 then searchList$(v+u+19) = " "
if ww-2 <> 0 then searchList$(v+u+20) = " ";ww-3;" Other Pages Containing ";upper$(searchFor$)
if u+v = 0 then searchList$(1) = " ";ww-2;" Pages Containing ";upper$(searchFor$)
searchList$(v+u+21) = " "
searchList$(v+u+ww+22) = " "
searchList$(v+u+ww+23) = " If you need more information "
searchList$(v+u+ww+24) = " on "
searchList$(v+u+ww+25) = " Liberty Basic v4.5.1 Coding "
searchList$(v+u+ww+26) = " "
searchList$(v+u+ww+27) = " Please Visit"
searchList$(v+u+ww+28) = " "
searchList$(v+u+ww+29) = " The Liberty Basic Forums by"
searchList$(v+u+ww+30) = " "
searchList$(v+u+ww+31) = " Clicking the link Below"
searchList$(v+u+ww+32) = " "
searchList$(v+u+ww+33) = " https://libertybasiccom.proboards.com/"
searchList$(v+u+ww+34) = " "
searchList$(v+u+ww+35) = " "
searchList$(v+u+ww+36) = " "
searchList$(v+u+ww+37) = " "
if match$ <> "" then searchList$(4) = " 1 Match "
#results.listbox2 "reload" : #results.default "!setfocus"
'finished displaying results - reset variables - cursor back to normal
[doneSearching]
u = 0 : v = 0 : ww = 0 : match$ = "" : count = 0
#codeTank.tb "!enable"
#codeTank.tb "!selectall"
#codeTank.tb "!setfocus"
#results.listbox2 "setfocus"
cursor normal
wait
'One of the Help Search results was Selected - Open the Help File in user's default browser
[openFile]
if lbHelp = 1 then
#results.listbox2 "selection? selectionH$"
selectionH$ = trim$(selectionH$)
if selection$ = " https://libertybasiccom.proboards.com/" then_
selection$ = right$(selection$, len(selection$)-1) : run "explorer ";selection$ : wait
selectionH$ = right$(selectionH$, len(selectionH$) - 2)
if selectionH$ = "XOR" or selectionH$ = "AND" or selectionH$ = "NOT" or selectionH$ = "OR" then
run "explorer.exe ";helpFilePath$;"\html\libe0azy.htm" : wait
end if
files helpFilePath$;"\html", info$()
numFiles = val(info$(0,0 ))
for i = 1 to numFiles
fileToOpen$ = info$(i, 0)
open helpFilePath$;"\html\";fileToOpen$ for input as #3
contents$ = input$(#3, lof(#3)) : close #3
if instr(lower$(contents$), lower$("<title>";selectionH$;"</TITLE>")) then
if fileToOpen$ = "idecode451.html" then fileToOpen$ = "libe0ze8.htm"
if fileExists("", "htmlviewer.exe") <> 0 then
run "htmlviewer.exe ";helpFilePath$;"\html\";fileToOpen$ : done = 1 : wait
else
run "explorer.exe ";helpFilePath$;"\html\";fileToOpen$ : done = 1 : wait
if instr(lower$(contents$), lower$("</A><B>";selectionH$;"</B></P>")) then
if fileExists("", "htmlviewer.exe") <> 0 then
run "htmlviewer.exe ";helpFilePath$;"\html\";fileToOpen$ : done = 1 : wait
else
run "explorer.exe ";helpFilePath$;"\html\";fileToOpen$ : done = 1 : wait
end if
end if
end if
end if
next i
end if
'a Code Example file was selected
if lbexamples = 1 then
#results.listbox2 "selection? selectionCE$"
selectionCE$ = right$(selectionCE$, len(selectionCE$) - 3)
if fileExists(uAppPath$, selectionCE$;".bas") then
run LBpath$;"\";LBexe$;" ";uAppPath$;"\";selectionCE$;".bas" : wait
end if
end if
'a Code Bank .bas file backup was selected
if codeTank = 1 then
#results.listbox2 "selection? selectionCB$"
selectionCB$ = right$(selectionCB$, len(selectionCB$) - 3)
if fileExists(DefaultDir$;"\BAS", selectionCB$;".bas") then
run LBpath$;"\";LBexe$;" ";DefaultDir$;"\BAS\";selectionCB$;".bas" : wait
end if
end if
'if the link to the Liberty basic Forums is clicked (link at bottom of search results)
#results.listbox2 "selection? selection$"
if selection$ = " https://libertybasiccom.proboards.com/" then_
selection$ = right$(selection$, len(selection$)-1) : run "explorer ";selection$ : wait
wait
'a selection was made from the Help Menu list
[mainList]
#codeTankList.listbox1 "selection? h$"
fileToOpen$= word$( h$,2,chr$(0))
fileToOpen$=replace$( fileToOpen$ , "/", "\" )
if fileExists(DefaultDir$, "htmlviewer.exe") <> 0 then run "htmlviewer.exe ";helpFilePath$; "\"; fileToOpen$_
else_
if fileExists(helpFilePath$, fileToOpen$) <> 0 then run "explorer.exe ";helpFilePath$; "\"; fileToOpen$
wait
'show results
[results]
if resultsOpen = 1 then return
WindowWidth = 255 : WindowHeight = 600
UpperLeftX=int((DisplayWidth-WindowWidth)/2) + 600
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
listbox #results.listbox2, searchList$(, [openFile], 0, 0, 256, 600
button #results.default, "", [startSearching], UL, 0, 0, 0, 0
Open "LB HELP SEARCH RESULTS" for dialog as #results
resultsOpen = 1
#results "trapclose [quitResults]"
#results.listbox2 "reload"
#results.listbox2 "singleclickselect"
if fontsize <> 0 then fontsize = fontsize else fontsize = 9
#results.listbox2 "font Arial_bold 0 ";fontsize+6
#results.listbox2 "setfocus"
return
'show LB Help Menu - button
[Contents]
if mainListOpen = 1 then #codeTankList.default "!setfocus" : #codeTank.tb "!setfocus" : wait
open helpFilePath$; "\"; helpFileMenu$ for input as #1
txt$ = input$(#1, lof(#1))
close #1
'Load the "Contents" menu list array
lowerTxt$= lower$(txt$)
while 1
scan
startAt = c+1
a = instr(lowerTxt$, "href",startAt)
b = instr(lowerTxt$, ">",a+1)
c = instr(lowerTxt$, "</a>",b+1)
if a=0 or b=0 or c= 0 then exit while
hrefA= instr(lowerTxt$,chr$(34),a+1)
hrefB= instr(lowerTxt$,chr$(34),hrefA+1)
idx = idx +1
mainList$(idx)= trim$(mid$(txt$,b+1,c-b-1));chr$(0);_
trim$(mid$(txt$,hrefA+1,hrefB-hrefA-1))
wend
WindowWidth = 255 : WindowHeight = 600
UpperLeftX=int((DisplayWidth-WindowWidth)/2 + 600)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
listbox #codeTankList.listbox1, mainList$(, [mainList], 0, 0, 256, 600
button #codeTankList.default, "&GO", [search], UL, 0, 0, 0, 0
Open "Liberty Basic v4.5.1 Help Menu" for dialog as #codeTankList
mainListOpen = 1
#codeTankList "trapclose [quitMainList]"
#codeTankList.listbox1 "singleclickselect"
#codeTankList.listbox1 "reload"
if fontsize <> 0 then fontsize = fontsize else fontsize = 9
#codeTankList.listbox1 "font Arial_bold 0 ";fontsize+6
idx = 0
#codeTankList.listbox1 "setfocus"
'if resultsOpen = 1 then #codeTank.tb "!setfocus"
wait
'resize window font - sets all Listbox fonts equal
[incFontSearch]
fontsize = fontsize + 1
if resultsOpen = 1 then #results.listbox2 "font Arial_bold 0 ";fontsize+6
if mainListOpen = 1 then #codeTankList.listbox1 "font Arial 0 ";fontsize+6
if resultsOpen = 1 then #results.default "!setfocus"
wait
[decFontSearch]
fontsize = fontsize - 1
if resultsOpen = 1 then #results.listbox2 "font Arial_bold 0 ";fontsize+6
if mainListOpen = 1 then #codeTankList.listbox1 "font Arial 0 ";fontsize+6
if resultsOpen = 1 then #results.default "!setfocus"
wait
'set and reset checkboxes for search categories
[lbHelp] lbHelp = 1
if resultsOpen = 1 then #results.default "!setfocus"
wait
[nolbHelp] lbHelp = 0
if resultsOpen = 1 then #results.default "!setfocus"
wait
[lbexamples] lbexamples = 1
if resultsOpen = 1 then #results.default "!setfocus"
wait
[nolbexamples] lbexamples = 0
if resultsOpen = 1 then #results.default "!setfocus"
wait
[cbank] codeTank = 1
if resultsOpen = 1 then #results.default "!setfocus"
wait
[nocbank] codeTank = 0
if resultsOpen = 1 then #results.default "!setfocus"
wait
'The [?] or 'help' button for this program was pressed
[searchhelp]
if helpOpen = 1 then wait
notice " Tiny LB-Search Help File";_
CHR$(13);CHR$(13);_
"Type your Search Word ( no char minimum ), and hit [Search In >]";_
" If your text doesn't appear at any time, just hit [Enter] and start typing agin";_
CHR$(13);_
CHR$(13);_
"Search results are marked to indicate the category they represent";_
CHR$(13);_
CHR$(13);" CHECKBOXES and CATEGORIES: ";_
CHR$(13);_
"H= LB Help, CE= LB Code Examples, CT = CodeTank Files";_
CHR$(13);_
CHR$(13);_
"Results marked H open help pages in your default browser";_
CHR$(13);_
"C stands for Code - Results marked CE, and CT open in Liberty Basic";_
CHR$(13);CHR$(13);_
CHR$(13);CHR$(13);_
"Alt + F4 closes the open window with focus";_
" unless another window is clicked on";_
CHR$(13);CHR$(13);_
"Use + or - to Adjust Font Size - Fontsize changes on all Lists, opened or not";_
CHR$(13);CHR$(13);_
CHR$(13);CHR$(13);" ADDING TO the Liberty BASIC RUN MENU";_
CHR$(13);CHR$(13);_
"How to ADD this to the Liberty BASIC menu Run > for easy access.";_
CHR$(13);_
"1) To Make the TKN file : Top Menu > Run > Make *.tkn File.";_
" Use any name for the file when the -File 'Save As'- window opens";_
" Remember the File Location, and Name of the File.";_
CHR$(13);_
"2) In Liberty Basic click the menu item: Setup > External Programs";_
CHR$(13);_
"3) Click on New , type a name that suits the app, eg: LB_Help_Search";_
" This name will appear in LB's Menu as Run > NameYouChose ";_
CHR$(13);_
"4) Click on Create Item.";_
CHR$(13);_
"5) Click the Browse Button, then navigate to the .tkn File created in step 1.";_
CHR$(13);_
"6) Liberty BASIC will inform you changes take effect after restarting Liberty Basic."
helpOpen = 1
wait
'close Help List
[quitMainList]
if resultsOpen = 1 then close #results : resultsOpen = 0
close #codeTankList : mainListOpen = 0
wait
'close results List
[quitResults]
close #results : resultsOpen = 0
wait
[fastGui]
'Title FFUltra v2.x author = Rod
'version FFNSL_vxx2.0
'edited by xxgeek
fastGuiOpen = 1
ver$="xx2.0"
'nomainwin
dim info$(10,10)
dim form$(10)
form$(1)="Restore"
form$(2)="New"
form$(3)="Save .ffu"
form$(4)="Load .ffu"
form$(5)="-----------"
form$(6)="Write .bas"
form$(7)="Import .bas"
form$(8)="Export .bas"
form$(9)="File"
dim hnd$(30)
hnd$(1)="#1"
dim grid$(20)
grid$(1)="1"
grid$(2)="3"
g=3
for n= 5 to 30 step 5
grid$(g)=str$(n)
g=g+1
next
grid$(g)="Invisible"
grid$(g+1)="Visible"
grid$(g+2)="Set Grid"
grid=10
gridvisible=1
gridcolor$="buttonface"
projectctrh=25
ctrh=25
dim color$(10)
color$(1)="Control Back"
color$(2)="Project Back"
color$(3)="Project Fore"
color$(4)="Grid Color"
color$(5)="Border Color"
color$(6)="CrossHair"
color$(7)="Set Color"
projectback$="white"
projectfore$="black"
dim font$(10)
font$(1)="Control Font"
font$(2)="ResetControl"
font$(3)="Project Font"
font$(4)="Set Font"'default is Consolas 9"
dim wind$(20)'window type names
wind$(1)="window"
wind$(2)="window_nf"
wind$(3)="window_popup"
wind$(4)="dialog"
wind$(5)="dialog_modal"
wind$(6)="dialog_nf"
wind$(7)="dialog_nf_modal"
wind$(8)="dialog_fs"
wind$(9)="dialog_nf_fs"
wind$(10)="dialog_popup"
wind$(11)="graphics"
wind$(12)="graphics_fs"
wind$(13)="graphics_fs_nsb"
wind$(14)="graphics_nsb"
wind$(15)="graphics_nf_nsb"
wind$(16)="text"
wind$(17)="text_fs"
wind$(18)="text_nsb"
wind$(19)="text_nsb_ins"
dim v$(2000)
for n= 100 to 2000 step 20
v$(n)=str$(n)
next
dim obj(200,6) 'x,y,width/height,type,textheight
XX=1
Y=2
W=3
H=4
TT=5
TH=6
dim obj$(200,7) 'name,text,resource,font,backcolor,basline
Ctr=1
Tex=2
Ress=3
Fon=4
Bak=5
Bass=7
'set default starting position
projectfile$="Untitled.bas"
projectwind$="window_nf"
projecttitl$="Untitled"
projectform$="#1"
projectctrl$=""
projecttext$=""
projectreso$=""
projectfont$="Consolas 9"
projectback$="white"
projectfore$="black"
projecttbcl$="white"
projectlbcl$="white"
projectcbcl$="white"
projecttecl$="white"
gridcolor$="buttonface"
bordercolor$ = "darkgray" 'border of grid dimension limits of x,y
crosshair$ = gridcolor$ 'crosshair available in grid = 0 or grid = 1
barrier = 1 'barrier - form dimension limit - when tracking / resizing controls
negbar = 1 'negative barrier - less than zero - when tracking / resizing controls
projectctrh=25
projectgrid=10
projectw=600
projecth=400
insertx=grid
inserty=grid*2
'open a small progress bar window and hide it
WindowWidth=230
WindowHeight=60
UpperLeftX=(DisplayWidth-230)/2
UpperLeftY=(DisplayHeight-350)/2
graphicbox #prog.gb1,10,0,200,25
open "Import" for window_nf as #prog
#prog "font Consolas 9"
#prog "hide"
progOpen = 1
'open a small properties window and hide it
WindowWidth=230
WindowHeight=260
UpperLeftX=(DisplayWidth)/2+420
UpperLeftY=(DisplayHeight-180)/2
statictext #prop.st1 "File",5,10,30,25
textbox #prop.tbfile,45,5,150,25
statictext #prop.st2 "Wind",5,32,30,25
combobox #prop.cbwind,wind$(,[windowtype],47,29,146,25
statictext #prop.st3 "Titl",5,54,30,25
textbox #prop.tbtitl,45,49,150,25
statictext #prop.st4 "Form",5,76,30,25
textbox #prop.tbform,45,71,150,25
statictext #prop.st5 "Ctrl",5,98,30,25
textbox #prop.tbctrl,45,93,150,25
statictext #prop.st6 "Text",5,120,30,25
textbox #prop.tbtext,45,115,150,25
statictext #prop.st7 "Reso",5,142,30,25
textbox #prop.tbreso,45,137,150,25
statictext #prop.st8 "xywh",5,164,30,25
textbox #prop.tbxywh,45,159,150,25
statictext #prop.st9 "Font",5,186,30,25
textbox #prop.tbfont,45,181,150,25
statictext #prop.st10 "Colo",5,208,30,25
textbox #prop.tbcolo,45,203,150,25
open "Properties" for window_nf as #prop
#prop "font Consolas 9"
#prop "trapclose [show]"
#prop.cbwind "select window_nf"
#prop.tbfile "!disable"
#prop.tbxywh "!disable"
#prop.tbfont "!disable"
#prop.tbcolo "!disable"
gosub [propertyupdate]
#prop "hide"
propOpen = 1
'open the main form window
'this window is resizable, the graphicox will resize but the
'client area, which is a drawn representation of the window
'will only change size if you change the project w/h dimensions
WindowWidth=862
WindowHeight=600 'gb is offset by 25
UpperLeftX=(DisplayWidth-WindowWidth)/2
UpperLeftY=(DisplayHeight-WindowHeight)/2
combobox #fful.fastfunctionsList,fastfunctionsList$(),fastfunctionSelected,680,2,140,25
combobox #fful.form,form$(,[form],5,2,85,30
combobox #fful.hand,hnd$(,[hand],91,2,85,30
button #fful.code,"Co&de",[code],UL,177,0,43,25
button #fful.gui,"G&UI",[prev],UL,222,0,40,25
combobox #fful.w,v$(,[formsize],265,2,55,30
combobox #fful.h,v$(,[formsize],321,2,55,30
combobox #fful.grid,grid$(,[grid],375,2,90,30
statictext #fful.gridsize "10",470,7,15,15
combobox #fful.color,color$(,[color],490,2,90,30
combobox #fful.font,font$(,[font],585,2,90,30
button #fful.barrier,"No Barrier &+",[barrier],UL,850,0,100,20
button #fful.help,"&?",[help],UL,820,0,25,25
button #fful.negbarrier,"No Barrier &-",[negbarrier],UL,850,22,100,20
statictext #fful.corner, "UpperLeft",960,12,75,15
statictext #fful.cornertext, " Corner >",960,25,85,15
statictext #fful.Xco, "x 0" ,1045,2,65,20
statictext #fful.Yco, "y 0",1045,24,65,20
button #fful.mnu,"&Menu",[bttnMNU],UL,5,25,45,20
button #fful.button,"&Button",[bttnBTTN],UL,50,25,55,20
button #fful.textbox,"&Textbox",[bttnTXBX],UL,105,25,65,20
button #fful.lstbx,"&Listbox",[bttnLSTBX],UL,170,25,65,20
button #fful.cmbobx,"&Combobox",[bttnCMBOBX],UL,235,25,65,20
button #fful.statictext,"&Statictext",[bttnSTTX],UL,300,25,80,20
button #fful.bmpbttn,"BM&Pbutton",[bttnBMPBTTN],UL,380,25,75,20
button #fful.grphcbx,"&Graphicbox",[bttnGRPHCBX],UL,455,25,80,20
button #fful.rdiobttn,"&Radiobutton",[bttnRDBTTN],UL,535,25,85,20
button #fful.chckbx,"Chec&kbox",[bttnCHKBX],UL,620,25,70,20
button #fful.grpbx,"Groupbo&x",[bttnGRPBX],UL,690,25,70,20
button #fful.txtedtr,"Text&editor",[bttnTXTEDTR],UL,760,25,85,20
graphicbox #fful.gb,5,45,830,510
textbox #fful.path,1115,0,200,20
combobox #fful.blocks,block$(,[block],1115,22,200,30
open ver$;" Form Preview Form Dimensions Grid - Size Colors Fonts Add Subs\Functions Help Form Limits (X,Y) Coordinates" for window as #fful
#fful "trapclose [quitfful]"
#fful "font Consolas 9 "
#fful.Xco "!font Consolas 11 "
#fful.Yco "!font Consolas 11 "
#fful "resizehandler [resize]"
#fful.hand "selectindex 1"
#fful.grid "select Set Grid"
#fful.color "select Set Color"
#fful.font "select Set Font"
#fful.w "select ";projectw
#fful.h "select ";projecth
#fful.gb "autoresize"
#fful.gb "vertscrollbar on 0 ";projectw
#fful.gb "horizscrollbar on 0 ";projecth
#fful.gb "font ";projectfont$
#fful.gb "down"
#fful.path "File - untitled.ffu"
#fful.form "!File"
block$(1) = " ! COMING SOON ! "
#fful.blocks "reload"
#fful.blocks "!Add Code Blocks/Snippets"
#fful.fastfunctionsList "!Subs / Functions"
fastfunctionsList$(1) = " ! COMING SOON ! "
#fful.fastfunctionsList "reload"
gosub [drawgrid]
gosub [drawall]
#fful.gb "when rightButtonDown [show]"
#fful.gb "when leftButtonDown [select]"
#fful.gb "when characterInput [keys]"
'load subs and functions combobox
#fful.gb "setfocus"
#prop "show"
show=1
fastGuiOpen = 1
#codeTank.fastgui "!disable"
wait
[show]
if show then
#prop "hide"
show=0
else
#prop "show"
show=1
end if
wait
'the user clicked on the form design window
'either to chose a control or to deselect a control
[select]
xs=MouseX
ys=MouseY
'hide property window if it is open
if show then
#prop "hide"
show=0
end if
'before we move on update the currently selected control from properties
'get the project data and only the editable contents of controls
if selected=0 then
'the form name #xxxx
#prop.tbform "!contents? t$"
if t$<>projectform$ then
projectform$=t$
dim hnd$(10)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "select ";projectform$
end if
'the form/window title text
#prop.tbtitl "!contents? t$"
if t$<>projecttitl$ then projecttitl$=t$
end if
#prop.tbctrl "!contents? t$" : obj$(selected,Ctl)=t$
#prop.tbtext "!contents? t$" : obj$(selected,Tex)=t$
#prop.tbreso "!contents? t$" : obj$(selected,Ress)=t$
'find the object selected by user
selected=0
action=1 ' 1=move 2=expand - bmps dont expand
for cn=obj to 1 step -1
if xs>obj(cn,XX) and xs<(obj(cn,XX)+obj(cn,W)) and ys>obj(cn,Y) and ys<(obj(cn,Y)+obj(cn,H)) then
if xs>obj(cn,XX)+obj(cn,W)/1.4 and ys>obj(cn,Y)+obj(cn,H)/1.4 then action=2
if obj(cn,TT)=6 then action=1
selected=cn
exit for
end if
next
if selected=0 then
gosub [propertyupdate]
action=0
end if
if selected>0 and action=1 then
#fful.gb "when leftButtonMove [track]"
#fful.gb "when leftButtonUp [stop]"
offsetX=xs-obj(selected,XX)
offsetY=ys-obj(selected,Y)
end if
if selected>0 and obj(selected,TT)<>6 and action=2 then 'dont resize bmp
#fful.gb "when leftButtonMove [tracksize]"
#fful.gb "when leftButtonUp [stopsize]"
offsetX=xs-(obj(selected,XX)+obj(selected,W))
offsetY=ys-(obj(selected,Y)+obj(selected,H))
end if
if selected>0 then
gosub [drawit]
else
insertx=int((xs+(grid/2))/grid)*grid
inserty=int((ys+(grid/2))/grid)*grid
gosub [drawall]
end if
wait
'moving controls on form
[track]
#fful.corner "UpperLeft"
#fful.gb "rule xor"
gosub [drawit]
xt=int((MouseX-offsetX+(grid/2))/grid)*grid
if negbar then
if xt<1 then xt=0
end if
if xt+obj(selected,W)>projectw and barrier then xt=projectw-obj(selected,W)
obj(selected,XX)=xt
yt=int((MouseY-offsetY+(grid/2))/grid)*grid
if menuset = 0 and textEd = 0 then
if negbar then
if yt<0 then yt=0
end if
if yt+obj(selected,H)>projecth-25 and barrier then yt=projecth-obj(selected,H)-25
obj(selected,Y)=yt
end if
if menuset = 1 or textEd > 0 then
if negbar then
if yt < 0 then yt =0
end if
if yt+obj(selected,H)>projecth-50 and barrier then yt=projecth-obj(selected,H)-50
obj(selected,Y)=yt
end if
#fful.Xco "x ";str$(xt)
#fful.Yco "y ";str$(yt)
gosub [drawit]
wait
'when user stops moving mouse or lifts left button
[stop]
#fful.gb "when leftButtonMove"
#fful.gb "when leftButtonUp"
action=0
#fful.gb "rule over"
gosub [drawall]
wait
'resizing controls on form
[tracksize]
#fful.corner "BottomRight" 'print to window #fful for x,y coordinates
#fful.gb "rule xor"
gosub [drawit]
xs=int((MouseX-offsetX+(grid/2))/grid)*grid
if xs>projectw and barrier then xs=projectw
if xs<obj(selected,XX) then xs=obj(selected,XX)+grid
ys=int((MouseY-offsetY+(grid/2))/grid)*grid
if ys>projecth and barrier then ys=projecth
if ys<obj(selected,Y)+ctrh and barrier then ys=obj(selected,Y)+ctrh
obj(selected,W)=xs-obj(selected,XX)'
'form workspace changes when menu, or textEditor added/removed
if menuset = 1 or textEd > 0 then obj(selected,H)=ys-obj(selected,Y)-50'height
if menuset = 0 and textEd = 0 then obj(selected,H)=ys-obj(selected,Y)-25'height
#fful.Xco "x ";xs : #fful.Yco "y ";ys
gosub [drawit]
wait
[stopsize]
#fful.gb "when leftButtonMove"
#fful.gb "when leftButtonUp"
action=0
#fful.gb "rule over"
gosub [drawall]
wait
'user uses keys to copy/paste or delete controls
[keys]
k1=asc(right$(Inkey$,1))
k2=asc(left$(Inkey$,1))
if k1=46 then 'delete selected
if obj(selected,TT)=12 then menuset=0
if obj(selected,TT)=11 then textEd = textEd - 1
obj(selected,TT)=0
selected=0
gosub [drawgrid]
gosub [drawall]
end if
if k1=3 then 'copy control
cpy(1)=obj(selected,XX) 'x
cpy(2)=obj(selected,Y) 'y
cpy(3)=obj(selected,W) 'w
cpy(4)=obj(selected,H) 'h
cpy(5)=obj(selected,TT) 'type
cpy(6)=obj(selected,TH) 'textheight
cpy$(1)=obj$(selected,Ctr)'name
cpy$(2)=obj$(selected,Tex)'text content
cpy$(3)=obj$(selected,Ress)'resource array or file path
cpy$(4)=obj$(selected,Fon)'ctrl specific font or ""
cpy$(5)=obj$(selected,Bak)'ctrl specific backcolor
end if
if k1=22 then 'paste control
if cpy(5)<>0 then
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
inserty=inserty+cpy(4)+grid
obj(obj,W)=cpy(3)
obj(obj,H)=cpy(4)
obj(obj,TT)=cpy(5)
obj(obj,TH)=cpy(6)
obj$(obj,Ctr)=left$(cpy$(1),2);obj
obj$(obj,Tex)=cpy$(2)
obj$(obj,Ress)=cpy$(3)
if obj(obj,TT)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Ress)
if obj(selected,TT)=11 then textEd = textEd + 1 : gosub [drawgrid] 'keep track of # of texteditors
obj$(obj,Fon)=cpy$(4)
obj$(obj,Bak)=cpy$(5)
selected=obj
gosub [drawall]
end if
end if
#fful.gb "setfocus"
wait
'[tool]
'#fful.tool "selectionindex? i"
[drawTool]
cpy(5)=0
select case i
case 1 'statictext
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=130
obj(obj,H)=ctrh
obj(obj,TT)=1
obj$(obj,Ctr)="sttctxt";obj
obj$(obj,Tex)="StaticText ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectback$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 2 'textbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=140
obj(obj,H)=ctrh
obj(obj,TT)=2
obj$(obj,Ctr)="txtbx";obj
obj$(obj,Tex)="TextBox ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projecttbcl$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 3 'listbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=120
obj(obj,H)=ctrh*5
obj(obj,TT)=3
obj$(obj,Ctr)="lstbx";obj
obj$(obj,Tex)="ListBox ";obj;"\item2\item3\item4\item5"
obj$(obj,Ress)=obj$(obj,Ctr);"$("
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectlbcl$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 4 'combobox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=120
obj(obj,H)=ctrh
obj(obj,TT)=4
obj$(obj,Ctr)="cmbbx";obj
obj$(obj,Tex)="ComboBox ";obj;"\item2\item3\item4\item5"
obj$(obj,Ress)=obj$(obj,Ctr);"$("
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectcbcl$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 5 'button
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=90
obj(obj,H)=ctrh
obj(obj,TT)=5
obj$(obj,Ctr)="btn";obj
obj$(obj,Tex)="Button ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)="white"
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 6 'bmp button
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=50
obj(obj,H)=50
obj(obj,TT)=6
obj$(obj,Ctr)="bmpbtn";obj
filedialog "Choose an image","*.bmp",file$
if file$<>"" then
file$=right$(file$,len(file$)-len(DefaultDir$)-1)
open file$ for input as #bmp
'the bmpfileheader
bmp$ = Input$(#bmp,lof(#bmp))
if mid$(bmp$,1,2) ="BM" then 'always BM
obj(obj,W)=value(mid$(bmp$,19,4))'width
obj(obj,H)=value(mid$(bmp$,23,4))'height
obj$(obj,Ress)=file$
obj$(obj,Tex)="bmp"
loadbmp obj$(obj,Ctr),file$
close #bmp
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
else
obj(obj,TT)=0
close #bmp
obj=obj-1
end if
else
obj(obj,TT)=0
obj=obj-1
end if
case 7 'graphicbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=90
obj(obj,H)=90
obj(obj,TT)=7
obj$(obj,Ctr)="grphcbx";obj
obj$(obj,Tex)="GraphicBox ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 8 'radiobutton
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=100
obj(obj,H)=ctrh
obj(obj,TT)=8
obj$(obj,Ctr)="rdbtn";obj
obj$(obj,Tex)="RadioButton ";obj
obj$(obj,Ress)="[";obj$(obj,Ctr);"Set],[";obj$(obj,Ctr);"Reset]"
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 9 'checkbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=90
obj(obj,H)=ctrh
obj(obj,TT)=9
obj$(obj,Ctr)="chkbx";obj
obj$(obj,Tex)="CheckBox ";obj
obj$(obj,Ress)="[";obj$(obj,Ctr);"Checked],[";obj$(obj,Ctr);"Unchecked]"
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectback$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 10 'groupbox
obj=obj+1
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=110
obj(obj,H)=110
obj(obj,TT)=10
obj$(obj,Ctr)="grpbx";obj
obj$(obj,Tex)="GroupBox ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projectback$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 11 'texteditor
obj=obj+1
textEd = textEd + 1 : gosub [drawgrid]
obj(obj,XX)=insertx
obj(obj,Y)=inserty
obj(obj,W)=150
obj(obj,H)=100
obj(obj,TT)=11
obj$(obj,Ctr)="txtedtr";obj
obj$(obj,Tex)="TextEditor ";obj
if ctrf$<>projectfont$ then
obj$(obj,Fon)=ctrf$
obj(obj,TH)=ctrh
end if
obj$(obj,Bak)=projecttecl$
inserty=int((inserty+obj(obj,H)+(grid/2))/grid)*grid
case 12 'menu
if menuset=0 then
obj=obj+1
obj(obj,XX)=0
obj(obj,Y)=0
obj(obj,W)=100
obj(obj,H)=10
obj(obj,TT)=12
obj$(obj,Ctr)="mn";obj
obj$(obj,Tex)=" Menu Added ";obj
menuset=1
end if
end select
selected=obj
gosub [drawall]
'#fful.tool "select Add New"
#fful.gb "setfocus"
wait
[form]
#fful.form "selectionindex? i"
select case i
case 1 'restore
#fful.path "lastsession.ffu"
file$ = "lastsession.ffu"
gosub [loadit]
#fful.path "lastsession.ffu"
case 2 'new
if import <> 1 then #fful.path "Untitled.bas"
gosub [new]
case 3 'save as
gosub [saveas]
case 4 'load
gosub [load]
case 6 'write
gosub [write]
#fful.path file$
case 7 'import
import = 1
gosub [import]
import = 0
case 8 'export
gosub [export]
end select
#fful.form "select File"
gosub [drawall]
#fful.gb "setfocus"
wait
[drawall]
#fful.gb "discard ; redraw bak"
ocn=cn
projecttbcl$="white"
projectlbcl$="white"
projectcbcl$="white"
projecttecl$="white"
for cn=1 to obj
gosub [drawit]
next
cn=ocn
#fful.gb "place ";insertx;" ";inserty;" ; north ; turn 180 ; go ";10
#fful.gb "place ";insertx;" ";inserty;" ; turn -90 ; go ";10
#fful.gb "place ";insertx;" ";inserty;" ; turn 45 ; go ";20
#fful.gb "setfocus"
return
[drawit]
'redraws control cn
'set the color for the drawn object and action taking place
if cn=selected then
#fful.gb "color red" 'action 1 or 2
if action=2 then #fful.gb "color green"
else
#fful.gb "color ";projectfore$
end if
'set the font for the drawn object
if obj$(cn,Fon)="" then
#fful.gb "font ";projectfont$
ch=projectctrh
if obj(cn,H)<ch then obj(cn,H)=ch
else
#fful.gb "font ";obj$(cn,Fon)
ch=obj(cn,TH)
if obj(cn,H)<ch then obj(cn,H)=ch
end if
'update the properties textboxes for selected control
if cn=selected then
#prop.tbctrl obj$(cn,Ctr) 'ctrlname
#prop.tbtext obj$(cn,Tex) 'text
#prop.tbreso obj$(cn,Ress) 'resource
#prop.tbxywh obj(cn,XX);" ";obj(cn,Y);" ";obj(cn,W);" ";obj(cn,H) 'xywh
if obj$(cn,Fon)="" then #prop.tbfont projectfont$;":";obj(cn,TH) else #prop.tbfont obj$(cn,Fon);":";obj(cn,TH) 'font and height
#prop.tbcolo obj$(cn,Bak)
end if
#fful.gb "place ";obj(cn,XX);" ";obj(cn,Y)
if obj$(cn,Tex)="" or obj$(cn,Tex)=chr$(34) then obj$(cn,Tex)="Missing Text?"
select case obj(cn,TT)
case 1 'statictext
#fful.gb "backcolor ";projectback$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
#fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 2 'textbox
#fful.gb "backcolor ";projecttbcl$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 3 'listbox
#fful.gb "backcolor ";projectlbcl$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 4 'combobox
#fful.gb "backcolor ";projectcbcl$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 5 'button
#fful.gb "backcolor white"
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
'buttons are always black on white
#fful.gb "color black"
'centre button text
#fful.gb "stringwidth? ";"A";" width"
xp=(obj(cn,W)-width*len(obj$(cn,Tex)))/2
if action=0 then #fful.gb "place ";obj(cn,XX)+xp;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
#fful.gb "color ";projectfore$
#fful.gb "backcolor ";projectback$
case 6 'bmpbutton
if action=0 then #fful.gb "drawbmp ";obj$(cn,Ctr)
#fful.gb "box ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
case 7 ' graphicbox
#fful.gb "backcolor white"
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
#fful.gb "backcolor ";projectback$
case 8 'radiobutton
#fful.gb "backcolor ";projectback$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
'radiobutton text is always black
#fful.gb "color black"
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
#fful.gb "color ";projectfore$
case 9 'checkbox
#fful.gb "backcolor ";projectback$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
'checkbox text is always black
#fful.gb "color black"
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
#fful.gb "color ";projectfore$
case 10 'groupbox
#fful.gb "backcolor ";projectback$
'groupbox is an outline
#fful.gb "box ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
'group box text is always black
#fful.gb "color black"
'groupbox text is offset
if action=0 then #fful.gb "place ";obj(cn,XX)+5;" ";obj(cn,Y)+ch/1.33-ch/2;" ;\";obj$(cn,Tex)
#fful.gb "color ";projectfore$
case 11 ' texteditor
#fful.gb "backcolor ";projecttecl$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
if action=0 then #fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 12 'menu
'pin to top left
obj(cn,XX)=10 : obj(cn,Y)=-8 : obj(cn,W)=100 : obj(cn,H)=10
#fful.gb "backcolor ";projectback$
#fful.gb "boxfilled ";obj(cn,XX)+obj(cn,W);" ";obj(cn,Y)+obj(cn,H)
#fful.gb "place ";obj(cn,XX)+2;" ";obj(cn,Y)+ch/1.33;" ;\";obj$(cn,Tex)
case 21 'tecolor
projecttecl$=obj$(cn,Bak)
case 22 'tbcolor
projecttbcl$=obj$(cn,Bak)
case 23 'lbcolor
projectlbcl$=obj$(cn,Bak)
case 24 'cbcolor
projectcbcl$=obj$(cn,Bak)
'41,42,43,44,45 and 50 51 ignored ie back/fore w/h open and font objects
end select
return
[prev]
file$="preview.bas"
gosub [writeit]
wait
[write]
projectfile$=left$(projectfile$,len(projectfile$)-3)+"bas"
filedialog "Save .bas",projectfile$,file$
file$=right$(file$,len(file$)-len(DefaultDir$)-1)
[writeit]
if file$<>"" then
open file$ for output as #op
'the header
#op " 'Project ";projecttitl$
if val(left$(time$(), 2)) > 11 then mer$ = "pm" else mer$ = "am"
#op " 'Created with FFNotSoLite v";ver$;" ";date$();" at ";time$();" ";mer$
#op " nomainwin"
if projectback$<>"white" or projectfore$<>"black" then
#op " 'Set BackgroundColor$ and ForegroundColor$ of project"
#op " BackgroundColor$=";chr$(34);projectback$;chr$(34)
#op " ForegroundColor$=";chr$(34);projectfore$;chr$(34)
#op ""
end if
if code = 1 then
#op " 'Create arrays needed for controls listbox,combobox"
for n= 1 to obj
if obj(n,TT)=3 or obj(n,TT)=4 then
#op " dim ";obj$(n,Ress);"10)"
#op " for n = 1 to 10"
#op " ";obj$(n,Ress);"n)= str$(n)"
#op " next"
end if
next
end if
#op " 'Create controls and open window"
#op " WindowWidth = ";projectw
#op " WindowHeight = ";projecth
#op " UpperLeftX = int((DisplayWidth-WindowWidth)/2)"
#op " UpperLeftY = int((DisplayHeight-WindowHeight)/2)"
if menuset then
#op " menu ";projectform$;", ";chr$(34);"&File";chr$(34);", ";chr$(34);"&Open";chr$(34);", [dummy], ";chr$(34);"&Save";chr$(34);", [dummy], ";chr$(34);"&Save As";chr$(34);", [dummy],";chr$(34);"&Load";chr$(34);", [dummy], ";chr$(34);"&Exit";chr$(34);", [dummy]"
if textEd > 0 then
#op " menu ";projectform$;", ";chr$(34);"Edit";chr$(34)
end if
#op " menu ";projectform$;", ";chr$(34);"&Tools";chr$(34);", ";chr$(34);"Preferences";chr$(34);", [dummy] "
#op " menu ";projectform$;", ";chr$(34);"&Options";chr$(34);", ";chr$(34);"Fonts";chr$(34);", [dummy], ";chr$(34);"Colors";chr$(34);", [dummy]"
#op " menu ";projectform$;", ";chr$(34);"&Help";chr$(34);", ";chr$(34);"About";chr$(34);", [dummy]";", ";chr$(34);"Help";chr$(34);", [dummy]"
end if
for n=1 to obj
select case obj(n,TT)
case 1 'statictext
#op " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,XX);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H)
case 2 'textbox
#op " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 3 'list box
#op " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ress);",[";obj$(n,Ctr);"Selected],";obj(n,XX)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H)
case 4 'combobox
#op " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ress);",[";obj$(n,Ctr);"Selected],";obj(n,XX)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H)
case 5 'button
#op " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"Clicked], UL, ";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 6 'bmpbutton
#op " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ress);chr$(34);",[";obj$(n,Ctr);"Clicked], UL, ";obj(n,XX);",";obj(n,Y)
case 7 'graphicbox
#op " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 8 'radiobutton
#op " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Ress);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 9 'checkbox
#op " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Ress);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 10 'group box
#op " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,XX);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H)
case 11 'texteditor
#op " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 22 'tbcolor
#op " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 23 'lbcolor
#op " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 24 'cbcolor
#op " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 21 'tecolor
#op " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
end select
next
#op " open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$
if instr(projectwind$, "text") then
#op " ";projectform$;" ";chr$(34);"!trapclose [quit]";chr$(34)
else
#op " ";projectform$;" ";chr$(34);"trapclose [quit]";chr$(34)
end if
#op ""
if code = 1 then
#op " 'Set any listboxes to singleclick and display the first item on the list for all listboxes and comboboxes"
for n= 1 to obj
if obj(n,TT)=4 then
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1";chr$(34)
end if
if obj(n,TT)=3 then
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selectindex 1, singleclickselect";chr$(34)
end if
next
#op " 'apply any control specific fonts"
end if
for n= 1 to obj
if obj(n,TT)<>0 and obj$(n,Fon)<>"" then
if obj(n,TT)=1 or obj(n,TT)=2 or obj(n,TT)=5 or obj(n,TT)=10 or obj(n,TT)=11 then
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34)
end if
if obj(n,TT)=3 or obj(n,TT)=4 or obj(n,TT)=7 or obj(n,TT)=8 or obj(n,TT)=9 then
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34)
end if
[remDot]
end if
next
#op " 'Your code here. eg: Declare variables and globals, goto/gosub/call subs and invoke functions, etc etc"
#op ""
#op " wait"
#op ""
#op " 'Create the required handlers for each control"
for n=1 to obj
select case obj(n,TT)
case 3 'listbox
#op " [";obj$(n,Ctr);"Selected]"
#op " 'Your handler code here, read the control with"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? Selected$";chr$(34)
#op " wait"
#op ""
case 4 'combobox
#op " [";obj$(n,Ctr);"Selected]"
#op " 'Your handler code here, read the control with"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"selection? Selected$";chr$(34)
#op " wait"
#op ""
case 5 'button
#op " [";obj$(n,Ctr);"Clicked]"
#op " 'Your handler code here"
#op " wait"
#op ""
case 6 'bmpbutton
#op " [";obj$(n,Ctr);"Clicked]"
#op " 'Your handler code here"
#op " wait"
#op ""
case 8 'radiobutton
#op " [";obj$(n,Ctr);"Set]"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34)
#op " 'Your handler code here"
#op " wait"
#op ""
case 9 'checkbox
#op " [";obj$(n,Ctr);"Checked]"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34)
#op " 'Your handler code here"
#op " wait"
#op ""
#op " [";obj$(n,Ctr);"Unchecked]"
#op " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"value? result$";chr$(34)
#op " 'Your handler code here"
#op " wait"
#op ""
end select
next
#op " [quit]"
#op " 'Add code for any actions to take while shutting down. eg:backup settings to a file"
#op " close ";projectform$
#op " end"
#op " "
#op " 'Subs and Functions go below this line"
#op "'########################################################"
#op " "
close #op
if code <> 1 then run chr$(34);LBpath$;"\";LBexe$;chr$(34);" -R -A ";DefaultDir$;"\";file$
if code = 1 then run chr$(34);LBpath$;"\";LBexe$;chr$(34);" -A ";DefaultDir$;"\";file$
[done]
end if
code = 0
return
[saveas]
projectname$=left$(projectfile$,len(projectfile$)-4)+".ffu"
filedialog "Save As...",projectname$,file$
if file$<>"" then
open file$ for output as #op
projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1)
#fful.path projectfile$
'the form name #xxxx
#prop.tbform "!contents? t$"
if t$<>projectform$ then
projectform$=t$
dim hnd$(10)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "select ";projectform$
end if
'the form/windo title text
#prop.tbtitl "!contents? t$"
if t$<>projecttitl$ then projecttitl$=t$
#op projectfile$
#op projectwind$
#op projectform$
#op projecttitl$
#op projectfont$
#op projectback$
#op projectfore$
#op projectctrh
#op projectgrid
#op projectw
#op projecth
for n=1 to obj
if obj(n,TT)<>0 then
#op obj(n,XX);",";
#op obj(n,Y);",";
#op obj(n,W);",";
#op obj(n,H);",";
#op obj(n,TT);",";
#op obj(n,TH)
#op obj$(n,Ctr)
#op obj$(n,Tex)
#op obj$(n,Ress)
#op obj$(n,Fon)
#op obj$(n,Bak)
end if
next
close #op
gosub [propertyupdate]
redim hnd$(30)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "selectindex 1"
end if
return
[load]
filedialog "Open Project...","*.ffu",file$
[loadit]
if file$<>"" then
projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1)
#fful.path projectfile$
open file$ for input as #ses
input #ses, projectfile$
input #ses, projectwind$
input #ses, projectform$
input #ses, projecttitl$
input #ses, projectfont$
if projectfont$="" then projectfont$="Consolas 9"
#fful.gb "font ";projectfont$
input #ses, projectback$
input #ses, projectfore$
input #ses, c$
input #ses, g$
input #ses, w$
input #ses, h$
projectctrh=val(c$)
projectgrid=val(g$)
grid=projectgrid
projectw=val(w$)
projecth=val(h$)
#prop.cbwind "select ";projectwind$
redim hnd$(30)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "selectindex 1"
#fful.grid "select ";grid
#fful.w "select ";projectw
#fful.h "select ";projecth
gosub [drawgrid]
obj=0
while eof(#ses) = 0
obj=obj+1
line input #ses, l$
obj(obj,XX)=val(word$(l$,1,","))
obj(obj,Y)=val(word$(l$,2,","))
obj(obj,W)=val(word$(l$,3,","))
obj(obj,H)=val(word$(l$,4,","))
obj(obj,TT)=val(word$(l$,5,","))
obj(obj,TH)=val(word$(l$,6,","))
line input #ses, obj$(obj,Ctr)
line input #ses, obj$(obj,Tex)
line input #ses, obj$(obj,Ress)
line input #ses, obj$(obj,Fon)
line input #ses, obj$(obj,Bak)
if obj(obj,TT)=6 then loadbmp obj$(obj,Ctr),obj$(obj,Ress)
if obj(obj,TT)=12 then menuset=1
if obj(obj,TT)=11 then textEd = textEd + 1
wend
close #ses
gosub [propertyupdate]
#prop "hide"
#prop "show"
end if
return
[import]
filedialog "Open .bas...","*.bas",file$
[importit]
if file$<>"" then
'check size
open file$ for input as #bas
maxln=0
while eof(#bas)=0
line input #bas, wln$
maxln=maxln+1
wend
close #bas
'add margin for split lines
dim bas$(maxln+1000,4)'an array of code lines and line numbers
'set up progress bar
#prog.gb1 "down ; fill white ; backcolor cyan"
#prog "show"
projectfile$=right$(file$,len(file$)-len(DefaultDir$)-1)
gosub [new]
'set grid to 1 and invisible so controls stay where they import from initially
'grid=1
'gridvisible=0
gosub [drawgrid]
#fful.path projectfile$
'create objects for only those lines defining controls we are interested in
wordlist$=" statictext textbox listbox combobox button bmpbutton graphicbox "
wordlist$=wordlist$+"radiobutton checkbox groupbox texteditor open " 'no menu
wordlist$=wordlist$+"textboxcolor$ listboxcolor$ comboboxcolor$ texteditorcolor$ "
wordlist$=wordlist$+"windowwidth windowheight "' no upperleftx upperlefty "
wordlist$=wordlist$+"backgroundcolor$ foregroundcolor$ font "
ln=1
bln=1
open file$ for input as #bas
while eof(#bas)=0
line input #bas, wln$
'update progress bar
#prog.gb1 "cls ; place 0 0 ; boxfilled ";100/maxln*ln;" 25"
'ignore 'or rem lines
if left$(lower$(trim$(wln$)),1)="'" or left$(lower$(trim$(wln$)),4)="rem " then
bas$(ln,1)=str$(ln)
bas$(ln,2)=trim$(wln$)
ln=ln+1
else
'break into multiple lines if ":" found outside quotes
pos=1
ln$=""
while pos<=len(wln$)
c$=mid$(wln$,pos,1)
dd$ = mid$(win$,pos,2)
if c$=chr$(34) then
if quote=0 then quote=1 else quote=0
end if
if c$=":" and quote=0 or c$=":" and right$(dd$,1) = "\" then
gosub [line]
ln$=""
pos=pos+1
else
ln$=ln$+c$
pos=pos+1
end if
wend
gosub [line]
bln=bln+1
end if
wend
basln=ln-1
close #bas
redim win$(30,10)'an array of forms within .bas
redim hnd$(30)'an array of form names for handle combobox
wh=1
for ln=1 to basln
if bas$(ln,3)="#" then
if instr(bas$(ln,2),"BackgroundColor$",1)>0 then projectback$=getcolor$(bas$(ln,2)) : win$(wh,6)=bas$(ln,1)
if instr(bas$(ln,2),"ForegroundColor$",1)>0 then projectfore$=getcolor$(bas$(ln,2)) : win$(wh,7)=bas$(ln,1)
if instr(bas$(ln,2),"WindowWidth",1)>0 then w$=getsize$(bas$(ln,2)):win$(wh,8)=bas$(ln,1)
if instr(bas$(ln,2),"WindowHeight",1)>0 then h$=getsize$(bas$(ln,2)):win$(wh,9)=bas$(ln,1)
'if instr(lower$(bas$(ln,2)),"open",1)>0 then
if lower$(word$(bas$(ln,2),1)) = "open" and left$(word$(bas$(ln,2),2, " as "),1) = "#" then
if instr(lower$(bas$(ln,2)),"window",1)>0 or instr(lower$(bas$(ln,2)),"dialog",1)>0 or instr(lower$(bas$(ln,2)),"graphic",1)>0 then
win$(wh,10)=bas$(ln,1)
n$=word$(bas$(ln,2),2,chr$(34))
hn$="#"+right$(bas$(ln,2),len(bas$(ln,2))-instr(bas$(ln,2),"#",1))
'find last "for" in command line
i=1
while i
oi=i
i=instr(lower$(bas$(ln,2))," for ",i+1)
wend
wt$=right$(bas$(ln,2),len(bas$(ln,2))-oi)
wt$=word$(wt$,2)
win$(wh,1)=hn$ 'handle #fful etc
win$(wh,2)=n$ 'title
win$(wh,3)=w$ 'width
win$(wh,4)=h$ 'height
win$(wh,5)=wt$ 'windowtype
hnd$(wh)=hn$ 'for combobox
wh=wh+1
end if
end if
end if
next
#fful.hand "reload"
#fful.hand "selectindex 1"
wh=1
gosub [loadwindow]
end if
return
[line]
bas$(ln,1)=str$(ln)
bas$(ln,2)=trim$(ln$)
w$=lower$(word$(ln$,1))
if instr(w$,"=",1)>1 then w$=word$(w$,1,"=")
if len(w$)>3 then
w1$=" "+w$+" "
w2$=" "+w$+"="
if instr(wordlist$,w1$,1)>0 or instr(wordlist$,w2$,1)>0 or instr(lower$(ln$),"font ",1)>0 then bas$(ln,3)="#"
end if
ln=ln+1
return
[hand]
#fful.hand "selectionindex? wh"
gosub [loadwindow]
wait
[loadwindow]
redim obj(300,6) 'x,y,width/height,type,textheight
redim obj$(300,7) 'name,text content,resource,font
obj=1
menuset=0
textEd = 0
projectback$="white"
TextboxColor$="white"
ListboxColor$="white"
ComboboxColor$="white"
TexteditorColor$="white"
projectfore$="black"
projectw=val(win$(wh,3))
if projectw=0 then projectw=320
projecth=val(win$(wh,4))
if projecth=0 then projecth=360
projecttitl$=win$(wh,2)
projectwind$=win$(wh,5)
projectform$=win$(wh,1)
tbc$=""
lbc$=""
cbc$=""
tec$=""
gosub [propertyupdate]
#fful.w "!";str$(projectw)
#fful.h "!";str$(projecth)
'find controls and create obj() array for form we are interested in
for ln=1 to basln
'update progress bar
#prog.gb1 "cls ; place 0 0 ; boxfilled ";100+100/maxln*ln;" 25"
if bas$(ln,3)="#" then
'reset obj pointer
bas$(ln,4)=""
'create objects to control color only check lines after previous open statement up to our open statement
if bas$(ln,1)>win$(wh-1,10) and bas$(ln,1)<=win$(wh,10) then
if instr(bas$(ln,2),"TextboxColor$",1)>0 then obj(obj,TT)=22 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bass)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1
if instr(bas$(ln,2),"ListboxColor$",1)>0 then obj(obj,TT)=23 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bass)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1
if instr(bas$(ln,2),"ComboboxColor$",1)>0 then obj(obj,TT)=24 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bass)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1
if instr(bas$(ln,2),"TexteditorColor$",1)>0 then obj(obj,TT)=21 : obj$(obj,Bak)=getcolor$(bas$(ln,2)):obj$(obj,Bass)=bas$(ln,1):bas$(ln,4)=str$(obj):obj=obj+1
end if
for wc=1 to 12
if instr(lower$(bas$(ln,2)),word$(wordlist$,wc),1)=1 and instr(lower$(bas$(ln,2)),lower$(projectform$),1)>0 then exit for
next
if wc<=11 then
obj$(obj,Bass)=bas$(ln,1)
bas$(ln,4)=str$(obj)
l$=bas$(ln,2)
ll$="" 'remove spaces leaving only , separation but keep "" text untouched
inString=0
for i=1 to len(l$)
c$=mid$(l$,i,1)
select case
case c$=chr$(34)
inString=1-inString
case (inString=0) and c$=" "
c$=""
end select
ll$=ll$+c$
next
'insert missing comma if missing
if instr(ll$,","+chr$(34),1)=0 then ll$=left$(ll$,instr(ll$,chr$(34),1)-1)+","+right$(ll$,len(ll$)-instr(ll$,chr$(34),1)+1)
if left$(ll$,1)="," then ll$=right$(ll$,len(ll$)-1)
obj(obj,TT)=wc 'type
obj(obj,TH)=projectctrh
'get the .ctrl name
obj$(obj,Ctr)=right$(word$(ll$,1,","),len(word$(ll$,1,","))-len(word$(ll$,1,"."))-1)
'for un-named controls
if obj$(obj,Ctr)="" then obj$(obj,Ctr) = word$(wordlist$,wc);obj
'get the text
if wc=1 or wc=5 or wc=8 or wc=9 or wc=10 then obj$(obj,Tex)=word$(ll$,2,chr$(34)) else obj$(obj,Tex)=word$(wordlist$,wc)
'get the array or bmp file name
if wc=3 or wc=4 or wc=6 then obj$(obj,Ress)=word$(ll$,2,",")
if wc=8 or wc=9 then obj$(obj,Ress)=word$(ll$,3,",")+","+word$(ll$,4,",")
'get rid of ""
if wc=6 and left$(obj$(obj,Ress),1)=chr$(34) then obj$(obj,Ress)=mid$(obj$(obj,Ress),2,len(obj$(obj,Ress))-2)
'array() -> array(
if (wc=3 or wc=4) and right$(obj$(obj,Ress),1)=")" then obj$(obj,Ress)=left$(obj$(obj,Ress), len(obj$(obj,Ress))-1)
i=1
while word$(ll$,i,",")<>""
i=i+1
wend
i=i-4
if wc=6 or wc=5 then
'buttons and bmpbuttons can have xy, wh is optional and they have XX corners
if i=3 then
obj(obj,XX)=val(word$(ll$,i+2,","))'x
obj(obj,Y)=val(word$(ll$,i+3,","))'y
if wc=5 then
'we need to find a way to calculate width and height if not given
#fful.gb "stringwidth? ";"A";" width"
obj(obj,W)=width*len(obj$(obj,Tex))+10
obj(obj,H)=projectctrh
end if
if wc=6 then
'we need a way to set bmp w and h
on error goto [dummybmp]
open obj$(obj,Ress) for input as #bmp
'the bmpfileheader
bmp$ = Input$(#bmp,lof(#bmp))
if mid$(bmp$,1,2) ="BM" then 'always BM
obj(obj,W)=value(mid$(bmp$,19,4))'width
obj(obj,H)=value(mid$(bmp$,23,4))'height
obj$(obj,Tex)="bmp"
end if
loadbmp obj$(obj,Ctr),obj$(obj,Ress)
close #bmp
goto [passdummy]
[dummybmp]
obj(obj,W)=25
obj(obj,H)=25
obj$(obj,Tex)="bmp"
loadbmp obj$(obj,Ctr),"path.bmp"
[passdummy]
end if
else
obj(obj,XX)=val(word$(ll$,i,","))'x
obj(obj,Y)=val(word$(ll$,i+1,","))'y
obj(obj,W)=val(word$(ll$,i+2,","))'w
obj(obj,H)=val(word$(ll$,i+3,","))'h
end if
if upper$(word$(ll$,4,","))="LR" then
obj(obj,XX)=projectw-obj(obj,XX)-obj(obj,W)'x
obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y
end if
if upper$(word$(ll$,4,","))="LL" then
'obj(obj,XX)=projectw-obj(obj,XX)-obj(obj,W)'x
obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y
end if
if upper$(word$(ll$,4,","))="UR" then
obj(obj,XX)=projectw-obj(obj,XX)-obj(obj,W)'x
'obj(obj,Y)=projecth-obj(obj,Y)-obj(obj,H)'y
end if
else
'write to .bas tweaks listbox and combobox controls to line up properly
'so we need to untweak them now
obj(obj,XX)=val(word$(ll$,i,","))'x
obj(obj,Y)=val(word$(ll$,i+1,","))'y
if wc=1 then obj(obj,Y)=obj(obj,Y)-5
if wc=10 then obj(obj,Y)=obj(obj,Y)+5
if wc=3 or wc=4 then obj(obj,XX)=obj(obj,XX)-1
obj(obj,W)=val(word$(ll$,i+2,","))'w
if wc=3 or wc=4 then obj(obj,W)=obj(obj,W)+2
obj(obj,H)=val(word$(ll$,i+3,","))'h
end if
obj=obj+1
end if
end if
next
'now find font commands listed after the open statement referring to the #form
'#form.ctrl !font fontname
'if so add a new font object
for ln = 1 to basln
if bas$(ln,3)="#" then
lln$=lower$(bas$(ln,2))
if (instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"font ",1)>0) or (instr(lln$,lower$(projectform$),1)>0 and instr(lln$,chr$(34);"!font ",1)>0) then
f$=right$(lln$,len(lln$)-instr(lln$,"font",1)-4)
if instr(f$,";",1)=0 then
obj$(obj,Fon)=f$
obj$(obj,Fon)=left$(obj$(obj,Fon),len(obj$(obj,Fon))-1)
obj$(obj,Ctr)=word$(word$(lln$,1),2,".")
if instr(lln$,"!font",1)>0 then obj(obj,TT)=51 else obj(obj,TT)=50
obj$(obj,Bass)=str$(ln)
bas$(ln,4)=str$(obj)
'find the visible object and store the font change
for n=1 to obj
if obj$(n,Ctr)=obj$(obj,Ctr) then
obj$(n,Fon)=obj$(obj,Fon)
#fful.gb "font ";obj$(obj,Fon)
#fful.gb "place 100 100 ;\Q\Q"
#fful.gb "posxy xp yp"
obj(n,TH)=(yp-100)/2+7
exit for
end if
next
obj=obj+1
end if
end if
end if
next
if win$(wh,6)<>"" then
bas$(val(win$(wh,6)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,6)
obj(obj,TT)=41
obj=obj+1
'backgroundcolor
end if
if win$(wh,7)<>"" then
bas$(val(win$(wh,7)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,7)
obj(obj,TT)=42
obj=obj+1
'foregroundcolor
end if
if win$(wh,8)<>"" then
bas$(val(win$(wh,8)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,8)
obj(obj,TT)=43
obj=obj+1
'windowwidth
end if
if win$(wh,9)<>"" then
bas$(val(win$(wh,9)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,9)
obj(obj,TT)=44
obj=obj+1
n=n+1
'windowheight
end if
if win$(wh,10)<>"" then
bas$(val(win$(wh,10)),4)=str$(obj)
obj$(obj,Bass)=win$(wh,10)
obj(obj,TT)=45
obj=obj+1
'open statement
end if
obj=obj-1
gosub [drawgrid]
gosub [drawall]
#prog "hide"
#prop "hide"
#prop "show"
show=1
return
[export]
'all previously imported lines will be deleted and replaced by the obj( lines
'deletelist$ remembers the original imported line numbers in line number order
if file$<>"" and right$(file$,3)="bas" then
open file$ for output as #bas
'open "export.bas" for output as #bas
for ln=1 to basln
'find any object associated with this line
found=0
for l=1 to obj
if bas$(ln,1)=obj$(l,Bass) then
found=1
'have we got to the open command line yet
if obj(l,TT)=45 then
'write all new lines prior to 45 (controls)
for m=1 to obj
if obj$(m,Bass)="" and obj(m,TT)<45 and obj(m,TT)<>0 then
n=m
gosub [exportline]
end if
next
'write 45 (open line)
n=l
gosub [exportline]
'write all new lines after 45 (open) ie (fonts)
'apply any control specific fonts"
for m= 1 to obj
if obj(m,TT)<>0 and obj$(m,Fon)<>"" then
if obj(m,TT)=1 or obj(m,TT)=2 or obj(m,TT)=5 or obj(m,TT)=10 or obj(m,TT)=11 then
#bas " ";projectform$;".";obj$(m,Ctr);" ";chr$(34);"!font ";obj$(m,Fon);chr$(34)
end if
if obj(m,TT)=3 or obj(m,TT)=4 or obj(m,TT)=7 or obj(m,TT)=8 or obj(m,TT)=9 then
#bas " ";projectform$;".";obj$(m,Ctr);" ";chr$(34);"font ";obj$(m,Fon);chr$(34)
end if
end if
next
end if
'edit or erase existing line
if obj(l,TT)=0 then
else
if obj(l,TT)<>45 then
n=l
gosub [exportline]
end if
end if
end if
next
if found=0 then #bas " ";bas$(ln,2)
next
close #bas
end if
'now reload amended .bas file
gosub [importit]
return
[exportline]
select case obj(n,TT)
'handle the visible controls
case 1 'statictext
#bas " statictext ";projectform$;".";obj$(n,Ctr);" ";chr$(34);trim$(obj$(n,Tex));chr$(34);",";obj(n,XX);",";obj(n,Y)+5;",";obj(n,W);",";obj(n,H)
case 2 'textbox
#bas " textbox ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 3 'list box
#bas " listbox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ress);",[";obj$(n,Ctr);"Selected],";obj(n,XX)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H)
case 4 'combobox
#bas " combobox ";projectform$;".";obj$(n,Ctr);",";obj$(n,Ress);",[";obj$(n,Ctr);"Selected],";obj(n,XX)+1;",";obj(n,Y);",";obj(n,W)-2;",";obj(n,H)
case 5 'button
#bas " button ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",[";obj$(n,Ctr);"Clicked], UL, ";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 6 'bmpbutton
#bas " bmpbutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Ress);chr$(34);",[";obj$(n,Ctr);"Clicked], UL, ";obj(n,XX);",";obj(n,Y)
case 7 'graphicbox
#bas " graphicbox ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 8 'radiobutton
#bas " radiobutton ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Ress);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 9 'checkbox
#bas " checkbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj$(n,Ress);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
case 10 'group box
#bas " groupbox ";projectform$;".";obj$(n,Ctr);",";chr$(34);obj$(n,Tex);chr$(34);",";obj(n,XX);",";obj(n,Y)-5;",";obj(n,W);",";obj(n,H)
case 11 'texteditor
#bas " texteditor ";projectform$;".";obj$(n,Ctr);",";obj(n,XX);",";obj(n,Y);",";obj(n,W);",";obj(n,H)
'handle the undisplayed color and font objects only used for import/export
case 22 'textboxcolor
#bas " TextboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 23 'listboxcolor
#bas " ListboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 24 'comboboxcolor
#bas " ComboboxColor$=";chr$(34);obj$(n,Bak);chr$(34)
case 21 'texteditorcolor
#bas " TexteditorColor$=";chr$(34);obj$(n,Bak);chr$(34)
' handle the window code
case 41'backgroundcolor
#bas " BackgroundColor$=";chr$(34);projectback$;chr$(34)
case 42'foregroundcolor
#bas " ForegroundColor$=";chr$(34);projectfore$;chr$(34)
case 43'windowidth
#bas " WindowWidth=";projectw
case 44'windowheight
#bas " WindowHeight=";projecth
case 45'open
#bas " Open ";chr$(34);projecttitl$;chr$(34);" for ";projectwind$;" as ";projectform$
'handle font changes
case 50 'font
if obj$(n,Ctr) = "" and projectform$ <> "" and projectfont$ <> "" then
#bas " ";projectform$;" ";chr$(34);"font ";projectfont$;chr$(34)
goto [delDot]
end if
#bas " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"font ";obj$(n,Fon);chr$(34)
[delDot]
case 51 '!font
#bas " ";projectform$;".";obj$(n,Ctr);" ";chr$(34);"!font ";obj$(n,Fon);chr$(34)
end select
return
[new]
redim obj(300,6) 'x,y,width/height,type,textheight
redim obj$(300,7) 'name,text content,resource,font
obj=0
menuset=0
textEd = 0
projectw=600
projecth=400
projectback$="white"
projectfore$="black"
projectctrc$="white"
projecttitl$="Untitled"
projectform$="#1"
'if import <> 1 then projectfile$="Untitled.bas"
projectwind$="window_nf"
#prop.cbwind "select window_nf"
redim hnd$(30)
hnd$(1)=projectform$
#fful.hand "reload"
#fful.hand "selectindex 1"
#fful.w "select ";projectw
#fful.h "select ";projecth
gosub [propertyupdate]
gosub [drawgrid]
gosub [drawall]
#prop "hide"
#prop "show"
show=1
return
[propertyupdate]
#prop.tbfile projectfile$
#prop.cbwind "select ";projectwind$
#prop.tbtitl projecttitl$
#prop.tbform projectform$
#prop.tbctrl ""
#prop.tbtext ""
#prop.tbreso ""
#prop.tbxywh projectw;"x";projecth
#prop.tbfont projectfont$
#prop.tbcolo projectfore$;"/";projectback$
return
[resize]
'#fful.tool "select Add New"
#fful.form "select File"
if wh=0 then wh=1
#fful.hand "selectindex ";wh
#fful.grid "select Set Grid"
#fful.font "select Set Font"
#fful.color "select Set Color"
#fful.w "select ";projectw
#fful.h "select ";projecth
gosub [drawall]
wait
[formsize]
#fful.w "contents? w$"
#fful.h "contents? h$"
wf=val(w$)
hf=val(h$)
if wf=0 or hf=0 or (wf=projectw and hf=projecth) then wait
projectw=wf
projecth=hf
insertx=grid
inserty=grid
gosub [drawgrid]
#fful.gb "setfocus"
gosub [drawall]
wait
[grid]
'resize the grid spacing according to user choice, default is 10
#fful.grid "contents? g$"
select case g$
case "Invisible"
gridvisible=0
grid=1
case "Visible"
gridvisible=1
case else
grid=val(g$)
if grid = 1 then gridvisible = 0
if grid > 2 then gridvisible = 1
end select
gosub [drawgrid]
gosub [drawall]
#fful.gridsize grid
#fful.gb "setfocus"
wait
[drawgrid]
projectgrid=grid
#fful.gb "cls; fill lightgray"
if grid > 0 and gridvisible = 1 then
#fful.gb "color ";gridcolor$
' Grid - Draw vertical lines
if menuset = 0 and textEd = 0 then
#fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25
for xs = 0 to projectw step grid
' Grid - Draw horizontal lines
#fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-25
next xs
for ys = 0 to projecth-25 step grid
#fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys
next ys
#fful.gb "color ";bordercolor$
#fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25
#fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25
#fful.gb "line "; 0; " "; 0; " "; projectw; " "; 0
#fful.gb "line ";0;" "; 0;" "; 0; " ";projecth-25
end if
'adjust grid when menu, or texeditor control is selected - revert if menu and texeditor deleted /no longer used.,
if menuset = 1 or textEd > 0 then
#fful.gb "place 0 0 ; color ";gridcolor$;" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50
#fful.gb "color ";gridcolor$
for xs = 0 to projectw step grid
#fful.gb "line "; xs; " "; 0; " "; xs; " "; projecth-50
next xs
for ys = 0 to projecth-50 step grid
#fful.gb "line "; 0; " "; ys; " "; projectw; " "; ys
next ys
#fful.gb "color ";bordercolor$
#fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50
#fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50
#fful.gb "line "; 0; " "; 0; " "; 0; " "; projecth-50
#fful.gb "line ";0;" "; 0;" "; projectw; " ";0
end if
end if
[nogrid]
if grid < 2 or gridvisible = 0 then
if textEd =0 and menuset = 0 then
#fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-25
#fful.gb "color ";crosshair$
#fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-25
#fful.gb "line "; 0; " "; ((projecth)/2)-12; " "; projectw; " "; ((projecth)/2)-12
#fful.gb "color ";bordercolor$
#fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-25
#fful.gb "line ";0;" "; projecth-25;" "; projectw; " ";projecth-25
#fful.gb "line "; 0; " "; 0; " "; projectw; " "; 0
#fful.gb "line ";0;" "; 0;" "; 0; " ";projecth-25
end if
if textEd > 0 or menuset = 1 then
#fful.gb "place 0 0 ; color white";" ; backcolor ";projectback$;" ; boxfilled ";projectw;" ";projecth-50
#fful.gb "color ";crosshair$
#fful.gb "line "; projectw/2; " "; 0; " "; projectw/2; " "; projecth-50
#fful.gb "line "; 0; " "; (projecth-50)/2; " "; projectw; " "; (projecth-50)/2
#fful.gb "color ";bordercolor$
#fful.gb "line "; projectw; " "; 0; " "; projectw; " "; projecth-50
#fful.gb "line ";0;" "; projecth-50;" "; projectw; " ";projecth-50
#fful.gb "line "; 0; " "; 0; " "; 0; " "; projecth-50
#fful.gb "line ";0;" "; 0;" "; projectw; " ";0
end if
end if
#fful.gb "flush bak"
#fful.grid "select 0"
#fful.grid "!Set Grid"
return
[font]
#fful.font "contents? f$"
if f$="Project Font" then
fontdialog projectfont$,f$
if f$<>"" then
projectfont$=f$
#fful.gb "font ";projectfont$
#fful.gb "place 100 100 ;\Q\Q"
#fful.gb "posxy xp yp"
projectctrh=(yp-100)/2+7
ctrf$=projectfont$
ctrh=projectctrh
end if
end if
if f$="Control Font" then
fontdialog projectfont$,f$
if f$<>"" then
ctrf$=f$
#fful.gb "font ";ctrf$
#fful.gb "place 100 100 ;\Q\Q"
#fful.gb "posxy xp yp"
ctrh=(yp-100)/2+7
end if
if selected then
obj$(selected,4)=ctrf$ 'font
obj(selected,6)=ctrh 'text height
end if
'for single line text controls auto adjust w and h
if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then
obj(selected,4)=ctrh
#fful.gb "stringwidth? ";"A";" width"
obj(selected,3)=width*len(obj$(selected,2))+10
end if
end if
if f$="ResetControl" then
ctrf$=projectfont$
ctrh=projectctrh
if selected then
obj$(selected,4)=ctrf$
obj(selected,6)=ctrh
end if
'for single line text controls auto adjust w and h
if selected and instr("1 2 5 8 9",str$(obj(selected,5)),1) >1 then
#fful.gb "font ";ctrf$
obj(selected,4)=ctrh
#fful.gb "stringwidth? ";"A";" width"
obj(selected,3)=width*len(obj$(selected,2))+10
end if
end if
#fful.font "select Set Font"
gosub [drawall]
#fful.gb "setfocus"
wait
[color]
#fful.color "contents? c$"
select case c$
case "Control Back"
gosub [colorpick]
if cp$<>"" then
if selected then 'insert color change event ahead of control
if obj(selected,TT)=2 then ct=22 : projecttbcl$=cp$
if obj(selected,TT)=3 then ct=23 : projectlbcl$=cp$
if obj(selected,TT)=4 then ct=24 : projectcbcl$=cp$
if obj(selected,TT)=11 then ct=21 : projecttecl$=cp$
for n=obj+1 to selected+1 step -1
obj(n,XX)=obj(n-1,XX)
obj(n,Y)=obj(n-1,Y)
obj(n,W)=obj(n-1,W)
obj(n,H)=obj(n-1,H)
obj(n,TT)=obj(n-1,TT)
obj(n,TH)=obj(n-1,TH)
obj$(n,Ctr)=obj$(n-1,Ctr)
obj$(n,Tex)=obj$(n-1,Tex)
obj$(n,Ress)=obj$(n-1,Ress)
obj$(n,Fon)=obj$(n-1,Fon)
obj$(n,Bak)=obj$(n-1,Bak)
obj$(n,Bass)=obj$(n-1,Bass)
next
obj(selected,TT)=ct
obj$(selected,Tex)="Color!"
obj$(selected,Bak)=cp$
'obj$(selected,Bass)="XX"
'remove any previous color change statement
if selected>=2 then
if obj(selected-1,TT)=ct then obj(selected-1,TT)=0
end if
obj=obj+1
end if
end if
case "Project Back"
gosub [colorpick]
if cp$<>"" then projectback$=cp$
if cp$<>"" then ctrc$=cp$
gosub [drawgrid]
case "Project Fore"
gosub [colorpick]
if cp$<>"" then projectfore$=cp$
case "Grid Color"
gosub [colorpick]
if cp$<>"" then gridcolor$=cp$
gosub [drawgrid]
case "Border Color"
gosub [colorpick]
if cp$<>"" then bordercolor$=cp$
case "CrossHair"
gosub [colorpick]
if cp$<>"" then crosshair$=cp$
end select
#fful.color "select Set Color"
gosub [drawgrid]
gosub [drawall]
#fful.gb "setfocus"
wait
[windowtype]
#prop.cbwind "contents? projectwind$"
wait
[colorpick]
WindowWidth=230
WindowHeight=225
UpperLeftX = insertx
UpperLeftY = inserty
graphicbox #pick.gb,25,10,170,170
open "Color Pick" for dialog_nf_modal as #pick
#pick "font Consolas 9"
#pick "trapclose [quitpick]"
#pick.gb "down ; fill white ; flush"
cl$="black darkgray lightgray buttonface red green blue yellow pink darkpink darkred brown darkgreen cyan white white "
c=1
for yc=1 to 160 step 40
for xc= 1 to 160 step 40
#pick.gb "backcolor ";word$(cl$,c);" ; place ";xc;" ";yc;" ; boxfilled ";xc+40;" ";yc+40
c=c+1
if c>15 then c=15
next
next
#pick.gb "when leftButtonDown [pick]"
wait
[pick]
xp=int(MouseX/40)
yp=int(MouseY/40)
c=xp+yp*4+1
cp$=word$(cl$,c)
[quitpick]
close #pick
return
[cthelp]
run "notepad help.txt"
wait
[code]
code = 1
goto [prev]
'control buttons
[bttnSTTX] i=1 : gosub [drawTool] : wait
[bttnTXBX] i=2 : gosub [drawTool] : wait : wait
[bttnLSTBX] i=3 : gosub [drawTool] : wait
[bttnCMBOBX] i=4 : gosub [drawTool] : wait
[bttnBTTN] i=5 : gosub [drawTool] : wait
[bttnBMPBTTN] i=6 : gosub [drawTool] : wait
[bttnGRPHCBX] i=7 : gosub [drawTool] : wait
[bttnRDBTTN] i=8 : gosub [drawTool] : wait
[bttnCHKBX] i=9 : gosub [drawTool] : wait
[bttnGRPBX] i=10 : gosub [drawTool] : wait
[bttnTXTEDTR] i=11 : gosub [drawTool] : wait
[bttnMNU] i=12 : gosub [drawTool] : wait
[negbarrier]
if negbar = 1 then
negbar = 0
#fful.negbarrier "Barrier -"
else
negbar = 1
#fful.negbarrier "No Barrier -"
end if
wait
[barrier]
if barrier = 1 then
barrier = 0
#fful.barrier "Barrier +"
else
barrier = 1
#fful.barrier "No Barrier +"
end if
wait
[block]
wait
[quitfful]
'save away current session to lastsession.ffu
open "lastsession.ffu" for output as #ses
#ses projectfile$
#ses projectwind$
#ses projectform$
#ses projecttitl$
#ses projectfont$
#ses projectback$
#ses projectfore$
#ses projectctrh
#ses projectgrid
#ses projectw
#ses projecth
for n=1 to obj
if obj(n,TT)<>0 then
#ses obj(n,XX);",";
#ses obj(n,Y);",";
#ses obj(n,W);",";
#ses obj(n,H);",";
#ses obj(n,TT);",";
#ses obj(n,TH)
#ses obj$(n,Ctr)
#ses obj$(n,Tex)
#ses obj$(n,Ress)
#ses obj$(n,Fon)
#ses obj$(n,Bak)
end if
next
close #ses
close #prop
close #prog
close #fful
fastGuiOpen = 0
#codeTank.fastgui "!enable"
wait
function replace$( text$ , this$, tothis$ )
while 1
if instr(text$, this$) then
f = instr(text$, this$)
lenght=len(this$)
text$ = mid$(text$,1,f-1);_
tothis$;mid$(text$,f+lenght)
else
exit while
end if
wend
replace$=text$
end function
sub pleasewait
global pleasewaitOpen
WindowWidth = 150 : WindowHeight = 170
UpperLeftX=int((DisplayWidth-WindowWidth)/2)'-100
UpperLeftY=int((DisplayHeight-WindowHeight)/2)'-500
statictext #pleasewait.text, "Please Wait", 30, 20, 100, 20
statictext #pleasewait.text2, "This Can Take", 40, 50, 100, 20
statictext #pleasewait.text3, " Take Up to", 25, 80, 100, 20
statictext #pleasewait.text4, "25 Secs / File", 20, 110, 110, 20
button #pleasewait.fake, "", [quit.pleasewait], ul, 0, 0, 0, 0
Open "untiltled" for dialog_popup as #pleasewait
#pleasewait "trapclose [quit.pleasewait]"
#pleasewait "font arial 12 bold"
pleasewaitOpen = 1
end sub
sub writeAutoSave
global autoSave$
autoSave$ = "autoSave.vbs"
open autoSave$ for output as #1
#1 "Set WshShell = WScript.CreateObject(";q$;"WScript.Shell";q$;")"
#1, "Do While Not WshShell.AppActivate(";q$;"Save *.TKN File As...";q$;")"
#1, "Loop"
#1, "Wscript.Sleep(500)"
#1, "WshShell.SendKeys ";q$;"{ENTER}";q$
#1, "Do While Not WshShell.AppActivate(";q$;"Information";q$;")"
#1, "Loop"
#1, "Wscript.Sleep(500)"
#1, "WshShell.SendKeys ";q$;"{ENTER}";q$
#1, "Wscript.Sleep(500)"
#1, "WshShell.AppActivate(";q$;"pleasewait";q$;")"
close #1
end sub
'function to retrieve Users Home Path (thanks to Brandon Parker)
Function GetSpecialFolder$(CSIDL)
S.OK = NULL
GetSpecialFolder$ = "Operation Failed"
pszPath$ = Space$(_MAX_PATH);chr$(0)
CallDLL #shell32, "SHGetFolderPathA", _NULL As ulong, _ 'hWnd is RESERVED
CSIDL As long, _ 'CSIDL value
_NULL As ulong, _ 'hToken is set to NULL to check the current token
0 As ulong, _ 'dwFlags is set to NULL to represent SHGFP_TYPE_CURRENT
pszPath$ As ptr, _ 'pszPath is where the path string will be stored upon return
ret As long
If (ret = S.OK) Then GetSpecialFolder$ = Trim$(pszPath$)
End Function
'edit date$() return for use in filenames
sub fixdate
fixDate$ = Date$() 'set up a date format that works with a filename(remove the /)
fix1$ =word$(fixDate$, 1, " ") ' = Month,
fix2$ = word$(fixDate$, 2, " ") ' = Month
fix2$ = left$(fix2$, len(fix2$)-1) ' = Number of day
fix3$ = word$(fixDate$, 3 ," ") ' = Year - 4 digits
fix3$ = right$(fix3$, 2) ' = Year - 2 digits
fixeddate$ = fix1$;"-";fix2$;"-";fix3$ ' = Month-NumberOfDay-Year
end sub
'edit Time$() return for use in filenames
sub fixtime
global fixedtime$
fixTime$ = Time$() 'set up a time format that works with a filename(remove the /)
fix1$ = word$(fixTime$, 1, ":")' - remove the "." 's
fix2$ = word$(fixTime$, 2 ,":")
fixedtime$ = "-";fix1$;"-";fix2$;"_"' ' add dashes -
end sub
sub resetRadioOptions
dictionary$ = "" : keyCount = 0 : lastKey$ = "" : selectedKey$ = ""
call readDictionary
call loadKeys
#codeTank.value, "!origin 0, 0 "
#codeTank.keys "select 0"
end sub
'function for checking file existence
function fileExists(path$, filename$)
dim info$(0, 0)
files path$, filename$, info$()
fileExists = val(info$(0, 0)) 'non zero is true
end function
'function for checking folder existence
function pathExists(path$)
pathExists = (mkdir(path$)=183)
end function
[textEdMirror]
if textedMOpen = 1 then #textedM.edMirror "!setfocus" : wait
WindowWidth = 700
WindowHeight = 500
texteditor #textedM.edMirror, 20, 20, 640, 400
button #textedM.incFont, "&+", [incEdFont], UL, 220, 0, 20, 23
button #textedM.decFont, "&-", [decEdFont], UL, 400, 0, 20, 23
button #textedM.mirror, "&ScratchPad", [scratch], UL, 250, 0, 140, 23
open "TextEditor Mirror" for Window as #textedM
#textedM "trapclose [quit.textedM]"
#codeTank.value "!contents? code$"
#textedM.edMirror code$
#textedM "Font Arial 12"
EdMirFont = 12
#textedM.edMirror, "!setfocus"
#textedM.edMirror "!origin 0 0"
textedMOpen = 1
#textedM.edMirror "!autoresize"
if selectedKey$ = "" then [setCatScratch]
wait
[scratch]
#codeTank.savedprojects "reset"
#textedM.edMirror "!contents? code$"
#codeTank.value "!cls"
#codeTank.value code$
call saveValue
mir = 1 : gosub [deleteOrig]
mir = 0
[setCatScratch]
newKey$ = selectedKey$
if categorie$ = "" or selectedKey$ = "" then
categorie$ = "ScratchPad" : selectedKey$ = "Scratch"
end if
call setValueByName newKey$, ""
call loadKeys
open categorie$ for append as #1
#1 chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134)+selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 code$
close #1
call resetRadioOptions
call readDictionary
call loadKeys
#codeTank.value "!cls"
categorie$ = "ScratchPad"
selectedKey$ = "Scratch"
#textedM.edMirror "!cls"
#textedM.edMirror, "!setfocus"
#textedM.edMirror, "!origin 0 0"
wait
[incEdFont]
EdMirFont = EdMirFont + 1
#textedM.edMirror "!font Arial ";EdMirFont
wait
[decEdFont]
EdMirFont = EdMirFont - 1
#textedM.edMirror "!font Arial ";EdMirFont
wait
[quit.pleaseWait]
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
wait
[quit.textedM]
call saveValue
#textedM.edMirror "!contents? code$"
close #textedM : textedMOpen = 0
#codeTank.value "!cls"
#codeTank.value code$
#codeTank.value "!origin 0 0"
mir = 1 : gosub [deleteOrig]
mir = 0
call setValueByName newKey$, ""
call loadKeys
#codeTank.keys "select "; newKey$
if categorie$ = "" then
categorie$ = "ScratchPad" : selectedKey$ = "Scratch"
end if
open categorie$ for append as #1
#1 chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134)+selectedKey$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
#1 code$
close #1
call resetRadioOptions
call readDictionary
call loadKeys
#codeTank.value "!cls"
#codeTank.keys "select 0"
wait
'quit program
[quit.codeTank]
if textedMOpen = 1 then
text$ = "Quiting will close the Editor Mirror"+chr$(13)+chr$(13)
text$ = text$+"Quit Anyway?"+chr$(13)
a$ = custcon$(text$)
if answer$ <> "Yes" then wait
end if
call saveValue
gosub [cleanUp]
if pickOpen = 1 then close #pick : pickOpen = 0
if fastcodeOpen = 1 then close #fastcode : fastcodeOpen = 0
if propOpen = 1 then close #prop : propOpen = 0
if progOpen = 1 then close #prog : progOpen = 0
if resultsOpen = 1 then close #results : resultsOpen = 0
if mainListOpen = 1 then close #codeTankList : mainListOpen = 0
if fastGuiOpen = 1 then close #fful : fastGuiOpen = 0
if textedMOpen = 1 then close #textedM : textedMOpen = 0
if pleasewaitOpen = 1 then close #pleasewait : pleasewaitOpen = 0
if codetankOpen = 1 then close #codeTank : codetankOpen = 0
if customconfirmOpen = 1 then close #customconfirm : customconfirmOpen = 0
end
'sub to create pauses in program
sub pause mil
t=time$("ms")+mil
while time$("ms")<t
scan
wend
end sub
'sub to save current Dictionary Listings and text in texeditor
sub saveValue 'if the value is changed, save it
if lastKey$ <> "" then
#codeTank.value "!modified? modified$";
if modified$ = "true" then
#codeTank.value "!contents? saveThisValue$";
call setValueByName lastKey$, saveThisValue$
call collectGarbage
call writeDictionary
end if
end if
end sub
'function to get selected Listing
function getKeys$(delimiter$)
global keyCount
pointer = 1
while pointer <> 0
'get the next key
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), pointer)
if pointer then
keyPointer = pointer + 9
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), pointer)
key$ = mid$(dictionary$, keyPointer, pointer - keyPointer)
if instr(keyList$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)) = 0 then
getKeys$ = getKeys$ + key$ + delimiter$
keyList$ = keyList$ + chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$
keyCount = keyCount + 1
end if
end if
wend
end function
'sub to write each Listing to corresponding file
sub writeDictionary
if categorie$ = "" then categorie$ = "ScratchPad"
if categorie$ = "ScratchPad" then
open DefaultDir$;"\";categorie$ for append as #writeDict
#writeDict date$();time$()
goto [writeit]
end if
open DefaultDir$;"\";categorie$ for output as #writeDict
[writeit]
#writeDict, dictionary$
close #writeDict
end sub
'sub to read each Listing from corresponding file
sub readDictionary
if fileExists(DefaultDir$, categorie$) <> 0 then
open categorie$ for input as #readDict
length = lof(#readDict)
dictionary$ = input$(#readDict, length)
close #readDict
else
end if
end sub
'sub to cleanup any mess in the dictionary text
sub collectGarbage
pointer = 1
while pointer > 0
'get the next key
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), pointer)
if pointer then
keyPointer = pointer + 9
pointer = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), pointer)
key$ = mid$(dictionary$, keyPointer, pointer - keyPointer)
if instr(keyList$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)) = 0 then
value$ = getValue$(key$)
newDictionary$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134) + value$ + newDictionary$
keyList$ = keyList$ + chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134) + key$ + chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)
end if
end if
wend
dictionary$ = newDictionary$
end sub
sub setValueByName key$, value$
dictionary$ = chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134);key$;chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134)+value$+dictionary$
end sub
'function to get info from selected Listing
function getValue$(key$)
getValue$ = chr$(0)
keyPosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134)+key$+chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134))
if keyPosition > 0 then
keyPosition = keyPosition + 9 'skip over key tag
valuePosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"value";chr$(134);chr$(165);chr$(134), keyPosition)
if valuePosition > 0 then
valuePosition = valuePosition + 11 'skip over value tag
endPosition = instr(dictionary$, chr$(134);chr$(165);chr$(134);"key";chr$(134);chr$(165);chr$(134), valuePosition)
if endPosition > 0 then
getValue$ = mid$(dictionary$, valuePosition, endPosition - valuePosition)
else
getValue$ = mid$(dictionary$, valuePosition)
end if
end if
end if
end function
'sub to load selected categorie List
sub loadKeys
keyList$ = getKeys$(chr$(134);chr$(165);chr$(134))
redim keys$(keyCount)
for item = 1 to keyCount
keys$(item-1) = word$(keyList$, item, chr$(134);chr$(165);chr$(134))
next item
sort keys$(), 0, keyCount
#codeTank.keys "reload"
keyCount = 0
end sub
'function to separate filename from full path to file
function GetFilename$(fileName$)
i = len(fileName$)
while mid$(fileName$, i, 1) <> "\" and mid$(fileName$, i, 1) <> ""
i = i-1
wend
GetFilename$ = mid$(fileName$, i+1)
end function
'function to delete entire folder (including sub folders and files)
function delete$(folder$)
run "cmd.exe /c rd /s /q ";q$;folder$;q$, HIDE
end function
'function makes customized confirmation window
function custcon$(text$)
global text$, customconfirmOpen, a$, answer$, fault
WindowWidth = 540 : WindowHeight = 300
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
statictext #customconfirm.header "Notice to User", 190, 10, 130, 30
statictext #customconfirm.text text$, 40, 60, 490, 120
button #customconfirm.default "&OK", [confirmYes], ul, 220, 200, 80, 35
button #customconfirm.yes "&Yes", [confirmYes], ul, 100, 200, 120, 35
button #customconfirm.no "&No", [confirmNo], ul, 320, 200, 120, 35
open "Confirmation Required" for dialog_modal as #customconfirm
#customconfirm "trapclose [confirmNo]"
#customconfirm "font arial 12"
customconfirmOpen = 1
#customconfirm.default "!hide"
wait
[confirmNo]
answer$ = "No"
if customconfirmOpen = 1 then close #customconfirm : customconfirmOpen = 0
goto [endFunction]
[confirmYes]
answer$ = "Yes"
if customconfirmOpen = 1 then close #customconfirm : customconfirmOpen = 0
[endFunction]
end function
FUNCTION FN.Screen(BYREF Szx, BYREF Szy)
Szx = DisplayWidth
Szy = DisplayHeight
FN.Display = Szx * Szy
END FUNCTION
FUNCTION FN.PercentScreen(PercentX, PercentY, BYREF Szx, BYREF Szy)
Szx = INT(DisplayWidth * PercentX)
Szy = INT(DisplayHeight * PercentY)
FN.PercentScreen = Szx * Szy
END FUNCTION
FUNCTION FN.ScreenCenter(BYREF Cx, BYREF Cy)
Cx = INT(DisplayWidth * 0.5)
Cy = INT(DisplayHeight * 0.5)
FN.ScreenCenter = Cx * Cy
END FUNCTION
FUNCTION FN.SetWinPos(PosX, PosY)
UpperLeftX = PosX
UpperLeftY = PosY
FN.SetWinPos = PosX * PosY
END FUNCTION
FUNCTION FN.SetWinSize(Szx, Szy)
WindowWidth = Szx
WindowHeight = Szy
FN.SetWinSize = Szx * Szy
END FUNCTION
sub resized handle$
TxbUx = 100 '<--- location and size of text box
TxbUy = 50
Txbsx = 100
Txbsy = 25
Txbsx = WindowWidth - TxbUx - Txbsx '<--- resize text box
#codeTank.numLines, "!LOCATE ";WindowWidth-130;" "; 50;" ";120;" "; 25
#codeTank.filePath, "!LOCATE ";TxbUx;" ";TxbUy;" ";Txbsx-30;" ";Txbsy
#codeTank.keys, "LOCATE ";100;" ";75;" ";340;" ";WindowHeight-600+60+270
#codeTank, "REFRESH"
end sub
'sub to make folder dialog window
sub browser caption$
dim info$(0, 0)
dim folderInfo$(0, 0)
WindowWidth = 700
WindowHeight = 500
UpperLeftX=INT((DisplayWidth-WindowWidth)/2)
UpperLeftY=INT((DisplayHeight-WindowHeight)/2)
gosub [FolderDlgGetDrives]
statictext #folderdlg.selection, "Selection >> ", 40, 505, 95, 15
statictext #folderdlg.caption, caption$, 150, 20, 525, 35
listbox #folderdlg.filelist, fileList$(, [fileSelect], 350, 50, 320, 310
listbox #folderdlg.list, FolderList$(, [FolderDlgSelect], 15, 50, 320, 310
button #folderdlg.default, "OK", [FolderDlgOk], UL, 220, 410, 75, 25
button #folderdlg.back, "< < <", [FolderDlgBack], UL, 10, 10, 60, 30
button #folderdlg.C, "Cancel", [FolderDlgCancel], UL, 395, 410, 75, 25
button #folderdlg.plusfont, "+", [plusFont], UL, 75, 10, 30, 30
button #folderdlg.minusfont, "-", [minusFont], UL, 110, 10, 30, 30
textbox #folderdlg.text, 15, 360, 655, 25
BackgroundColor$ = "lightgray"
open "Liberty Basic File Browser" for dialog_modal as #folderdlg
#folderdlg, "trapclose [FolderDlgCancel]"
#folderdlg.text, "Selected (Drive \ Folder \ File) Path Appears Here"
#folderdlg, "font Arial 12 bold"
#folderdlg.filelist, "singleclickselect"
#folderdlg.list, "singleclickselect"
fontsize = 12
wait
[minusFont]
fontsize = fontsize - 1
#folderdlg.list, "font arial ";fontsize;" bold"
#folderdlg.filelist, "font arial ";fontsize;" bold"
wait
[plusFont]
fontsize = fontsize + 1
#folderdlg.list, "font arial ";fontsize;" bold"
#folderdlg.filelist, "font arial ";fontsize;" bold"
wait
[FolderDlgSelect]
#folderdlg.list, "selection? temp$"
if temp$ <> "" then
level = level+1
folder$ = folder$; temp$; "\"
#folderdlg.text, folder$
gosub [FolderDlgGetDir]
#folderdlg.list, "reload"
#folderdlg.list, "select 0"
#folderdlg.default "!setfocus"
end if
wait
[FolderDlgBack]
if level > 0 then
level = level-1
if level = 0 then
folder$ = ""
gosub [FolderDlgGetDrives]
else
i = len(folder$)-1
while mid$(folder$, i, 1) <> "\" and mid$(folder$, i, 1) <> ""
i = i-1
wend
folder$ = left$(folder$, i)
gosub [FolderDlgGetDir]
end if
#folderdlg.text, folder$
fileList$(0) = " F I L E S"
#folderdlg.list, "reload"
#folderdlg.filelist, "reload"
end if
wait
[FolderDlgGetDrives]
c = 1
while word$(Drives$, c) <> ""
c = c+1
wend
redim FolderList$(c)
FolderList$(0) = " D R I V E S"
for i = 1 to c
FolderList$(i) = word$(Drives$, i)
next i
redim fileList$(0)
return
[FolderDlgGetDir]
files folder$, info$(
s = val(info$(0,0))
tt = val(info$(0,1))
redim FolderList$(tt)
FolderList$(0) = " F O L D E R S"
for i = 1 to tt
FolderList$(i) = info$(i+s, 1)
next i
[filesBack]
files folder$, "*.*", folderInfo$()
numFiles = val(folderInfo$(0, 0))
redim fileList$(numFiles)
for x = 1 to numFiles
filename$ = folderInfo$(x, 0)
fileList$(x) = filename$
next x
fileList$(0) = " F I L E S"
sort fileList$(), 0 , numFiles
#folderdlg.filelist, "reload"
return
[fileSelect]
#folderdlg.filelist "selection? file$"
#folderdlg.text, folder$;file$
wait
[FolderDlgOk]
#folderdlg.text, "!contents? FolderDialog$"
If right$(FolderDialog$,1) = "\" then
if right$(FolderDialog$, 2) = ":\" then [goAround]
FolderDialog$ = left$(FolderDialog$, len(FolderDialog$) - 1)
else
[goAround]
notice "The Selection was Not a Folder" : close #folderdlg : wait
end if
[FolderDlgCancel]
close #folderdlg
end sub
sub quit fast$
close #fastcode
fastcodeOpen = 1
end sub
'sub to generate the window code and copy to clipboard, and texeditor
sub dummy fast$
global toPrint$
select case
case fast$ = "#fastcode.button1"
#fastcode.txt1 "!contents? txt$"
#fastcode.txt2 "!contents? theName$"
#fastcode.r1 "value? result$"
if result$="set" then
itag$="["
otag$="]"
closingCode$= "[quit]";chr$(13);_
" close ";txt$;chr$(13);_
" end"
else
closingCode$ = "Sub quit fast$";chr$(13);_
" close #fast$" ;chr$(13);_
" end";chr$(13);_
"End Sub"
end if
#fastcode.combo "selection? sel$"
if instr(sel$,"popup") then
includeButton$= "button ";txt$;".button1 ";chr$(34);_
"&X";chr$(34);", "; itag$;"quit";otag$;", ul, 610, 5, 25, 20"
end if
toPrint$ = "nomainwin";chr$(13);"WindowWidth = 640";chr$(13);"WindowHeight = 480";chr$(13);_
"UpperLeftX=int((DisplayWidth-WindowWidth)/2)";chr$(13);_
"UpperLeftY=int((DisplayHeight-WindowHeight)/2)";chr$(13);_
includeButton$;chr$(13);_
"Open ";chr$(34);theName$;chr$(34);" for ";sel$; " as ";txt$;chr$(13);_
" ";txt$;" "; chr$(34); "trapclose ";itag$;"quit";otag$; chr$(34);chr$(13);_
"wait";chr$(13);chr$(13);_
closingCode$
#fastcode.ed "!cls"
#fastcode.ed toPrint$
#fastcode.ed "!selectall"
#fastcode.ed "!copy"
#fastcode.ed "!paste"
#fastcode.ed "!origin 0 0"
end select
end sub
function getsize$(l$)
'what if it is a variable?
v$=""
pos=1
n$=mid$(l$,pos,1)
while instr("1234567890",n$,1)=0 and pos<len(l$)
pos=pos+1
n$=mid$(l$,pos,1)
wend
while n$>="0" and n$<="9" and pos<=len(l$)
v$=v$+n$
pos=pos+1
n$=mid$(l$,pos,1)
wend
getsize$=v$
end function
function getcolor$(l$)
if l$="palegray" then l$="lightgray"
'what if it is a variable?
cl$="darkgray lightgray buttonface darkred darkpink darkgreen blue yellow pink red brown green cyan white black "
for c= 1 to 15
if instr(l$,word$(cl$,c),1)>0 then getcolor$=word$(cl$,c) : exit for
next
if getcolor$="" then getcolor$="white"
end function
function value(x$)
select case len(x$)
case 1
value = asc(x$)
case 2
value=asc(mid$(x$,1,1))
value=value+(asc(mid$(x$,2,1))*256)
case 3
value=asc(mid$(x$,1,1))
value=value+(asc(mid$(x$,2,1))*256)
value=value+(asc(mid$(x$,3,1))*65536)
case 4
value=asc(mid$(x$,1,1))
value=value+(asc(mid$(x$,2,1))*256)
value=value+(asc(mid$(x$,3,1))*65536)
value=value+(asc(mid$(x$,4,1))*16777216)
end select
end function
'subroutine for selections of combo boxes
sub asciiSelected asciiList$
#codeTank.asciiList, "selection? asciiChoice$"
#codeTank.filePath asciiChoice$
#codeTank.fake "!cls"
#codeTank.fake asciiChoice$
#codeTank.fake "!selectall"
#codeTank.fake "!copy"
#codeTank.asciiList, "! ASCII Codes"
end sub
sub getAscii
dim asciiList$(250)
y = 7
asciiList$(0)= " Controls"
asciiList$(1) = " chr$(0) = (nul) ";chr$(0)
asciiList$(2) = " chr$(27) = (escape) ";chr$(27)
asciiList$(3) = " chr$(32) = (space) ";chr$(32)
asciiList$(4) = " chr$(13) = (enter) ";chr$(13)
asciiList$(5) = " Printables"
asciiList$(6) = " chr$(32)= (space) ";chr$(32)
for x = 33 to 255
asciiList$(y) = " chr$(";x;") = ";chr$(x)
y = y + 1
next x
#codeTank.asciiList, "reload"
#codeTank.asciiList, "! ASCII Codes"
end sub
sub lbreservedwordSelected lbReservedwordList$
#codeTank.lbreservedwordsList, "selection? lbreserved$"
#codeTank.filePath lbreserved$
#codeTank.fake "!cls"
#codeTank.fake lbreserved$
#codeTank.fake "!selectall"
#codeTank.fake "!copy"
#codeTank.lbreservedwordsList "select 0"
#codeTank.lbreservedwordsList "! Reserved Words"
end sub
sub getlbreservedwords
global lbReservedWords$
dim lbreservedwordsList$(250)
for x = 0 to 250
filename$ = word$(lbReservedWords$, x ,",")
lbreservedwordsList$(x) = filename$
next x
sort lbreservedwordsList$(), 1 ,250
#codeTank.lbreservedwordsList, "reload"
#codeTank.lbreservedwordsList "! Reserved Words"
end sub
[LBB_EXE]
'LBB = 0
LBB$ = DefaultDir$;"\LBB.exe"
cursor hourglass
fname0$ = GetFilename$(fname$)
open DestPath1$;"\";fname0$ for input as #1
open DefaultDir$;"\EXE\";fname0$ for output as #2
temp$ = input$(#1, lof(#1))
#2 temp$
close #1
close #2
call writeAutoSaveLBB
run "wscript ";autoSaveLBB$
run LBB$;" -C -M -A ";DefaultDir$;"\EXE\";fname0$
fname1$ = fnamenobas$;".exe"
while fileExists(DefaultDir$;"\EXE", fname1$) = 0
scan
wend
call pause 4000
fullname$ = DefaultDir$;"\EXE\";fnamenobas$;ve$;fixeddate$;fixedtime$;".exe"
if fileExists(DefaultDir$;"\EXE", fname1$) then
name DefaultDir$;"\EXE\";fname1$ as fullname$
end if
if fileExists(DefaultDir$;"\EXE", fnamenobas$;".bas") then
name DefaultDir$;"\EXE\";fnamenobas$;".bas" as DefaultDir$;"\EXE\";fnamenobas$;ve$;fixeddate$;fixedtime$;".bas"
end if
print x
x=0
goto [LBB_RETURN]
return
sub writeAutoSaveLBB
global fullname$
q$ = chr$(34)
global autoSaveLBB$, fname1$, fname$, fnamenobas$
autoSaveLBB$ = "autoSaveLBB.vbs"
open autoSaveLBB$ for output as #1
dir$ = DefaultDir$;"\EXE"
#1 "Set FSO = CreateObject(";q$;"Scripting.FileSystemObject";q$;")"
#1 "Set objFolder = FSO.GetFolder(";q$;dir$;q$;")"
#1 "Set objFiles = objFolder.Files "
#1 "Set WshShell = WScript.CreateObject(";q$;"WScript.Shell";q$;")"
#1 "Do While Not WshShell.AppActivate(";q$;"Save standalone executable";q$;")"
#1 "Loop"
#1 "WshShell.AppActivate(";q$;"Save standalone executable";q$;")"
#1 "WshShell.SendKeys ";q$;"{ENTER}";q$
#1 "For i=0 to objFiles.Count"
#1 "If FSO.FileExists(";q$;"EXE\";fnamenobas$;".exe";q$;") Then exit for"
#1 "Next"
#1, "Do While Not WshShell.AppActivate(";q$;"LB Booster";q$;")"
#1 "Loop"
#1 "Wscript.Sleep(12000)"
#1 "WshShell.AppActivate(";q$;"LB Booster";q$;")"
#1 "Wscript.Sleep(300)"
#1 "WshShell.SendKeys ";q$;"{ENTER}";q$
#1 "Set WshShell = nothing"
#1 "Set FSO = nothing"
#1 "Set objFolder = nothing"
#1 "Set objFiles = nothing"
close #1
end sub
|
|
Coders Corner
