2003-06-09 14:34

     $APPTYPE CONSOLE
     $TYPECHECK ON

     $RESOURCE qxls_dat AS "qxls.dat"
     $INCLUDE "RapidQ.inc"
     $INCLUDE "Qxls.inc"

     CONST flen=11  'FIELD WIDTH.  CHANGE IT AS YOU LIKE.

     DECLARE SUB Field(c$ AS STRING)
     DIM t$ AS STRING
     DIM ret AS LONG, sh AS LONG, ir AS LONG, ic AS LONG
     DIM maxcol AS LONG, prtrow AS LONG, prtcol AS LONG, maxrow AS LONG

     PRINT "This demo shows use of QXLS functions in a console or GUI application."
     PRINT "This demo does not check if you are overwriting/replacing a file."
     PRINT "Therefore, use a *different* file name to save files as you test it."
     PRINT
     b=0: xIntegrity = 0 'xIntegrity = 1 TO FORCE READ OF EVERY BIFF8 RECORD ON OPEN

NextFile:
     INPUT "xls file specification (Enter to quit) = "; FileSpec(b)
     IF FileSpec(b) = "" THEN GOTO ProgEnd

     PRINT "Parsing "+FileSpec(b)+", please wait..."
     ret = xlsOpen
     PRINT "BIFF8 data length = "+STR$(p(b,0,1))
     PRINT "No. of Sheets = "+STR$(ret)+" "+sERR
'PrintSheetNames: PrintSSTRecords 'REMOVE COMMENT TO SEE INTERNAL DATA
     IF ret<1 THEN GOTO NextFile

WriteValue:
     INPUT "WRITE sheet (1 to "+STR$(nSR(b))+", 0 to quit)= ";sh
     IF sh=0 THEN GOTO GetValue
WriteValue1:
     INPUT "WRITE row ("+STR$(xlsMINROW(sh)+1)+" to "+STR$(xlsMAXROW(sh)+1)+", 0 to quit)= ";ir
     IF ir=0 THEN GOTO WriteValue
WriteValue2:
     INPUT "WRITE column (1 to 256, 0 to quit)= ";ic
     IF ic=0 THEN GOTO WriteValue1
     INPUT "new value (anything including null) = ";t$
     ret=xlsWRITE(sh,ir-1,ic-1,t$)
'PRINT "WRITE = "+STR$(ret)+" bytes written.
     IF sERR <> "" THEN PRINT "Write Error: "+sERR
     GOTO WriteValue2

GetValue:
     INPUT "READ sheet (1 to "+STR$(xlsNUMBERSHEETS(b))+", 0 to quit)= ";sh
     IF sh < 1 THEN GOTO xlsDone
     IF sh > nSR(b) THEN PRINT "No Sheet "+STR$(sh): GOTO GetValue

GetColInput:
     INPUT "READ column ("+STR$(xlsMINCOL(sh)+1)+" to "+STR$(xlsMAXCOL(sh)+1)+", 0 to quit)= ";prtcol
     IF prtcol < 1 THEN GOTO GetValue
     prtcol=prtcol-1
     IF prtcol < xlsMINCOL(sh) OR prtcol > xlsMAXCOL(sh) THEN
      PRINT "No Column "+STR$(prtcol+1): GOTO GetColInput
     END IF

GetRowInput:
     INPUT "READ row ("+STR$(xlsMINROW(sh)+1)+" to "+STR$(xlsMAXROW(sh)+1)+", 0 to quit)= ";prtrow
     IF prtrow < 1 THEN GOTO GetColInput
     prtrow=prtrow-1
     IF prtrow < xlsMINROW(sh) OR prtrow > xlsMAXROW(sh) THEN
      PRINT "No Row "+STR$(prtrow+1): GOTO GetRowInput
     END IF
     maxrow = prtrow + 19
     IF maxrow > xlsMAXROW(sh) THEN maxrow = xlsMAXROW(sh)
     maxcol=xlsMAXCOL(sh)
     IF maxcol-prtcol > 5 THEN maxcol=prtcol+5
     Field(xlsSHEETNAME(sh))
     FOR ic = prtcol TO maxcol
      Field(CHR$(65+ic)): NEXT ic: PRINT
      FOR ir = prtrow TO maxrow    'USE NEXT LINE INSTEAD TO DISPLAY ALL ROWS
'For ir = xlsMINROW(sh) to xlsMAXROW(sh)
       t$="Row "+STR$(ir+1):Field(t$)
       FOR ic = prtcol TO maxcol
        t$=xlsREAD(sh,ir,ic)
'IF t$="" THEN t$=sERR      'REMOVE COMMENT TO SEE sERR STRINGS
't$=RIGHT$(HEX$(xFormat),4) 'REMOVE COMMENT TO SEE xFormat VALUES
        Field(t$): NEXT ic
        PRINT: NEXT ir
        GOTO GetRowInput

xlsDone:
        INPUT "Save file name (without extension; null = no)? ";t$
        IF t$<>"" THEN
         ret=xlsSAVE(t$+".xls")
         IF ret < 1 THEN PRINT sERR ELSE PRINT t$+".xls size = "+STR$(ret)
        END IF

        ret = xlsClose
        IF ret=b THEN GOTO NextFile
        PRINT "Error closing file"
ProgEnd:
        END

        SUB Field(c$ AS STRING)
         PRINT LEFT$(c$,flen);
         IF LEN(c$)<flen THEN PRINT SPACE$(flen-LEN(c$));
        END SUB

2003-06-09 14:34