CODIGO QR EN DOCUMENTO CON TPRINTER

[kpidata]

Estimados amigos hace mucho que no escribia al foro, pero el tiempo y la necesidad me lleva a consultar un tema,, que me supera, me están pidiendo que genere un documento en la clase tprinter, al pie coloque un codigo QR, que identifique la fecha y el numero de documento realizado, pero por mas que he buscado no encuentro información de ayuda, favor alguien tiene alguna idea

[Antonio Linares]

https://forums.fivetechsupport.com/view ... hp?t=43100

[karinha]

Directo en el .BMP:

Code: Select all | Expand

// Our first DialogBox sample

#include "FiveWin.ch"
#include "ttitle.ch"

#define HTTPREQUEST_PROXYSETTING_PROXY 2

// Para xHarbour

#ifdef __XHARBOUR__
#xtranslate hb_DateTime([<x,...>]) => DateTime(<x>)
#xtranslate hb_tstostr([<x>]) => TToS(<x>)
#xtranslate hb_stot([<x>]) => SToT(<x>)
#xtranslate hb_ttod([<x>]) => TToD(<x>)
#xtranslate hb_hour([<x>]) => Hour(<x>)
#xtranslate hb_minute([<x>]) => Minute(<x>)
#xtranslate hb_sec([<x>]) => Secs(<x>)
#xtranslate hb_NumToHex([<x>]) => NumToHex(<x>)
#xtranslate hb_StrFormat([<x,...>]) => StrFormat(<x>)
#xtranslate <x>:__EnumIndex => hb_EnumIndex
#endif

MEMVAR SEQUENC

FUNCTION Main()

   LOCAL obmp , cBmp
   LOCAL oDlg, oIco
   LOCAL ofont
   LOCAL cCode := space( 440 ) // maximo de 440 caracteres por qrcode.

   // Master Mastintin: con 431 caracteres el formato es invalido, porque?
   // Que me falta? Prueba porfa
   SEQUENC := "35141146377222003730599000004630001158179941|20141105134922|10.00|61694805808|m+4o8FY1lig1zcy6VU3t7INVwE6kiA/ykLXKDFZfb9gu0g4wl3Fk2HYaRhSt8G+yk9mP/R65m3R7V2IO8CxnmO1oVtlamB6UKA+UZZqDNEqtYlhQzLySNzMG0thaNMZsq5RxmQ3eQLPw8LLez3MqWvUveFXNSSq6AGEX2+KOdavteo3K2L06SQoVIjwkmcgRzqhfHP3y8t2wfr1nw/WAnaCF9ZY/K4dTykk3hsXcan/MKCTBlcSOhNgSh3sdsQHpl2w2tmbLBsYBLFkuvKlwzHarNJQ1RfRznGdojHglQH1KVtbAUXKke54pdRt3JL7nJlR+Lbmtd2tjcT2vRyTepw=="

   cCode := ALLTRIM( SEQUENC )

   DEFINE Font ofont NAME "Verdana" SIZE 0, 14

   DEFINE ICON oIco FILE "..\icons\fivewin.ico"

   DEFINE DIALOG oDlg TITLE "AdaptaPro Qrcode Generator" ;
      ICON oIco SIZE 350, 440

   @ 30, 24 IMAGE oBmp FILE cBmp OF oDlg size 128, 128 pixel NOBORDER

   oBmp:lTransparent := .T.

   // cargaBmp( "hola",oBmp )

   @ 160, 10 SAY "Introduce el codigo a generar :" size 100, 12 ;
      FONT oFont pixel OF oDlg

   @ 170, 10 GET cCode size 120, 12 FONT oFont pixel OF oDlg MEMO

   @ 205, 85 BUTTON "&Buscar" SIZE 40, 12 OF oDlg pixel ;
      FONT oFont ;
      ACTION cargaBmp( alltrim( cCode ) , oBmp )

   @ 205, 130 BUTTON "&Salir" SIZE 40, 12 pixel OF oDlg;
      FONT oFont ;
      ACTION oDlg:End()

   ACTIVATE DIALOG oDlg CENTERED ;
      ON INIT DlgBarTitle( oDlg, " Generador de Qrcode", "" , 44 ) ;
      ON PAINT DlgStatusBar( oDlg, 68, , .T. )

RETURN nil

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

FUNCTION cargaBmp( cCode, oImage )

   LOCAL cResp, hDib
   LOCAL nZeroZeroClr
   LOCAL ogbmp := GdiBmp():new()
   LOCAL nHeight := 248
   LOCAL nWidth := 248
   LOCAL cUrl := "http://api.qrserver.com/v1/create-qr-code/?data="
   LOCAL nQuality := 1

   cUrl += GetSafeURL( hb_strtoutf8( cCode ) )
   cUrl += "&size=" + alltrim( str( nWidth ) ) + "x" + alltrim( str( nHeight ) )

   cResp := loadBmp( cUrl )

   IF !Empty( cResp )

      oGbmp:hbmp := GDIPLUSIMAGELOADPNGFROMSTR( cResp, len( cResp ) )

      oImage:hBitmap := oGBmp:GetGDIHbitmap()
      oImage:HasAlpha()
      oImage:Refresh()

      IF msgYesNo( " ¨ quiere grabar el codigo QR a Disco ?" )


         // oGBmp:save(".\qrcode.png" ) // FORMATO INVALIDO ?
         oImage:SaveImage( "qrcode.bmp", 0, nQuality )

      ENDIF

      oGbmp:End()

   ENDIF

   RETURN nil

STATIC FUNCTION GetSafeURL( cUrl )

   LOCAL cAsc
   LOCAL nChr
   LOCAL sHex
   LOCAL i
   LOCAL cGetSafeURL := ""

   FOR i = 1 TO Len( cUrl )
      cASC := substr( cUrl, i, 1 )
      nChr := Asc( cASC )

      IF ( nChr > 47 .AND. nChr < 58 ) .OR. ( nChr > 64 .AND. nChr < 91 ) .OR. ( nChr > 96 .AND. nChr < 123 )
         cGetSafeURL += cASC
      ELSE
         sHex := hb_NumtoHex( nChr )
         IF Len( sHex ) = 1
            cGetSafeURL += "%0" + sHex
         ELSE
            cGetSafeURL += "%" + sHex
         End IF
      End IF
   NEXT

RETURN cGetSafeURL

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

FUNCTION loadBmp( cUrl )

   LOCAL oHttp
   LOCAL cResp := nil

// Try
   oHttp := CreateObject( "winhttp.winhttprequest.5.1" )

   oHttp:Open( "GET", cUrl, .F. )
   oHttp:Send()
   cResp := oHttp:ResponseBody()

// Catch
// MsgStop( "Error" )
// Return cResp
// End Try

RETURN cResp

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

FUNCTION DlgStatusBar( oDlg, nHeight, nCorrec , lColor )

   LOCAL nDlgHeight := oDlg:nHeight
   LOCAL aColor := { { 0.40, nRGB( 200, 200, 200 ), nRGB( 184, 184, 184 ) }, ;
      { 0.60, nRGB( 184, 184, 184 ), nRGB( 150, 150, 150 ) } }

   DEFAULT nHeight := 72
   DEFAULT nCorrec := 0
   DEFAULT lColor := .F.

   nDlgHeight := nDlgHeight + ncorrec

   IF lColor
      GradienTfill( oDlg:hDC, nDlgHeight - ( nHeight - 2 ), 0, nDlgHeight - 20, oDlg:nWidth, aColor , .T. )
      WndBoxIn( oDlg:hDc, nDlgHeight - ( nHeight - 1 ), 0, nDlgHeight - ( nHeight ), oDlg:nWidth )
   ELSE
      WndBoxIn( oDlg:hDc, nDlgHeight - ( nHeight - 1 ), 4, nDlgHeight - ( nHeight ), oDlg:nWidth - 10 )
   ENDIF

RETURN Nil

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

FUNCTION DlgBarTitle( oWnd, cTitle, cBmp , nHeight )

   LOCAL oFont
   LOCAL oTitle
   LOCAL nColText := 180
   LOCAL nRowImg := 0

   DEFAULT cTitle := ""
   DEFAULT nHeight := 48

   IF nHeight < 48
      nColText := 60
      nRowImg := 12
      DEFINE FONT oFont NAME "Arial" size 10, 30
   ELSE
      DEFINE FONT oFont NAME "Arial" size 12, 30
   ENDIF

   @ - 1, - 1 TITLE oTitle size oWnd:nWidth + 1, nHeight + 1 of oWnd SHADOWSIZE 0

   @ nRowImg, 10 TITLEIMG OF oTitle BITMAP cBmp SIZE 48, 48 REFLEX ;
      TRANSPARENT

   @ nRowImg - 2 , nColText TITLETEXT OF oTitle TEXT cTitle COLOR CLR_BLACK FONT oFont

   oTitle:aGrdBack := { { 1, RGB( 255, 255, 255 ), RGB( 229, 233, 238 ) } }
   oTitle:nShadowIntensity = 0
   oTitle:nShadow = 0
   oTitle:nClrLine1 := nrgb( 0, 0, 0 )
   oTitle:nClrLine2 := RGB( 229, 233, 238 )
   oWnd:oTop := oTitle

RETURN oTitle

Regards, saludos.

[FiveWiDi]

Hola,

Yo lo hago así.

En el inicio del PRG:

// Para usar QR precisa de "REQUEST FWZEBRA"
REQUEST FWZEBRA


Donde corresponda de tu código para imprimir el documento:

@ 1.0, 8.75 PRINT TO oPrinter TEXT ;
"Texto que contiene los valores que deseas" ;
AS BARCODE TYPE "QR-CODE" SIZE 3.5, 3.5 CM // 0.5, 0.5 INCHES

[sysctrl2]

Alguien tiene compilada la lib zebra para xharbour?
gracias !

[karinha]

Code: Select all | Expand

Pasta de c:\XHBBCC77\lib

09/10/2024  10:55            53.248 hbzebra.lib

Regards, saludos.

[Cesar_SCS]

Como siempre Joao es usted muy amable,
voy a probar
gracias !

[sysctrl2]

TESTQR.PRG/tPrinter

//oPrn:Say()

Code: Select all | Expand

#INCLUDE <fivewin.ch>

STATIC oPrn
STATIC nRow
STATIC nRowStep
STATIC nColStep
STATIC nWidthPage := 80
STATIC nHightPage := 66

FUNCTION Main()
   LOCAL cCia := "SysCtrl Software"
   LOCAL cCalle := "CERRA CORAL SN"
   LOCAL cColonia := "RESIDENCIAL DEL NORTE"
   LOCAL cLocalidad := "CDMX"
   LOCAL cUrl := "sysctrl.com.mx"
   LOCAL oFont,oFontBig, oPen

   nRow := 1

   PRINTER oPrn PREVIEW NAME 'SysCtrl Report'

   oPrn:lPrvModal := .t.
   oPrn:SetPage(1)  // carta
   oPrn:SetPortrait()

   if ! oPrn:setup()
      return nil
   endif

   DEFINE FONT oFont NAME "TAHOME" SIZE 0, -20   OF oPrn BOLD
   DEFINE FONT oFontBig NAME "TAHOME" SIZE 0, -28   OF oPrn BOLD
   DEFINE PEN  oPen COLOR CLR_BLACK OF oPrn

   nRowStep := oPrn:nVertRes() / nHightPage
   nColStep := oPrn:nHorzRes() / nWidthPage

   IF Empty( oPrn:hDC )
      oPrn:end()
      MSGINFO( "No hay impresoras instaladas...", "Usuario ..." )
      RETURN NIL
   ENDIF
   PAGE

   nRow += nRowStep * 2

   SayQR(cUrl, oPrn, nRow, nColStep*10, 4,4,"PIXEL", "QR-CODE" )

   oPrn:Say( nRow, nColStep * (5+(nWidthPage/2)-(Len( cCia )/2)), cCia, oFontBig )
   nRow += nRowStep * 4
   oPrn:Say( nRow, nColStep * (5+(nWidthPage/2)-(Len( cCalle )/2)), cCalle, oFont )
   nRow += nRowStep * 2
   oPrn:Say( nRow, nColStep * (5+(nWidthPage/2)-(Len( cColonia )/2)), cColonia, oFont )
   nRow += nRowStep * 2
   oPrn:Say( nRow, nColStep * (5+(nWidthPage/2)-(Len( cLocalidad )/2)), cLocalidad, oFont )
   nRow += nRowStep * 3
   oPrn:Line( nRow, nColStep*1, nRow , nColStep * (nWidthPage-1), oPen )
  nRow += nRowStep*.5

   ENDPAGE
   ENDPRINT

RETURN (.T.)

FUNCTION SayQR( cText, oPrn, nRow, nCol, nAncho, nAlto, cUnits, cType )
   LOCAL aTam := oPrn:Cmtr2Pix(nAncho,nAlto)
   oPrn:PrintBarcode( cText, nRow, nCol, aTam[1], aTam[2], cUnits, cType )
RETURN NIL

INIT PROCEDURE Setup()
   REQUEST FWZEBRA //codigos de barra o QR tipo zebra
RETURN

[Antonio Linares]

Querido César,

Muchas gracias!

[karinha]

Excelente César.

Code: Select all | Expand

// https://forums.fivetechsupport.com/viewtopic.php?p=276837#p276837

// C:\FWH\SAMPLES\QRCODE4.PRG

#Include "fivewin.ch"

STATIC oPrn, nRow, nRowStep, nColStep
STATIC nWidthPage := 80
STATIC nHightPage := 66

FUNCTION Main()

   LOCAL cCia       := "SysCtrl Software"
   LOCAL cCalle     := "CERRA CORAL SN"
   LOCAL cColonia   := "RESIDENCIAL DEL NORTE"
   LOCAL cLocalidad := "CDMX"
   LOCAL cUrl       := "sysctrl.com.mx"
   LOCAL oFont, oFontBig, oPen

   nRow := 1

   PRINTER oPrn PREVIEW NAME 'SysCtrl Report'

      oPrn:lPrvModal := .t.
      oPrn:SetPage(1)  // carta
      oPrn:SetPortrait()

      IF .NOT. oPrn:Setup()

         RETURN NIL

      ENDIF

      DEFINE FONT oFont NAME "TAHOME" SIZE 0, -20    OF oPrn BOLD
      DEFINE FONT oFontBig NAME "TAHOME" SIZE 0, -28 OF oPrn BOLD
      DEFINE PEN  oPen COLOR CLR_BLACK OF oPrn

      nRowStep := oPrn:nVertRes() / nHightPage
      nColStep := oPrn:nHorzRes() / nWidthPage

      IF Empty( oPrn:hDC )

         oPrn:end()

         MSGINFO( "No hay impresoras instaladas...", "Usuario ..." )

         RETURN NIL

      ENDIF

      PAGE

         nRow += nRowStep * 2

         SayQR(cUrl, oPrn, nRow, nColStep*10, 4,4,"PIXEL", "QR-CODE" )

         oPrn:Say( nRow, nColStep * (5+(nWidthPage/2)-(Len( cCia )/2)), cCia, oFontBig )

         nRow += nRowStep * 4

         oPrn:Say( nRow, nColStep * (5+(nWidthPage/2)-(Len( cCalle )/2)), cCalle, oFont )

         nRow += nRowStep * 2

         oPrn:Say( nRow, nColStep * (5+(nWidthPage/2)-(Len( cColonia )/2)), cColonia, oFont )

         nRow += nRowStep * 2

         oPrn:Say( nRow, nColStep * (5+(nWidthPage/2)-(Len( cLocalidad )/2)), cLocalidad, oFont )

         nRow += nRowStep * 3

         oPrn:Line( nRow, nColStep*1, nRow , nColStep * (nWidthPage-1), oPen )

         nRow += nRowStep*.5

      ENDPAGE

   ENDPRINT

   oFont:End()
   oFontBig:End()
   oPen:End()

RETURN NIL // (.T.)

FUNCTION SayQR( cText, oPrn, nRow, nCol, nAncho, nAlto, cUnits, cType )

   LOCAL aTam := oPrn:Cmtr2Pix(nAncho,nAlto)

   oPrn:PrintBarcode( cText, nRow, nCol, aTam[1], aTam[2], cUnits, cType )

RETURN NIL

INIT PROCEDURE Setup()

   REQUEST FWZEBRA // codigos de barra o QR tipo zebra

RETURN

// FIN / END

Regards, saludos.

[sysctrl2]

A la orden amigos
que 2025 sea productivo