#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