Imprimir Codigos QR

[remtec]

Amigos buen dia, un Feliz y exito año 2022.

Tengo la necesidad de imprimir codigos QR.

La consulta es, se puede realizar con FWH 17.09 y Harbour, de poderse algun ejemplo?

Muchos Saludos.

Antonio.

[karinha]

Si, use HBZEBRA.LIB haga una busqueda en el foro, porfa.

http://forums.fivetechsupport.com/viewtopic.php?f=6&t=40111&p=239345&hilit=CLASS+TCodeBars&sid=c8d47dad6baaffdc8bd2abbc58a44c7b&sid=43b16eb12f4a32b1d2b22be33532b7a8#p239345

Regards, saludos.

[cmsoft]

Tienes 2 maneras de hacerlo, una como bien te dice Jao con la libreria hbzebra de la cual hay mucha info en el foro.
La otra es con la dll QRCodelib.Dll, que te genera el QR en un archivo de imagen
Te paso el ejemplo con la libreria.

Code: Select all  Expand view

QRCode("http://forums.fivetechsupport.com/viewtopic.php?f=6&t=41301&sid=b582c65aae64bb65b43ee074709255ee","qrfivewin.jpg")

DLL32 STATIC FUNCTION QRCode(cStr As STRING, cFile As STRING) AS LONG PASCAL ;
FROM "FastQRCode" LIB "QRCodelib.Dll"
RETURN NIL
// Estas funciones son necesarias
// Extraídas del foro fivewin de Brasil
FUNCTION StrToBase64( cTexte )
  //******************
// Conversion en base 64 de la chaine cTexte
// Un alphabet de 65 caractères est utilisé pour permettre la représentation de 6 bits par caractère :
// "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
// Le '=' (65e caractère) est utilisé dans le processus de codage pour les caractères finaux.
   LOCAL cTexte64 := ""
   LOCAL X
   LOCAL cHex
   DO WHILE !( cTexte == "" )
      cHex := ""
      // Le processus de codage représente des groupes de 24 bits de données en entrée par une chaîne en sortie de 4 caractères codés.
      // En procédant de gauche à droite, un groupe de 24 bits est créé en concaténant 3 octets (8 bits par octet).
      FOR X := 1 TO 3
         // Conversion de chaque caractère en chaine binaire de 8 octets
         cHex += CarToBin( LEFT( cTexte, 1 ) )
         IF LEN( cTexte ) > 1
            cTexte := SUBSTR( cTexte, 2 )
         ELSE
            cTexte := ""
            EXIT
         ENDIF
      NEXT X
      // Ces 24 bits (ici contenus dans cHex, ou au moins un multiple) sont traités comme 4 groupes concaténés de 6 bits chacun convertis
      // en un unique caractère dans l'alphabet de la base 64.
      // Chaque groupe de 6 bits est utilisé comme index dans la table des caractères de la base 64.
      // Le caractère référencé par l'index correspondant est utilisé comme codage de ce groupe de 6 bits.
      FOR X := 1 TO 4
         IF SUBSTR( cHex, ( (X - 1 ) * 6 ) + 1 ) == ""
            cTexte64 += REPLICATE( "=", 4 - X + 1 )
            EXIT
         ELSE
            // Un traitement spécial est effectué si moins de 24 bits sont disponibles à la fin des données
            // à coder. Aucun bit ne restant non-codé,
            // si moins de 24 bits sont disponibles alors des bits à zéro sont ajoutés à la droite des données
            // pour former un nombre entier de groupes de 6 bits.
            IF LEN( cHex ) % 6 > 0
               // Ajout des bits à zéro
               cHex += REPLICATE( "0", 6 - ( LEN( cHex ) % 6 ) )
            ENDIF
            cTexte64 += Carac64( "00" + SUBSTR( cHex, ( (X - 1 ) * 6 ) + 1, 6 ) )
         ENDIF
      NEXT X
   ENDDO
RETURN cTexte64


FUNCTION Carac64( cBin )
  //***************
// Renvoie le caractère correspondant en base 64
   LOCAL nPos := ASC( BinToCar( @cBin ) ) + 1
RETURN SUBSTR( "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", nPos, 1 )
FUNCTION Hex64( carac64 )
  //*************
// Renvoie le caractère correspondant en base 64
   LOCAL cCodeAsc := CHR( AT( carac64, "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" ) - 1 )
RETURN SUBSTR( CarToBin( @cCodeAsc ) , 3, 6 )

FUNCTION CarToBin( carac, lInverse )
  //****************
// Renvoie le caractère correspondant dans une chaine binaire (composée de 0 et 1) de 8 bits
#define cHexa "0123456789ABCDEF"
#define aBin {"0000", "0001", "0010", "0011", "0100", "0101", "0110", "0111", "1000", "1001", "1010", "1011", "1100", "1101", "1110", "1111" }
   LOCAL cToHex
   IF EMPTY( lInverse )
      // Retourne la chaine binaire en ayant reçu le caractère ASCII
      cToHex := str2Hex( carac )
      RETURN aBin[ AT( LEFT(cToHex,1), cHexa ) ] + aBin[ AT( SUBSTR(cToHex,2), cHexa ) ]
   ELSE
      // Retourne le caractère ASCII en ayant reçu la chaine binaire
      cToHex := SUBSTR( cHexa, ASCAN( aBin, LEFT(carac,4 ) ), 1 ) + SUBSTR( cHexa, ASCAN( aBin, SUBSTR(carac,5,4 ) ), 1 )
      RETURN Hex2str( cToHex )
   ENDIF
RETURN NIL

FUNCTION BinToCar( cBin )
  //****************
RETURN CarToBin( @cBin, .T. )

 

[karinha]

Ejemplo completo by César, download completo, usando HBMK2.exe:

https://mega.nz/file/BAV10C4C#GA42Kq5Jdw7eqsjLZY9gtOWBn0jOTZa0Uv7OfHpG3MM

Código modificado:

Code: Select all  Expand view

// C:\QRCODE2\CMSOFTQR.PRG

#Include "FiveWin.ch"

FUNCTION Main()

   QRCode("http://forums.fivetechsupport.com/viewtopic.php?f=6&t=41301&sid=b582c65aae64bb65b43ee074709255ee","qrfivewin.jpg")

   MeuWinExec( "qrfivewin.jpg" )

RETURN NIL

FUNCTION MeuWinExec( cParametro )

   LOCAL cExecute := GetPvProfString( "" )

   // NT, 2000 e XP
   IF  IsWinNT() .OR. IsWin2000()

      cExecute := GetEnv( "COMSPEC" ) + " /C "

   ENDIF

RETURN WinExec( cExecute + cParametro, 0 )

DLL32 STATIC FUNCTION QRCode(cStr As STRING, cFile As STRING) AS LONG PASCAL ;
FROM "FastQRCode" LIB "QRCodelib.Dll"

// FIN / END
 

Regards, saludos.

[remtec]

Hola Karinha y Cesar.

Mil gracias por responder y facilitarme codigos.

Lo que habia leido en el foro era aplicable a versiones de FWH superiores a la 17.09.

Revisare si puedo adaptarlo a lo que necesito.

En este caso, debo imprimir un informe de un examen, el se me ha pedido que agregue un codigo QR, que permita validar que este informe corresponda a quien corresponda y pienso que al leer los datos que contiene QR, debiera mostrar los datos originales del informe.

Muchos saludos y mil gracias por su atencion.

Antonio

[cmsoft]

Antonio, el código que te pase funciona bien en mi FW 16.
Para imprimir, te dejo un link de otra consulta de este foro donde se muestra eso.
viewtopic.php?f=6&t=39859&hilit=qrcodelib.dll&start=15#p237864
Espero te sirva.
Saludos!

[acuellar]

Antonio

Con éste código no se necesita de LIB ni de DLL

Code: Select all  Expand view

#Include "Fivewin.ch"
#Include "Codebar.ch"

#define CODEBAR_QRCODE         14

STATIC oCode, oWnd, cCode

FUNCTION QrCode()
     Private oWnd
     
    oCode := TCodeBars():New(500,500)

     cCode := MemoRead( "D:\Sistemas\QR.TXT" )
   
      MsgWait( "Generando QRCODE... Vía archivo...", ;
               "Espere un momento... ", 2.5 )
   DEFINE WINDOW oWnd FROM -10, -10 TO -5, -5

   ACTIVATE WINDOW oWnd ON INIT( BuildCode( CODEBAR_QRCODE, cCode  ), oWnd:End() )

RETURN NIL
*
function BuildCode( nCode, cCode, nFlags )

   local oVent, oGbmp
   local hDC := oWnd:GetDC()
   local oPrn
   LOCAL hDib
   LOCAL hBmp := CreateCompatibleBitmap( hDC, 150, 50 )  // 150, 50
   LOCAL hOldBmp := SelectObject( hDC, hBmp )

   default nFlags := 0

   oCode:Reset()
   oCode:nHeightCode =  2   // altura  // 7.23 PAGINA CHEIA
   oCode:nWidthCode  =  2   // Largura // 7.23 PAGIAN CHEIA

   oCode:SetType( nCode )
   oCode:SetCode( cCode )
   oCode:SetFlags( nFlags )
   oCode:Build()
   DrawBitmap( hDC, oCode:hCodeBar, 500, 500 )  

   hDib := DibFromBitmap( oCode:hCodeBar )

   DibWrite( "TEMP.BMP" , hDib )

   oGbmp:= GDIBmp():new( "TEMP.BMP" )  
   oGBmp:Save( "D:\SISTEMAS\QRCODE.JPG" )    
   oGbmp:End()
   IF FILE( "TEMP.BMP" )
  *    FERASE( "TEMP.BMP" )
   ENDIF

   GloBalFree( hDib )
 
return nil  

// LA CLASE


CLASS TCodeBars
   
   DATA aTypes HIDDEN
   
   DATA cCode
   DATA nFlags
   
   DATA hCodeBar
   DATA hData
   
   DATA nType, nWidth, nHeight, nWidthCode, nHeightCode

   METHOD New()
   METHOD End()     INLINE  DeleteObject( ::hCodeBar ),  If( ::hData != NIL, hb_zebra_destroy( ::hData ), )
   
   METHOD DefError( nError )
   METHOD SetCode( cCode )
   METHOD SetFlags( nFlags )
   METHOD SetType( cnType )
   METHOD Reset()   INLINE ::End()
   METHOD Build()  
   METHOD Rebuild() INLINE ::Reset(), ::Build()
   
   
ENDCLASS
*
METHOD New( nWidth, nHeight, nWidthCode, nHeightCode, cnType, cCode, nFlags ) CLASS TCodeBars

   DEFAULT nWidth := 200,;
           nHeight := 100,;
           nWidthCode := 1,;
           nHeightCode := 3
   

   ::aTypes = { { "EAN13"      , {| | hb_zebra_create_ean13( ::cCode, ::nFlags )      } },;
                { "EAN8"       , {| | hb_zebra_create_ean8( ::cCode, ::nFlags )       } },;
                { "UPCA"       , {| | hb_zebra_create_upca( ::cCode, ::nFlags )       } },;
                { "UPCE"       , {| | hb_zebra_create_upce( ::cCode, ::nFlags )       } },;
                { "ITF"        , {| | hb_zebra_create_itf( ::cCode, ::nFlags )        } },;
                { "MSI"        , {| | hb_zebra_create_msi( ::cCode, ::nFlags )        } },;
                { "CODABAR"    , {| | hb_zebra_create_codabar( ::cCode, ::nFlags )    } },;
                { "CODE11"     , {| | hb_zebra_create_code11( ::cCode, ::nFlags )     } },;
                { "CODE39"     , {| | hb_zebra_create_code39( ::cCode, ::nFlags )     } },;
                { "CODE93"     , {| | hb_zebra_create_code93( ::cCode, ::nFlags )     } },;
                { "CODE128"    , {| | hb_zebra_create_code128( ::cCode, ::nFlags )    } },;
                { "PDF417"     , {| | NIL /*hb_zebra_create_pdf417( ::cCode, ::nFlags )     */} },;
                { "DATAMATRIX" , {| | hb_zebra_create_datamatrix( ::cCode, ::nFlags ) } },;
                { "QRCODE"     , {| | hb_zebra_create_qrcode( ::cCode, ::nFlags )     } } }
   
   ::nWidth  = nWidth
   ::nHeight = nHeight
   ::nWidthCode  = nWidthCode
   ::nHeightCode = nHeightCode
   
   ::SetType( cnType )
   ::SetCode( cCode )
   ::SetFlags( nFlags )

return Self

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

METHOD Build() CLASS TCodeBars

   local hBmpOld
   local hDCDesk := GetDC( GetDesktopWindow() )
   local hDCMem  := CreateCompatibleDC( hDCDesk )
   local hBrush  := CreateSolidBrush( 0 )
   local hBack   := CreateSolidBrush( CLR_WHITE )

   ::hCodeBar = CreateCompatibleBitMap( hDCDesk, ::nWidth, ::nHeight )
   hBmpOld    = SelectObject( hDCMem, ::hCodeBar )  

   ::hData := Eval( ::aTypes[ ::nType ][ CODEBAR_BLOCK ] )
   
   ::DefError()
   FillRect( hDCMem, { 0, 0, ::nHeight, ::nWidth }, hBack )
   hb_zebra_draw( ::hData, {| x, y, w, h | FillRect( hDCMem, { y, x, y +  h, x + w }, hBrush ) }, 0, 0, ::nWidthCode, ::nHeightCode )
   
   SelectObject( hDCMem, hBmpOld )
   ReleaseDC( GetDesktopWindow(), hDCDesk )
   DeleteDC( hDCMem )
   DeleteObject( hBrush )
   DeleteObject( hBack )
   
   
return NIL
*
METHOD SetCode( cCode ) CLASS TCodeBars

   if ! Empty( cCode )
      if ValType( cCode ) != "C"
         cCode = cValToChar( cCode )
      endif
      ::cCode = cCode
   endif

return NIL
*
METHOD SetFlags( nFlags ) CLASS TCodeBars

   ::nFlags = nFlags

return NIL
*
METHOD SetType( cnType ) class TCodeBars

   local cType

   if ( ( cType := ValType( cnType ) )$"CN" )
      if cType == "N"
         if cnType > 0 .and. cnType < 15
            ::nType = cnType
         endif
      else
         ::nType = AScan( ::aTypes, {| a | a[ CODEBAR_TYPE ] == Upper( cnType ) } )
      endif
   else
      ::nType = DEFAULT_CODEBAR
   endif
   
return NIL  
*
METHOD DefError( ) CLASS TCodeBars
   local oError
   local nError := 0
   
   if ::hData != NIL
      nError = hb_zebra_geterror( ::hData )
   endif
   
   
   if nError != 0
      hb_zebra_destroy( ::hData )

      oError := ErrorNew()
      oError:SubSystem   = "TCODEBARS"
      oError:SubCode     = nError
      oError:Severity    = 2
     
      Eval( ErrorBlock(), oError )  
   
   endif

RETURN nil

 

[cmsoft]

Adhemar, cual es el archivo Codebar.ch, no está en mis archivos de include.
Hay que enlazar alguna librería? Intuyo que la librería hbzebra.lib de harbour...
Desde ya muchas gracias...

[alerchster]

http://forums.fivetechsupport.com/viewtopic.php?f=3&t=34399&p=204283&hilit=codebar.ch

[cmsoft]

Muchas gracias Anton!

[remtec]

Amigos, tengan uds, un excelente dia.

Mil gracias a todos por todo el aporte a mi solicitud, estoy implementando el codigo y probando la mejor opcion.

Una vez probado, comentare el resultado.

Eternamente agradecido por toda la ayuda.

Saludos.

Antonio.