HMGforum.com

Code: Select all

#include <hmg.ch>
#include "fileio.ch"

Function Main()
   dbCreate( "Clientes", { { "CODE", "C", 16, 0 }, { "TITLE", "C", 80, 0 }, { "PRICE", "N", 9, 2 } }, , .T., "Ctes" )
   dbAppend()
   Ctes->CODE  := "0001"
   Ctes->TITLE := "El Título   áéíóú"
   Ctes->PRICE := 123.45
   
   DEFINE WINDOW FORM_1 AT 0,0 WIDTH 500 HEIGHT 300 MAIN TITLE "HMG Report Writer"
   
      @ 050,100 BUTTON Button_1 CAPTION "Make Report" ACTION ImpClientes()
            
   END WINDOW
   
   CENTER WINDOW Form_1
   ACTIVATE WINDOW Form_1
Return Nil

FUNCTION ImpClientes()
   LOCAL CRaiz   := HB_CurDrive()+':\'+CurDir()+'\'
   
   cpso1:= "[ La Empresa ] "
   cpso2:= "Periodo del:  [  ]"
   cpso3:= cRaiz+'LOGOPSO.JPG'
   
   CreateReportCtes( cpso1, cpso2, cpso3, cRaiz+'LOGOPSO.JPG' )
   *MSGINFO( "En la siguiente pantalla de PREVIEW, si le damos Guardar como .PDF," + HB_OsNewLine() + " no guarda nada en el contenido del archivo" )
   MSGINFO( "In the next screen PREVIEW, if we give save as .PDF," + HB_OsNewLine () + "does not save anything in the file contents")
   
   ExecuteReport('Clientes1',.t.,.f. )
   *MSGINFO( "El mismo archivo anterior generado directamente como .PDF,"  + HB_OsNewLine() + ;
   *       "no despliega la imagen ni los acentos," + HB_OsNewLine() + ;
   *       "y en el texto no despliega las diagonales... " )
   MSGINFO("Same old file, generated directly as .PDF," + HB_OsNewLine () +;
         "does not display the image or accents," + HB_OsNewLine () +;
         "and the text does not display diagonal ...")

//<amarante>
/*
   ExecuteReport('Clientes1',.t.,.t., cRaiz+"xxx.pdf" )
   SHELLEXECUTE( 0, "open" , "AcroRd32.exe", 'xxx.pdf' )
*/
Run_MyProcess( CRaiz + [SumatraPDF.exe "] + cRaiz + [Clientes.pdf"], .t. )
//<amarante>
   
RETURN( Nil )

//------------------------------------------------------------------------------
Function CreateReportCtes( cpso1, cpso2, clogo )
   *msginfo(cpso2)
    DEFINE REPORT Clientes1

        * Report Layout ***********************************************
        BEGIN LAYOUT
            PAPERSIZE    PRINTER_PAPER_LETTER
            ORIENTATION  PRINTER_ORIENT_PORTRAIT
        END LAYOUT
        * Header Band *************************************************
        BEGIN HEADER
            BANDHEIGHT        25
            BEGIN LINE
                FROMROW 23 ; FROMCOL 10 ; TOROW 23 ; TOCOL 200 ; PENWIDTH 0.1 ; PENCOLOR BLACK
            END LINE
            BEGIN TEXT
                EXPRESSION    'REPORTE DE CLIENTES  '
                ROW 7 ; COL 10 ; WIDTH 100 ; HEIGHT 20 ; FONTNAME 'Helvetica' ; FONTSIZE 13 ; FONTCOLOR BLUE ; ALIGNMENT Left
            END TEXT
            BEGIN TEXT
                EXPRESSION    cpso1
                ROW 12  ; COL 10 ; WIDTH 100 ; HEIGHT 15 ; FONTNAME 'Helvetica' ; FONTSIZE 11 ; FONTBOLD .F.
                FONTITALIC .T. ; FONTUNDERLINE .F. ; FONTSTRIKEOUT .F. ; FONTCOLOR BLACK ; ALIGNMENT Left
            END TEXT
            BEGIN TEXT
                EXPRESSION    cpso2
                ROW 17  ; COL 10 ; WIDTH 100 ; HEIGHT 15 ; FONTNAME 'Helvetica' ; FONTSIZE 11 ; FONTBOLD .F.
                FONTITALIC .T. ; FONTUNDERLINE .F. ; FONTSTRIKEOUT .F. ; FONTCOLOR BLACK ; ALIGNMENT Left
            END TEXT
            BEGIN TEXT
                EXPRESSION    cpso3
                ROW 17  ; COL 80 ; WIDTH 100 ; HEIGHT 15 ; FONTNAME 'Helvetica' ; FONTSIZE 11 ; FONTBOLD .T.
                FONTITALIC .T. ; FONTUNDERLINE .F. ; FONTSTRIKEOUT .F. ; FONTCOLOR RED ; ALIGNMENT Left
            END TEXT         
            BEGIN PICTURE
                VALUE clogo ; ROW 5 ; COL 160 ; WIDTH 47 ; HEIGHT 16 ; STRETCH .T.
                *VALUE cpso3 ; ROW 5 ; COL 160 ; WIDTH 47 ; HEIGHT 16 ; STRETCH .T.
            END PICTURE
        END HEADER
        * Detail Band *************************************************
        BEGIN DETAIL
            BANDHEIGHT        6
            BEGIN TEXT
                EXPRESSION   Ctes->CODE
                ROW 2 ; COL 10 ; WIDTH 20 ; HEIGHT 10 ; FONTNAME 'Helvetica' ; FONTSIZE 9 ; FONTBOLD .F.
                FONTITALIC .F. ; FONTUNDERLINE .F. ; FONTSTRIKEOUT .F. ; FONTCOLOR BLACK ; ALIGNMENT Left
            END TEXT
            BEGIN TEXT
                EXPRESSION   Ctes->TITLE
                ROW 2 ; COL 25 ; WIDTH 60 ; HEIGHT 10 ; FONTNAME 'Helvetica' ; FONTSIZE 9 ; FONTBOLD .T.
                FONTITALIC .F. ; FONTUNDERLINE .F. ; FONTSTRIKEOUT .F. ; FONTCOLOR RED ; ALIGNMENT Left
            END TEXT
            BEGIN TEXT
                EXPRESSION   Ctes->PRICE
                ROW 2 ; COL 65 ; WIDTH 20 ; HEIGHT 10 ; FONTNAME 'Helvetica' ; FONTSIZE 9 ; FONTBOLD .F.
                FONTITALIC .F. ; FONTUNDERLINE .F. ; FONTSTRIKEOUT .F. ; FONTCOLOR BLACK ; ALIGNMENT Left
            END TEXT         
        END DETAIL
        * Footer Band *************************************************
        BEGIN FOOTER
            BANDHEIGHT        27
            BEGIN LINE
                FROMROW 4 ; FROMCOL 10 ; TOROW 4 ; TOCOL 200 ; PENWIDTH 0.1 ; PENCOLOR BLACK
            END LINE
            BEGIN TEXT
                EXPRESSION    'Página #: '
                ROW 7 ; COL 11 ; WIDTH 100 ; HEIGHT 10 ; FONTNAME 'Helvetica' ; FONTSIZE 12 ; FONTBOLD .F.
                FONTITALIC .F. ; FONTUNDERLINE .F. ; FONTSTRIKEOUT .F. ; FONTCOLOR BLACK ; ALIGNMENT Left
            END TEXT
            BEGIN TEXT
                EXPRESSION    Date()
                ROW 7 ; COL 177 ; WIDTH 30 ; HEIGHT 10 ; FONTNAME 'Helvetica' ; FONTSIZE 12 ; FONTBOLD .F.
                FONTITALIC .F. ; FONTUNDERLINE .F. ; FONTSTRIKEOUT .F. ; FONTCOLOR BLACK ; ALIGNMENT Left
            END TEXT
        END FOOTER
        * Summary Band ************************************************
        BEGIN SUMMARY
            BANDHEIGHT        50
            BEGIN TEXT
                EXPRESSION    'Total Registros: '
                ROW 10 ; COL 20 ; WIDTH 100 ; HEIGHT 30 ; FONTNAME 'Helvetica' ; FONTSIZE 12 ; FONTBOLD .T.
                FONTITALIC .F. ; FONTUNDERLINE .F. ; FONTSTRIKEOUT .F. ; FONTCOLOR BLACK ; ALIGNMENT Left
            END TEXT
        END SUMMARY
    END REPORT
   *msgdebug(_HMG_SYSDATA[434])
   *msgdebug(_HMG_SYSDATA[116])
Return


/**
*
* Run_MyProcess
*
* Description: Executes an external process
* Syntax.....: Run_MyProcess( <expC1>, [expL1], [expB1], [expN1], [expN2] )
* Parameters.: <expC1> - Expression of process running
*              [expL1] - Wait on process (default .T.)
*              [expB1] - Block-function to be performed during the process
*              [expN1] - Time (default 1)
*              [expN2] - Number of times to perform the block-function (default 0)
* Return.....: expN - Result of the process
* Example....:
*   Run_MyProcess( "SumatraPDF.exe " + "Certidao.PDF", .T. )
*   ------ other sample -----
*   hb_memowrit( "test.txt", "Test File..." )
*   ? "Retorno:", Run_MyProcess( "notepad test.txt", .T., { || QOUT( "Waiting Notepad close..." ) }, 1 )
*   WAIT "When you get here notepad already ended. press ENTER..."
*   ? "Retorno:", Run_MyProcess( "notepad test.txt", .F. )
*   WAIT "When you get here notepad is still running. press ENTER..."
*   ? "Retorno:", Run_MyProcess( "notepad test.txt",, { | nCtd | QOUT( "Waiting Notepad close (" + hb_ntos( 5 - nCtd ) + ")..." ) },, 5 )
*   WAIT "The Loop was closed after in 5 seconds..."
*   ? "Retorno:", Run_MyProcess( "notepad test.txt",, { | nCtd | QOUT( "Forcing the closure of Notepad by returning the codeblock..." ), IIF( nCtd = 2, .F., .T. ) } )
*   WAIT "The Loop was closed..."
*
*/
FUNCTION Run_MyProcess( cExecute, lWait, bBlock, nTime, nOccurs )

  #define LWA_ALPHA    0x02

  LOCAL cWin_ := _HMG_SYSDATA[ 316 ]                      // Name of the current window
  LOCAL hProcess
  LOCAL nCtd := 0
  LOCAL nResult
  LOCAL lRet

  __DefaultNIL( @lWait, .T. )
  __DefaultNIL( @nTime, 1 )
  __DefaultNIL( @nOccurs, 0 )

  hProcess := HB_ProcessOpen( cExecute )
  IF hProcess <> F_ERROR
    SetLayeredWindowAttributes( GetFormHandle( cWin_ ), 0, 180, LWA_ALPHA )
    DO WHILE ( nResult := HB_ProcessValue( hProcess, .F. ) ) == - 1
      DO EVENTS
      IF .NOT. lWait
        EXIT
      ENDIF
      nCtd += 1
      IF HB_IsBlock( bBlock )
        lRet := EVAL( bBlock, nCtd )
        IF HB_IsLogical( lRet ) .AND. .NOT. lRet
          HB_ProcessClose( hProcess, .T. )
          EXIT
        ENDIF
      ENDIF
      IF nTime > 0
        HB_IdleSleep( nTime )
      ENDIF
      IF nCtd == nOccurs
        HB_ProcessClose( hProcess, .T. )
        EXIT
      ENDIF
    ENDDO
    SetLayeredWindowAttributes( GetFormHandle( cWin_ ), 0, 255, LWA_ALPHA )
  ELSE
    MsgInfo( "Error Open Process" )
  ENDIF
  RETURN nResult