Alfredo Arteaga wrote:Puedes evaluar esto: http://www.despachoarteaga.com.mx/Visor.zip si te agrada, lo usas o haces alguna mejora te agradeceremos la compartas.
// --- Cambios a RPreview para trabajar con Image2PDF
// ---
DEFINE BUTTON RESOURCE "Acrobat" OF oBar ;
MESSAGE "Generar archivo tipo PDF" ;
ACTION SavePDF( oDevice ) ;
TOOLTIP "Generar archivo PDF"
// ---
MENUITEM "Generar PDF" ACTION SavePDF(oDevice) ;
MESSAGE "Generar archivo tipo PDF" RESOURCE "Acrobat"
FUNCTION SavePDF(oDevice)
LOCAL error, hLibImg2PDF
LOCAL imageFilename:=" "
LOCAL cPdfFilename
LOCAL nI, iErr:=0
LOCAL aFiles:={}, cTemp
cPdfFileName:=cUTem+"\"+Left(cNSys,2)+"_Temp\"+oDevice:cDocument+".Pdf"
IF !File("Image2PDF.Dll")
MsgAlert("No existe DLL para generar PDFs.","Precaución!")
RETURN (NIL)
ENDIF
aFiles:=oDevice:aMeta
hLibImg2PDF:=LoadLib32("Image2PDF.Dll")
IF ValType(aFiles)=="A"
I2PDF_License("LICENCIA")
iErr:=IPMeta() // Flag that his is a meta file
iErr:=IPSize() // Reset the size
iErr:=IPMetaAdjustText()
iErr:=IPSetDPI(0) // Set DPI to the default for PDF's. It works better
FOR nI:=1 TO Len(aFiles) // Build the pages using the array of temp files
CursorWait()
imageFilename:=aFiles[nI]
iErr:=IPAddImg(imageFilename)
NEXT nI
CursorWait()
iErr:=IPMakePDF(cPdfFileName,0,error,40) // Create the PDF.
ENDIF
FreeLib32(hLibImg2PDF)
CursorArrow()
IF !File(cPdfFileName)
MsgInfo("No se generó el archivo PDF.","Información!")
ELSE
ShellExecute(,"Open",cPdfFileName,"",".\",.T.)
ENDIF
RETURN (NIL)
//--- Wrappers ---------------------------------------------------------------//
DLL32 STATIC FUNCTION I2PDF_License( code AS LPSTR) AS LONG;
PASCAL FROM "I2PDF_License" LIB "IMAGE2PDF.dll"
DLL32 STATIC FUNCTION IPMeta( ) AS LONG;
PASCAL FROM "I2PDF_MetaToNativePDF" LIB "Image2PDF.dll"
DLL32 STATIC FUNCTION IPMetaAdjustText() AS LONG;
PASCAL FROM "I2PDF_MetaTextFitBoundingRect" LIB "Image2PDF.dll"
DLL32 STATIC FUNCTION IPSize( ) AS LONG;
PASCAL FROM "I2PDF_UseEMFDeviceSize" LIB "Image2PDF.DLL"
DLL32 STATIC FUNCTION IPAddImg( cImage AS LPSTR ) AS LONG;
PASCAL FROM "I2PDF_AddImage" LIB "Image2PDF.dll"
DLL32 STATIC FUNCTION IPSetDpi( nDpi AS LONG ) AS LONG;
PASCAL FROM "I2PDF_SetDPI" LIB "Image2PDF.dll"
DLL32 STATIC FUNCTION IPMakePDF( cOutFile AS LPSTR, nOptions AS LONG, cErrTxt AS LPSTR, nMaxESize AS LONG ) AS LONG;
PASCAL FROM "I2PDF_MakePDF" LIB "Image2PDF.dll"
DLL32 FUNCTION COPYFILE( cExistName AS LPSTR, cNewName AS LPSTR, nFailIfExist AS LONG ) AS BOOL;
PASCAL FROM "CopyFileA" LIB "kernel32.dll"
DLL32 FUNCTION xI2PDF_BatesFormat( format AS LPSTR ) AS LONG;
PASCAL FROM "I2PDF_BatesFormat" LIB "Image2PDF.dll"
DLL32 FUNCTION xI2PDF_BatesLocation( verticalPosition AS LONG, horizontalPosition AS LONG, orientation AS LONG, margin AS LONG) AS LONG;
PASCAL FROM "I2PDF_BatesLocation" LIB "Image2PDF.dll"
DLL32 FUNCTION xI2PDF_BatesFont_Int( iSize AS LONG, FontID AS LPSTR, fillRed AS LONG, fillGreen AS LONG, fillBlue AS LONG, iStyle AS LONG, otherRed AS LONG, otherGreen AS LONG, otherBlue AS LONG) AS LONG;
PASCAL FROM "I2PDF_BatesFont_Int" LIB "Image2PDF.dll"
DLL32 FUNCTION xI2PDF_BatesBackground_Int( shape AS LONG, bkRed AS LONG, bkGreen AS LONG, bkBlue AS LONG, borderRed AS LONG, borderGreen AS LONG, borderBlue AS LONG ) AS LONG;
PASCAL FROM "I2PDF_BatesBackground_Int" LIB "Image2PDF.dll"
//----------------------------------------------------------------------------//
FUNCTION New_Report(oLbx)
LOCAL oDlg, oHdr, oData, oField, nI
LOCAL nFld, nDat, nF, cAlias, oSiz
LOCAL oCel, lCel, nOpt, cTit, oAlg
LOCAL aAlg:={"Izq.","Cen.","Der."}
aField:={}
aData:={}
aHead:={}
aTypD:={}
aSizD:={}
aAlig:={}
aType:={}
aSizs:={}
aPict:={}
nDat:= 1
nFld:= 1
nOpt:= 1
lCel:=.F.
cTit:="Reporte de "+cTitl+Space(25)
cAlias:=oLbx:cAlias()
DbSelectArea(cAlias)
nF:=(cAlias)->(FCount())
ASize(aField,nF)
ASize(aType,nF)
ASize(aSizs,nF)
ASize(aPict,nF)
AFields(aField,aType,aSizs)
FOR nI=1 TO nF
IF nI<=3 // tres como mínimo
AAdd(aData,aField[nI])
AAdd(aHead,aField[nI])
AAdd(aTypD,aType[nI])
AAdd(aSizD,aSizs[nI])
AAdd(aAlig,IF(aType[nI]="N","Der.","Izq."))
ELSE
nI:=nF
ENDIF
NEXT nI
AFill(aPict,"")
DEFINE DIALOG oDlg RESOURCE "SDS_VSR" FONT oWnd:oFont ;
TITLE "Configuración del Reporte"
REDEFINE BUTTON ID 101 OF oDlg ; // Agregar
ACTION ;
(oData:Add(aField[nFld]) ,;
AAdd(aHead,aField[nFld]) ,;
AAdd(aTypD,aType[nFld]) ,;
AAdd(aSizD,aSizs[nFld]) ,;
AAdd(aAlig,IF(aType[nFld]="N","Der.","Izq.")) ,;
nDat:=Len(aHead) ,;
oSiz:Refresh() ,;
oAlg:Refresh() ,;
oHdr:Refresh() )
REDEFINE BUTTON ID 102 OF oDlg ; // Borrar
ACTION ;
IF(Len(aHead)==1, MsgBeep() ,;
(oData:Del(nDat), ,;
ADel(aHead,nDat) ,;
ASize(aHead,Len(aHead)-1) ,;
ADel(aTypD,nDat) ,;
ASize(aTypD,Len(aTypD)-1) ,;
ADel(aSizD,nDat) ,;
ASize(aSizD,Len(aSizD)-1) ,;
ADel(aAlig,nDat) ,;
ASize(aAlig,Len(aAlig)-1) ,;
nDat:=Min(Len(aHead),nDat) ,;
oSiz:Refresh() ,;
oAlg:Refresh() ,;
oHdr:Refresh() ))
REDEFINE BUTTON ID 103 OF oDlg ; // Insertar
ACTION ;
(oData:Insert(aField[nFld],nDat),;
AAdd(aHead,NIL) ,;
aIns(aHead,nDat) ,;
aHead[nDat]:=aField[nFld] ,;
AAdd(aTypD,NIL) ,;
aIns(aTypD,nDat) ,;
aTypD[nDat]:=aType[nFld] ,;
AAdd(aSizD,NIL) ,;
aIns(aSizD,nDat) ,;
aSizD[nDat]:=aSizs[nFld] ,;
AAdd(aAlig,NIL) ,;
aIns(aAlig,nDat) ,;
aAlig[nDat]:=IF(aType[nFld]="N","Der.","Izq.") ,;
oSiz:Refresh() ,;
oAlg:Refresh() ,;
oHdr:Refresh() )
REDEFINE LISTBOX oField VAR nFld ITEMS aField ID 104 OF oDlg
REDEFINE LISTBOX oData VAR nDat ITEMS aData ID 105 OF oDlg ;
ON CHANGE (oHdr:Refresh(),oSiz:Refresh(),oAlg:Refresh())
REDEFINE GET oHdr VAR aHead[nDat] ID 106 OF oDlg MEMO // Get head
REDEFINE GET oSiz VAR aSizD[nDat] ID 107 OF oDlg PICTURE "9999" // Get size
REDEFINE COMBOBOX oAlg VAR aAlig[nDat] ITEMS aAlg ID 108 OF oDlg // Get align
REDEFINE CHECKBOX oCel VAR lCel ID 111 OF oDlg
REDEFINE RADIO nOpt ID 112,113,114,115 OF oDlg
REDEFINE GET cTit ID 116 OF oDlg MEMO
REDEFINE BUTTON ID 110 OF oDlg ACTION Gen_Report(cAlias,cTit,nOpt,lCel)
REDEFINE BUTTON ID 120 OF oDlg ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTERED
RETURN (NIL)
STAT FUNC Gen_Report(cAlias,cTit,nOpt,lCel)
LOCAL oReport, oDevice, cFTxt, cHead, cData
LOCAL cGroup, oFont, nI, nRecno, nFld
DEFINE FONT oFont NAME cFont SIZE 0,-10
DO CASE
CASE nOpt==1 // pantalla
PRINT oDevice TITLE cTit PREVIEW
REPORT oReport ;
TITLE Trim(cTit) ;
FONT oFont ;
HEADER "Fecha: "+DtoC(Date()) ,;
"Hora: " +Time() RIGHT ;
FOOTER "Hoja: " + ;
Str(oReport:nPage,3) ;
CENTERED ;
PREVIEW ;
CAPTION cTit ;
TO DEVICE oDevice
CASE nOpt==2 // Impresora
PRINT oDevice TITLE cTit
REPORT oReport ;
TITLE Trim(cTit) ;
FONT oFont ;
HEADER "Fecha: "+DtoC(Date()) ,;
"Hora: " +Time() RIGHT ;
FOOTER "Hoja: " + ;
Str(oReport:nPage,3) ;
CENTERED ;
CAPTION cTit ;
TO DEVICE oDevice
CASE nOpt==3 // Archivo
cFTxt:=cPatD+cAlias+".Txt"
REPORT oReport ;
TITLE Trim(cTit) ;
FONT oFont ;
HEADER "Fecha: "+DtoC(Date()) ,;
"Hora: " +Time() RIGHT ;
FOOTER "Hoja: " + ;
Str(oReport:nPage,3) ;
CENTERED ;
CAPTION cTit ;
TO FILE (cFTxt)
CASE nOpt==4 // Excel
Rpt_Excel(cAlias)
RETURN (NIL)
ENDCASE
FOR nI:=1 TO Len(aData)
RptAddColumn({Get_Head(aHead,nI)},, ;
{Get_Data(aData,nI)}, ;
aSizD[nI], ;
{Trim(aPict[nI])}, ;
{|| 1}, ;
(aTypD[nI]=="N"), ;
{|| .T. }, ;
IF(aAlig[nI]="Der.","RIGHT",IF(aAlig[nI]="Cen.","CENTER","LEFT")))
NEXT
ENDREPORT
IF lCel
oReport:CellView()
ENDIF
nRecno:=(cAlias)->(Recno())
ACTIVATE REPORT oReport ON STARTGROUP oReport:NewLine() ;
ON INIT (cAlias)->(DbGotop())
(cAlias)->(DbGoto(nRecno))
IF nOpt=3
ShellExecute(oWnd:hWnd,"Open",cFTxt,Nil,Nil,1)
ENDIF
RETURN (NIL)
Alfredo Arteaga wrote:No hay secretos Manuel, uso Image2PDF.Dll que va incluida en el zip.
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: No registered users and 55 guests