Category : BASIC Source Code
Archive   : 123QB11.ZIP
Filename : 123DEMO.BAS

DEFINT A-Z

'DEMO123.BAS Demonstration program for the 123-Write Library Routines.

'Note that the current subdirectory is used for the input data file
' and to write the (default) spreadsheet file.

'Be sure to DECLARE LotusCol if you are going to use the function in
' your program!

DECLARE FUNCTION LotusCol% (col$)

DECLARE SUB LotusCellFunction (col1%, row1%, funcNumber%)
DECLARE SUB LotusCellMath (col1%, row1%, col2%, row2%, operation%)
DECLARE SUB LotusClose ()
DECLARE SUB LotusColFunction (fromRow%, toRow%, operation%)
DECLARE SUB LotusConstMath (col1%, row1%, constant#, operation%)
DECLARE SUB LotusDate (dat$)
DECLARE SUB LotusDown (count%)
DECLARE SUB LotusFileAppend (lotusFileName$, returnErrCode%)
DECLARE SUB LotusFileOpen (lotusFileName$)
DECLARE SUB LotusGetLoc (currentColumn%, currentRow%)
DECLARE SUB LotusLeft (count%)
DECLARE SUB LotusLineFeed ()
DECLARE SUB LotusMCellMath (dataArray%())
DECLARE SUB LotusPrintBorders (rulc%, rulr%, rlrc%, rlrr%, culc%, culr%, clrc%, clrr%)
DECLARE SUB LotusPrintMargins (lMargin%, rMargin%, tMargin%, bMargin%, pageLen%)
DECLARE SUB LotusPrintRange (ulc%, ulr%, lrc%, lrr%)
DECLARE SUB LotusPrintSetup (setup$)
DECLARE SUB LotusPrintTitle (pTitle$, heading%)
DECLARE SUB LotusRange (rangeName$, ulc%, ulr%, lrc%, lrr%)
DECLARE SUB LotusRight (count%)
DECLARE SUB LotusSetCellFormat (fmt$)
DECLARE SUB LotusSetCol (column%, colWidth%)
DECLARE SUB LotusSetCols (colArray%())
DECLARE SUB LotusSetDateForm (formatNumber%)
DECLARE SUB LotusSetLoc (newCol%, newRow%)
DECLARE SUB LotusSetProtect (inSwitch%)
DECLARE SUB LotusSetStrFormat (fmt$)
DECLARE SUB LotusSetTimeForm (formatNumber%)
DECLARE SUB LotusSortKey (primary%, ulc%, ulr%, lrc%, lrr%, order%)
DECLARE SUB LotusSortRange (ulc%, ulr%, lrc%, lrr%)
DECLARE SUB LotusTime (inTime$)
DECLARE SUB LotusWriteInt (a%)
DECLARE SUB LotusWriteNum (a#)
DECLARE SUB LotusWriteStr (inData$)

DIM cols(0 TO 4) 'Holds col widths

FOR i = 0 TO 4
READ cols(i)
NEXT

CLS
LINE INPUT "Enter your name: ", user$
PRINT "Is DEMO.WKS an OK filename for the worksheet? (Y/N)"
z$ = ""

DO
z$ = UCASE$(INKEY$)
LOOP UNTIL z$ = "Y" OR z$ = "N"

IF z$ = "N" THEN
INPUT "ENTER filename [d:][path]filename[.ext] ", fileNme$
IF fileNme$ = "" THEN END
ELSE
fileNme$ = "DEMO.WKS"
END IF

CALL LotusFileOpen(fileNme$) 'Open the spreadsheet
CALL LotusSetCols(cols()) 'Write column widths.
CALL LotusSetCellFormat("F2") 'Fixed, 2 decimal places.
CALL LotusWriteStr("Demo worksheet file.") 'Title in A1
CALL LotusRight(2) 'Move right to D. (was in B)
CALL LotusWriteStr("Created by: ") 'Personalize it.
CALL LotusWriteStr(user$) 'Then back up from F to
CALL LotusLeft(2) ' D and drop down a row.
CALL LotusDown(1) 'Now in D2
CALL LotusWriteStr(CHR$(34) + "Date:") 'Date stamp in D2, E2
CALL LotusDate(DATE$)
CALL LotusLeft(2) 'Move left and
CALL LotusDown(1) ' down to D3
CALL LotusWriteStr(CHR$(34) + "Time:") 'and time stamp the
CALL LotusTime(TIME$) ' spreadsheet.
CALL LotusSetLoc(0, 1) 'Move to B1
CALL LotusWriteStr("Account Credit Balances") 'Another title.
CALL LotusSetLoc(0, 3) 'Drop to A4

FOR i = 1 TO 5 'Read 5 column headings
READ a$
CALL LotusWriteStr(a$) 'And write them.
NEXT

CALL LotusLineFeed 'Return (to A5)

FOR i = 1 TO 5
CALL LotusWriteStr("\=") 'Break Line
NEXT

CALL LotusLineFeed 'Set to A6
CALL LotusGetLoc(col, startRow) 'Save starting data row
inFile = FREEFILE 'Example
OPEN "DEMO1.DAT" FOR INPUT AS inFile ' sequential file.

WHILE NOT EOF(inFile)
INPUT #inFile, nme$, addr$, balance#, limit#
CALL LotusWriteStr(nme$)
CALL LotusWriteStr(addr$)
CALL LotusWriteNum(balance#)
CALL LotusWriteNum(limit#)

IF balance# > limit# THEN 'If Over credit limit,
CALL LotusWriteStr("^*OVER*") 'flag it. Otherwise
ELSE 'show available credit
CALL LotusGetLoc(col, row) 'limit. (sub balance
CALL LotusCellMath(col - 1, row, col - 2, row, 2) 'from limit)
END IF

CALL LotusLineFeed
WEND

CALL LotusGetLoc(col, row) 'One row above is last
lastRow = row - 1 'row of data


FOR i = 1 TO 5
CALL LotusWriteStr("\=") 'Break Line
NEXT

CALL LotusLineFeed 'Set to col A
CALL LotusRight(1) 'Move to col B
CALL LotusWriteStr(CHR$(34) + "Total A/R:") 'Right justify
CALL LotusColFunction(startRow, lastRow, 1) '@Sum the column.
CALL LotusLineFeed 'Set to col A
CALL LotusRight(1) 'Move to col B
CALL LotusWriteStr(CHR$(34) + "Avg Bal:") 'Right justify
CALL LotusColFunction(startRow, lastRow, 2) '@Avg the column.
CALL LotusClose 'Finished.

' Everything above this line is the same as in version 1.0
' Below, I want to demonstrate anything not included above,
' and all the routines added with version 1.1, so bear with me!

PRINT
PRINT "The worksheet file ("; fileNme$; ") has been closed at this point."
PRINT "New additions to 123-Write version 1.1 include:"
PRINT
PRINT "LotusFileAppend which allows to add data to an existing worksheet."

PRINT "LotusCol a FUNCTION for those of us who think in lettered,"
PRINT " rather than numbered columns."
PRINT " and"
PRINT "LotusRange which allows you to create named ranges in the worksheet."
PRINT

CALL LotusFileAppend(fileNme$, errCode) 'Open the spreadsheet

IF errCode THEN
PRINT "oops!"; errCode
END
END IF

PRINT "File is re-opened for 'APPEND'"
CALL LotusLineFeed
CALL LotusWriteStr("'This cell and everything below were added in 'append' mode.")
CALL LotusLineFeed
CALL LotusWriteStr("'Hit page down to see some more. Alt-S to Sort, Alt-P to print.")
PRINT "Now the range..."
INPUT " Enter a column letter from A to C: ", column$
column$ = UCASE$(column$)

IF column$ < "A" OR column$ > "C" THEN
PRINT " OK, I'll use B!"
column$ = "B"
END IF

INPUT " And a row from 1 to 16 please: ", rowNumber

IF rowNumber < 1 OR rowNumber > 16 THEN
PRINT " OK, I'll use 4!"
rowNumber = 4
END IF

PRINT "The range will be 2 columns wide, and 2 rows deep in the worksheet."
INPUT "Now, what name should the range have"; rangeName$

IF rangeName$ < "A" THEN
PRINT "OK, I'll use RANGE as the name."
rangeName$ = "RANGE"
END IF

rowNumber = rowNumber - 1 'Adjust for Lotus, 0 based
colNumb = LotusCol(column$) 'Then name the range:
CALL LotusRange(rangeName$, colNumb, rowNumber, colNumb + 2, rowNumber + 2)

'Next we'll define a print range, there's no name needed, just the
'coordinates. We'll make the range run from A6 to E18, the visible
'window in Lotus with the data from our file.

CALL LotusPrintRange(0, 5, LotusCol("E"), 17)

'Next we'll mess up the Print margins, just to show we can do it.
' left bottom
' | right | page
' | | top | length
' | | | | |
CALL LotusPrintMargins(3, 77, 4, 5, 60)

'ASCII 27 88 1 as a setup string will cause nlq printing on my IBM
'compatible printer. If it's not right for yours, change to the sequence
'you want. This is for illustration only.

CALL LotusPrintSetup("\027\088\001")

'add a title, and then a footer (the | indicates to Lotus
'that it is to be centered on the page.):

CALL LotusPrintTitle("|Demo WorkSheet Print Header", -1)
CALL LotusPrintTitle("|Demo WorkSheet Print Footer", 0)

'and finally, we'll add border rows to the top. The first
'four parameters define the border rows, and the last four
'the border columns. There are no columns, so the last 4
'are set to 0.


' Col A Col E
' | Row 1 | Row 5
' | | | |
CALL LotusPrintBorders(0, 0, LotusCol("E"), 4, 0, 0, 0, 0)

'Now we'll move the cell pointer to A21, and have a clean
'window to mess up:

CALL LotusSetLoc(0, 20)

'The following loop will write 12 different functions across
'row 21. For brevity, they'll all do their thing on cell C6.
'NOTE though that some of these variables will cause ERR conditions
' and raising C6 to a power of 5 is a little outlandish!

col = LotusCol("C")
row = 5
' operation type, all 12
FOR i = 1 TO 12 ' |
CALL LotusCellFunction(col, row, i)
NEXT

CALL LotusLineFeed

'This loop will use the index as a 'Constant' and write 5 math
'operations across row 22.
' Value to use in operation
' | operation type, all 5
FOR i = 1 TO 5 ' | |
CALL LotusConstMath(col, row, CDBL(i), i)
NEXT

CALL LotusLineFeed

' I'm going to jump around for a bit, but I will want to come back
' here later, so I'm saving the cell pointer.

CALL LotusGetLoc(holdcol, holdrow)

'Now some wierd multiple cell math in column F. What I want to end up
'with is a indication of what percentage each customer's credit limit
'is in relation to the total of all the credit limits. I know, I'm
'stretching!

col = LotusCol("D")
CALL LotusSetLoc(col, 16) 'Hard coded because I know
' what I'm dealing with.
CALL LotusColFunction(5, 14, 1) '@SUM the credit limit column.

'Now I need a cell to hold a constant of 100.

CALL LotusSetLoc(LotusCol("F"), 0)
CALL LotusWriteInt(100)
CALL LotusLeft(1) 'And I want to start in F6.
CALL LotusDown(5)

REDIM array(1 TO 12) 'To hold the formula steps.

'The sequence of values in the array must be: col, row, operation
'The column is going to be fixed, Column D (variable 'col' at the moment)
'has each credit limit, cell D17 has the value to divide by (Total of
'all the credit limits), and F1 has the '100' we need to multiply by to
'get the percentage.

array(1) = col 'The column to work with.
array(2) = 5 'This row number will change as we loop.
array(3) = 4 'Divide by the next col-row coordinates.
array(4) = col 'The divisor is absolute, D17
array(5) = 16 'This row won't need to change in the loop.
array(6) = 3 'Multiply by the next col-row coordinates.
array(7) = LotusCol("f") 'The multiplier is absolute, F1
array(8) = 0 'So this row won't change in the loop either.
array(9) = 0 'Operation: 0 = End of formula.
'We're in F6 at the start, and we'll
FOR i = 6 TO 15 ' run from F6 thru F15
CALL LotusMCellMath(array()) 'Write the formula
CALL LotusLeft(1) 'Back up 1 (the formula moved us right)
CALL LotusDown(1) 'and drop down 1
array(2) = i 'Next loop, this will be the correct
NEXT ' zero based row number.

ERASE array

'Now that that's over, I'll jump back to row 23 col A...

CALL LotusSetLoc(holdcol, holdrow)

'Now the different formats that can be set in a worksheet. Start
'by writting a row with the format strings (right justified) in them.

CALL LotusSetStrFormat(CHR$(34))
RESTORE FormatCodes

FOR i = 1 TO 3
READ format$

DO
CALL LotusWriteStr(format$)
READ format$
LOOP UNTIL format$ = "THAT'S ALL"

CALL LotusLineFeed
CALL LotusLineFeed
NEXT

CALL LotusSetStrFormat("'")

'Now we'll take a 16 digit number and write it to each cell immediately
'below the corresponding format description.

CALL LotusSetLoc(holdcol, holdrow)
CALL LotusDown(1)
RESTORE FormatCodes

FOR i = 1 TO 3
READ format$

DO
CALL LotusSetCellFormat(format$)
CALL LotusWriteNum(12345.67890123456#)
READ format$
LOOP UNTIL format$ = "THAT'S ALL"

CALL LotusLineFeed
CALL LotusLineFeed
NEXT

'Now to put the regular format back in effect. Would have used
'comma 15 decimal places for the rest of the worksheet otherwise.

CALL LotusSetCellFormat("F2")

'Whoops, the columns from F over are going to be full of
'astericks because of the size of these numbers. I'll take
'a real easy approach to the problem:

FOR i = LotusCol("F") TO LotusCol("Z")
CALL LotusSetCol(i, 25)
NEXT

'Just set all the columns from F to Z to 25 characters wide.
'Next I'll try out all the date formats available with Lotus 2.0+.
'I also want this row to be highlighted, so I'll make these cells
'un-protected.

CALL LotusSetProtect(0)

dat$ = "02-16-1953"

FOR i = 1 TO 5
CALL LotusSetDateForm(i)
CALL LotusDate(dat$)
NEXT

CALL LotusSetProtect(-1)
CALL LotusLineFeed

'Now we'll try the time formats, same idea, but we'll see how
'long this takes to execute. Note that these cells will be
'protected again.

FOR i = 1 TO 4
CALL LotusSetTimeForm(i)
CALL LotusTime(TIME$)
NEXT

'OK, we're almost finished at this point. Let me point out the
'data sort routines, and write two macros:

CALL LotusSortRange(0, 5, LotusCol("E"), 14)

'That's the visible screen at the {home} position.

col = LotusCol("c") 'Set the primary sort key to Col C
CALL LotusSortKey(-1, col, 5, col, 14, -1) 'in ascending order.

'Now a Print macro, and a Sort macro:

col = LotusCol("G")
CALL LotusSetLoc(col, 0)
CALL LotusWriteStr("{HOME}/DSG")
CALL LotusWriteStr("{HOME}/PPAGPQ")
CALL LotusRange("\S", col, 0, col, 0)
CALL LotusRange("\P", col + 1, 0, col + 1, 0)

CALL LotusClose
PRINT
PRINT "Done!"

END

DATA 22,16,9,12,12 : REM column widths
DATA "^Name","^Address","^Balance","^Limit","^Available" : REM column headings

FormatCodes:

DATA "G","F1","F2","F3","F4","F5","F6","F7","F8","F9","F10","F11","F12","F13","F14","F15","THAT'S ALL"
DATA "G","C1","C2","C3","C4","C5","C6","C7","C8","C9","C10","C11","C12","C13","C14","C15","THAT'S ALL"
DATA "G",",1",",2",",3",",4",",5",",6",",7",",8",",9",",10",",11",",12",",13",",14",",15","THAT'S ALL"