home *** CD-ROM | disk | FTP | other *** search
/ ftp.alaska-software.com / 2014.06.ftp.alaska-software.com.tar / ftp.alaska-software.com / documents / RecordSet.prg < prev    next >
Text File  |  2003-01-16  |  9KB  |  318 lines
  1. /////////////////////////////////////////////////////////////////////////////
  2. //
  3. // RecordSet.prg
  4. //
  5. //  Copyright:
  6. //    Alaska Software, (c) 2003. All rights reserved.         
  7. //
  8. // Contents:
  9. //    The RecordSet class is a Meta class. It creates classes for accessing
  10. //    columns of a 2-dimensional array via symbolic names
  11. //
  12. // Remarks:
  13. //    Procedure Main demonstrates how to take advantage of a Meta class.
  14. //
  15. //    Two dynamic classes are created for displaying the Direcory() array:
  16. //      - the first class manages the Directory() array
  17. //      - the second class manages data required to create a text-mode browser
  18. //
  19. /////////////////////////////////////////////////////////////////////////////
  20.  
  21. #include "Inkey.ch"
  22. #include "class.ch"
  23.  
  24.  
  25. PROCEDURE Main
  26.    LOCAL nKey
  27.    LOCAL aRecords, aColumnNames
  28.    LOCAL oClass  , oRecordSet, oBrowse , oColumn, oColumnData
  29.  
  30.    CLS
  31.  
  32.    /*
  33.     * 1. Create a class for accessing the Directory() array
  34.     */
  35.    aColumnNames := { "FILENAME" , "FILESIZE", "WRITEDATE" , "WRITETIME", ;
  36.                      "ATTRIBUTE", "EXTENDED", "CREATEDATE","CREATETIME", ;
  37.                      "ACCESSDATE", "ACCESSTIME" }
  38.    oClass       := RecordSet():createClass( "Dir", aColumnNames )
  39.    oRecordSet   := oClass:new( Directory() )
  40.  
  41.    /*
  42.     * 2. Create a class holding data for TBrowse/TBColumn creation
  43.     */
  44.    aColumnNames := { "COLUMNNAME", "HEADING", "BLOCK", "WIDTH" }
  45.    oClass       := RecordSet():createClass( "ColumnData", aColumnNames )
  46.    aRecords     := { ;
  47.        { "FILENAME"  , "File Name", {|| oRecordSet:FILENAME   }, 35 }, ;
  48.        { "FILESIZE"  , "File Size", {|| oRecordSet:FILESIZE   }, 10 }, ;
  49.        { "ATTRIBUTE" , "Attrib"   , {|| oRecordSet:ATTRIBUTE  },  6 }, ;
  50.        { "ACCESSDATE", "Last Date", {|| oRecordSet:ACCESSDATE }, 12 }, ;
  51.        { "ACCESSTIME", "Last Time", {|| oRecordSet:ACCESSTIME }, 12 }  ;
  52.    }
  53.    oColumnData  := oClass:new( aRecords )
  54.  
  55.    /*
  56.     * Build the TBrowse using navigational methods of the oRecordSet object
  57.     * that navigates through the Directory() array
  58.     */
  59.    oBrowse               := TBrowse():new( 1,1,25,78 )
  60.    oBrowse:goTopBlock    := {||  oRecordSet:goTop()    }
  61.    oBrowse:goBottomBlock := {||  oRecordSet:goBottom() }
  62.    oBrowse:skipBlock     := {|n| oRecordSet:skipper(n) }
  63.  
  64.    /*
  65.     * Add columns to the browser using data managed by the
  66.     * oColumnData object. The browser displays only 5 of 10 columns
  67.     * of the Directory() array. The numeric position of the displayed
  68.     * column is not relevant, since it is identified by symbolic name
  69.     * stored in oColumnData:block.
  70.     */
  71.    DO WHILE .NOT. oColumnData:eof()
  72.       oColumn       := TBColumn():new( oColumnData:heading, ;
  73.                                        oColumnData:block    )
  74.       oColumn:width := oColumnData:width
  75.       oBrowse:addColumn( oColumn )
  76.       oColumnData:skip()
  77.    ENDDO
  78.  
  79.    /*
  80.     * Display the Directory() array
  81.     */
  82.    nKey := 0
  83.    DO WHILE nKey <> K_ESC
  84.       oBrowse:forceStable()
  85.       nKey    := Inkey(0)
  86.       TBApplyKey( oBrowse, nKey )
  87.  
  88.       /*
  89.        * When Enter is pressed, display data sorted by
  90.        * the current column
  91.        */
  92.       IF Lastkey() == K_ENTER
  93.          /* 
  94.           * oBrowse:colPos is the current browser column
  95.           * Navigate to the equivalent row of the column data array
  96.           */
  97.          oColumnData:goTo( oBrowse:colPos )
  98.  
  99.          /*
  100.           * Sort the Directory() array by column name and refresh browser
  101.           */
  102.          oRecordSet:sort( oColumnData:COLUMNNAME )
  103.          oBrowse:refreshAll()
  104.       ENDIF
  105.    ENDDO
  106. RETURN
  107.  
  108.  
  109. /*
  110.  * Class for accessing 2-dim arrays
  111.  */
  112. CLASS RecordSet
  113.    PROTECTED:
  114.    CLASS VAR columnNames                   // Names of the array columns
  115.  
  116.    VAR bof                                 // Logical flag for BoF
  117.    VAR eof                                 // Logical flag for EoF
  118.    VAR index                               // Array holding sort order
  119.  
  120.    INLINE METHOD resetFlags
  121.       ::bof := .F.
  122.       ::eof := .F.
  123.    RETURN self
  124.  
  125.    EXPORTED:
  126.    CLASS METHOD createClass
  127.  
  128.    METHOD skipper
  129.    METHOD sort
  130.  
  131.    VAR records    READONLY                 // The 2-dim data array
  132.    VAR recno      READONLY                 // Pointer to current row
  133.    VAR lastrec    READONLY                 // Total number of rows
  134.  
  135.  
  136.    INLINE CLASS METHOD initClass( aColumnNames )
  137.       IF Valtype( aColumnNames ) == "A"
  138.          ::columnNames := AClone( aColumnNames )
  139.       ENDIF
  140.    RETURN self
  141.  
  142.  
  143.    INLINE METHOD init( aRecords )
  144.       ::resetFlags()
  145.       ::records    := aRecords
  146.       ::recno      := 1
  147.       ::lastrec    := Len( aRecords )
  148.       ::index      := Array( ::lastrec )
  149.  
  150.       // Initial sort order is the natural/original order
  151.       AEval( ::index, {|n,i| n:=i },,, .T. )
  152.    RETURN self
  153.  
  154.  
  155.    INLINE METHOD getVar( nColumn )
  156.       IF ::lastrec == 0
  157.          RETURN NIL
  158.       ENDIF
  159.    RETURN ::records[ ::index[ ::recno ], nColumn ]
  160.  
  161.  
  162.    INLINE METHOD putVar( nColumn, xValue )
  163.       IF ::lastrec == 0
  164.          RETURN NIL
  165.       ENDIF
  166.    RETURN ::records[ ::index[ ::recno ], nColumn ] := xValue
  167.  
  168.  
  169.    INLINE METHOD bof
  170.    RETURN ::bof
  171.  
  172.  
  173.    INLINE METHOD eof
  174.    RETURN ::eof
  175.  
  176.  
  177.    // Navigate the row pointer for the array.
  178.    // NOTE: There is no "ghost record" as for database files
  179.    INLINE METHOD skip( n )
  180.       IF n == NIL
  181.          n := 1
  182.       ENDIF
  183.  
  184.       ::recno += n
  185.       ::resetFlags()
  186.  
  187.       IF ::recno < 1
  188.          ::bof   := .T.
  189.          ::recno := 1
  190.       ENDIF
  191.  
  192.       IF ::recno > ::lastrec
  193.          ::eof   := .T.
  194.          ::recno := ::lastrec
  195.       ENDIF
  196.    RETURN self
  197.  
  198.  
  199.    INLINE METHOD goTo( nRecno )
  200.       ::skip( nRecno - ::recno )
  201.    RETURN self
  202.  
  203.  
  204.    INLINE METHOD goTop
  205.       ::resetFlags()
  206.       ::recno := 1
  207.    RETURN self
  208.  
  209.  
  210.    INLINE METHOD goBottom
  211.       ::resetFlags()
  212.       ::recno := ::lastRec
  213.    RETURN self
  214. ENDCLASS
  215.  
  216.  
  217. /*
  218.  * Create a new class for accessing a 2-dim array of known columns
  219.  */
  220. CLASS METHOD RecordSet:createClass( cClassname, aColumnNames )
  221.    LOCAL oClass := ClassObject( cClassName )
  222.    LOCAL i, imax:= Len( aColumnNames )
  223.    LOCAL aMethod, cBlock, cName, nType
  224.  
  225.    IF oClass <> NIL
  226.       // Class object exists already
  227.       RETURN oClass
  228.    ENDIF
  229.  
  230.    // Instance variables are in fact EXPORTED ACCESS/ASSIGN methods
  231.    nType := CLASS_EXPORTED + METHOD_INSTANCE + ;
  232.             METHOD_ACCESS  + METHOD_ASSIGN
  233.  
  234.    // Class does not exist yet
  235.    aMethod:= Array( imax )
  236.  
  237.    FOR i:=1 TO imax
  238.       // Name of iVar
  239.       cName  := aColumnNames[i]
  240.  
  241.       // Each iVar is mapped to the generic :getVar()/:putVar() methods. 
  242.       // Both receive the numeric column index i
  243.       cBlock := "{|o,x| IIf(x==NIL,"                        + ;
  244.                          "o:getVar(" + Var2Char(i) + "),"   + ;
  245.                          "o:putVar(" + Var2Char(i) + ",x))}"
  246.       aMethod[i] := { cName, nType, &(cBlock), cName }
  247.    NEXT
  248.  
  249.    // Create the new class object and use RecordSet as super class (=self).
  250.    // This way, the derived new class knows the :getVar()/:putVar()
  251.    // and navigational methods
  252.    oClass := ClassCreate( cClassName, { self }, {}, aMethod )
  253.  
  254.    // Initialize the new class object
  255.    oClass:initClass( aColumnNames )
  256.  
  257. RETURN oClass
  258.  
  259.  
  260. /*
  261.  * Method to be used by a browser for navigating
  262.  * the row pointer of a 2-dim array
  263.  */
  264. METHOD RecordSet:skipper( nWantSkip )
  265.    LOCAL nDidSkip := 0
  266.  
  267.    DO CASE
  268.    CASE ::lastrec == 0 .OR. nWantSkip == 0
  269.       ::skip(0)
  270.  
  271.    CASE nWantSkip > 0
  272.       DO WHILE nDidSkip < nWantSkip
  273.          ::skip(1)
  274.          IF ::eof
  275.             EXIT
  276.          ENDIF
  277.          nDidSkip ++
  278.       ENDDO
  279.  
  280.    CASE nWantSkip < 0
  281.       DO WHILE nDidSkip > nWantSkip
  282.          ::skip(-1)
  283.          IF ::bof
  284.             EXIT
  285.          ENDIF
  286.          nDidSkip --
  287.       ENDDO
  288.  
  289.    ENDCASE
  290. RETURN  nDidSkip
  291.  
  292.  
  293. /*
  294.  * Sort the ::index array, not the data array referenced in ::records
  295.  * The ::index array holds numeric row pointers.
  296.  * Sorting the ::index array leaves the original data array intact!
  297.  */
  298. METHOD RecordSet:sort( nColumn )
  299.    IF nColumn == NIL
  300.       nColumn := 0
  301.    ENDIF
  302.  
  303.    IF Valtype( nColumn ) == "C"
  304.       nColumn := AScan( ::columnNames, {|c| Upper(c) == Upper(nColumn) } )
  305.    ENDIF
  306.  
  307.    IF nColumn == 0
  308.       AEval( ::index, {|n,i| n:=i },,, .T. )
  309.    ELSE
  310.       AASort( ::index, ::records, nColumn )
  311.    ENDIF     
  312. RETURN self
  313.  
  314.  
  315. STATIC PROCEDURE AASort( aIndex, aRecords, nColumn )
  316.    ASort( aIndex, , ,{|n1,n2| aRecords[n1,nColumn] < aRecords[n2,nColumn] } )
  317. RETURN 
  318.