home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR19 / OBJPROB.ZIP / TBARRAY.PRG < prev    next >
Text File  |  1993-09-24  |  4KB  |  137 lines
  1. /*
  2. ╔═══════════════════════════════════════════════════════════════╗
  3. ║ Módulo: TBArray.prg                                           ║
  4. ║ Lenguaje: Clipper 5.xx + ObjectsP                             ║
  5. ║ Fecha: Agosto  1993                                           ║
  6. ║ Compilar: Clipper TBArray  /a /n /w                           ║
  7. ║ Desc.:Demo de herencia de la Clase TBrowse                    ║
  8. ║                                                               ║
  9. ║ (c) 1993 Francisco Pulpón y Antonio Linares                   ║
  10. ╚═══════════════════════════════════════════════════════════════╝
  11.  
  12.  RECUERDA: TBrowse() devuelve lo mismo que TBrowseNew(). Un objeto
  13.            TBrowse sin skipBlock. Si deseas un Objeto TBrowse como
  14.            el que devuelve TbrowseDB() debes llamar a...
  15.  
  16.               SetTBrowDB( oBrowse )
  17.  
  18.            después de llamar a TBrowse().
  19.  
  20.            EJ.:
  21.                   local oBrow := TBrowse( 10, 10, 30, 70 )
  22.                    ó
  23.                   local oBrow := TBrowse():New( 10, 10, 30, 70 )
  24.  
  25.                   SetTBrowDb( oBrow )
  26.  
  27. */
  28.  
  29. #include "ObjectsP.ch"
  30. #include "inkey.ch"
  31.  
  32.  
  33. /*******************************
  34. */
  35. CREATE CLASS TBArray FROM  TBrowse
  36.  
  37.   PROTECT INSTVAR  nIndex, nLen  AS  Numeric
  38.  
  39.   METHOD New, lKeyEval, SetStable, AddColumn, DeftBlocks
  40.  
  41.  
  42. ENDCLASS
  43.  
  44.  
  45. METHOD TBArray::New( nTop, nLeft, nBottom, nRight )
  46.  
  47.  
  48.    ::Parent:New( nTop, nLeft, nBottom, nRight )
  49.  
  50.    ::nIndex        = 1
  51.    ::nLen          = 0
  52.    ::DeftBlocks()
  53.  
  54. Return Self
  55.  
  56.  
  57. METHOD DeftBlocks  CLASS TBArray
  58.  
  59.   ::GoTopBlock    = { || ::nIndex := 1 }
  60.   ::GoBottomBlock = { || ::nIndex := ::nLen }
  61.   ::SkipBlock     = { | nReq, nMoved | ;
  62.                       nMoved := Min( Max( nReq, 1 - ::nIndex ),;
  63.                            ::nLen - ::nIndex ), ::nIndex += nMoved, nMoved }
  64. Return nil
  65.  
  66.  
  67. METHOD AddColumn( cHeader, aColumn ) CLASS TBArray
  68.    
  69.    if valtype( aColumn ) == "A"
  70.    
  71.       ::Parent:AddColumn( TbColumnNew( cHeader, ;
  72.           { || if( len( aColumn ) < ::nIndex, "", aColumn[ ::nIndex ] ) } ) )
  73.    
  74.       ::nLen = max( len( aColumn ), ::nLen )
  75.  
  76.    elseif valtype( aColumn ) == "B"  // Y el user deberá fijar nLen antes
  77.                                      // de llamar a TBArray():exec()
  78.       ::Parent:AddColumn( TbColumnNew( cHeader, aColumn ) )
  79.    
  80.    endif
  81.  
  82. Return nil
  83.  
  84.  
  85.  
  86. METHOD TBArray::lKeyEval( nKey )
  87.  static aKeys := ;
  88.        { K_DOWN      , "down"      ,;
  89.          K_UP        , "up"        ,;
  90.          K_PGDN      , "pageDown"  ,;
  91.          K_PGUP      , "pageUp"    ,;
  92.          K_CTRL_PGUP , "goTop"     ,;
  93.          K_CTRL_PGDN , "goBottom"  ,;
  94.          K_RIGHT     , "right"     ,;
  95.          K_LEFT      , "left"      ,;
  96.          K_HOME      , "home"      ,;
  97.          K_END       , "end"       ,;
  98.          K_CTRL_LEFT , "panLeft"   ,;
  99.          K_CTRL_RIGHT, "panRight"  ,;
  100.          K_CTRL_HOME , "panHome"   ,;
  101.          K_CTRL_END  , "panEnd"     ;
  102.        }
  103.  
  104.  local  nFound
  105.  
  106.    nFound = aScan( aKeys, nKey )
  107.  
  108.    if nFound > 0
  109.  
  110.       if valtype( aKeys[ ++nFound ] ) == "C"
  111.          aKeys[ nFound ] = Command( aKeys[ nFound ] )
  112.       endif
  113.  
  114.       ::send( aKeys[ nFound ] )
  115.  
  116.       ::SetStable()
  117.  
  118.       if ::stable .and. ( ::hitTop .OR. ::hitBottom )
  119.           tone( 58, 0.2 )
  120.       endif
  121.  
  122.    endif
  123.  
  124. Return ( nFound > 0 )
  125.  
  126.  
  127. METHOD SetStable CLASS TBArray
  128.  
  129.   DispBegin()
  130.  
  131.      While !::stabilize()
  132.      end
  133.  
  134.   DispEnd()
  135.  
  136. Return nil
  137.