Bueno, como ya le he comentado a Rick por e mail las modificaciones que ha hecho en el ejemplo autocontenido han funcionado a excepción de que el recordset siempre trae el primer registro sin atender a la fecha inicial que se pide.
A ver si algún gurú puede indicarme como hacer para que pueda tomar las fechas correctamente.
Aqui os pongo el ejemplo y el rd, podeis crearos una tabla de ACCESS con _ que aparecen en la función REPLISVTO, en concreto los de nOption = 2 que se introducen en el arreglo aVtos
Code: Select all
#Include "FiveWin.ch"
#Include "Xbrowse.ch"
*#Include "Adodef.ch"
#Include "Dtpicker.ch"
#Include "Report.ch"
*-------------------------------------------------------------------------------
FUNCTION Main()
*-------------------------------------------------------------------------------
Local oWMain
PUBLIC oConex, cArea
SET DATE TO ITALIAN
SET CENTURY ON
SET 3DLOOK ON
REQUEST HB_LANG_ES
SetDialogEsc(.f.)
HB_LangSelect('ES')
HB_SetCodePage("ESMWIN")
SetBalloon( .T. )
DEFINE WINDOW oWMain MDI FROM 02, 02 TO ( MaxRow() - 2 ), ( MaxCol() - 10 );
TITLE "ADO with Test Dates" ;
COLOR RGB(0,0,51),RGB(255,255,255);
MENU MainMenu()
ACTIVATE WINDOW oWMain MAXIMIZED ;
ON INIT EscogeArea();
VALID MsgYesNo( "Finalizar sesion?","Elija" )
return( nil )
*===============================================================================
Function MainMenu()
MENU oMenu 2007
MENUITEM "Vencimientos" ACTION VENCTOS()
ENDMENU
return( oMenu )
*===============================================================================
function EscogeArea()
*===============================================================================
Local cDir
Local lConecta,nStart
cDir := GetModuleFileName(GetInstance())
nSTART := RAT( "\", cDir )
cArea := SUBSTR(cDir,1,nSTART-1)
SET DEFA to ( cArea )
Set Path to ( cArea )
lConecta := Abretablas()
If !lConecta
oWMain:End()
EndIf
Return nil
*-------------------------------------------------------------------------------
FUNCTION AbreTABLAS()
*-------------------------------------------------------------------------------
// oConex is just the connection STRING
// to be passed to the Recordset :Open()
// See REPLISVTO()
Local lConecta := .T.
Local xPROVIDER := "Microsoft.Jet.OLEDB.4.0"
Local cSource := cArea+"\Datos.mdb"
oConex := 'Provider='+xPROVIDER+';Data Source='+cSOURCE
Return(lConecta)
/*
*===============================================================================
Function ShowError(oError)
MsgInfo( "Descripción : " + oError:Description + CRLF + ;
"Error Nativo : " + Str(oError:NativeError) + CRLF + ;
"Número Error : " + Str(oError:Number) + CRLF + ;
"Origen : " + oError:Source + CRLF + ;
"Estado SQL : " + oError:SQLState )
Return nil
*-------------------------------------------------------------------------------
Function FW_OpenRecordSet( oCn, cSql, nLockType )
*-------------------------------------------------------------------------------
Local oRs,oError
DEFAULT nLockType := 3 // adLockOptimistic
oRs := TOleAuto():new( "ADODB.RecordSet" )
WITH OBJECT oRs
:ActiveConnection := oCn
:Source := cSql
:LockType := nLockType
:CursorLocation := 3 // adUseClient
:CacheSize := 100
END
TRY
oRs:Open()
CATCH
FOR EACH oError IN oConex:Errors
ShowError(oError)
NEXT
oRs := nil
END
return oRs
*/
*-------------------------------------------------------------------------------
Function Venctos()
*-------------------------------------------------------------------------------
Local oDlgVtos
Local dInicio := Ctod("01/02/2012"), dFinal := Date()
Local oRadVto,nOpcion := 1
DEFINE DIALOG oDlgVtos RESOURCE "LISVTOS"
REDEFINE RADIO oRadVto VAR nOpcion ID 4005,4006 OF oDlgVtos UPDATE
REDEFINE DTPicker dInicio ID 4007 PICTURE "@D" OF oDlgVtos UPDATE
REDEFINE DTPicker dFinal ID 4008 PICTURE "@D" OF oDlgVtos UPDATE
REDEFINE BUTTONBMP ID 221 OF oDlgVtos BITMAP "ACEPTAR" TEXTRIGHT ;
ACTION REPLISVTO(nOpcion,dInicio,dFinal)
REDEFINE BUTTONBMP ID 223 OF oDlgVtos BITMAP "SALIR1" TEXTRIGHT CANCEL ACTION oDlgVtos:End()
ACTIVATE DIALOG oDlgVtos CENTER
SysRefresh()
Return nil
*-------------------------------------------------------------------------------
Function REPLISVTO(nOption,dInicio,dFinal)
*-------------------------------------------------------------------------------
Local aVtos := {}
Local oRsLisVto
Local oError
Local cSource
Local dDini
Local dDfin
dDini := dInicio
dDfin := dFinal
If Dtos(dInicio)> Dtos(dFinal)
MsgStop("Parámetros de fechas incorrectos","ATENCION")
Return nil
EndIf
oRsLisVto := TOleAuto():New( "ADODB.Recordset" )
oRsLisVto:CursorType := 1 // opendkeyset
oRsLisVto:CursorLocation := 3 // local cache
oRsLisVto:LockType := 3 // lockoportunistic
cSource := "SELECT * from [Venctos] where [Vencto] "
cSource += "between #"+dtoc(dDini)+"# and #"+dtoc(dDfin)+"# Order by [Vencto]"
TRY
oRsLisVto:Open( cSource,oConex )
CATCH oErr
MsgInfo( "Error in Opening Venctos table" )
RETURN(.f.)
END TRY
If oRsLisVto:eof
MsgInfo( "Sorry .. no Rows Found" )
oRsLisVto:CLose()
Return(nil)
Endif
If nOption == 1
oRsLisVto:MoveFirst()
While !oRsLisVto:Eof()
If oRsLisVto:Fields("Pagado"):Value == .F.
AADD(aVtos,{oRsLisVto:Fields("FECHA"):Value,;
oRsLisVto:Fields("FACTURA"):Value,;
oRsLisVto:Fields("CODIGO"):Value,;
oRsLisVto:Fields("NOMBRE"):Value,;
oRsLisVto:Fields("VENCTO"):Value,;
oRsLisVto:Fields("IMPORTE"):Value })
EndIf
oRsLisVto:MoveNext()
EndDo
Else
oRsLisVto:MoveFirst()
While !oRsLisVto:Eof()
If oRsLisVto:Fields("Pagado"):Value == .T.
AADD(aVtos,{oRsLisVto:Fields("FECHA"):Value,;
oRsLisVto:Fields("FACTURA"):Value,;
oRsLisVto:Fields("CODIGO"):Value,;
oRsLisVto:Fields("NOMBRE"):Value,;
oRsLisVto:Fields("VENCTO"):Value,;
oRsLisVto:Fields("IMPORTE"):Value,;
oRsLisVto:Fields("FPAGO"):Value,;
oRsLisVto:Fields("TIPOPAGO"):Value })
EndIf
oRsLisVto:MoveNext()
EndDo
EndIf
If nOption == 1
REPORTNOPAGADAS(aVtos,dInicio,dFinal)
Else
REPORTPAGADAS(aVtos,dInicio,dFinal)
EndIf
oRsLisVto:Close()
Return nil
*-------------------------------------------------------------------------------
FUNCTION REPORTNOPAGADAS(aVtos,dInicio,dFinal)
*-------------------------------------------------------------------------------
LOCAL oFont1, oFont2, oPen1
Local oReport
Local n := 1
DEFINE FONT oFont1 NAME "TAHOMA" SIZE 0,-10
DEFINE FONT oFont2 NAME "TAHOMA" SIZE 0,-8
DEFINE PEN oPen1 WIDTH 1 COLOR CLR_BLACK
PrinterSetup()
REPORT oReport TITLE "LISTADO DE VENCIMIENTOS DE FACTURAS","",;
"DESDE EL "+DTOC(dInicio)+" "+"HASTA EL "+DTOC(dFinal);
FONT oFont1, oFont2 ;
PEN oPen1 ;
HEADER "Fecha: "+dtoc(date()),"","Página:"+Str(oReport:nPage,3) RIGHT ;
PREVIEW
COLUMN TITLE "FECHA" ;
DATA DTOC(aVtos[n,1]) ;
FONT 2 ;
GRID 1
COLUMN TITLE "FACTURA" ;
DATA aVtos[n,2] ;
FONT 2 ;
GRID 1
COLUMN TITLE "CODIGO" ;
DATA aVtos[n,3];
FONT 2 ;
GRID 1
COLUMN TITLE "NOMBRE" ;
DATA aVtos[n,4] ;
FONT 2 ;
GRID 1
COLUMN TITLE "VENCIMIENTO" ;
DATA DTOC(aVtos[n,5]) ;
FONT 2 ;
GRID 1
COLUMN TITLE "IMPORTE" ;
DATA aVtos[n,6] ;
PICTURE "99,999.99" ;
TOTAL ;
FONT 2 ;
GRID 1
oReport:bSkip := {|| n++}
oReport:nTitleUpLine := RPT_SINGLELINE
oReport:nTitleDnLine := RPT_SINGLELINE
END REPORT
oReport:CellView()
ACTIVATE REPORT oReport WHILE (n <= Len(aVtos) )
oFont1:End()
oFont2:End()
oPen1:End()
Set Default to (cArea)
RETURN NIL
*-------------------------------------------------------------------------------
FUNCTION REPORTPAGADAS(aVtos,dInicio,dFinal)
*-------------------------------------------------------------------------------
LOCAL oFont1, oFont2, oPen1
Local oReport
Local n := 1
DEFINE FONT oFont1 NAME "TAHOMA" SIZE 0,-10
DEFINE FONT oFont2 NAME "TAHOMA" SIZE 0,-8
DEFINE PEN oPen1 WIDTH 1 COLOR CLR_BLACK
PrinterSetup()
REPORT oReport TITLE "LISTADO DE VENCIMIENTOS PAGADOS","",;
"DESDE EL "+DTOC(dInicio)+" "+"HASTA EL "+DTOC(dFinal);
FONT oFont1, oFont2 ;
PEN oPen1 ;
HEADER "Fecha: "+dtoc(date()),"","Página:"+Str(oReport:nPage,3) RIGHT ;
PREVIEW
COLUMN TITLE "FECHA" ;
DATA DTOC(aVtos[n,1]) ;
FONT 2 ;
GRID 1
COLUMN TITLE "FACTURA" ;
DATA aVtos[n,2] ;
FONT 2 ;
GRID 1
COLUMN TITLE "CODIGO" ;
DATA aVtos[n,3];
FONT 2 ;
GRID 1
COLUMN TITLE "NOMBRE" ;
DATA aVtos[n,4] ;
FONT 2 ;
GRID 1
COLUMN TITLE "VENCIMIENTO" ;
DATA DTOC(aVtos[n,5]) ;
FONT 2 ;
GRID 1
COLUMN TITLE "IMPORTE" ;
DATA aVtos[n,6] ;
PICTURE "99,999.99" ;
TOTAL ;
FONT 2 ;
GRID 1
COLUMN TITLE "FECHA PAGO" ;
DATA DTOC(aVtos[n,7]) ;
FONT 2 ;
GRID 1
COLUMN TITLE "TIPO PAGO" ;
DATA aVtos[n,8] ;
FONT 2 ;
GRID 1
oReport:bSkip := {|| n++}
oReport:nTitleUpLine := RPT_SINGLELINE
oReport:nTitleDnLine := RPT_SINGLELINE
END REPORT
oReport:CellView()
ACTIVATE REPORT oReport WHILE (n <= Len(aVtos) )
oFont1:End()
oFont2:End()
oPen1:End()
RETURN NIL
// end
RC
Code: Select all
LISVTOS DIALOG DISCARDABLE 92, 23, 316, 161
STYLE WS_POPUP|DS_MODALFRAME|WS_CAPTION|WS_SYSMENU|WS_VISIBLE
CAPTION "LISTADO DE VENCIMIENTOS DE FACTURAS"
FONT 8, "MS Sans Serif"
{
CONTROL "Desde Vencimiento", 4002, "Static", SS_CENTERIMAGE|WS_GROUP, 28, 36, 72, 12
CONTROL "Hasta Vencimiento", 4003, "Static", SS_CENTERIMAGE|WS_GROUP, 28, 56, 72, 12
CONTROL "FRAS. NO PAGADAS", 4005, "Button", BS_AUTORADIOBUTTON, 204, 36, 95, 10
CONTROL "FACTURAS PAGADAS", 4006, "Button", BS_AUTORADIOBUTTON, 204, 56, 95, 10
CONTROL "", 4007, "SysDateTimePick32", WS_TABSTOP, 104, 36, 60, 14
CONTROL "", 4008, "SysDateTimePick32", WS_TABSTOP, 104, 56, 60, 14
CONTROL "ACEPTAR", 221, "Button", BS_RIGHT|WS_TABSTOP, 60, 124, 55, 16
CONTROL "SALIR", 223, "Button", BS_RIGHT|WS_TABSTOP, 176, 124, 55, 16
}
Los bitmaps de los botones podéis quitarlos