Category : Files from Magazines
Archive   : VOL7N21.ZIP
Filename : WRITE123.BAS

'********** WRITE123.BAS
'Copyright (c) 1988, Ziff Communications Co.
'PC Magazine * Ethan Winer * Martin Valley
'Writes data to a file readable by Lotus 123

DEFINT A-Z
DECLARE SUB WriteColWidth (Column, ColWidth)
DECLARE SUB WriteNumber (Row, Column, ColWidth, Fmt$, Number#)
DECLARE SUB WriteInteger (Row, Column, ColWidth, Integ)
DECLARE SUB WriteLabel (Row, Column, ColWidth, Msg$)

DIM SHARED ColNum(40) 'the maximum number of columns to be written
DIM SHARED FileNum 'the file number to use

FileNum = FREEFILE 'get the next available file number
OPEN "READWRIT.WKS" FOR BINARY AS #FileNum

Temp = 0 'OpCode for Start of File
PUT FileNum, , Temp
Temp = 2 'the data length is 2 (for the following integer)
PUT FileNum, , Temp
Temp = 1028 'the Lotus version number
PUT FileNum, , Temp 'Note: Lotus version 1 = 1028; version 2 = 1030

Row = 0 'row numbers in Lotus begin with 0
DO
WriteLabel Row, 0, 16, "This is a Label" 'a label
WriteLabel Row, 1, 12, "So's This" 'another label
WriteInteger Row, 2, 7, 12345 'an integer
WriteNumber Row, 3, 9, "C2", 57.23# 'a number: $57.23
WriteNumber Row, 4, 9, "F5", 12.3456789# 'another number
WriteInteger Row, 6, 9, 99 'it's okay to skip a column
Row = Row + 1 'go on to the next row
LOOP WHILE Row < 6

'Write the "End of File" record and close the file
Temp = 1 'OpCode for End of File
PUT FileNum, , Temp
Temp = 0 'its Data length is zero
PUT FileNum, , Temp

CLOSE

SUB WriteColWidth (Column, ColWidth)

IF ColNum(Column) = 0 THEN 'if width record not already written
IF ColWidth = 0 THEN ColWidth = 9 'default to 9 if no value
Temp = 8
PUT FileNum, , Temp
Temp = 3
PUT FileNum, , Temp
PUT FileNum, , Column
Temp$ = CHR$(ColWidth)
PUT FileNum, , Temp$
ColNum(Column) = 1 'show we did this one for later
END IF

END SUB

SUB WriteInteger (Row, Column, ColWidth, Integ)

Temp = 13 'OpCode for an integer
PUT FileNum, , Temp
Temp = 7 'Length + 5 byte header
PUT FileNum, , Temp
Temp$ = CHR$(127) 'the format portion of the header
PUT FileNum, , Temp$ '(use CHR$(255) for a protected field)
PUT FileNum, , Column
PUT FileNum, , Row
PUT FileNum, , Intg

CALL WriteColWidth(Column, ColWidth)

END SUB

SUB WriteLabel (Row, Column, ColWidth, Msg$)

IF LEN(Msg$) > 240 THEN Msg$ = LEFT$(Msg$, 240)

Temp = 15 'OpCode for a label
PUT FileNum, , Temp
Temp = LEN(Msg$) + 7 'Length + 5-byte header + "'" + CHR$(0) byte
PUT FileNum, , Temp
Temp$ = CHR$(127) '127 is default format for unprotected cell
PUT FileNum, , Temp$
PUT FileNum, , Column
PUT FileNum, , Row
Temp$ = "'" + Msg$ + CHR$(0) 'NOTE: "'" means label will be left aligned

PUT FileNum, , Temp$
CALL WriteColWidth(Column, ColWidth)

END SUB

SUB WriteNumber (Row, Column, ColWidth, Fmt$, Number#)

IF LEFT$(Fmt$, 1) = "F" THEN 'fixed ...
Format$ = CHR$(0 + VAL(RIGHT$(Fmt$, 1))) 'number of decimal places
ELSEIF LEFT$(Fmt$, 1) = "C" THEN 'currency ...
Format$ = CHR$(32 + VAL(RIGHT$(Fmt$, 1))) 'number of decimal places
ELSEIF LEFT$(Fmt$, 1) = "P" THEN 'percent ...
Format$ = CHR$(48 + VAL(RIGHT$(Fmt$, 1))) 'number of decimal places
ELSE
Format$ = CHR$(127) 'use default format
'Format$ = CHR$(255) 'optional to protect cell
END IF

Temp = 14
PUT FileNum, , Temp
Temp = 13
PUT FileNum, , Temp
PUT FileNum, , Format$
PUT FileNum, , Column
PUT FileNum, , Row
PUT FileNum, , Number#

CALL WriteColWidth(Column, ColWidth)

END SUB