home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR19 / TDCO69.ZIP / LISTADO.PRG < prev    next >
Text File  |  1993-09-20  |  7KB  |  209 lines

  1. /*------------------------------------------------------------------------------
  2.  
  3.    ESPAÑOL                                    ENGLISH
  4.  
  5.    Función general para producir              General function that produces
  6.    listados. Llamada desde RecMgr().          lists. Invoked from RecMgr()
  7.    Puedes cambiar SOLO los mensajes           You can change ONLY the messages
  8.    y volverlo a meter en TDCO.LIB             and include it in TDCO.LIB again.
  9.    Como no dispones de todos los              As you have not all code rela_
  10.    fuentes relacionados con este              tioned with this module, if you
  11.    módulo, si cambias algo del código         change any code, it could produ_
  12.    pueden producirse comportamientos          ces a malfunction.
  13.    anómalos.
  14.  
  15.  
  16.    (c) Francisco Morero Peyrona - 1993
  17.    (c) Alfonso Fraguas Bravo    - 1993
  18.  
  19. ------------------------------------------------------------------------------*/
  20.  
  21. #include "tdco.ch"
  22. #include "DbStruct.ch"
  23. #include "Inkey.ch"
  24.  
  25. #define nCOD_USA 1
  26.  
  27. function Listado( aCabecera, cTitulo )
  28.  
  29.    local GetList   := {}, Wnd,;
  30.      aStruct   := DbStruct(),;
  31.      acNomFld  := {},;
  32.      acCheckFld:= {},;
  33.      xDesde    := "",;
  34.      xHasta    := "",;
  35.      nFldSort  := 1,;
  36.      nCheck    := 1,;
  37.      lTotales  := .T.,;
  38.      aInfPrn   := {},;
  39.      nCols       := 0,;         // nº col (ancho) del lst para información
  40.      nOrdNtx   := IndexOrd(),;              // Ntx actualmente activo
  41.      i, xAux
  42.  
  43.  
  44.    FOR i = 1 TO Len( aStruct )                   // Eliminar los memos
  45.        IF aStruct[ i ][ DBS_TYPE ] == "M"
  46.       ADel( aStruct, i )
  47.       ASize( aStruct, Len( aStruct ) - 1 )
  48.        ENDIF
  49.    NEXT
  50.  
  51.    AEval( aStruct, { |aItem| AAdd( acNomFld, PadR( aItem[ DBS_NAME ], 10 ) ) } )
  52.    acCheckFld = AClone( acNomFld )
  53.    AEval( acCheckFld, { |aItem,i| acCheckFld[ i ] := PadL( aItem, 13 ) } )
  54.  
  55.    DEFAULT cTitulo := If( nCOUNTRY == nCOD_USA, "LISTING ", "LISTADO DE " ) + Alias()
  56.  
  57.  //---------- Pantalla ---------------
  58.    @ 1,1,23,48 CREATE WINDOW Wnd;
  59.            TITLE cTitulo;
  60.            COLOR aClr[ CLR_DLGBOX ];
  61.            CONTROL GetList
  62.  
  63.  
  64.    @ 14,30 SAY If( nCOUNTRY == nCOD_USA, "Columns: ", "Columnas:" ) COLOR aClr[ CLR_DLGBOX, 4 ]
  65.  
  66.    @  3, 4 GET nFldSort LISTBOX acNomFld ;
  67.            LABEL If( nCOUNTRY == nCOD_USA, " S&ort by ", " &Ordenar por " ) ;
  68.            SIZE 10,14 ;
  69.        VALID DesdeHasta( @xDesde, @xHasta, nFldSort, aStruct, Wnd );
  70.        COLOR aClr[ CLR_LIST ]
  71.  
  72.    @  3,28 GET nCheck  LISTBOX acCheckFld ;
  73.            LABEL If( nCOUNTRY == nCOD_USA, "F&ields to include" , " &Incluir campos " ) ;
  74.            SIZE 10,17 ;
  75.        VALID CheckFld( nCheck, acCheckFld, aStruct, @nCols, Wnd );
  76.        COLOR aClr[ CLR_LIST ]
  77.  
  78.    @ 15, 4 SAY If( nCOUNTRY == nCOD_USA, "From ", "Desde" ) ;
  79.                        COLOR aClr[ CLR_DLGBOX, 4 ];
  80.        GET xDesde  COLOR aClr[ CLR_GET ]
  81.    @ 17, 4 SAY If( nCOUNTRY == nCOD_USA, "To   ", "Hasta" ) ;
  82.                        COLOR aClr[ CLR_DLGBOX, 4 ];
  83.        GET xHasta  COLOR aClr[ CLR_GET ]
  84.  
  85.    @ 19, 4 GET lTotales CHECK If(nCOUNTRY == nCOD_USA, "Include totals in numeric columns     ",;
  86.                                                        "Incluir totales en columnas numéricas " );
  87.        COLOR aClr[ CLR_CHECK ]
  88.  
  89.    @ 21, 5 BUTTON "    &Ok    "  EXEC BTM_OK
  90.    @ 21,31 BUTTON "  &Cancel  "  EXEC BTM_CANCEL
  91.  
  92.    ACTIVATE WINDOW Wnd KILL
  93.  
  94.    IF LastKey() != K_ESC
  95.       IF !Empty( (aInfPrn := Prn( ;
  96.                   If( nCOUNTRY == nCOD_USA, "Listing", "Listado de " ) + Alias() )) )
  97.  
  98.      Set( _SET_DEVICE, "PRINTER" )
  99.  
  100.      IF aInfPrn[ PRN_DEVICE ] != "PRN"
  101.         Set( _SET_PRINTFILE, aInfPrn[ PRN_NOMFIC ] )
  102.      ENDIF
  103.  
  104.      Set( _SET_MARGIN, aInfPrn[ PRN_MGR_IZQ ] )
  105.  
  106.      xDesde = ValExtremo( xDesde, .t., aStruct[ nFldSort ][ DBS_LEN ] )
  107.      xHasta = ValExtremo( xHasta, .f., aStruct[ nFldSort ][ DBS_LEN ] )
  108.      xDesde = If( ValType( xDesde ) == "C", AllTrim( xDesde ), xDesde )
  109.      xHasta = If( ValType( xHasta ) == "C", AllTrim( xHasta ), xHasta )
  110.  
  111.      ListPrn( aInfPrn, aCabecera, aStruct, nFldSort, acCheckFld,;
  112.           xDesde, xHasta, lTotales )
  113.  
  114.      Set( _SET_DEVICE, "SCREEN" )
  115.      Set( _SET_PRINTFILE, "" )
  116.  
  117.      IF aInfPrn[ PRN_DEVICE ] == "SCR"
  118.         i = MemoRead( aInfPrn[ PRN_NOMFIC ] )
  119.         MemoShow( @i, nCols, 2, 4, nMAXROW-3, Min( nMAXCOL-4, nCols+6 ),;
  120.               "VISUALIZANDO LISTADO" )
  121.      ENDIF
  122.  
  123.     //-------- Dejar las cosas como estaban en este area --------------
  124.       xAux = Select()
  125.       DbClearIndex()
  126.       IF Len( aNtx ) >= xAux
  127.          FOR i = 1 TO Len( aNtx[ xAux ][ 2 ] )
  128.          DbSetIndex( aNtx[ xAux ][ 2 ][ i ] )
  129.          NEXT
  130.          DbSetOrder( nOrdNtx )
  131.       ENDIF
  132.       ENDIF
  133.    ENDIF
  134.  
  135. return NIL
  136.  
  137.  
  138. //----------------------------------------------------------------------------//
  139. // Da valor a las variables xDesde y xHasta
  140.  
  141. static function DesdeHasta( xDesde, xHasta, nFldSort, aStruct, Wnd )
  142.  
  143.    DO CASE
  144.       CASE aStruct[ nFldSort ][ DBS_TYPE ] == "C"
  145.        xDesde = Left( Space( aStruct[ nFldSort ][ DBS_LEN ] ), 35 )
  146.       CASE aStruct[ nFldSort ][ DBS_TYPE ] == "D"
  147.        xDesde = CtoD( Space( 8 ) )
  148.       CASE aStruct[ nFldSort ][ DBS_TYPE ] == "N"
  149.        xDesde = 0
  150.       CASE aStruct[ nFldSort ][ DBS_TYPE ] == "L"
  151.        xDesde = .F.
  152.    ENDCASE
  153.  
  154.    xHasta = xDesde
  155.  
  156.    @ 14,10 SAY Space( 35 ) WINDOW Wnd COLOR aClr[ CLR_DLGBOX, 4 ]
  157.    @ 16,10 SAY Space( 35 ) WINDOW Wnd COLOR aClr[ CLR_DLGBOX, 4 ]
  158.  
  159.    @ 14,10 SAY xDesde       WINDOW Wnd COLOR aClr[ CLR_GET ]
  160.    @ 16,10 SAY xHasta       WINDOW Wnd COLOR aClr[ CLR_GET ]
  161.  
  162. return .T.
  163.  
  164.  
  165. //----------------------------------------------------------------------------//
  166.  
  167. static function ValExtremo( xValor, lMenor, nLen )
  168.  
  169.    IF Empty( xValor )
  170.       DO CASE
  171.      CASE ValType( xValor ) == "C"
  172.           xValor = Replicate( If( lMenor, Chr( 0 ), Chr( 255 ) ), nLen )
  173.      CASE ValType( xValor ) == "N"
  174.           xValor = Val( Replicate( "9", nLen ) ) * If( lMenor, -1, 1 )
  175.      CASE ValType( xValor ) == "D"
  176.           xValor = CtoD( If( lMenor, Space( 8 ), "31/12/2999" ) )
  177.      CASE ValType( xValor ) == "L"
  178.           xValor = !lMenor
  179.       ENDCASE
  180.    ENDIF
  181.  
  182. return xValor
  183.  
  184. //----------------------------------------------------------------------------//
  185. // Pone o Quita la marca ( √ )
  186.  
  187. static function CheckFld( nSelec, acNom, aStruct, nCols, Wnd )
  188.  
  189.    local nAnchoFld
  190.  
  191.    IF LastKey() == K_ENTER
  192.       acNom[ nSelec ] = If( Left( acNom[ nSelec ], 2 ) == " √", "  ", " √" ) +;
  193.             SubStr( acNom[ nSelec ], 3 )
  194.  
  195.       // Se le suma o resta 1 al final porque entre cada columna hay " "
  196.       // Los números llevan separadores de miles (",")
  197.       nAnchoFld = aStruct[ nSelec ][ DBS_LEN ] +;
  198.           If( aStruct[ nSelec ][ DBS_TYPE ] == "N",;
  199.               Int( (aStruct[ nSelec ][ DBS_LEN ]-1) / 3 ), 0 )
  200.  
  201.       nCols += If( Left( acNom[nSelec], 2 ) == " √", nAnchoFld+1, -nAnchoFld-1 )
  202.  
  203.       @ 13,39 SAY nCols  WINDOW Wnd COLOR aClr[ CLR_DLGBOX, 4 ] PICTURE "9999"
  204.    ENDIF
  205.  
  206. return (LastKey() != K_ENTER)
  207.  
  208. //----------------------------------------------------------------------------//
  209.