FiveTech Software tech support forums

MemoRead()
Reads an entire file from disk into memory.
Syntax
MemoRead( <cFileName> ) --> cString

Arguments
<cFileName>
This is a character string holding the name of the file to read. It must include path and file extension. If the path is omitted from <cFileName>, the file is searched in the current directory. Return
The function returns the entire contents of file <cFileName> as a character string. If the file is not found, an empty string ("") is returned.

FileStr()
Reads a string from a file beginning at a specified offset.
Syntax
FileStr( <cFileName>, ;
[<nBytes>] , ;
[<nStart>] , ;
[<lCtrl_Z>] ) --> cString

Arguments
<cFileName>
This is a character string holding the name of the file to read from. It must include path and file extension. If the path is omitted from <cFileName>, the file is searched in the current directory.
<nBytes>
This is a numeric value specifying the number of bytes to read from the file. If omitted, the entire file is read.
<nStart>
This optional numeric parameter specifies the number of bytes to skip before reading from the file. It defaults to 0 bytes, which reads from the beginning of the file.
<lCtrl_Z>
This parameter defaults to .F. (false). When .T. (true) is passed, only the characters up to the first Ctrl-Z character (Chr(26)) are returned. This is useful for reading Chr(26) terminated DBT memo fields directly from a DBT file.

Code: Select all  Expand view

oRich:SaveToRTFFile(cFile)

Code: Select all  Expand view

oRich:LoadFromRTFFile(cFile)

Code: Select all  Expand view

cBuf         := FileStr( cEMF )

Code: Select all  Expand view

"        "+cDetalleTA+renglon+renglon+;

Code: Select all  Expand view

"        "+alltrim(cDetalleTA)+renglon+renglon+;

Code: Select all  Expand view

#include "fivewin.ch"

#define a4_width           595.0
#define a4_height          842.0

//----------------------------------------------------------------------------//

function FWSavePreviewToPDF( oDevice, cPDF, lOpen )   // oDevice can be oPrinter or oPreview

   local cOrient, oPDF
   local hWnd

   if oDevice:IsKindOf( "TPREVIEW" )
      hWnd     := oDevice:oWnd:hWnd
      oDevice  := oDevice:oDevice
   endif

   if LoadFreeImage() <= 32
      MsgAlert( "freeimage.dll not found" )
      return nil
   endif

   DEFAULT cPDF   := cGetFile( "PDF File (*.pdf)|*.pdf|", "Select PDF File to Save", ;
                               CurDir(), .t. )

   if ! Empty( cPDF )
      cPDF = cFileSetExt( cPDF, "pdf" )
      CursorWait()
      cOrient = If( oDevice:nHorzSize() > oDevice:nVertSize(), 'L', 'P' )
      oPdf = fwPdf():New( cPdf, cOrient )

      // problemas no XP
      //AEval( oDevice:aMeta, { | cMeta | oPdf:AddMeta( cMeta ) } )

      // si usas xharbour - Carlos Vargas - 18/10/2013 - Joao
      AEval( oDevice:aMeta, { | cMeta | Tracelog( "cMeta:" + cMeta ), oPdf:AddMeta( cMeta ) } )

      oPdf:Close()
      CursorArrow()

      DEFAULT lOpen := MsgYesNo( "View " + cPDF + " (Y/N)?" )

      if lOpen
         ShellExecute( IfNil( hWnd, GetWndDefault() ), "open", cPDF )
      endif
   else
      cPDF  := nil
   endif

return cPDF

//----------------------------------------------------------------------------//

static function Emf2Jpeg( cEMF )

   local cJpeg    := cFileSetExt( cEMF, "jpg" )
   local hDC1, hDC, hDib, hDib2, hMem, hBmp, hOldBmp, hEMF
   local cBuf, oRect, lRet := .f.
   local nFormat

   // Probelmas no XP
   //cBuf         := MemoRead( cEMF )

   // Modificado em: 17/10/2013 - By Carlos Vargas
   cBuf         := FileStr( cEMF )

   oRect        := TRect():New( 0, 0, Bin2L( SubStr( cBuf, 21, 4 ) ) / 2, ;
                                  Bin2L( SubStr( cBuf, 17, 4 ) ) / 2  )
   hEMF        := GetEnhMetaFile( cEMF )
   hDC1        := GetDC( GetDesktopWindow() )
   hDC         := CreateCompatibleDC( hDC1 )
   hBmp        := CreateCompatibleBitmap( hDC1, oRect:nWidth, oRect:nHeight )
   hOldBmp     := SelectObject( hDC, hBmp )
   FillRect( hDC, oRect:aRect, GetStockObject( 0 ) )
   PlayEMF( hDC, hEMF, oRect:cRect )
   hDib        := DibFromBitmap( hBmp )

   cBuf        := DibToStr( hDib )

MsgInfo( 1 )

   GloBalFree( hDib )
   CloseEnhMetafile( hEMF )
   SelectObject( hDC, hOldBmp )
   DeleteDC( hDC )
   DeleteDC( hDC1 )
   DeleteObject( hBmp )

   hMem        := FI_OpenMemory( cBuf, Len( cBuf ) )
   nFormat     := FI_GetFileTypeFromMemory( hMem, 0 )
   hDib        := FI_LoadFromMemory( nFormat, hMem, 0 )
   cBuf        := nil  // to release memory
   FI_CloseMemory( hMem )
   hDib2       := FICnv24( hDib )
   FIUnload( hDib )
   lRet        := FISave( 2, hDib2, cJpeg, 0 )
   FIUnload( hDib2 )
   cBuf        := If( lRet, MemoRead( cJpeg ), "" )
   FErase( cJpeg )

MsgInfo( 2 )

return cBuf

//----------------------------------------------------------------------------//

CLASS FWPDF STATIC

   DATA nPageWidth   INIT a4_width
   DATA nPageHeight  INIT a4_height
   DATA nPage        INIT 0
   DATA nObject      INIT 1
   DATA nNextObj     INIT 5
   DATA nDocLen      INIT 0
   DATA cKids        INIT ""
   DATA aRefs        INIT Array( 0 )
   DATA nImageAt

   METHOD New( cFile, cOrient )
   METHOD AddMeta( cMeta )
   METHOD WritePage()
   METHOD Close()

ENDCLASS

METHOD New( cFile, cOrient ) CLASS FWPDF

   DEFAULT cOrient   := "P"

   if cOrient == "P"
      ::nPageWidth   := a4_width
      ::nPageHeight  := a4_height
   else
      ::nPageWidth   := a4_height
      ::nPageHeight  := a4_width
   endif
   ::aRefs           := { 0, 0 }
   ::nDocLen      := PdfBegin( cFile )

return Self

METHOD AddMeta( cMeta ) CLASS FWPDF

   local nAt

   ::nPage++
   ::WritePage( Emf2Jpeg( cMeta ) )

return Self


METHOD WritePage( cJpeg ) CLASS FWPDF

   local nAt, x, y
   local lClose   := Empty( cJpeg )

   Aadd( ::aRefs, ::nDocLen )

   if ! lClose
      ::cKids += " " + NTrim( ::nObject + 1 ) + " 0 R"
   endif

   AAdd( ::aRefs, PgPart1( ::nObject, ::nPageWidth, ::nPageHeight ) )
   ::nObject   += 3
   if ! lClose
      ::nNextObj ++
      ::nImageAt   := ::nNextObj
   endif
   AAdd( ::aRefs, PgPart2( ::nObject - 1, ::nPage, ::nImageAt ) )
   AAdd( ::aRefs, PgPart3( ::nObject, ::nPageWidth, ::nPageHeight, ::nPage ) )
   ::nDocLen := PgPart4( ++ ::nObject )

   if ! lClose
      Aadd( ::aRefs, ::nDocLen )

      nAt   := At( Chr( 255 ) + Chr( 192 ), cJpeg ) + 5
      y     := Asc( Substr( cJpeg, nAt,     1 ) ) * 256 + Asc( Substr( cJpeg, nAt + 1, 1 ) )
      x     := Asc( Substr( cJpeg, nAt + 2, 1 ) ) * 256 + Asc( Substr( cJpeg, nAt + 3, 1 ) )

      ::nDocLen := PGJPEG1( ::nImageAt, ::nPage, x, y, cJpeg )
   endif

   ::nObject      := ::nNextObj
   ::nNextObj     := ::nObject + 4

return nil

METHOD Close() CLASS FWPDF

   ::WritePage()
   ::aRefs[ 2 ]   := ::nDocLen
   Aadd( ::aRefs, PdfClose1( ::nPage, ::cKids ) )
   AAdd( ::aRefs, PdfClose2( ++ ::nObject, Left( TToS( DateTime() ), 14 ) ) )
   AAdd( ::aRefs, PdfClose3( ++ ::nObject ) )
   PdfClose4( ++ ::nObject, ::aRefs )

return Self

//----------------------------------------------------------------------------//

static function NTrim( n )
return LTrim( Str( n ) )

//----------------------------------------------------------------------------//

dll32 static function PLAYEMF( hDC AS LONG, hEMF AS LONG, cRect AS LPSTR ) AS BOOL;
      PASCAL FROM "PlayEnhMetaFile" LIB "gdi32.dll"

//----------------------------------------------------------------------------//

#pragma BEGINDUMP
#include <windows.h>
#include <hbapi.h>

#ifdef __XHARBOUR__
  #define hb_parvnl( x, y ) hb_parnl( x, y )
  #define hb_storvnl( v, x, y ) hb_stornl( v, x, y )
#endif


FILE * fp;
LONG nDocLen;
int iBufLen = 0;

HB_FUNC_STATIC( PDFBEGIN ) // ( cPDF )
{
   fp       = fopen( hb_parcx( 1 ), "wb" );
   nDocLen  = fprintf( fp, "%s\r\n", "%PDF-1.3" );

   hb_retnl( nDocLen );
}

HB_FUNC_STATIC( PGPART1 ) // ( nObj, nPageWidth, nPageHeight )
{

   LONG  nObj;
   char * format = "%d 0 obj\r\n<<\r\n/Type /Page /Parent 1 0 R\r\n"
                   "/Resources %d 0 R\r\n/MediaBox [ 0 0 %.2f %.2f ]\r\n"
                   "/Contents %d 0 R\r\n>>\r\nendobj\r\n";

   nObj     =  hb_parnl( 1 );
   nDocLen  += fprintf( fp, format, nObj+1, nObj+2, hb_parnd( 2 ), hb_parnd( 3 ), nObj+3 );

   hb_retnl( nDocLen );
}

HB_FUNC_STATIC( PGPART2 ) // ( nObject, nPage, nImageAt )
{
   char * format = "%d 0 obj\r\n<<\r\n/ColorSpace << /DeviceRGB /DeviceGray >>\r\n"
                   "/ProcSet [ /PDF /Text /ImageB /ImageC ]\r\n/XObject\r\n<<"
                   "\r\n/Image%d %d 0 R\r\n>>\r\n>>\r\nendobj\r\n";

   nDocLen  += fprintf( fp, format, hb_parnl( 1 ), hb_parnl( 2 ), hb_parnl( 3 ) );
   hb_retnl( nDocLen );
}

HB_FUNC_STATIC( PGPART3 ) // ( nObject, nPageWidth, nPageHeight, nPage )
{
   LONG nObj;

   nObj     =  hb_parnl( 1 );
   nDocLen  += fprintf( fp, "%d 0 obj << /Length %d 0 R \r\n\r\n>>\r\nstream\r\n",
                        nObj, nObj + 1 );
   iBufLen  =  fprintf( fp,
                        "\r\nq\r\n%.1f 0 0 %.1f 0 0 cm\r\n/Image%d Do\r\nQ \r\nendstream\r\nendobj\r\n",
                        hb_parnd( 2 ), hb_parnd( 3 ), hb_parnl( 4 ) );
   nDocLen  += iBufLen;
   iBufLen  -= 21;

   hb_retnl( nDocLen );
}

HB_FUNC_STATIC( PGPART4 ) // ( nObj, nBufLen )
{
   char * format = "%d 0 obj\r\n%d\r\nendobj\r\n";

   nDocLen  += fprintf( fp, format, hb_parnl( 1 ), iBufLen );
   hb_retnl( nDocLen );
}

HB_FUNC_STATIC( PGJPEG1 ) // ( nImageAt, nPage, nJpegWidth, nJpegHeight, cJpegBuf )
{

   LONG nBufSize = hb_parclen( 5 );
   char * format = "%d 0 obj\r\n<<\r\n/Type /XObject\r\n/Subtype /Image\r\n/Name /Image%d\r\n"
              "/Filter [ /DCTDecode ]\r\n/Width %d\r\n/Height %d\r\n/BitsPerComponent 8\r\n"
              "/ColorSpace/DeviceRGB\r\n/Length %d\r\n>>\r\nstream\r\n";

   nDocLen  += fprintf( fp, format, hb_parnl( 1 ), hb_parnl( 2 ), hb_parnl( 3 ), hb_parnl( 4 ), nBufSize );
   nDocLen  += fwrite( hb_parcx( 5 ), sizeof( char ), nBufSize, fp );
   nDocLen  += fprintf( fp, "endstream\r\nendobj\r\n" );
   hb_retnl( nDocLen );
}

HB_FUNC_STATIC( PDFCLOSE1 ) // ( nPages, cKids )
{
   char * format = "1 0 obj\r\n<<\r\n/Type /Pages /Count %d\r\n/Kids [%s ]\r\n>>\r\nendobj\r\n";

   nDocLen  += fprintf( fp, format, hb_parnl( 1 ), hb_parcx( 2 ) );
   hb_retnl( nDocLen );
}

HB_FUNC_STATIC( PDFCLOSE2 ) // ( nObj, cDateTime )
{
   char * format = "%d 0 obj\r\n<< /Title ()\r\n/Producer ()\r\n/Author ()\r\n/Creator ()\r\n"
           "/Subject ()\r\n/Keywords ()\r\n/CreationDate (D:%s)\r\n>>\r\nendobj\r\n";

   nDocLen  += fprintf( fp, format, hb_parnl( 1 ), hb_parcx( 2 ) );
   hb_retnl( nDocLen );
}

HB_FUNC_STATIC( PDFCLOSE3 ) // ( nObject )
{
   char * format = "%d 0 obj\r\n<< /Type /Catalog /Pages 1 0 R /Outlines %d 0 R >>\r\nendobj\r\n";
   LONG nObject = hb_parnl( 1 );

   nDocLen  += fprintf( fp, format, nObject, nObject + 1 );
   hb_retnl( nDocLen );
}

HB_FUNC_STATIC( PDFCLOSE4 ) // ( nObj, aRefs )
{

   long nRefs, nLen;
   int n;
   LONG nObj = hb_parnl( 1 );

   nDocLen  += fprintf( fp, "%d 0 obj\r\n<< /Type /Outlines /Count 0 >>\r\nendobj\r\n\r\n", hb_parnl( 1 ) );
   // This is the final Document Length to be written at the end of file

   nRefs    =  hb_parinfa( 2, 0 );
   nLen     = fprintf( fp, "xref\r\n0 %d\r\n", nObj + 1 );

   nLen     += fprintf( fp, "%010d 65535 f\r\n", hb_parvnl( 2, 1 ) );
   for ( n = 2; n <= nRefs; n++ )
   {
      nLen  += fprintf( fp, "%010d 00000 n\r\n", hb_parvnl( 2, n ) );
   }

   nLen     += fprintf( fp,
            "trailer << /Size %d /Root %d 0 R /Info %d 0 R >>\r\nstartxref\r\n%d\r\n%s\r\n",
            nObj + 1, nObj - 1, nObj - 2, nDocLen, "%%EOF" );

   nDocLen  += nLen;
   fclose( fp );
   fp       = NULL;

   hb_retnl( nDocLen );
}

#pragma ENDDUMP