home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR19
/
TDCO69.ZIP
/
LISTADO.PRG
< prev
next >
Wrap
Text File
|
1993-09-20
|
7KB
|
209 lines
/*------------------------------------------------------------------------------
ESPAÑOL ENGLISH
Función general para producir General function that produces
listados. Llamada desde RecMgr(). lists. Invoked from RecMgr()
Puedes cambiar SOLO los mensajes You can change ONLY the messages
y volverlo a meter en TDCO.LIB and include it in TDCO.LIB again.
Como no dispones de todos los As you have not all code rela_
fuentes relacionados con este tioned with this module, if you
módulo, si cambias algo del código change any code, it could produ_
pueden producirse comportamientos ces a malfunction.
anómalos.
(c) Francisco Morero Peyrona - 1993
(c) Alfonso Fraguas Bravo - 1993
------------------------------------------------------------------------------*/
#include "tdco.ch"
#include "DbStruct.ch"
#include "Inkey.ch"
#define nCOD_USA 1
function Listado( aCabecera, cTitulo )
local GetList := {}, Wnd,;
aStruct := DbStruct(),;
acNomFld := {},;
acCheckFld:= {},;
xDesde := "",;
xHasta := "",;
nFldSort := 1,;
nCheck := 1,;
lTotales := .T.,;
aInfPrn := {},;
nCols := 0,; // nº col (ancho) del lst para información
nOrdNtx := IndexOrd(),; // Ntx actualmente activo
i, xAux
FOR i = 1 TO Len( aStruct ) // Eliminar los memos
IF aStruct[ i ][ DBS_TYPE ] == "M"
ADel( aStruct, i )
ASize( aStruct, Len( aStruct ) - 1 )
ENDIF
NEXT
AEval( aStruct, { |aItem| AAdd( acNomFld, PadR( aItem[ DBS_NAME ], 10 ) ) } )
acCheckFld = AClone( acNomFld )
AEval( acCheckFld, { |aItem,i| acCheckFld[ i ] := PadL( aItem, 13 ) } )
DEFAULT cTitulo := If( nCOUNTRY == nCOD_USA, "LISTING ", "LISTADO DE " ) + Alias()
//---------- Pantalla ---------------
@ 1,1,23,48 CREATE WINDOW Wnd;
TITLE cTitulo;
COLOR aClr[ CLR_DLGBOX ];
CONTROL GetList
@ 14,30 SAY If( nCOUNTRY == nCOD_USA, "Columns: ", "Columnas:" ) COLOR aClr[ CLR_DLGBOX, 4 ]
@ 3, 4 GET nFldSort LISTBOX acNomFld ;
LABEL If( nCOUNTRY == nCOD_USA, " S&ort by ", " &Ordenar por " ) ;
SIZE 10,14 ;
VALID DesdeHasta( @xDesde, @xHasta, nFldSort, aStruct, Wnd );
COLOR aClr[ CLR_LIST ]
@ 3,28 GET nCheck LISTBOX acCheckFld ;
LABEL If( nCOUNTRY == nCOD_USA, "F&ields to include" , " &Incluir campos " ) ;
SIZE 10,17 ;
VALID CheckFld( nCheck, acCheckFld, aStruct, @nCols, Wnd );
COLOR aClr[ CLR_LIST ]
@ 15, 4 SAY If( nCOUNTRY == nCOD_USA, "From ", "Desde" ) ;
COLOR aClr[ CLR_DLGBOX, 4 ];
GET xDesde COLOR aClr[ CLR_GET ]
@ 17, 4 SAY If( nCOUNTRY == nCOD_USA, "To ", "Hasta" ) ;
COLOR aClr[ CLR_DLGBOX, 4 ];
GET xHasta COLOR aClr[ CLR_GET ]
@ 19, 4 GET lTotales CHECK If(nCOUNTRY == nCOD_USA, "Include totals in numeric columns ",;
"Incluir totales en columnas numéricas " );
COLOR aClr[ CLR_CHECK ]
@ 21, 5 BUTTON " &Ok " EXEC BTM_OK
@ 21,31 BUTTON " &Cancel " EXEC BTM_CANCEL
ACTIVATE WINDOW Wnd KILL
IF LastKey() != K_ESC
IF !Empty( (aInfPrn := Prn( ;
If( nCOUNTRY == nCOD_USA, "Listing", "Listado de " ) + Alias() )) )
Set( _SET_DEVICE, "PRINTER" )
IF aInfPrn[ PRN_DEVICE ] != "PRN"
Set( _SET_PRINTFILE, aInfPrn[ PRN_NOMFIC ] )
ENDIF
Set( _SET_MARGIN, aInfPrn[ PRN_MGR_IZQ ] )
xDesde = ValExtremo( xDesde, .t., aStruct[ nFldSort ][ DBS_LEN ] )
xHasta = ValExtremo( xHasta, .f., aStruct[ nFldSort ][ DBS_LEN ] )
xDesde = If( ValType( xDesde ) == "C", AllTrim( xDesde ), xDesde )
xHasta = If( ValType( xHasta ) == "C", AllTrim( xHasta ), xHasta )
ListPrn( aInfPrn, aCabecera, aStruct, nFldSort, acCheckFld,;
xDesde, xHasta, lTotales )
Set( _SET_DEVICE, "SCREEN" )
Set( _SET_PRINTFILE, "" )
IF aInfPrn[ PRN_DEVICE ] == "SCR"
i = MemoRead( aInfPrn[ PRN_NOMFIC ] )
MemoShow( @i, nCols, 2, 4, nMAXROW-3, Min( nMAXCOL-4, nCols+6 ),;
"VISUALIZANDO LISTADO" )
ENDIF
//-------- Dejar las cosas como estaban en este area --------------
xAux = Select()
DbClearIndex()
IF Len( aNtx ) >= xAux
FOR i = 1 TO Len( aNtx[ xAux ][ 2 ] )
DbSetIndex( aNtx[ xAux ][ 2 ][ i ] )
NEXT
DbSetOrder( nOrdNtx )
ENDIF
ENDIF
ENDIF
return NIL
//----------------------------------------------------------------------------//
// Da valor a las variables xDesde y xHasta
static function DesdeHasta( xDesde, xHasta, nFldSort, aStruct, Wnd )
DO CASE
CASE aStruct[ nFldSort ][ DBS_TYPE ] == "C"
xDesde = Left( Space( aStruct[ nFldSort ][ DBS_LEN ] ), 35 )
CASE aStruct[ nFldSort ][ DBS_TYPE ] == "D"
xDesde = CtoD( Space( 8 ) )
CASE aStruct[ nFldSort ][ DBS_TYPE ] == "N"
xDesde = 0
CASE aStruct[ nFldSort ][ DBS_TYPE ] == "L"
xDesde = .F.
ENDCASE
xHasta = xDesde
@ 14,10 SAY Space( 35 ) WINDOW Wnd COLOR aClr[ CLR_DLGBOX, 4 ]
@ 16,10 SAY Space( 35 ) WINDOW Wnd COLOR aClr[ CLR_DLGBOX, 4 ]
@ 14,10 SAY xDesde WINDOW Wnd COLOR aClr[ CLR_GET ]
@ 16,10 SAY xHasta WINDOW Wnd COLOR aClr[ CLR_GET ]
return .T.
//----------------------------------------------------------------------------//
static function ValExtremo( xValor, lMenor, nLen )
IF Empty( xValor )
DO CASE
CASE ValType( xValor ) == "C"
xValor = Replicate( If( lMenor, Chr( 0 ), Chr( 255 ) ), nLen )
CASE ValType( xValor ) == "N"
xValor = Val( Replicate( "9", nLen ) ) * If( lMenor, -1, 1 )
CASE ValType( xValor ) == "D"
xValor = CtoD( If( lMenor, Space( 8 ), "31/12/2999" ) )
CASE ValType( xValor ) == "L"
xValor = !lMenor
ENDCASE
ENDIF
return xValor
//----------------------------------------------------------------------------//
// Pone o Quita la marca ( √ )
static function CheckFld( nSelec, acNom, aStruct, nCols, Wnd )
local nAnchoFld
IF LastKey() == K_ENTER
acNom[ nSelec ] = If( Left( acNom[ nSelec ], 2 ) == " √", " ", " √" ) +;
SubStr( acNom[ nSelec ], 3 )
// Se le suma o resta 1 al final porque entre cada columna hay " "
// Los números llevan separadores de miles (",")
nAnchoFld = aStruct[ nSelec ][ DBS_LEN ] +;
If( aStruct[ nSelec ][ DBS_TYPE ] == "N",;
Int( (aStruct[ nSelec ][ DBS_LEN ]-1) / 3 ), 0 )
nCols += If( Left( acNom[nSelec], 2 ) == " √", nAnchoFld+1, -nAnchoFld-1 )
@ 13,39 SAY nCols WINDOW Wnd COLOR aClr[ CLR_DLGBOX, 4 ] PICTURE "9999"
ENDIF
return (LastKey() != K_ENTER)
//----------------------------------------------------------------------------//