PC Toledo

Código: Selecionar todos

#include <hmg.ch>
// #include <minigui.ch>
#include 'common.ch'
#define SODIUM	"0123456789+"
#define NEON	"0123456789" 
#define EAN2	102
#define EAN5	105
#define EAN13Parity {"AAAAAA", "AABABB", "AABBAB", "AABBBA", "ABAABB", "ABBAAB", "ABBBAA", "ABABAB", "ABABBA", "ABBABA"}
#DEFINE EANsetA {"3211", "2221", "2122", "1411", "1132", "1231", "1114", "1312", "1213",	"3112"}
#DEFINE EANsetB {"1123", "1222", "2212", "1141", "2311", "1321", "4111", "2131", "3121","2113"}
*--------------------------
function MOL_ean13( cSource )

	local i
	local cParity
	local cPrepared := ""

	cParity := ""
	cParity := MOL_lookup(SODIUM, EAN13Parity, substr(cSource,1,1))

	/* start character */
	cPrepared := "111"
	
	//left side
	for i = 2 to 7
		if substr(cParity, i-1,1) == 'B'
			cPrepared += MOL_lookup(NEON, EANsetB, substr(cSource,i,1))
		else
			cPrepared += MOL_lookup(NEON, EANsetA, substr(cSource,i,1))
		endif
	next i
	
	//middle control characters
	cPrepared += "11111"
	
	// right side
	for i:=8 to 13
		cPrepared += MOL_lookup(NEON, EANsetA, substr(cSource,i,1))
	next i

	/* stop character */
	cPrepared += "111"	
 return cPrepared
*--------------------------
function MOL_lookup
	param cSetString, aSearchedTable, cWhatToSearch
 /* Replaces huge switch statements for looking up in tables */
	local i
	
	i := at(cWhatToSearch, cSetString)
	if i > 0
		return aSearchedTable[i]
	endif

 return 'ERROR'
 
*----------------------------------------------------------------------------------------------------------------------*
function PrintEAN13(cKodEan13, nCodeHeight, nModuleWidth)
local i, cPreparedEAN13
local nOffset, nBeginRow, nEndRow
local lWhiteStrip, vcod, vdesc, vquant, vpreco
Local nLinha
// altd()
Caminho:= "\"+curdir()+"\gerauxme.DBF"
Select 1
USE (Caminho) alias AUX NEW SHARED
index on itens to gerteste
select AUX
go top
vcod:=  AUX->codpro
vdesc:= AUX->nomepro
vquant:=AUX->quantid
vpreco:=AUX->precuni/3
if valtype (cKodEAN13) <> "C"
   *	cKodEAN13 := "7896026200001"
   cKodEAN13 := "78960262"+TRANSFORM(STRZERO(AUX->codpro),"@!")
   cKodEAN  := "78960262"+"-"+TRANSFORM(STRZERO(AUX->codpro),"@!")
   *	cKodEan13 := space(13)
   *		cKodEan13 := InputBox("Enter EAN13 BarCode","Enter EAN13 BarCode", cKodEan13)
endif
	
cKodEAN13 := alltrim(cKodEAN13)
	
if len(cKodEAN13) < 13
	MsgStop("Entered code is too short. Try again!")
	return .f.
endif
* altura do codigo de barras	
if valtype(nCodeHeight) <> "N"
	nCodeHeight := 6
endif

if valtype(nModuleWidth) <> "N"
	nModuleWidth := 0.33
endif
	
// left margin
nOffset := 7
nBeginRow := 10
nEndRow := nBeginRow + nCodeHeight

cPreparedEAN13 := MOL_ean13(cKodEAN13)

SELECT PRINTER DEFAULT PREVIEW ;
		ORIENTATION	PRINTER_ORIENT_PORTRAIT ;
		PAPERSIZE	PRINTER_PAPER_A4 ;
		QUALITY		PRINTER_RES_MEDIUM
        *  PRINTER_RES_DRAFT         (-1)
        *  PRINTER_RES_LOW           (-2)
        *  PRINTER_RES_MEDIUM        (-3)
        *  PRINTER_RES_HIGH          (-4)


START PRINTDOC name 	'Etiquetas de Produtos com Codigo de Barras ' 
START PRINTPAGE
select AUX
go top
col:= 0
lin:= 2
reg:= 0
nlin:= 2
ncol:= 2
nLinha:=0
do while .not. eof()
   vpreco:=AUX->precuni/3
   cKodEAN13 := "78960262"+TRANSFORM(STRZERO(AUX->codpro),"@!")
   cKodEAN  := "78960262"+"-"+TRANSFORM(STRZERO(AUX->codpro),"@!")
   cPreparedEAN13 := MOL_ean13(cKodEAN13)
   reg++
   if reg = 1 
  	  nOffset := 7
	  nBeginRow := 10
	  nEndRow := nBeginRow + nCodeHeight
      nlin:= lin
      ncol:= 2
   elseif reg = 2 
	  nOffset := 7
	  nBeginRow := 10
	  nEndRow := nBeginRow + nCodeHeight
      nlin:= lin
      ncol:= 43
   elseif reg = 3
	  nOffset := 7
	  nBeginRow := 10
	  nEndRow := nBeginRow + nCodeHeight
      nlin:= lin
      ncol:= 83
   elseif reg = 4
	  nOffset := 7
	  nBeginRow := 10
	  nEndRow := nBeginRow + nCodeHeight
      nlin:= lin
      ncol:= 124
   elseif reg = 5
	  nOffset := 7
	  nBeginRow := 10
	  nEndRow := nBeginRow + nCodeHeight
      nlin:= lin
      ncol:= 165
      reg:= 0
      lin:= lin+21
	  nLinha++
   ENDIF
   @ nEndRow+1+nlin, nOffset+ncol print cKodEAN ;
		FONT "ARIAL CE" ;
		SIZE 9 ;
		COLOR BLACK
   @ nEndRow+4+nlin, nOffset+ncol print SUBSTR(AUX->nomepro,1,20) FONT "ARIAL CE" SIZE 8 COLOR BLACK            
   @ nEndRow+7+nlin, nOffset+ncol print "3 x R$ "+TRANSFORM(vpreco,"@E 99999.99") FONT "ARIAL CE" SIZE 9 COLOR BLACK            
   
   lWhiteStrip := .f.
   For i:=1 to len(cPreparedEAN13)
		nStripWidth := val( substr(cPreparedEAN13,i,1) )
		if lWhiteStrip
			//@ nBeginRow, nOffset print rectangle to nEndRow, nOffset + nModuleWidth*nStripWidth penwidth 0.1 color WHITE
		else
			//print black strip
   		    @ nBeginRow+nlin, nOffset+ncol print rectangle to nEndRow+nlin, nOffset+ncol + nModuleWidth*nStripWidth penwidth 0.01 color BLACK FILLED
		endif
		//switch colors		
		lWhiteStrip := !lWhiteStrip
		nOffset += nModuleWidth*nStripWidth
	next i
	If nLinha>12
	   END PRINTPAGE
	   START PRINTPAGE
	   nLinha:=0
	   lin:= 2
       nlin:= 2
	Endif
    skip
enddo  
DBCLOSEALL()
END PRINTPAGE
END PRINTDOC
return