home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / DATABASE / XCLAS20D.ZIP / CLMANTEN.PRG < prev    next >
Encoding:
Text File  |  1993-03-23  |  6.4 KB  |  233 lines
  1. #include "xclass.ch"
  2. #include "inkey.ch"
  3. #include "set.ch"
  4.  
  5. #ifndef DEFAULT
  6.    #command DEFAULT <var> = <valor>  =>;
  7.    <var> := if( <var> == NIL, <valor>, <var> )
  8. #endif
  9.  
  10. //Sintaxis de la clase Manten:
  11. // Creación: Manten( nArriba, nIzquierda, nAbajo, nDerecha, bValorARetornar,
  12. //                   lPermisoAppend, lEditable, lPermisoBorrar )
  13. //
  14. //   obj:InsColumn( nPosición, objetoTBColumn )
  15. //        Inserta una columna
  16. //
  17. //   obj:DelColumn( nPosicion )
  18. //        Borra una columna
  19.  
  20. //   obj:AddKey( numeroTecla, bAcción )
  21. //        Añade una Acción a una tecla
  22.  
  23. //   obj:DelKey( numeroTecla )
  24. //        Elimina la acción de una tecla
  25.  
  26. //   obj:DoGet()
  27. //        Efectúa un READ sobre la casilla del cursor
  28.  
  29.  
  30. CLASS Manten
  31.     VAR Fondo
  32.     VAR oB
  33.     VAR lAppend
  34.     VAR lAppMode
  35.     VAR lEdit
  36.     VAR lDel
  37.     VAR Freeze
  38.     VAR bReturn
  39.     VAR Tecla
  40.     VAR bStable
  41.     VAR aGets
  42.         VAR aKeys
  43.         VAR bInkey
  44.         CONSTRUCTOR New METHOD ManNew( nTop, nLeft, nBottom, nRight, bReturn, lAppend, lEdit, lDel )
  45.     MESSAGE Exec METHOD ManExec
  46.     MESSAGE InsColumn METHOD ManIColumn( nPos, oCol )
  47.     MESSAGE DelColumn BLOCK {| Self, nCol | Self:oB:delcolumn( nCol ), adel( ::aGets, nCol ), ::oB:configure() }
  48.     MESSAGE AddKey BLOCK {| Self, nKey, bAction | aadd( ::aKeys, nKey ), aadd( ::aKeys, bAction ) }
  49.     MESSAGE DelKey METHOD ManDelKey( nKey )
  50.     MESSAGE DoGet METHOD ManDoGet
  51. END CLASS
  52.  
  53. METHOD ManNew( nTop, nLeft, nBottom, nRight, bReturn, lAppend, lEdit, lDel )
  54.     LOCAL n
  55.    DEFAULT lAppend = .f.
  56.    DEFAULT lEdit   = .f.
  57.    DEFAULT lDel    = .f.
  58.    DEFAULT bReturn = {|| recno() }
  59.    ::bInkey := {|| Inkey( 0 ) }
  60.    ::oB := tbrowsedb( nTop, nLeft, nBottom, nRight )
  61.    ::oB:HeadSep   := "═╤═"
  62.    ::oB:colsep    := " │ "
  63.    ::oB:footSep   := "═╧═"
  64.     ::oB:ColorSpec := "W+/GB, W+/B, R+/BG, R+/B, GR+/BG, GR+/B"
  65.    ::lAppend      := lAppend
  66.    ::lEdit        := lEdit
  67.     ::lDel         := lDel
  68.    ::bReturn      := bReturn
  69.    ::freeze       := 0
  70.     ::bStable      := {|| NIL }
  71.     ::lAppMode     := .f.
  72.     ::oB:skipblock := {|x| Skipper( x, Self ) }
  73.     for n := 1 to fcount()
  74.         ::oB:addcolumn( tbcolumnnew( fieldname( n ), fieldblock( fieldname(n) ) ) )
  75.     next
  76.     ::aGets := array( ::oB:ColCount )
  77.     for n := 1 to ::oB:ColCount
  78.         ::aGets[ n ]:= GetNew( 0,0, ::oB:getcolumn( n ):block, ::oB:getcolumn( n ):heading )
  79.     next
  80.    ::aKeys := ;
  81.        { K_DOWN      , {|obj| obj:oB:down() },;
  82.          K_UP        , {|obj| obj:oB:up() },;
  83.          K_PGDN      , {|obj| obj:oB:pageDown() },;
  84.          K_PGUP      , {|obj| obj:oB:pageUp() },;
  85.          K_CTRL_PGUP , {|obj| obj:oB:goTop() },;
  86.          K_CTRL_PGDN , {|obj| obj:oB:goBottom() },;
  87.          K_RIGHT     , {|obj| obj:oB:right() },;
  88.          K_LEFT      , {|obj| obj:oB:left() },;
  89.          K_HOME      , {|obj| obj:oB:home() },;
  90.          K_END       , {|obj| obj:oB:end() },;
  91.          K_CTRL_LEFT , {|obj| obj:oB:panLeft() },;
  92.          K_CTRL_RIGHT, {|obj| obj:oB:panRight() },;
  93.          K_CTRL_HOME , {|obj| obj:oB:panHome() },;
  94.          K_CTRL_END  , {|obj| obj:oB:panEnd() }, ;
  95.             K_ENTER     , {|obj| obj:DoGet() }, ;
  96.             K_DEL       , {|obj| ManDel( obj ) } }
  97. RETURN Self
  98.  
  99. METHOD ManIColumn( nPos, oCol )
  100.     ::oB:InsColumn( nPos, oCol )
  101.     ains( ::aGets, nPos )
  102.     ::aGets[ nPos ] := GetNew( 0, 0, ::oB:getcolumn( nPos ):block, ::oB:getcolumn( nPos ):heading )
  103.     ::oB:Invalidate()
  104. Return Self
  105.  
  106. METHOD ManExec()
  107.     LOCAL OldColor, OldCur, nFound
  108.     ::Fondo  := savescreen( ::oB:nTop, ::oB:nLeft, ::oB:nBottom + 1, ::oB:nRight + 2)
  109.     OldColor := setcolor( ::ob:colorspec )
  110.     OldCur   := setcursor( 0 )
  111.     Sombra( ::oB:nTop + 1, ::oB:nLeft + 2, ::oB:nBottom + 1, ::oB:nRight + 2 )
  112.     @ ::oB:nTop, ::oB:nLeft clear to ::oB:nBottom, ::oB:nRight
  113.     while .t.
  114.         while( ::oB:colpos <= ::oB:freeze )
  115.             ::oB:colpos++
  116.         end
  117.         ::Tecla := 0
  118.                 while ( ::Tecla := Inkey() ) == 0 .and. !::oB:stabilize()
  119.         end
  120.         if ::oB:stable
  121.             if ::oB:hitbottom .and. ::lAppend .and. .not. ::lAppMode
  122.                 ::lAppMode := .t.
  123.                 ::Tecla := K_DOWN
  124.             else
  125.                 eval( ::bStable, Self )
  126.                                 ::Tecla := eval( ::bInkey )
  127.             endif
  128.         endif
  129.         if ::Tecla == K_ESC
  130.             exit
  131.         endif
  132.        if( nFound := ASCAN( ::aKeys, ::Tecla ) ) != 0
  133.           EVAL( ::aKeys[ ++nFound ], Self )
  134.        endif
  135.         do case
  136.         case ::Tecla == K_UP .or. ::Tecla == K_PGUP
  137.             if ::lAppMode
  138.                 ::lAppMode := .f.
  139.                 ::oB:refreshall()
  140.             endif
  141.         case ::Tecla == K_CTRL_PGDN .or. ::Tecla == K_CTRL_PGUP
  142.             ::lAppMode := .f.
  143.         endcase
  144.     end
  145.     setcolor( OldColor )
  146.     restscreen( ::oB:nTop, ::oB:nLeft, ::oB:nBottom + 1, ::oB:nRight + 2, ::Fondo)
  147.     setcursor( OldCur )
  148. RETURN eval( ::bReturn, ::oB )
  149.  
  150. STATIC FUNCTION Skipper( n, o )
  151.     LOCAL i := 0
  152.     if n == 0 .or. lastrec() == 0
  153.         dbskip( 0 )
  154.     elseif n > 0 .and. recno() != lastrec() + 1
  155.         do while i < n
  156.             dbskip( 1 )
  157.             if ( eof() )
  158.                 if ( o:lAppMode .and. o:lAppend )
  159.                     i++
  160.                 else
  161.                     dbskip( -1 )
  162.                 endif
  163.  
  164.                 exit
  165.             endif
  166.             i++
  167.         enddo
  168.     elseif n < 0
  169.         do while i > n
  170.             dbskip( -1 )
  171.             if ( bof() )
  172.                 exit
  173.             endif
  174.             i--
  175.         enddo
  176.     endif
  177.     return i
  178.  
  179. METHOD ManDoGet()
  180.     LOCAL Get, OldCursor := setcursor( 1 )
  181.     if  ::lEdit .or. ( ::lAppend .and. ::lAppMode ) 
  182.         while !::oB:stabilize()
  183.         end
  184.         if ::lAppMode .and. recno() == Lastrec() + 1
  185.             dbappend()
  186.         endif
  187.         Get := ::aGets[ ::oB:colpos ]
  188.         get:row := row()
  189.         get:col := col()
  190.         readmodal( {get} )
  191.         setcursor( OldCursor )
  192.         if lastkey() != 27 .and. upper( Get:name ) $ upper( indexkey() )
  193.             ::oB:refreshall()
  194.         else
  195.             ::oB:refreshcurrent()
  196.         endif
  197.     endif
  198.     if lastkey() != 27
  199.         keyboard( chr( K_RIGHT ) )
  200.     endif
  201. Return NIL
  202.  
  203. METHOD ManDelKey( nKey )
  204.     LOCAL n, bRes
  205.     if( n := ascan( ::aKeys, nKey ) ) != 0
  206.         adel( ::aKeys, n )
  207.         bRes := ::aKeys[ n ]
  208.         adel( ::aKeys, n )
  209.     else
  210.         bRes := NIL
  211.     endif
  212. RETURN bRes
  213.  
  214. STATIC PROCEDURE ManDel( oMan )
  215.     if oMan:lDel
  216.         dbdelete()
  217.         dbskip()
  218.         if eof()
  219.             dbskip( -1 )
  220.         endif
  221.         oMan:oB:refreshall()
  222.     endif
  223. RETURN
  224.  
  225. #define PARAMS  nTop, nLeft, nBottom, nRight
  226.  
  227. FUNCTION Sombra( PARAMS )
  228.    LOCAL cFondo := savescreen( PARAMS )
  229.    restscreen( PARAMS, transform( cFondo, replicate( "X" + chr( 7 ), ;
  230.                len( cFondo ) / 2 ) ) )
  231. RETURN cFondo
  232.  
  233.