home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / TBASIC / MC4.INC < prev    next >
Text File  |  1987-04-01  |  9KB  |  281 lines
  1. '┌───────────────────────────────────────────────────────────────────────────┐
  2. '│                               MC.BAS                                   │
  3. '│                             VERSION 1.0                                   │
  4. '│                                                                           │
  5. '│                           MODULE: MC4.INC                                 │
  6. '│                                                                           │
  7. '│                   Turbo Basic                     │
  8. '│        (C) Copyright 1987 by Borland International             │
  9. '│                                                                           │
  10. '│ DESCRIPTION: Load, Save and print a spreadsheet. Display on-line manual   │
  11. '│              and DOS accces.                             │
  12. '│                                                                           │
  13. '└───────────────────────────────────────────────────────────────────────────┘
  14.  
  15. DEF FNExists%(FileName$)
  16. ' The function Exists% returns a non zero integer value
  17. ' If the file specified by FileName$ is on the current disk drive.
  18.  
  19.     LOCAL ExistF%
  20.     ON ERROR GOTO FileError             ' if error occurs then trap it at
  21.                                         ' FileError
  22.     ExistF% = %TRUE                     ' Initial value of FNexists%
  23.     OPEN FileName$ FOR INPUT AS #9      ' Trying to open file
  24.     IF ERR=0 THEN CLOSE #9              ' If no error occurs we need to close
  25.     GOTO Finish                ' file
  26.  
  27.     FileError:
  28.       ExistF% = %FALSE                  ' File doesn't exist
  29.       RESUME NEXT
  30.  
  31.     Finish:
  32.     ON ERROR GOTO 0
  33.     FNExists%=ExistF%
  34.  
  35. END DEF
  36.  
  37. SUB GetFileName(FileName$,FileNameOk%)
  38. ' GetFileName prompts the user for a filename and reads it
  39.  
  40.     FileName$=""
  41.     CALL GetLine(POS(0), CSRLIN, 12, UpperCase%, ErrorPosition%, FileName$)
  42.     IF FileName$="" THEN
  43.        FileNameOk%=%False
  44.     ELSEIF INSTR(FileName$,".")>9 THEN
  45.        FileNameOk%=%False
  46.     ELSEIF  INSTR(FileName$,".")=0 AND LEN(FileName$)>8 THEN
  47.        FileNameOk%=%False
  48.     ELSE
  49.        ON ERROR GOTO ErrOpenFile
  50.        OPEN "R",#9,FileName$,1 : Fsize=LOF(9) : CLOSE 9 : FileNameOk%=%True
  51.        IF Fsize=0 THEN KILL FileName$
  52.     END IF
  53.  
  54.     FinishOpenFile:
  55.     ON ERROR GOTO 0
  56.     EXIT SUB
  57.  
  58.    ErrOpenFile:
  59.        CLOSE 9 : FileNameOk%=%False
  60.        RESUME  FinishOpenFile
  61.  
  62. END SUB
  63.  
  64. SUB save
  65. ' Save the SpreadSheet into file
  66.  
  67.   SHARED SpreadSheet%(),Globfx%,Globfy%,AutoCalc%,Border%
  68.   LOCAL FileName$,Byte$
  69.  
  70.     CALL NormVideo
  71.     DO
  72.        CALL Msg( "Enter the SpreadSheet save name : " )
  73.        CALL GetFileName( FileName$, FileNameOk%)
  74.        IF FileNameOk%<>%True  THEN BEEP
  75.     LOOP UNTIL FileName$="" OR FileNameOk%=%True  OR Filename$=CHR$(255)
  76.     IF FileName$<>CHR$(255) AND FileName$<>"" THEN
  77.        CALL Msg("Saving File "+UCASE$(Filename$)+" ...")
  78.        DEF SEG=VAL("&H"+HEX$(FNUnsign&(varseg(SpreadSheet%(%FxMin ,%FyMin ,1)))))
  79.        BSAVE FileName$,FNUnsign&(varptr(SpreadSheet%(%FxMin ,%FyMin ,1)))_
  80.              ,%SheetSize
  81.        DEF SEG
  82.        OPEN FileName$ FOR BINARY AS #1
  83.        SEEK #1,LOF(1)
  84.        IF AutoCalc%<0 THEN Byte$=CHR$(0) ELSE Byte$=CHR$(1)  ' to prevent
  85.        PUT$ #1,Byte$                                         ' negative value
  86.        IF Border%<0 THEN Byte$=CHR$(0) ELSE Byte$=CHR$(1)    '
  87.        PUT$ #1,Byte$                                         '
  88.        CLOSE #1
  89.     END IF
  90.  
  91.     CALL GotoCell(GlobFx%,GlobFy%)
  92.  
  93. END SUB
  94.  
  95. SUB load
  96. ' load a spreadsheet
  97.  
  98.   SHARED SpreadSheet%(),GlobFx%,GlobFy%,AutoCalc%,Border%,FileName$
  99.   LOCAL Byte$, Ofs%
  100.  
  101.     IF FileName$="" THEN
  102.        CALL NormVideo
  103.        DO
  104.           CALL Msg( "Enter the SpreadSheet Name TO load : " )
  105.           CALL GetFileName( FileName$, FileNameOk%)
  106.           IF FileNameOk%=%True  THEN FileNameOk%=FNexists%(FileName$)
  107.           IF FileNameOk%<>%True  THEN BEEP
  108.        LOOP UNTIL FileName$="" OR FileNameOk%=%True  OR Filename$=CHR$(255)
  109.     END IF
  110.  
  111.     IF FileName$<>CHR$(255) AND FileName$<>"" THEN
  112.       CALL Msg("Loading File "+UCASE$(Filename$)+" ...")
  113.       DEF SEG = VAL("&H"+HEX$(FNUnsign&(varseg(SpreadSheet%(%FxMin ,%FyMin ,1)))))
  114.       BLOAD FileName$,FNUnsign&(varptr(SpreadSheet%(%FxMin ,%FyMin ,1)))
  115.       DEF SEG
  116.       OPEN FileName$ FOR BINARY AS #1
  117.       SEEK #1,LOF(1)-2
  118.       GET$ #1,1,Byte$
  119.       AutoCalc%=ASC(Byte$)
  120.       GET$ #1,1,Byte$
  121.       Border%=ASC(Byte$)
  122.       CLOSE #1
  123.       IF AutoCalc%=0 THEN AutoCalc%=-2         ' to retrieve a boolean value
  124.       IF Border%=0 THEN Border%=-2
  125.       GlobFx% = %FXMin
  126.       GlobFy% = %FYMin
  127.       CALL UpDate
  128.     END IF
  129.  
  130.     CALL GotoCell(GlobFx%,GlobFy% )
  131.  
  132. END SUB
  133.  
  134. SUB PrintSheet
  135. ' print sheet to the printer (or to a file)
  136.  
  137.   SHARED Enter$,SpreadSheet%(),GlobFx%,GlobFy%,Xpos%()
  138.  
  139.   LOCAL I%, J%, FX%, FY%, Contents$, M$
  140.   LOCAL Value#, Dec%, FW%, FileName$
  141.   LOCAL CurrLine$, TabCount%, CellStatus%
  142.  
  143.     DO
  144.        CALL Msg( "Enter filename or "+Enter$+" for Printer : " )
  145.        CALL GetFileName( FileName$, FileNameOk%)
  146.        IF FileNameOk%<>%True  AND FileName$<>"" THEN BEEP
  147.     LOOP UNTIL FileName$="" OR FileNameOk%=%True  OR FileName$=CHR$(255)
  148.     IF FileName$<>CHR$(255) THEN
  149.        IF FileName$=""  THEN
  150.          FileName$ = "LPT1:"
  151.        END IF
  152.        CALL Msg( "Left Margin : " )
  153.        CALL GetLine(POS(0), CSRLIN, 3, UpperCase%, ErrorPosition%, M$)
  154.        LeftMargin%=abs(VAL(M$))
  155.        CALL BlinkVideo
  156.        CALL Msg( "  Printing to " + FileName$ + " ..." )
  157.        CALL NormVideo
  158.        ON ERROR GOTO PRError
  159.        OPEN FileName$ FOR output AS #1
  160.        FOR I% = 1 TO 2
  161.           PRINT# 1,""
  162.        NEXT I%
  163.        FOR J% = %FYMin  TO %FYMax
  164.         CurrLine$ = ""
  165.         FOR I% = %FXMin  TO %FXMax
  166.            CALL GetRec( I%,J%,CellStatus%,Contents$,Value#,Dec%,FW%,CellColor% )
  167.            WHILE LEN(CurrLine$) < XPos%(I%)
  168.              CurrLine$ = CurrLine$ + " "
  169.            WEND
  170.            IF FNIN%( %Constant , CellStatus% ) THEN
  171.                         IF NOT ( FNIN%( %Locked , CellStatus% )) THEN
  172.                CurrLine$ = CurrLine$ + STR$(Value#)
  173.              END IF
  174.            ELSE
  175.              CurrLine$ = CurrLine$ + Contents$
  176.            END IF
  177.         NEXT I%
  178.         PRINT# 1,SPACE$(LeftMargin%)+CurrLine$
  179.        NEXT J%
  180.        CLOSE# 1
  181.     END IF
  182.     CALL Grid
  183.     CALL GotoCell( GlobFX%, GlobFY% )
  184.     ON ERROR GOTO 0
  185.     EXIT SUB
  186.  
  187. PRError:
  188.     I%=%FxMax : J%=%FyMax
  189.     RESUME NEXT
  190.  
  191. END SUB
  192.  
  193. SUB HELP
  194. ' on-line Help
  195.  
  196.   LOCAL L$,J,Bold,Bold$,Revers,Revers$
  197.   SHARED Enter$
  198.  
  199.   Bold$=CHR$(2) : Ch$="" : Revers$=CHR$(9)
  200.   IF FNExists%("NC.HLP") THEN
  201.     OPEN "NC.HLP" FOR INPUT AS #9
  202.     WHILE NOT eof(9) AND UCASE$(Ch$)<>"Q"
  203.       Bold=%False  : Revers=%False
  204.       CALL LowVideo
  205.       CLS
  206.       LINE INPUT#9,L$
  207.       DO
  208.         PRINT "     ";
  209.         FOR J=1 TO LEN(L$)
  210.           IF MID$(L$,J,1)=Bold$ THEN
  211.              Bold=NOT Bold
  212.              IF Bold THEN CALL NormVideo ELSE CALL LowVideo
  213.           ELSEIF MID$(L$,J,1)=Revers$ THEN
  214.              Revers=NOT Revers
  215.              IF Revers THEN COLOR 0,7 ELSE CALL LowVideo
  216.           ELSE
  217.              PRINT MID$(L$,J,1);
  218.           END IF
  219.         NEXT
  220.         PRINT
  221.         LINE INPUT#9,L$
  222.       LOOP UNTIL  eof(9) OR LEFT$(L$,3)=".PA"
  223.       CALL NormVideo : LOCATE 23,12
  224.       PRINT "--- Please Strike ";
  225.       COLOR 9,0 : PRINT "Q"; : CALL NormVideo
  226.       PRINT " To Quit help or any key to continue ---"
  227.       CALL LowVideo
  228.       CALL ReadKBD(Ch$)
  229.     WEND
  230.     CLOSE #9
  231.     IF UCASE$(Ch$)<>"Q" THEN
  232.        CALL NormVideo : LOCATE 23,13 : CALL ClrEol : BEEP
  233.        PRINT "-- Please strike ";
  234.        COLOR 9,0 : PRINT ENTER$; : CALL Normvideo
  235.        PRINT " TO start MicroCalc ---";
  236.        CALL LowVideo
  237.        DO
  238.          CALL ReadKBD(Ch$)
  239.        LOOP UNTIL Ch$=CHR$(13)
  240.     END IF
  241.   ELSE
  242.     PLAY "CDC"
  243.     CALL Msg("   To get help the file NC.HLP must be on your disk. Strike "_
  244.     +ENTER$+" to continue")
  245.     DO
  246.       CALL ReadKBD(Ch$)
  247.     LOOP UNTIL Ch$=CHR$(13)
  248.   END IF
  249.  
  250. END SUB
  251.  
  252. SUB DosShell
  253. ' execute a DOS command
  254.  
  255.     SHARED Enter$
  256.     LOCAL Dos$,Ch$
  257.  
  258.     CALL NormVideo
  259.     CALL Msg( "Enter a DOS command or "+Enter$+" to go to DOS : ")
  260.     CALL Getline(POS(0),CSRLIN,79-POS(0),%False ,0,Dos$)
  261.     IF Dos$<>CHR$(255) THEN
  262.        CLS
  263.        PRINT "MicroCalc Version 1.00A - Dos Shell"
  264.        IF Dos$="" THEN
  265.           PRINT
  266.           COLOR 4,15
  267.           PRINT " Type EXIT and "+Enter$+" to return to MicroCalc "
  268.           COLOR 14,0
  269.        END IF
  270.        Shell Dos$
  271.        IF Dos$<>"" THEN
  272.           LOCATE 24,1
  273.           PRINT
  274.           PRINT "Strike any key to come back to MicroCalc ...";
  275.           CALL ReadKbd(Ch$)
  276.        END IF
  277.     END IF
  278.  
  279. END SUB
  280.  
  281.