FiveTech Support Forums

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. )

// 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

#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