home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR502.DOS / SOURCE / SYS / LBLBACK.PRG < prev    next >
Encoding:
Text File  |  1993-02-15  |  5.9 KB  |  204 lines
  1. /***
  2. *
  3. *  Lblback.prg
  4. *
  5. *  Clipper LABEL FORM runtime system
  6. *
  7. *  Copyright (c) 1990-1993, Computer Associates International, Inc.
  8. *  All rights reserved.
  9. *
  10. *  Compile: /m /n /w
  11. *
  12. */
  13.  
  14. #include "lbldef.ch"
  15. #include "error.ch"
  16.  
  17. #define BUFFSIZE        1034          // Size of label file
  18. #define FILEOFFSET      74            // Start of label content descriptions
  19. #define FIELDSIZE       60
  20. #define REMARKOFFSET    2
  21. #define REMARKSIZE      60
  22. #define HEIGHTOFFSET    62
  23. #define HEIGHTSIZE      2
  24. #define WIDTHOFFSET     64
  25. #define WIDTHSIZE       2
  26. #define LMARGINOFFSET   66
  27. #define LMARGINSIZE     2
  28. #define LINESOFFSET     68
  29. #define LINESSIZE       2
  30. #define SPACESOFFSET    70
  31. #define SPACESSIZE      2
  32. #define ACROSSOFFSET    72
  33. #define ACROSSSIZE      2
  34.  
  35. // File error definitions
  36. #define  F_OK              0          // No error
  37. #define  F_EMPTY          -3          // File is empty
  38. #define  F_ERROR          -1          // Some kind of error
  39. #define  F_NOEXIST         2          // File does not exist
  40.  
  41.  
  42. /***
  43. *  __LblLoad( cLblFile ) --> aLabel
  44. *  Load a (.lbl) file into a label array as specified in lbldef.ch
  45. *
  46. */
  47. FUNCTION __LblLoad( cLblFile )
  48.    LOCAL i, j       := 0                  // Counters
  49.    LOCAL cBuff      := SPACE(BUFFSIZE)    // File buffer
  50.    LOCAL nHandle    := 0                  // File handle
  51.    LOCAL nReadCount := 0                  // Bytes read from file
  52.    LOCAL lStatus    := .F.                // Status
  53.    LOCAL nOffset    := FILEOFFSET         // Offset into file
  54.    LOCAL nFileError := F_OK               // File error
  55.    LOCAL cFieldText := ""                 // Text expression container
  56.    LOCAL err                              // error object
  57.  
  58.    LOCAL cDefPath          // contents of SET DEFAULT string
  59.    LOCAL aPaths            // array of paths
  60.    LOCAL nPathIndex := 0   // iteration counter
  61.  
  62.    // Create and initialize default label array
  63.    LOCAL aLabel[ LB_COUNT ]
  64.    aLabel[ LB_REMARK ]  := SPACE(60)      // Label remark
  65.    aLabel[ LB_HEIGHT ]  := 5              // Label height
  66.    aLabel[ LB_WIDTH ]   := 35             // Label width
  67.    aLabel[ LB_LMARGIN ] := 0              // Left margin
  68.    aLabel[ LB_LINES ]   := 1              // Lines between labels
  69.    aLabel[ LB_SPACES ]  := 0              // Spaces between labels
  70.    aLabel[ LB_ACROSS ]  := 1              // Number of labels across
  71.    aLabel[ LB_FIELDS ]  := {}             // Array of label fields
  72.  
  73.    // Open the label file
  74.    nHandle := FOPEN( cLblFile )
  75.  
  76.    IF ( ! EMPTY( nFileError := FERROR() ) ) .AND. !( "\" $ cLblFile .OR. ":" $ cLblFile )
  77.  
  78.       // Search through default path; attempt to open label file
  79.       cDefPath := SET( _SET_DEFAULT )
  80.       cDefPath := STRTRAN( cDefPath, ",", ";" )
  81.       aPaths := ListAsArray( cDefPath, ";" )
  82.  
  83.       FOR nPathIndex := 1 TO LEN( aPaths )
  84.          nHandle := FOPEN( aPaths[ nPathIndex ] + "\" + cLblFile )
  85.          // if no error is reported, we have our label file
  86.          IF EMPTY( nFileError := FERROR() )
  87.             EXIT
  88.  
  89.          ENDIF
  90.  
  91.       NEXT nPathIndex
  92.  
  93.    ENDIF
  94.  
  95.    // File error
  96.    IF nFileError != F_OK
  97.       err := ErrorNew()
  98.       err:severity := ES_ERROR
  99.       err:genCode := EG_OPEN
  100.       err:subSystem := "FRMLBL"
  101.       err:osCode := nFileError
  102.       err:filename := cLblFile
  103.       Eval(ErrorBlock(), err)
  104.    ENDIF
  105.  
  106.    // If we got this far, assume the label file is open and ready to go
  107.    // and so go ahead and read it
  108.    nReadCount := FREAD( nHandle, @cBuff, BUFFSIZE )
  109.  
  110.    // READ ok?
  111.    IF nReadCount == 0
  112.       nFileError := F_EMPTY             // File is empty
  113.    ELSE
  114.       nFileError := FERROR()            // Check for DOS errors
  115.    ENDIF
  116.  
  117.    IF nFileError == 0
  118.  
  119.       // Load label dimension into aLabel
  120.       aLabel[ LB_REMARK ] := SUBSTR(cBuff, REMARKOFFSET, REMARKSIZE)
  121.       aLabel[ LB_HEIGHT ] := BIN2W(SUBSTR(cBuff, HEIGHTOFFSET, HEIGHTSIZE))
  122.       aLabel[ LB_WIDTH  ] := BIN2W(SUBSTR(cBuff, WIDTHOFFSET, WIDTHSIZE))
  123.       aLabel[ LB_LMARGIN] := BIN2W(SUBSTR(cBuff, LMARGINOFFSET, LMARGINSIZE))
  124.       aLabel[ LB_LINES  ] := BIN2W(SUBSTR(cBuff, LINESOFFSET, LINESSIZE))
  125.       aLabel[ LB_SPACES ] := BIN2W(SUBSTR(cBuff, SPACESOFFSET, SPACESSIZE))
  126.       aLabel[ LB_ACROSS ] := BIN2W(SUBSTR(cBuff, ACROSSOFFSET, ACROSSSIZE))
  127.  
  128.       FOR i := 1 TO aLabel[ LB_HEIGHT ]
  129.  
  130.          // Get the text of the expression
  131.          cFieldText := TRIM( SUBSTR( cBuff, nOffset, FIELDSIZE ) )
  132.          nOffset += 60
  133.  
  134.          IF !EMPTY( cFieldText )
  135.  
  136.             AADD( aLabel[ LB_FIELDS ], {} )
  137.  
  138.             // Field expression
  139.             AADD( aLabel[ LB_FIELDS, i ], &( "{ || " + cFieldText + "}" ) )
  140.  
  141.             // Text of field
  142.             AADD( aLabel[ LB_FIELDS, i ], cFieldText )
  143.  
  144.             // Compression option
  145.             AADD( aLabel[ LB_FIELDS, i ], .T. )
  146.  
  147.        ELSE
  148.  
  149.          AADD( aLabel[ LB_FIELDS ], NIL )
  150.  
  151.          ENDIF
  152.  
  153.       NEXT
  154.  
  155.       // Close file
  156.       FCLOSE( nHandle )
  157.       nFileError = FERROR()
  158.  
  159.    ENDIF
  160.    RETURN( aLabel )
  161.  
  162. /***
  163. *
  164. *  ListAsArray( <cList>, <cDelimiter> ) --> aList
  165. *  Convert a delimited string to an array
  166. *
  167. */
  168. STATIC FUNCTION ListAsArray( cList, cDelimiter )
  169.  
  170.    LOCAL nPos
  171.    LOCAL aList := {}                  // Define an empty array
  172.    LOCAL lDelimLast := .F.
  173.   
  174.    IF cDelimiter == NIL
  175.       cDelimiter := ","
  176.    ENDIF
  177.  
  178.    DO WHILE ( LEN(cList) <> 0 )
  179.  
  180.       nPos := AT(cDelimiter, cList)
  181.  
  182.       IF ( nPos == 0 )
  183.          nPos := LEN(cList)
  184.       ENDIF
  185.  
  186.       IF ( SUBSTR( cList, nPos, 1 ) == cDelimiter )
  187.          lDelimLast := .T.
  188.          AADD(aList, SUBSTR(cList, 1, nPos - 1)) // Add a new element
  189.       ELSE
  190.          lDelimLast := .F.
  191.          AADD(aList, SUBSTR(cList, 1, nPos)) // Add a new element
  192.       ENDIF
  193.  
  194.       cList := SUBSTR(cList, nPos + 1)
  195.  
  196.    ENDDO
  197.  
  198.    IF ( lDelimLast )
  199.       AADD(aList, "")
  200.    ENDIF
  201.  
  202.    RETURN aList                       // Return the array
  203.  
  204.