Hola Kok:
Aqui tienes la clase TCRW, modifique algun pequeño detalle, pero es 100% funcional, yo tengo aplicaciones desde hace muchos años funcionando con esta clase perfectamente.
// ===========================================================================
// TCRW.PRG (C) Tom Groeger 1998
// ===========================================================================
//
// 16 & 32 Bit Wrapper Classes for Crystal Reports gives you access to
// Crystal Reports 32Bit Dll. The class constructor automatically checks if
// 32Bit Dll's are available, and falls back to 16Bit if not.
// Thanks to Matthew Cullen/Adsystems for his help !
//
// downloaded from
http://www.fivedb.com//
// Modifico la Clase para visualizar los botones que quiero, y quitar los
// botones de la ventana, para emular MODAL. ( J.LLoris )
// ===========================================================================
#define FW_LEAN_AND_MEAN
#include "fivewin.CH"
#include "struct.CH"
#define TRUE 1
#define FALSE 0
# DEFINE HORZRES 8
# DEFINE VERTRES 10
// ==========================================================================
// CLASS TCRW // Crystal Reports 16/32Bit Wrapper
// ==========================================================================
CREATE CLASS TJCrw32
VAR hDll AS NUM
VAR l32 AS BOOL
VAR nJobHandle
VAR lError
VAR cReport
VAR oJobInfo
VAR oTabLocation
VAR oWinOptions
MESSAGE New METHOD NEW_ CONSTRUCTOR
MESSAGE FreeLibrary METHOD FREECRPE_
MESSAGE GetModuleHandle METHOD GETMOD_
MESSAGE PEOpenEngine METHOD PEOPEN_
MESSAGE PEErrorText METHOD ERRORT_
MESSAGE PEGetErrorCode METHOD ERRORN_
MESSAGE PEGetHandleString METHOD GETSTR_
MESSAGE PEOpenPrintJob METHOD OPENJOB_
MESSAGE PEOutputToWindow METHOD OUTPUTW_
MESSAGE PEPrintWindow METHOD PRINTWND_
MESSAGE PEOutToPrinter METHOD OUTPUTP_
MESSAGE PEStartPrintJob METHOD STARTPR_
MESSAGE PEGetWindowHandle METHOD GETHWND_
MESSAGE PEGetJobStatus METHOD GETJOBS_
MESSAGE PESetSelFormula METHOD SETSELE_
MESSAGE PEGetSelFormula METHOD GETSELE_
MESSAGE PECheckSelFormula METHOD CHECKSEL_
MESSAGE PESetFormula METHOD SETFORM_
MESSAGE PECheckFormula METHOD CHECKFOR_
MESSAGE PEGetNTables METHOD GETNTAB_ // Devuelve n§ de tablas usuadas
MESSAGE PEGetTabLocation METHOD GETTLOC_
MESSAGE PESetTabLocation METHOD SETTLOC_
MESSAGE PEGetSqlQuery METHOD GETSQLQ_
MESSAGE PESetSqlQuery METHOD SETSQLQ_
MESSAGE PETestNTable METHOD TESTTAB_
MESSAGE PEIsPrintFinished METHOD ISPRTRDY_ //
MESSAGE PEClosePrintJob METHOD CLOSEJOB_
MESSAGE PECloseEngine METHOD PECLOSE_
MESSAGE PeSetWindowOptions METHOD PESETWIN_
MESSAGE PEGetNSortFields METHOD PEGETSOR_
//MESSAGE PEGetNGroups METHOD PEGETNGR_
END CLASS
// ===========================================================================
// METHOD TCrw::New()
//
// Purpose:
// 16/32Bit Crystal Reports Class Constructor
//
// ===========================================================================
METHOD NEW_( nDirCrPe )
LOCAL cTemp
::hDll := 0
::nJobHandle := 0
::lError := .F.
// Check if we load 16 or 32 Bits. First try to load CRPE32
//
IF IsWin95() .OR. IsWinNT()
::hDll := LoadLib32( nDirCrPe + "CRPE32.DLL" )
::l32 := .T.
ENDIF
// If CRPE32.DLL did not load, try CRPE.DLL
//
IF ABS( ::hDll ) <= 32
::hDll := LoadLibrary( nDirCrPe + "CRPE.DLL" )
::l32 := .F.
ENDIF
IF ABS( ::hDll ) <= 32
::lError := .T.
IF ::hDll == 2
cTemp := "find"
ELSE
cTemp := "load"
ENDIF
MsgAlert( "Could not " + cTemp + " CRPE or CRPE32.DLL")
ELSE
::PEOpenEngine()
// Crea JobInfo Class
//
STRUCT ::oJobInfo
MEMBER structSize AS WORD LEN 2
MEMBER NumRecords AS DWORD LEN 4
MEMBER NumSelect AS DWORD LEN 4
MEMBER NumPrinted AS DWORD LEN 4
MEMBER DispPageN AS WORD LEN 2
MEMBER LatestPage AS WORD LEN 2
MEMBER StartPageN AS WORD LEN 2
MEMBER PrintEnded AS BOOL LEN 2
ENDSTRUCT
::oJobInfo:SetMember( 1, 22 )
STRUCT ::oTabLocation
MEMBER structSize AS WORD LEN 2
MEMBER location AS STRING LEN 256
ENDSTRUCT
::oTabLocation:SetMember(1, 258 )
// Crea oWinOptions Class
STRUCT ::oWinOptions
MEMBER structSize AS WORD LEN 2
MEMBER hasGroupTree AS BOOL LEN 2
MEMBER CanDrillDown AS BOOL LEN 2
MEMBER hasNavigationControls AS BOOL LEN 2
MEMBER hasCancelButton AS BOOL LEN 2
MEMBER hasPrintButton AS BOOL LEN 2
MEMBER hasExportButton AS BOOL LEN 2
MEMBER hasZoomControl AS BOOL LEN 2
MEMBER hasCloseButton AS BOOL LEN 2
MEMBER hasProgressControls AS BOOL LEN 2
MEMBER hasSearchButton AS BOOL LEN 2
MEMBER hasPrintSetupButton AS BOOL LEN 2
MEMBER hasRefreshButton AS BOOL LEN 2
ENDSTRUCT
::oWinOptions:SetMember(1, 26 )
ENDIF
RETURN Self
// ==========================================================================
// Method TCrw::FreeLibrary()
//
// ========================================================================== */
METHOD FREECRPE_()
IF ABS( ::hDll ) > 32
IF ::l32
FreeLib32( ::hDll )
ELSE
FreeLibrary( ::hDll )
ENDIF
ENDIF
::hDll := 0
RETURN .T.
// ==========================================================================
// METHOD TCrw::PEOpenEngine() -> lError
//
// Prepares the Report Engine for requests. This method is a necessary
// part of any custom-print link. It is also required for any print-only
// link in which you want the report to print to a window that is to remain
// visible after the report is printed.
// It is not necessary to use this method with a print-only link where
// you are directing the report to a printer
// ========================================================================== */
METHOD PEOPEN_()
LOCAL cFarProc
LOCAL cFunc := "PEOpenEngine"
IF ::l32
cFarProc := GetProc32( ::hDLL, cFunc, .T., LONG )
::lError := ( CallDll32( cFarProc ) == FALSE )
ELSE
cFarProc := GetProcAddress( ::hDLL, cFunc, .T., _INT )
::lError := ( CallDll( cFarProc ) == FALSE )
ENDIF
IF ::lError
MsgAlert( "Could not open the Print Engine!" + CRLF + ::PeErrorText())
ENDIF
RETURN ! ::lError
// ==========================================================================
// Method TCrw::PEErrorText()
//
// Purpose:
// Returns a string describing the status of the most recent Report
// Engine method called. These method can be used in a custom-print
// link to display the error string to the user as part of an error message.
// ========================================================================== */
METHOD ERRORT_()
LOCAL cFarProc
LOCAL cBuffer
LOCAL cError
LOCAL hError := 0
LOCAL nLen := 0
LOCAL nRet
LOCAL cFunc := "PEGetErrorText"
// Get ErrorCode
//
cError := "Error Code " + ALLTRIM( STR( ::PEGetErrorCode())) + ":" + CRLF
// Get StringHandle of ErrorText
//
IF ::l32
cFarProc := GetProc32( ::hDLL, cFunc, .T., _INT, LONG, PTR, PTR )
nRet := CallDll32( cFarProc , ::nJobHandle, @hError, @nLen )
ELSE
cFarProc := GetProcAddress( ::hDll, cFunc, .T., _INT, WORD, PTR, PTR )
nRet := CallDll( cFarProc , ::nJobHandle, @hError, @nLen )
ENDIF
// Now get the String
//
IF nRet == TRUE
cError += ::PEGetHandleString( hError, nLen )
ENDIF
return cError
// ==========================================================================
// Method TCrw::PEGetErrorCode() ->
nCode//
// Returns a number that indicates the status of the most recent Report
// Engine method called. When a call to another method fails, this call
// gets the error code that was generated so you can take some action based
// on that error code. If no Error occured, the method returns 0
// ========================================================================== */
METHOD ERRORN_()
LOCAL cFarProc
LOCAL
nCode := 0
LOCAL cFunc := "PEGetErrorCode"
IF ::l32
cFarProc := GetProc32( ::hDLL, cFunc, .T., _INT, LONG )
nCode := CallDll32( cFarProc, ::nJobHandle )
ELSE
cFarProc := GetProcAddress( ::hDLL, cFunc, .T., _INT, _INT )
nCode := CallDll( cFarProc, ::nJobHandle )
ENDIF
RETURN
nCode// ==========================================================================
// Method TCrw::PEOpenPrintJob() -> lError
//
// Prepares to print a report and sets a number which identifies the
// particular print job, called a print job handle. This Handle is
// used in all subsequent calls related to the new print job
// (where a print job handle is required). This method is used as a
//
// reportFilePath Specifies the file name and path of the report
// you want to open
//
// ========================================================================== */
METHOD OPENJOB_( cReportName )
LOCAL cFarProc
LOCAL cFunc := "PEOpenPrintJob"
::cReport := cReportName
IF ::l32
cFarProc := GetProc32( ::hDll, cFunc,.T., _INT, LPSTR )
::nJobHandle := CallDll32( cFarProc, ::cReport )
ELSE
cFarProc := GetProcAddress( ::hDll, cFunc, .T., _INT, LPSTR )
::nJobHandle := CallDll( cFarProc, ::cReport )
ENDIF
::lError := .F.
IF ::nJobHandle == 0
MsgAlert( "Could not open Print Job!" + CRLF + '[' + ::cReport + ']' )
::lError := .T.
ENDIF
RETURN ! ::lError
// ==========================================================================
// Method TCrw::PEPrintWindow() -> lError
//
// Imprime el informe visualizado en el Preview.
//
// Prints the report displayed in the print window. This method can be
// used in a custom-print link to enable the user to preview the report
// in the print window, and then, if everything looks satisfactory, to
// print the report to the printer (in response to a user event).
//
// ========================================================================== */
METHOD PRINTWND_( lWait )
LOCAL cFarProc
LOCAL cFunc := "PEPrintWindow"
LOCAL nRet
DEFAULT lWait := .T.
::lError := .F.
IF ::l32
cFarProc := GetProc32( ::hDll, cFunc, .T., _INT, LONG, LONG )
nRet := CallDll32( cFarProc, ::nJobHandle, IIF(lWait,1,0))
ELSE
cFarProc := GetProcAddress( ::hDll, cFunc, .T., _INT, _INT, BOOL )
nRet := CallDll( cFarProc, ::nJobHandle, lWait )
ENDIF
IF nRet == FALSE
::lError := .T.
ENDIF
RETURN ! ::lError
// ==========================================================================
// Method TCrw::PEIsPrintFinished() -> lYesNo // PEIsPrintJobFinished
//
// Monitors the print job to see if it is finished or still in progress.
// You can use this method any time you have a call that is contingent
// on a print job being finished.
//
// ========================================================================== */
METHOD ISPRTRDY_()
LOCAL nRet
LOCAL cFarProc
LOCAL cFunc := "PEIsPrintJobFinished"
IF ::l32
cFarProc := GetProc32( ::hDll, cFunc, .T., _INT, LONG )
nRet := CallDll32( cFarProc, ::nJobHandle )
ELSE
cFarProc := GetProcAddress( ::hDll, cFunc, .T., _INT, _INT )
nRet := CallDll( cFarProc, ::nJobHandle )
ENDIF
RETURN ( nRet == TRUE )
// ==========================================================================
// Method TCrw::PEGetSelFormula() // PEGetSelectionFormula
//
// Returns the string for the selection formula used in the specified report.
// This method is typically used as one of a series of methods
// (PEGetSelectionFormula, PEGetHandleString, PESetSelectionFormula).
// The series can be used in a custom-print link to identify and then
// change an existing record selection formula at print time in response
// to a user selection.
//
// ========================================================================== */
METHOD GETSELE_()
LOCAL cFarProc
LOCAL nRet
LOCAL nText := 0
LOCAL nLen := 0
LOCAL cForm := ""
LOCAL cFunc := "PEGetSelectionFormula"
IF ::l32
cFarProc := GetProc32( ::hDll,cFunc,.T., _INT,LONG,PTR,PTR )
nRet := CallDll32( cFarProc, ::nJobHandle, @nText, @nLen )
ELSE
cFarProc := GetProcAddress( ::hDll,cFunc, .T., _INT, _INT, PTR, PTR )
nRet := CallDll( cFarProc, ::nJobHandle, @nText, @nLen )
ENDIF
IF nRet == FALSE
::lError := .T.
ELSE
cForm := ::PEGetHandleString( nText, nLen )
ENDIF
RETURN cForm
// ==========================================================================
// Method TCrw::PESetWindowOptions // PESetWindowOptions()
//
// ========================================================================== */
METHOD PESETWIN_()
LOCAL cStruc
LOCAL nRet
LOCAL cFarProc := "PESetWindowOptions"
::lError := .F.
//::oWinOptions:SetMember( 1, TRUE )
//::oWinOptions:SetMember( 2, TRUE )
//::oWinOptions:SetMember( 3, TRUE )
::oWinOptions:SetMember( 4, TRUE )
::oWinOptions:SetMember( 5, TRUE )
::oWinOptions:SetMember( 6, TRUE )
::oWinOptions:SetMember( 7, TRUE )
::oWinOptions:SetMember( 8, TRUE )
::oWinOptions:SetMember( 9, TRUE )
::oWinOptions:SetMember( 10, TRUE )
::oWinOptions:SetMember( 11, TRUE )
::oWinOptions:SetMember( 12, TRUE )
// ::oWinOptions:SetMember( 13, TRUE )
cStruc := ::oWinOptions:cBuffer
IF ::l32
cFarProc := GetProc32( ::hDll, cFarProc, .T., _INT, LONG, LPSTR )
nRet := CallDll32( cFarProc, ::nJobHandle, @cStruc )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc, .T., _INT, _INT, LPSTR )
nRet := CallDll( cFarProc, ::nJobHandle, @cStruc )
ENDIF
RETURN self
// ==========================================================================
// Method TCrw::PeOutputToWindow( oWnd ) -> lError
//
// Prepares to direct printed output to a print window
//
// ========================================================================== */
METHOD OUTPUTW_( vWnd )
LOCAL nRet
LOCAL cFarProc
///LOCAL oRect := vWnd:GetCliRect()
LOCAL cFunc := "PEOutputToWindow"
LOCAL aScreen := ScrResolution( 800, 600 )
::lError := .F.
IF ::l32
cFarProc := GetProc32( ::hDll, cFunc, .T., _INT,; // nRetVar
LONG,; // nHandle
LPSTR,; // cReport
LONG,; // nTop
LONG,; // nLeft
LONG,; // nWidth
LONG,; // nHeigth
LONG,; // nStyle
LONG ) // hWnd
// nRet := CallDll32( cFarProc, ::nJobHandle, ::cReport, 0, 0, vWnd:nWidth, vWnd:nHeight, 0, vWnd:hWnd )
// nRet := CallDll32( cFarProc, ::nJobHandle, ::cReport, 0, 0, vWnd:nWidth-7, vWnd:nHeight-7, 0, vWnd )
//llamada original para el Preview
//nRet := CallDll32( cFarProc, ::nJobHandle, ::cReport, 0, 0, 800, 600, 0, vWnd )
nRet := CallDll32( cFarProc,;
::nJobHandle,;
::cReport,;
0,; //0
,; //0
aScreen[1],; //800
aScreen[2],; //600
nOR( WS_VISIBLE, WS_THICKFRAME ),; // , WS_SYSMENU ),;
vWnd )
ELSE
cFarProc := GetProcAddress( ::hDll, cFunc, .T.,;
_INT,; // nRetVar
_INT,; // nHandle
LPSTR,; // cReport
_INT,; // nTop
_INT,; // nLeft
_INT,; // nWidth
_INT,; // nHeigth
LONG,; // nStyle
HDC ) // hWnd
// nRet := CallDll( cFarProc, ::nJobHandle, ::cReport, 0, 0, vWnd:nWidth, vWnd:nHeight, 0, vWnd:hWnd )
*nRet := CallDll( cFarProc, ::nJobHandle, ::cReport, 0, 0, vWnd:nWidth-7, vWnd:nHeight-7, 0, vWnd )
ENDIF
IF nRet == FALSE
MsgAlert( 'Could not output to Window!' )
::lError := .T.
ENDIF
RETURN ! ::lError
// ==========================================================================
// Method TCrw::PeOutToPrinter( nCopies ) -> lError
//
// Prepares to direct printed output to a printer
//
// ========================================================================== */
METHOD OUTPUTP_( nCopies)
LOCAL nRet
LOCAL cFarProc
LOCAL cFunc := "PEOutputToPrinter"
DEFAULT nCopies := 1
::lError := .F.
IF ::l32
cFarProc := GetProc32( ::hDll, cFunc, .T., _INT, LONG, LONG )
nRet := CallDll32( cFarProc, ::nJobHandle, nCopies )
ELSE
cFarProc := GetProcAddress( ::hDll, cFunc, .T., _INT,_INT, _INT )
nRet := CallDll( cFarProc, ::nJobHandle, nCopies )
ENDIF
IF nRet == FALSE
MsgAlert( 'Could not output to Printer!' )
::lError := .T.
ENDIF
RETURN ! ::lError
// ==========================================================================
// Method TCrw::PeStartPrintJob( ) -> lError
// Purpose: Starts the printing of a report.
// ========================================================================== */
METHOD STARTPR_()
LOCAL nRet
LOCAL cFarProc
LOCAL cFunc := "PEStartPrintJob"
::lError := .F.
MEMORY( -1 )
Sysrefresh()
IF ::l32
cFarProc := GetProc32( ::hDll, cFunc,.T., _INT, LONG, LONG )
nRet := CallDll32( cFarProc , ::nJobHandle, .T. )
ELSE
cFarProc := GetProcAddress( ::hDll, cFunc,.T., _INT, _INT, BOOL )
nRet := CallDll( cFarProc , ::nJobHandle, .T. )
ENDIF
IF nRet == FALSE
::lError := .T.
MsgAlert( "Could not start Report!" + CRLF + ::PEErrorText())
ENDIF
RETURN ! ::lError
// ==========================================================================
// Method TCrw::PEGetWindowHandle() -> hWnd
//
// Purpose:
// Returns the handle of the print window . This method can be used in
// a custom-print link if you want to do something with the print window
// (move it, change its size, etc.).
// PEGetWindowHandle can also be used to determine if the user has already
// closed the print window.
//
// ========================================================================== */
METHOD GETHWND_()
LOCAL hWnd
LOCAL cFarProc
LOCAL cFunc := "PEGetWindowHandle"
IF ::l32
cFarProc := GetProc32( ::hDll, cFunc,.T.,_INT, LONG )
hWnd := CallDll32( cFarProc , ::nJobHandle )
ELSE
cFarProc := GetProcAddress( ::hDll, cFunc,.T.,_INT,_INT )
hWNd := CallDll( cFarProc , ::nJobHandle )
ENDIF
RETURN hWnd
// ==========================================================================
// Method TCrw::PEGetGetJobStatus() -> nStatus
//
// Evaluates the status of a print job. You can use this method in a
// number of programming situations, for example:
// - to trigger error messages, for example, when a print job fails
// (due to insufficient memory, insufficient disk space, etc.),
// - to trigger screen displays (hourglass, series of graphics, etc.)
// that confirm to the user that work is in progress, or
// — to find out whether a job was canceled by the user after
// PEStartPrintJob returns.
//
// ========================================================================== */
METHOD GETJOBS_()
LOCAL cStruct
LOCAL nStatus := 0
LOCAL cFarProc := "PEGetJobStatus"
cStruct := ::oJobInfo:cBuffer
IF ::l32
cFarProc := GetProc32( ::hDll, cFarProc,.T.,_INT, LONG, LPSTR )
nStatus := CallDll32( cFarProc, ::nJobHandle, @cStruct )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc,.T.,_INT,_INT, LPSTR )
nStatus := CallDll( cFarProc, ::nJobHandle, @cStruct )
ENDIF
RETURN nStatus
// ==========================================================================
// Method TCrw::PESetSelFormula()
//
// Changes the selection formula to the formula string you supply as a
// parameter. This method can be used by itself to replace a known
// record selection formula.
// The method can also be used as one of a series of methods
// (PEGetSelectionFormula, PEGetHandleString, PESetSelectionFormula).
// The series can be used in a custom-print link to identify and then
// change an existing record selection formula at print time in response
// to a user selection.
// ========================================================================== */
METHOD SETSELE_( cFormula )
LOCAL nRet
LOCAL cFarProc := "PESetSelectionFormula"
::lError := .F.
IF ::l32
cFarProc := GetProc32( ::hDll, cFarProc,.T.,_INT,LONG, LPSTR )
nRet := CallDll32( cFarProc, ::nJobHandle, cFormula )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc,.T.,_INT, _INT, LPSTR )
nRet := CallDll( cFarProc, ::nJobHandle, cFormula )
ENDIF
IF nRet == FALSE
MsgAlert( "Invalid Selection!" + CRLF + "[" + cFormula + "]" )
::lError := .T.
ENDIF
RETURN ! ::lError
// ==========================================================================
// Method TCrw::PECheckSelFormula()
//
// Checks the text of the report's record selection formula for errors.
// Use this method whenever the record selection formula has been changed
// and you wish to check the formula for syntax errors.
// If the record selection formula contains an error, this method returns
// False
// ========================================================================== */
METHOD CHECKSEL_()
LOCAL nRet
LOCAL cFarProc := "PECheckSelectionFormula"
::lError := .F.
IF ::l32
cFarProc := GetProc32( ::hDll, cFarProc,.T.,_INT, LONG )
nRet := CallDll32( cFarProc, ::nJobHandle )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc,.T.,_INT, _INT )
nRet := CallDll( cFarProc, ::nJobHandle )
ENDIF
IF nRet == FALSE
::lError := .T.
ENDIF
RETURN ! ::lError
// ==========================================================================
// Method TCrw::PESetFormula( cformulaName, cFormulaString )
//
// Changes the specified formula to the formula string you supply as a
// parameter. This method will only change the text of a formula which
// already exists in the report; you can not use it to add a formula.
// This method can be used by itself to replace the formula string for
// a known formula.
// It can also be used as one of a series of methods (PEGetFormula,
// PEGetHandleString, PESetFormula). The series can be used in a
// custom-print link to identify and then change an existing formula at
// print time in response to a user selection.
//
// ==========================================================================
METHOD SETFORM_( cName, cString )
LOCAL nRet
LOCAL cFarProc := "PESetFormula"
::lError := .F.
IF ::l32
cFarProc := GetProc32( ::hDll,cFarProc ,.T.,_INT, LONG, LPSTR, LPSTR )
nRet := CallDll32( cFarProc, ::nJobHandle, cName, cString )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc,.T.,_INT,_INT,LPSTR,LPSTR)
nRet := CallDll( cFarProc, ::nJobHandle, cName, cString )
ENDIF
IF nret == FALSE
//MsgAlert( "Could not set Formula!" + CRLF + "[" + cName + "]" + ;
// + CRLF + "[" + cString + "]" )
::lError := .T.
ENDIF
RETURN ! ::lError
// ==========================================================================
// Method TCrw::PECheckFormula( cFormualName )
//
// The PECheckFormula method checks the text of a named formula for
// validity. Use this method to check a named formula for errors. This
// method works like the Check button in the Formula Editor. If the
// named formula contains an error, the method returns False
//
// ========================================================================== */
METHOD CHECKFOR_( cformulaName )
LOCAL nRet
LOCAL cFarProc := "PECheckFormula"
::lError := .F.
IF ::l32
cFarProc := GetProc32( ::hDll, cFarProc,.T.,_INT,LONG,LPSTR )
nRet := CallDll32( cFarProc, ::nJobHandle, cformulaName )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc,.T.,_INT,_INT, LPSTR )
nRet := CallDll( cFarProc, ::nJobHandle, cformulaName )
ENDIF
IF nRet == FALSE
MsgAlert("Invalid Formula!" + CRLF + "[" + cformulaName + "]" )
::lError := .T.
ENDIF
RETURN ! ::lError
// ==========================================================================
// Method TCrw::PEGetNTables()
//
// The PEGetNTables method retrieves the number of tables in the open report.
// It counts both PC and SQL databases. This method is one of a series of
// methods that enable you to retrieve and update database information in an
// opened report so that the report can be printed using different server,
// database, user, and/or table location settings.
//
// ========================================================================== */
METHOD GETNTAB_()
LOCAL nTables
LOCAL cFarProc := "PEGetNTables"
IF ::l32
cFarProc := GetProc32( ::hDll, cFarProc,.T.,_INT, LONG )
nTables := CallDll32( cFarProc, ::nJobHandle )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc ,.T.,_INT, _INT )
nTables := CallDll( cFarProc, ::nJobHandle )
ENDIF
RETURN nTables
// ==========================================================================
// Method TCrw::PEGetTabLocation // PEGetNthTableLocation()
//
// The PEGetNthTableLocation method determines the location of a selected
// table used in the specified print job. This method is typically combined
// with PESetNthTableLocation to identify the location of a table and then
// to change it.
// ========================================================================== */
METHOD GETTLOC_( nPos )
LOCAL cBuffer
LOCAL nRet
LOCAL cFarProc := "PEGetNthTableLocation"
// Clear Filename-Buffer
//
::lError := .F.
::oTabLocation:SetMember( 2, CHR(0) )
cBuffer := ::oTabLocation:cBuffer
IF ::l32
cFarProc := GetProc32( ::hDll, cFarProc, .T., _INT, LONG, LONG, LPSTR )
nRet := CallDll32( cFarProc, ::nJobHandle, nPos, @cBuffer )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc, .T., _INT, _INT, _INT, LPSTR )
nRet := CallDll( cFarProc, ::nJobHandle, nPos, @cBuffer )
ENDIF
::oTabLocation:cBuffer := cBuffer
cBuffer := ::oTabLocation:GetMember( 2 )
IF nRet == FALSE .OR. EMPTY( cBuffer )
MsgAlert( "Error locating Table", ::PEGetErrorCode())
::lError := .T.
ENDIF
RETURN IIF( ::lError, "", TRIM( cBuffer ))
// ==========================================================================
// Method TCrw::PESetTabLocation // peSetNthTableLocation()
//
// The PESetNthTableLocation method sets the location for a selected table
// in the specified print job. This method is typically combined with
// PEGetTableLocation to identify the location of a table and then to
// change it.
// ==========================================================================
METHOD SETTLOC_( nPos, cName )
LOCAL nRet
LOCAL cFarProc := "PESetNthTableLocation"
// Set Filename-Buffer
//
::oTabLocation:SetMember( 2, TRIM( cName ) + CHR(0) )
::lError := .F.
IF ::l32
cFarProc := GetProc32( ::hDll, cFarProc, .T., _INT, LONG, LONG, LPSTR )
nRet := CallDll32( cFarProc, ::nJobHandle, nPos, ::oTabLocation:cBuffer )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc, .T., _INT, _INT, _INT, LPSTR )
nRet := CallDll( cFarProc, ::nJobHandle, nPos, ::oTabLocation:cBuffer )
ENDIF
IF nRet == FALSE
::lError := .T.
MsgAlert( "Error setting Location " + cName, ::PEGetErrorText())
ENDIF
RETURN ! ::lError
// ==========================================================================
// Method TCrw::PEGetSqlQuery
//
// You can use this method to retrieve the SQL query that will be generated
// to print the report, and you can update the query using PESetSQLQuery.
//
// ========================================================================== */
METHOD GETSQLQ_()
LOCAL cFarProc := "PEGetSqlQuery"
LOCAL nHandle := 0
LOCAL nLen := 0
LOCAL cBuffer := ""
LOCAL nRet
::lError := .F.
IF ::l32
cFarProc := GetProc32( ::hDll, cFarProc, .T., _INT, LONG, PTR, PTR )
nRet := CallDll32( cFarProc, ::nJobHandle, @nHandle, @nLen )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc, .T.,_INT,_INT,PTR,PTR )
nRet := CallDll( cFarProc, ::nJobHandle, @nHandle, @nLen )
ENDIF
IF nRet == FALSE
MsgAlert("Could not get SQL query!" + CRLF )
::lError := .T.
ELSE
cBuffer := ::PEGetHandleString( nHandle, nLen )
ENDIF
RETURN cBuffer
// ==========================================================================
// Method TCrw::PESetSqlQuery
//
// You can use this method to set a SQL query
//
// ========================================================================== */
METHOD SETSQLQ_( cQuery )
LOCAL nRet
LOCAL cFarProc := "PESetSqlQuery"
::lError := .F.
IF ::l32
cFarProc := GetProc32( ::hDll, cFarProc, .T., _INT, LONG, LPSTR )
nRet := CallDll32( cFarProc, ::nJobHandle, cQuery )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc, .T., _INT, _INT, LPSTR )
nRet := CallDll( cFarProc, ::nJobHandle, cQuery )
ENDIF
IF nRet == FALSE
MsgAlert('Could not set query!' + CRLF + cQuery )
::lError := .T.
ENDIF
RETURN ! ::lError
// ==========================================================================
// Method TCrw::PETestNTable( n ) // PETestNthTableConnectivity( nPos )
//
// Purpose:
// The PETestNthTableConnectivity method tests whether a database
// table's settings are valid and ready to be reported on.
// This method is typically used if you plan to print at a later time
// but you want to test now to make sure everything is in order for
// logging on.
//
// ========================================================================== */
METHOD TESTTAB_( nPos )
LOCAL nRet
LOCAL cFarProc := "PETestNthTableConnectivity"
LOCAL cError := ""
LOCAL cBuffer
DEFAULT nPos := 0
IF ::l32
cFarProc := GetProc32( ::hDll, cFarProc, .T., _INT, LONG, LONG )
nRet := CallDll32( cFarProc, ::nJobHandle, nPos )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc, .T., _INT, WORD, WORD)
nRet := CallDll( cFarProc, ::nJobHandle, nPos )
ENDIF
IF nRet == FALSE
cError := ::PEErrorText()
cBuffer := ::PEGetTabLocation( nPos )
cError += CRLF + "File: " + cBuffer
ENDIF
RETURN cError
// ==========================================================================
// Method TCrw::PEClosePrintJob()
//
// PEClosePrintJob closes the print job. If printing has not yet finished,
// it continues; if the print window is open, it stays open.
// This method is used as a mandatory part of each custom-print link
// to shut down the print job once it has finished printing to screen
// or to window.
// ========================================================================== */
METHOD CLOSEJOB_()
LOCAL nRet
LOCAL cFarProc := "PEClosePrintJob"
::lError := .F.
IF ::nJobHandle != 0
IF ::l32
cFarProc := GetProc32( ::hDll, cFarPRoc, .T., _INT, LONG )
nRet := CallDll32( cFarProc, ::nJobHandle )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc, .T., _INT, _INT )
nRet := CallDll( cFarProc, ::nJobHandle )
ENDIF
IF nRet == FALSE
::lError := .T.
ENDIF
ENDIF
RETURN ::lError
// ==========================================================================
// Method TCrw::PECloseEngine()
//
// PECloseEngine terminates the Report Engine. All printing is stopped
// and all windows are closed.
//
// NOTE: This will only happen if the calling application is the
// last one using CRPE !!!
//
// This method stops the Report Engine from sending output, but the
// report may continue to print from data remaining in the spooler.
// This method is a necessary part of any custom-print link. It is
// also required for any print-only link in which you want the report
// to print to a window that is to remain visible after the report is
// printed. It is not necessary to use this method with a print-only link
// where you are directing the report to a printer.
// ========================================================================== */
METHOD PECLOSE_()
LOCAL cFarProc := "PECloseEngine"
IF ::hDll != 0
IF ::l32
cFarProc := GetProc32( ::hDll, cFarProc, .T., _INT )
CallDll32( cFarProc )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc, .T., _INT )
CallDll( cFarProc )
ENDIF
ENDIF
RETURN .T.
// ==========================================================================
// Method TCrw::PEGetHandleString( nHandle )
//
// This method will return the text that the string handle is pointing to.
//
// ========================================================================== */
METHOD GETSTR_( nHandle, nLen )
LOCAL nRet
LOCAL cFarProc := "PEGetHandleString"
LOCAL cBuffer := SPACE( nLen )
IF ::l32
cFarProc := GetProc32( ::hDll, cFarProc, .T., _INT, LONG,LPSTR,LONG )
nRet := CallDll32( cFarProc , nHandle, @cBuffer, nLen )
ELSE
cFarProc := GetProcAddress( ::hDll, cFarProc, .T., _INT, _INT,LPSTR,_INT)
nRet := CallDll( cFarProc , nHandle, @cBuffer, nLen )
ENDIF
IF nRet == FALSE
cBuffer := ""
ELSE
cBuffer := SUBSTR( cBuffer, 1, nLen -1 )
ENDIF
RETURN cBuffer
// ==========================================================================
// Method TCrw::GetModuleHandle( lpName )
//
// This method will return the Handle to a Module( Dll ) that is mapped
// into our address space
//
// ========================================================================== */
METHOD GETMOD_( cModule )
LOCAL hDll := LoadLib32( "Kernel32.dll" )
LOCAL cFarProc
LOCAL nRet
cFarProc := GetProc32( hDll, "GetModuleHandleA", .T., LONG, LPSTR )
nRet := CallDll32( cFarProc ,cModule )
RETURN nRet
//
// Devuelve los nombre de los campos de ordenacion del informe
//
METHOD PEGETSOR_( oDlg )
LOCAL nSort
LOCAL cFarProc := "PEGetNSortFields"
If ::l32
cFarProc := GetProc32( ::hDll, cFarProc, .T., _INT, LONG )
nSort := CallDll32( cFarProc, oDlg )
End
Return( nSort )
//
//
//
/*
METHOD PEGETNGR_( oDlg )
LOCAL cGrupos := ::oTabLocation:StrucSize
LOCAL cFarProc := "PEGetNGroups"
If ::l32
cFarProc := GetProc32( ::hDll, cFarProc, .T., _INT, LONG )
cGrupos := CallDll32( cFarProc, oDlg )
End
Return( cGrupos )
*/
Function ScrResolution( nWidth, nHeight)
LOCAL hDC
hDC := CreateDC("DISPLAY", "", "")
nWidth := GetDeviceCaps(hDC, HORZRES)
nHeight := GetDeviceCaps(hDC, VERTRES)
DeleteDC(hDc)
Return {nWidth, nHeight}
UN saludo
JLL