home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / pcmag / vol7n21.arc / WRITE123.BAS < prev    next >
BASIC Source File  |  1988-09-28  |  4KB  |  120 lines
  1. '********** WRITE123.BAS
  2. 'Copyright (c) 1988, Ziff Communications Co.
  3. 'PC Magazine * Ethan Winer * Martin Valley 
  4. 'Writes data to a file readable by Lotus 123
  5.  
  6. DEFINT A-Z
  7. DECLARE SUB WriteColWidth (Column, ColWidth)
  8. DECLARE SUB WriteNumber (Row, Column, ColWidth, Fmt$, Number#)
  9. DECLARE SUB WriteInteger (Row, Column, ColWidth, Integ)
  10. DECLARE SUB WriteLabel (Row, Column, ColWidth, Msg$)
  11.  
  12. DIM SHARED ColNum(40)   'the maximum number of columns to be written
  13. DIM SHARED FileNum      'the file number to use
  14.  
  15. FileNum = FREEFILE      'get the next available file number
  16. OPEN "READWRIT.WKS" FOR BINARY AS #FileNum
  17.  
  18. Temp = 0                'OpCode for Start of File
  19. PUT FileNum, , Temp
  20. Temp = 2                'the data length is 2 (for the following integer)
  21. PUT FileNum, , Temp
  22. Temp = 1028             'the Lotus version number
  23. PUT FileNum, , Temp     'Note: Lotus version 1 = 1028; version 2 = 1030
  24.  
  25. Row = 0                 'row numbers in Lotus begin with 0
  26. DO
  27.    WriteLabel Row, 0, 16, "This is a Label"     'a label
  28.    WriteLabel Row, 1, 12, "So's This"           'another label
  29.    WriteInteger Row, 2, 7, 12345                'an integer
  30.    WriteNumber Row, 3, 9, "C2", 57.23#          'a number:  $57.23
  31.    WriteNumber Row, 4, 9, "F5", 12.3456789#     'another number
  32.    WriteInteger Row, 6, 9, 99                   'it's okay to skip a column
  33.    Row = Row + 1                                'go on to the next row
  34. LOOP WHILE Row < 6
  35.  
  36. 'Write the "End of File" record and close the file
  37. Temp = 1                'OpCode for End of File
  38. PUT FileNum, , Temp
  39. Temp = 0                'its Data length is zero
  40. PUT FileNum, , Temp
  41.  
  42. CLOSE
  43.  
  44. SUB WriteColWidth (Column, ColWidth)
  45.  
  46.     IF ColNum(Column) = 0 THEN           'if width record not already written
  47.        IF ColWidth = 0 THEN ColWidth = 9 'default to 9 if no value
  48.        Temp = 8
  49.        PUT FileNum, , Temp
  50.        Temp = 3
  51.        PUT FileNum, , Temp
  52.        PUT FileNum, , Column
  53.        Temp$ = CHR$(ColWidth)
  54.        PUT FileNum, , Temp$
  55.        ColNum(Column) = 1                'show we did this one for later
  56.     END IF
  57.  
  58. END SUB
  59.  
  60. SUB WriteInteger (Row, Column, ColWidth, Integ)
  61.  
  62.     Temp = 13                   'OpCode for an integer
  63.     PUT FileNum, , Temp
  64.     Temp = 7                    'Length + 5 byte header
  65.     PUT FileNum, , Temp
  66.     Temp$ = CHR$(127)           'the format portion of the header
  67.     PUT FileNum, , Temp$        '(use CHR$(255) for a protected field)
  68.     PUT FileNum, , Column
  69.     PUT FileNum, , Row
  70.     PUT FileNum, , Intg
  71.  
  72.     CALL WriteColWidth(Column, ColWidth)
  73.  
  74. END SUB
  75.  
  76. SUB WriteLabel (Row, Column, ColWidth, Msg$)
  77.  
  78.     IF LEN(Msg$) > 240 THEN Msg$ = LEFT$(Msg$, 240)
  79.  
  80.     Temp = 15                   'OpCode for a label
  81.     PUT FileNum, , Temp
  82.     Temp = LEN(Msg$) + 7        'Length + 5-byte header + "'" + CHR$(0) byte
  83.     PUT FileNum, , Temp
  84.     Temp$ = CHR$(127)           '127 is default format for unprotected cell
  85.     PUT FileNum, , Temp$
  86.     PUT FileNum, , Column
  87.     PUT FileNum, , Row
  88.     Temp$ = "'" + Msg$ + CHR$(0) 'NOTE:  "'" means label will be left aligned
  89.  
  90.     PUT FileNum, , Temp$
  91.     CALL WriteColWidth(Column, ColWidth)
  92.  
  93. END SUB
  94.  
  95. SUB WriteNumber (Row, Column, ColWidth, Fmt$, Number#)
  96.  
  97.     IF LEFT$(Fmt$, 1) = "F" THEN                    'fixed ...
  98.        Format$ = CHR$(0 + VAL(RIGHT$(Fmt$, 1)))     'number of decimal places
  99.     ELSEIF LEFT$(Fmt$, 1) = "C" THEN                'currency ...
  100.        Format$ = CHR$(32 + VAL(RIGHT$(Fmt$, 1)))    'number of decimal places
  101.     ELSEIF LEFT$(Fmt$, 1) = "P" THEN                'percent ...
  102.        Format$ = CHR$(48 + VAL(RIGHT$(Fmt$, 1)))    'number of decimal places
  103.     ELSE
  104.        Format$ = CHR$(127)                          'use default format
  105.       'Format$ = CHR$(255)                          'optional to protect cell
  106.     END IF
  107.  
  108.     Temp = 14
  109.     PUT FileNum, , Temp
  110.     Temp = 13
  111.     PUT FileNum, , Temp
  112.     PUT FileNum, , Format$
  113.     PUT FileNum, , Column
  114.     PUT FileNum, , Row
  115.     PUT FileNum, , Number#
  116.  
  117.     CALL WriteColWidth(Column, ColWidth)
  118.  
  119. END SUB
  120.