A simple demonstration of programming in BASIC using the PowerBASIC Console Compiler
Click-on here to download the Kube-0-Seven Program
A simple demonstration of programming in BASIC using the PowerBASIC Console Compiler
' Nothing fancy or elaborate here. Just some simple fundamentals to learn from and build on.
' This is a demonstration of --
' 1. Raising Numbers to the Power of 3 - IE, 3x3x3 is 27 - An Example of "Cubed" Numbers.
' 2. Placing commands for various tasks into specific SUBs and FUNCTIONs.
' 3. Creating User Menus and Prompts, along with supporting on-screen displays.
' 4. Creating your own FUNCTIONs to assist in program flow, control and appearance.
' 5. Creating - with GLOBAL statement - a Master Control Variable whose values determine
' what is done at any given point within the program ... IE, a specific value for
' file saving, a specific value for output to a printer and so on.
' 6. Creating one or more SUBs (just one for this program) that, with the use of control variables,
' can handle the assembling of data for on-screen display, file saving and/or printing.
' The SUB in this program has compensation measures to handle data that will be displayed on-screen
' as well as either saved to file or printed out.
' 7. Creating a SUB that, with the use of control variables (those passed to it from other SUBs as
' those within the specific SUB itself), can produce a variety of on-screen displays.
' 8. A file-naming procedure that checks for and removes unwanted characters, then checks for specific
' minimum length of the filename.
' 9. Basic use of a few of the XPRINT statements and functions that are available to Power-BASIC
' Console Compiler programmers.
#COMPILE EXE
#DIM ALL
' #INCLUDE "win32api.inc" ''' For special calls and functions. Was not needed in this demo.
GLOBAL MasterAll AS LONG:' MasterAll is a Master Control Variable in this Program
' PBMAIN (or WINMAIN) is always the first "port of call" in any Power-Basic CC program
FUNCTION PBMAIN () AS LONG
' Console and cursor modes set here
CONSOLE SET LOC 40,80
CONSOLE SET SCREEN 43, 80
CURSOR OFF
MasterAll=1:' Action trigger that will get program started
CALL FirstMenu:' Official Starting Point of Main Program
' Console, Color and Cursor Modes re-set before leaving program
CONSOLE SET SCREEN 25,80
COLOR 7,0
CURSOR ON
END FUNCTION
FUNCTION FolderExist(File$) AS LONG
' checks for existence of a folder on a specified drive. See SUB FolderTest
LOCAL Dummy&
Dummy& = GETATTR(File$)
FUNCTION = (ERRCLEAR = 0)
END FUNCTION
FUNCTION AT0(BYVAL RRow AS LONG, BYVAL RCol AS LONG) AS STRING
' on-screen cursor placement
LOCATE RRow, RCol
END FUNCTION
FUNCTION AT2(BYVAL RRow AS LONG, BYVAL RCol AS LONG, BYVAL RRGB AS LONG) AS STRING
' on-screen cursor placement with foreground color
LOCATE RRow, RCol
COLOR RRGB
END FUNCTION
SUB FolderTest (Foldz AS LONG,ChekName AS STRING)
LOCAL Test AS STRING, CantDo AS LONG
SELECT CASE Foldz
CASE 1
Test="C:\Temp":' Check for existence of folder (Directory) TEMP on Drive C. Only need the one \ here
CASE 2
Test=ChekName:' A user-created folder (directory) on the drive of their choice
IF LEN(Test)<6 THEN EXIT SUB:' foldername to be at least 3 characters
' Case 2 not actually used in this demo, but is included to illustrate where-to-save options
CASE ELSE: EXIT SUB
END SELECT
IF FolderExist(Test)=-1 THEN
' -1 is YES, it exists - no further action needed
ELSEIF FolderExist(Test)=0 THEN
MKDIR Test
' 0 is no, it does not exist, so create it
END IF
END SUB
SUB FirstMenu
LOCAL HJBL AS LONG, NXAA AS LONG, NXBB AS LONG, JColor AS LONG
LOCAL GFAR AS STRING, WFAA AS STRING, ProgramName AS STRING
ProgramName="Kube-0-Seven"
CLS
CALL ShowDaResults(1):' Calculates and Compiles the CUBE info for display, file save or printing
HJBL=1
DO
GFAR=INKEY$
GFAR=UCASE$(GFAR)
SELECT CASE GFAR
CASE "F"
MasterAll=2:' File Saving
CALL DaSaveFileMenu
CASE "G","!"
MasterAll=1:' Display Refresh. Not needed, but included for demonstration purposes
CASE "P"
MasterAll=5:' Print Out
CALL DoPrintOut
CASE "~"
CALL MicroSoftAlarm:' Gag. Included for demonstration purposes
CASE "X"
MasterAll=9:' Exit Program
END SELECT
SELECT CASE MasterAll
CASE 1
HJBL=1
CALL ShowDaResults(2):' The Cube results from 1 to 99
CALL DaMainDisplay(1,0):' User Options Display
MasterAll=18:' Prevents needless repeats of this particular Case block
CASE 9
HJBL=2
CLS
? AT2(4,2,11);"Thank you for using ";
COLOR 15,0
? ProgramName
SLEEP 1701
END SELECT
LOOP UNTIL (HJBL>1)
END SUB
SUB DaSaveFileMenu
LOCAL HJBL AS LONG, GFAR AS STRING, JFAR AS STRING
HJBL=1
DO
GFAR=INKEY$
GFAR=UCASE$(GFAR)
SELECT CASE GFAR
CASE "S"
MasterAll=3:' Go to File Save Instructions
CALL KnameDaFile
CASE "G"
MasterAll=1:' Go back to User Options
CASE "X"
MasterAll=9:' Exit Program
END SELECT
SELECT CASE MasterAll
CASE 2,22
HJBL=1
CALL DaMainDisplay(2,0):' File Save Menu
IF MasterAll=22 THEN
CALL DaMainDisplay(2,2)
CALL DoFileSave(2,""):' shows that file was saved. See SUB DoFileSave RE parameter passing
END IF
MasterAll=28:' prevents needless repeats of this particular Case block
CASE 1,9
HJBL=2
END SELECT
LOOP UNTIL (HJBL>1)
END SUB
SUB KnameDaFile
LOCAL LegalCharacters AS STRING, IllegalCharacters AS STRING, YourInput AS STRING
LOCAL HJBL AS LONG
CALL DaMainDisplay(3,1):' File Saving Instructions Display
HJBL=1
DO
CALL DaMainDisplay(3,2)
? AT2(17,36,14);"";
LINE INPUT YourInput
YourInput=UCASE$(YourInput)
' Lower-case letters made upper-case, because character-stripping procedure below
' would take out any lower-cases.
LegalCharacters="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-"
IllegalCharacters=REMOVE$(YourInput, ANY LegalCharacters):' isolate any non-legal character
IF LEN(IllegalCharacters)>=1 THEN YourInput=REMOVE$(YourInput, ANY IllegalCharacters)
' If at least one illegal character exists, it will be removed here
SELECT CASE YourInput
CASE "FILE","SAVE","2","22"
MasterAll=2:' Go back to File Save Menu
HJBL=2
CASE "RETRY","3","33"
MasterAll=3:' Try Again. Not really needed, but included for demonstration purposes
HJBL=4
CASE "CANCEL","USER","1","11"
MasterAll=1:' Go back to User Options
HJBL=2
CASE "END","EXIT","9","99"
MasterAll=9:' Exit Program
HJBL=2
END SELECT
IF HJBL=4 THEN HJBL=1: YourInput="":' in case of unsuccessful entry
IF MasterAll=3 THEN
HJBL=1
CALL DaMainDisplay(3,1):' restores instructions display
MasterAll=38:' prevents needless repeats of this particular IF-THEN block
END IF
IF LEN(YourInput)>=3 AND HJBL=1 THEN HJBL=3:' successful filename entry
LOOP UNTIL (HJBL>1)
IF HJBL=3 THEN
MasterAll=4
CALL DoFileSave(1,YourInput):' 1 invokes file-naming commands in SUB DoFileSave
YourInput=""
END IF
END SUB
SUB DoFileSave (GTEXT AS LONG, YourInput AS STRING)
STATIC FullName AS STRING, DaDriveDir AS STRING, FileKname AS STRING
' For the IF-THEN Block, GTEXT needs to be 1 and YourInput needs to be a 3 to 25 character string
IF GTEXT=1 THEN
CALL DaMainDisplay(2,2):' Display name of user-created file
DaDriveDir="C:\TEMP":' Only need the one \ here
CALL FolderTest(1,DaDriveDir)
' Checks for Existence of a user-specified folder (directory).
' If the folder does not already exist, SUB FolderTest creates it
' 1 = C:\TEMP for which a test is already set up.
' If checking for folders on C or other drives, the numerical value would be 2 or more, and the
' string parameter would be the folder and drive - say, F:\Kube - in question.
FileKname=LEFT$(YourInput,25)+".TXT"
FullName=DaDriveDir+"\"+FileKname
OPEN FullName FOR OUTPUT AS #1
CALL ShowDaResults(3):' Save results stored in SUB ShowDaResults to a named file
CLOSE #1
MasterAll=22:' Triggers "File saved in ..." display in SUB DaFileSaveMenu
END IF
' If SUB DoFileSave is called again, GTEXT can be any number other than 1, and YourInput can be a null string
' As a result, only the lines below will be executed
COLOR 0,15
? AT0(30,33);FileKname
? AT0(32,33);"in folder ";DaDriveDir
COLOR 7,0
END SUB
SUB DoPrintOut
LOCAL HFAR AS STRING, HJBL AS LONG
CALL DaMainDisplay(4,1):' Printing Instructions Display
HJBL=1
DO
HFAR=INKEY$
HFAR=UCASE$(HFAR)
SELECT CASE HFAR
CASE "Y"
CALL DaMainDisplay(4,2):' Printing in progress
ERRCLEAR
XPRINT ATTACH CHOOSE:' Attach and Choose a Printer thru WINDOWS
IF ERR=0 AND LEN(XPRINT$)>0 THEN
CALL ShowDaResults(4):' Will print out info stored in SUB ShowDaResults
XPRINT FORMFEED:' Issue a formfeed
XPRINT CLOSE:' Detach the printer
END IF
CALL DaMainDisplay(4,3):' Printing Completed
CASE "G"
MasterAll=1:' Go back to User Options
HJBL=2
CASE "X"
MasterAll=9:' Exit Program
HJBL=2
END SELECT
LOOP UNTIL (HJBL>1)
END SUB
SUB DaMainDisplay (GTEXT AS LONG, GXTRA AS LONG)
LOCAL WFOR AS LONG, JColor AS LONG
LOCAL NXAA AS LONG,WFAA AS STRING
DIM Ktext(10) AS STRING, JXTRA(8) AS LONG
' Variables GTEXT, GXTRA and JXTRA() control what is displayed on-screen
JXTRA(1)=99:' JXTRA() variables used to invoke display of common info for two-or-more different GTEXT cases.
' Dimensioning JXTRA saves on having to define a lot of different variable names.
' JXTRA(1) ... Common displays in GTEXT cases 2 and 4 (actually done in this very SUB)
' JXTRA(2) ... Common displays in GTEXT cases 2, 5 and 7 (some other program)
' JXTRA(3) ... Common displays in GTEXT cases 4, 6, 8 and 9 (some other program)
SELECT CASE GTEXT
CASE 1
' User Options Menu
FOR WFOR=19 TO 39
? AT0(WFOR,46);STRING$(33,32):' clear out previous text
NEXT WFOR
? AT2(19,46,11);"User Options"
? AT2(21,46,14);"Press a Letter"
? AT2(24,46,15);"F -";AT2(24,50,11);"Save Results to a File"
? AT2(26,46,15);"P -";AT2(26,50,10);"Print Out Results"
? AT2(28,46,15);"X -";AT2(28,50,11);"Exit This Program"
? AT0(41,03);STRING$(75,32)
CASE 2
' File Save Menu
FOR WFOR=14 TO 39
? AT0(WFOR,32);STRING$(47,32):' clear out previous text
NEXT WFOR
? AT2(17,32,11);"Save Results to a File"
? AT2(20,32,15);"S -";AT2(20,36,11);"Save to File"
JXTRA(1)=1:' See below for the JXTRA(1) IF-THEN Block
IF GXTRA=2 THEN
COLOR 0,15
FOR WFOR=27 TO 33
? AT0(WFOR,32);STRING$(33,32):' Establish White Background Display
NEXT WFOR
' Remainder of this particular display generated in SUB DoFileSave
? AT0(28,33);"Results saved to file"
COLOR 7,0
END IF
CASE 3
' File Save Instructions
SELECT CASE GXTRA
CASE 1
FOR WFOR=12 TO 39
? AT0(WFOR,30);STRING$(49,32):' clear out previous text
NEXT WFOR
? AT2(14,32,11);"Saving Results to a File"
? AT2(16,32,11);"Enter a Filename (from 3 to 25 characters)"
? AT2(17,32,15);">>>"
? AT2(20,32,14);"Legal Characters to use are A to Z"
? AT2(21,32,14);"a to z 0 to 9 and the hyphen -"
? AT2(23,32,15);"Type your desired characters"
? AT2(24,32,15);"in the space after >>> above,"
? AT2(25,32,15);"then press the ENTER Key"
? AT2(27,32,14);"FILENAME.TXT will be saved to the"
? AT2(28,32,14);"folder TEMP on Drive C"
? AT2(30,32,15);"If the TEMP folder does not already"
? AT2(31,32,15);"exist, this program will create it."
? AT2(33,32,14);"Enter FILE or SAVE to go back"
? AT2(34,32,14);"to the Save File Menu"
? AT2(36,32,15);"Enter CANCEL or USER to"
? AT2(37,32,15);"return to User Options"
? AT2(39,32,14);"Enter END or EXIT to end this program"
CASE 2
? AT0(17,32);STRING$(47,32):' clears out previous entry text
? AT2(17,32,15);">>>"
END SELECT
CASE 4
' Printer Menu and Instructions
SELECT CASE GXTRA
CASE 1
FOR WFOR=14 TO 39
? AT0(WFOR,30);STRING$(49,32):' clear out previous text
NEXT WFOR
? AT2(17,32,11);"Print Out Results"
? AT2(20,32,15);"Y - ";AT2(20,36,10);"Print It!"
JXTRA(1)=1:' See below for the JXTRA(1) IF-THEN Block
? AT2(26,32,14);"Pressing Y will invoke the standard WINDOWS"
? AT2(27,32,14);"Printer Menu. Select your desired printer"
? AT2(28,32,14);"as you would normally, and the document"
? AT2(29,32,14);"will be printed."
CASE 2
COLOR 0,15
FOR WFOR=31 TO 36
? AT0(WFOR,32);STRING$(28,32):' Establish White Background Display
NEXT WFOR
? AT0(32,33);"Printing In Progress "
? AT0(34,33);"Press Y for another copy,"
? AT0(35,33);"or make another choice."
COLOR 7,0
CASE 3
COLOR 0,15
? AT0(32,33);"Printing Completed "
COLOR 7,0
END SELECT
END SELECT
IF JXTRA(1)=1 THEN
' This information is common to both GTEXT cases 2 and 4
? AT2(22,32,15);"G -";AT2(22,36,10);"Go Back to User Options"
? AT2(24,32,15);"X -";AT2(24,36,11);"Exit This Program"
? AT2(41,03,14);"NOTE: ";
COLOR 11: ? "Returning to User Options restores ";
COLOR 15: ? "Kube-0-Seven ";
COLOR 11: ? "display"
END IF
END SUB
SUB ShowDaResults (GTEXT AS LONG)
LOCAL WFOR AS LONG, JColor AS LONG, FCount AS LONG, ZCHEK AS LONG
LOCAL NXAA AS LONG, NXBB AS LONG, WFAA AS STRING, WFBB AS STRING
DIM Header(21) AS STATIC STRING, BBODY(35) AS STATIC STRING, KKube(8) AS STRING
' Variable GTEXT controls the action within this SUB
' In Case 1 below, Header and Body info will be compiled, then stored in static strings. This allows for
' such data to be displayed (Case 2), saved to file (Case 3) or printed out (Case 4), when appropriate
' calls are made back to this SUB.
' In more elaborate programs, information may be compiled in one or more other SUBs, then passed on to this
' SUB for final disposition. If such is done, then additional parameters, most or all of which would carry
' the compiled data, would be listed along with GTEXT. Also, appropriate adjustments would be made to each
' of the four cases below.
SELECT CASE GTEXT
CASE 1
' Compiling Header Info - See Case 2 (Display) for handling of Header(2)
' 123456789a123456789b123456789c123456789d123456789e12345678 MID$,1,14 MID$,15,44 - Header(2)
Header(2)=" Kube-0-Seven :: Numbers Cubed (Raised to the power of 3)"
Header(4)=" EXAMPLE: 64 is 4 cubed || 4 x 4 x 4"
Header(6)=" No. Cubed No. Cubed No. Cubed No. Cubed"
Header(7)=" "+STRING$(55,45):' The hyphen - strip below "No. Cubed" line
' Compiling Main Body Info
FOR WFOR=1 TO 30
ZCHEK=WFOR+90
FOR FCount=1 TO 4
WFAA=" ": WFBB="## ###,###"
IF Fcount=1 THEN WFAA=" ": WFBB="## ##,###"
NXAA=CHOOSE(Fcount,0,30,60,90)
KKube(FCount)=WFAA+USING$(WFBB,WFOR+NXAA,(WFOR+NXAA)^3)
IF ZCHEK>99 AND FCount=3 THEN
KKube(4)="":' Need Kube Info only from 1 to 99
EXIT FOR
END IF
NEXT FCount
BBody(WFOR)=KKube(1)+KKube(2)+KKube(3)+KKube(4)
NEXT WFOR
CASE 2
' On-Screen Display of Info
FOR WFOR=2 TO 41
? AT0(WFOR,1);STRING$(79,32):' Clear Out Old Text
NEXT WFOR
' Displaying Header Info
FOR WFOR=1 TO 7
JColor=15
IF WFOR=4 THEN JColor=14
SELECT CASE WFOR
CASE 2
? AT2(WFOR,1,JColor);MID$(Header(2),1,14)
? AT2(WFOR,15,11);MID$(Header(2),15,44)
' MID$ function allows on-screen display of Header(2) info at different points w/different colors
CASE 4,6,7
? AT2(WFOR,1,JColor);Header(WFOR)
END SELECT
NEXT WFOR
' Displaying Main Body Info
FOR WFOR=1 TO 30
SELECT CASE WFOR
CASE 1 TO 10: FCount=0:' for control of line breaks in display of Cube information
CASE 11 TO 20: FCount=1
CASE 21 TO 30: FCount=2
END SELECT
? AT2(7+WFOR+FCount,1,15);BBody(WFOR)
' From Row 8 (7+1+0) to 17 (7+10+0), then 19 (7+11+1) to 28 (7+20+1), then 30 (7+21+2) to 39 (7+30+2)
NEXT WFOR
CASE 3
' Save to File
' File is Named in SUB KnameDaFile
' File is Opened and Closed in SUB DoFileSave
' Saving Header Info
FOR WFOR=1 TO 7
PRINT #1, Header(WFOR)
NEXT WFOR
' Saving Main Body Info
FOR WFOR=1 TO 30
PRINT #1, BBody(WFOR)
SELECT CASE WFOR
CASE 10,20: PRINT #1, "":' controls line breaks (10-11, 40-41, 70-71 | 20-21, 50-51, 80-81)
END SELECT
NEXT WFOR
CASE 4
' Print Out Results
' Choice of Printer, Printing Options and XPRINT Attach/Formfeed/Close all done in SUB DoPrintOut
' Printing Header Info
FOR WFOR=1 TO 7
XPRINT Header(WFOR)
NEXT WFOR
' Printing Main Body Info
FOR WFOR=1 TO 30
XPRINT BBody(WFOR)
SELECT CASE WFOR
CASE 10,20: XPRINT "":' controls line breaks (10-11, 40-41, 70-71 | 20-21, 50-51, 80-81)
END SELECT
NEXT WFOR
END SELECT
END SUB
SUB MicroSoftAlarm
LOCAL JBAR AS LONG, JGZO AS STRING, WFAA AS STRING
LOCAL KFOR AS LONG, JColor AS LONG, MKount AS LONG
' JGZO used twice in this SUB, first as a regular string holding data, then as an INKEY$ string
FOR KFOR=19 TO 37
? AT0(KFOR,30);STRING$(48,32)
NEXT KFOR
SLEEP 0450
? AT2(20,32,15);"WHAT !?"
SLEEP 0280
MKount=0
FOR KFOR=41 TO 57 STEP 2
MKount=Mkount+1
IF MKount>9 THEN EXIT FOR
JGZO="MICROSOFT"
JColor=CHOOSE(MKount,11,14,11,10,07,10,11,14,11)
WFAA=MID$(JGZO,MKount,1)
SLEEP 0280
? AT2(20,KFOR,JColor);WFAA
NEXT KFOR
SLEEP 0280
? AT2(20,59,7);"..?";
SLEEP 0950
COLOR 15: ? " PLEASE !!"
SLEEP 1640
? AT2(23,32,11);"What kind of a ";
COLOR 14: ? CHR$(173);"!";CHR$(155);"$%^& ";
COLOR 11: ? "fool do you think I am?"
SLEEP 1640
? AT2(26,32,11);"Press the ";
COLOR 14: ? "SPACE BAR ";
COLOR 11: ? "and make another choice"
JBAR=1
DO
JGZO=INKEY$
IF JGZO=CHR$(32) THEN JBAR=2
MasterAll=1
LOOP UNTIL (JBAR=2)
END SUB
A simple demonstration of programming in BASIC using the PowerBASIC Console Compiler
|