#include "FiveWin.ch"
#include "TSBrowse.ch"
#define CLR_PINK nRGB( 255, 128, 128)
#define CLR_NBLUE nRGB( 128, 128, 192)
#define CLR_1 nRGB( 190, 215, 190 ) // Azul Clarito
#define CLR_2 nRGB( 230, 230, 230 ) // Gris muy Clarito
#define CLR_3 nRGB( 217, 217, 255 ) // Morado Clarito
//----------------------------------------------------------------------------//
// Nueva implementación con la clase TSBrowse de Manuel Mercado.
FUNCTION Browse3( cTitle, cListName, bNew, bModify, bDelete, bSearch, bList, oParWnd, oDbf )
LOCAL oDlg, oLbx, oFont, nOrden
LOCAL btnList, btnEnd, i, aFields:={}
//Guardamos el orden de entrada.
nOrden:= IndexOrd()
DEFAULT cTitle := "Ver fichas ", cListName := "",;
bList := { || Reporte( oLbx ) }
DEFINE FONT oFont NAME "Arial" SIZE 0, -12 //BOLD
DEFINE DIALOG oDlg FROM 3, 3 TO 26, 79 TITLE cTitle FONT oFont
@ 0, 1 SAY cListName OF oDlg
@ 1, 1 BROWSE oLbx SIZE 284, 137 OF oDlg FONT oFont;
ON CHANGE ( IF(oDbf!=NIL,oDbf:Gather(),), IF( oParWnd!=NIL,oParWnd:Update(),) );
ON dblClick ( oDlg:End() )
oLbx:LoadFields( .F. )
oLbx:nLineStyle := LINES_DOTTED
oLbx:nHeightHead += 4
oLbx:lMoveCols := .T.
oLbx:nAdjColumn := 0
aFields:= DbStruct()
FOR i:=1 TO LEN( oLbx:aColumns )
oLbx:aColumns[ i ]:cHeading:= UPPER( oLbx:aColumns[ i ]:cHeading )
oLbx:aColumns[ i ]:l3DLookHead:=.T.
oLbx:SetColSize( i, oLbx:aColumns[ i ]:nWidth + 42 )
IF aFields[i][2] = "N" // Numérico
oLbx:aColumns[ i ]:nAlign:= 2
oLbx:aColumns[ i ]:nHAlign:= 0
ENDIF
//oLbx:Set3DText( , , i , 2 )
NEXT
// Seteo de colores del Browse.
oLbx:SetColor( { 2, 3, 4, 5, 6, 15 },{ { | Pos | If( Pos % 2 = 0, ;
CLR_3, CLR_2 ) }, ;
CLR_WHITE,;
{ CLR_WHITE, CLR_BLUE },;
CLR_WHITE,;
{ CLR_WHITE, CLR_BLACK },;
CLR_BLUE })
//Botones del dialogo
@ 10.4, 33.6 BUTTON btnList PROMPT "&Imprimir" OF oDlg SIZE 40, 12
@ 10.4, 41.7 BUTTON btnEnd PROMPT "&Salir" OF oDlg SIZE 40, 12
btnList:bAction = { || Eval( bList ), oLbx:Refresh() }
btnEnd:bAction = { || oDlg:End() }
// Para ejecutar la función de ordenar por la columna.
oLbx:bRClicked := {|nRowPix, nColPix| CreaIndice( oLbx, oDbf, aFields, oLbx:nATCol(nColPix)) }
ACTIVATE DIALOG oDlg Centered;
ON PAINT FillWnd( oDlg, nRGB( 13, 147, 185 ),, 10 );
ON INIT CampoIndice( oLbx, aFields );
VALID ( DBSETORDER(nOrden), .T. )
// En el ON INIT estamos colocando como primera columna al campo clave del índice activo
RELEASE FONT oFont
return nil
//----------------------------------------------------------------------------//
// Colocación del campo índice activo como primera columna en el browse
//----------------------------------------------------------------------------//
STATIC FUNCTION CreaIndice( oLbx, oDbf, aFields, nCol )
LOCAL aIndices:={}, aIndices2:={}, n, j
//Averiguamos si el campo ya tiene un índice activo, en caso de tenerlo lo activamos
//En caso contrario generamos un índice temporal y lo añadimos a los índices activos.
//Cambiamos la columna a la 1ª posición en el browse.
//Indices en uso del fichero:
FOR j := 1 TO 15
IF !Empty( cExpKey:= IndexKey( j ) )
AADD( aIndices2, ORDBAGNAME(j) )
IF (n := AT("(", cExpKey)) > 0//n > 0 //Quitamos los caracteres STR(
cExpKey:= LEFT(cExpKey, n-4) + RIGHT(cExpKey, LEN(ALLTRIM(cExpKey))-n )
ENDIF
IF (n := AT(")", cExpKey) ) > 0 //n > 0 //Quitamos los caracteres ,n,y)
cExpKey:= LEFT(cExpKey, n-5) + RIGHT(cExpKey, LEN(ALLTRIM(cExpKey))-n )
ENDIF
IF (n := AT("+", cExpKey) ) >0 //n > 0 //Quitamos todo lo que está por detrás del caracter +
cExpKey:=LEFT(cExpKey, n-1)
ENDIF
AADD( aIndices, UPPER(cExpKey) )
ENDIF
NEXT
IF ( n:=ASCAN( aIndices, oLbx:aColumns[ nCol ]:cHeading ) ) > 0
//Ya existe ese índice
//Ponemos el orden como activo.
DBSETORDER(n)
ELSE
//Creamos un índice si no existe.
CreaIndex( oLbx:aColumns[ nCol ]:cHeading, aIndices2 )
SET INDEX TO
FOR j := 1 TO LEN( aIndices2 )
oDbf:AddIndex(aIndices2[j],aIndices2[j])
NEXT
SELECT( oDbf:cAlias )
DBSETORDER( LEN(aIndices2) )
ENDIF
//Cambiamos el campo índice como 1ª columna
oLbx:MoveColumn( nCol, 1 )
oDbf:GoFirst()
oLbx:GoTop()
oLbx:Reset()
RETURN NIL
//----------------------------------------------------------------------------//
// Colocación del campo índice activo como primera columna en el browse
//----------------------------------------------------------------------------//
STATIC FUNCTION CreaIndex( cHeading, aIndices2 )
LOCAL tempind1, passind, pasfor
tempind1 = "CC" + SUBSTR(TIME(),1,2) + SUBSTR(TIME(),4,2) + SUBSTR(TIME(),7,2) + ".ntx"
passind = cHeading //"Recno()"
passfor = "Recno() > 0"
MsgMeter( { | ometer, otext, odlg, lend | genindex( ometer, otext, odlg, @lend, tempind1, passind, passfor ) }, ;
"Ordenando fichero ...", "Ordenando fichero ...." )
AADD( aIndices2, tempind1 )
RETURN NIL
//----------------------------------------------------------------------------//
// Creación del fichero índice temporal.
//----------------------------------------------------------------------------//
STATIC FUNCTION genindex( ometer, otext, odlg, lend, tempind1, passind, passfor )
LOCAL cDbf
cDbf:=ALIAS()
ometer:ntotal := LASTREC()
INDEX ON &passind TO &tempind1 FOR &passfor ;
EVAL ( ometer:SET( RECNO() ), otext:settext("Ordenando ficha " + ALLTRIM(STR(RECNO()))), ;
sysrefresh(), !lend )
RETURN( nil )
//----------------------------------------------------------------------------//
// Colocación del campo índice activo como primera columna en el browse
//----------------------------------------------------------------------------//
STATIC FUNCTION CampoIndice( oLbx, aFields )
LOCAL nOrden, cExpKey
//Posicionamiento de campo índice activo en primer lugar.
nOrden:= IndexOrd()
cExpKey:= IndexKey( nOrden )
IF LEN(ALLTRIM(cExpKey)) > 0
n := AT("(", cExpKey) //Quitamos los caracteres STR(
IF n > 0
cExpKey:= LEFT(cExpKey, n-4) + RIGHT(cExpKey, LEN(ALLTRIM(cExpKey))-n )
ENDIF
n := AT(")", cExpKey) //Quitamos los caracteres ,n,y)
IF n > 0
cExpKey:= LEFT(cExpKey, n-5) + RIGHT(cExpKey, LEN(ALLTRIM(cExpKey))-n )
ENDIF
n := AT("+", cExpKey) //Quitamos todo lo que está por detrás del caracter +
IF n > 0
cExpKey:=LEFT(cExpKey, n-1)
ENDIF
//La movemos a la primera columna
IF (nPos:=ASCAN( aFields, {|x| x[1] = UPPER(cExpKey) } ) ) > 0
oLbx:MoveColumn( nPos, 1 )
ENDIF
ENDIF
RETURN NIL