Salvar Codigo de barras com Bitmap

Mauro · Post by **Mauro** » Tue Apr 17, 2007 2:30 pm

Ola a todos
Aproveitanto a Classe VRDBarcode de Timm Sodtalbers, conforme abaixo

Substitui a funcao Retangle() do original para FillRect() no FWPPC,
está funcionando pereitamento
///////////////////////////////////////////////////////////////////////////////////
/*
==================================================================
EasyReport - The Visual Report Designer VRDBCODE.PRG
Version 1.1.2
------------------------------------------------------------------
(c) copyright: Timm Sodtalbers, 2000 - 2003
Sodtalbers+Partner
info@reportdesigner.info
www.reportdesigner.info
==================================================================

This barcode class is based on the great work of Cayetano Gomez.
I have added some features - for example the possiblitity to show
barcodes on a window or dialog - but the main work comes from
Cayetano.

1.07.2003 1.1.2 VRDBCODE.CH added
28.10.2002 1.1.1 Command support added
*/

#IFDEF __XPP__
#INCLUDE "VRDXPP.ch"
#ELSE
#INCLUDE "FiveWin.ch"
#ENDIF

*-- CLASS DEFINITION ---------------------------------------------------------
* Name: VRDBarcode
* Description:
* Author: Timm Sodtalbers
*-----------------------------------------------------------------------------
CLASS VRDBarcode

DATA hDC // handle of the window, dialog or printer object
DATA cText // barcode text
DATA nTop // top position
DATA nLeft // left position
DATA nWidth // barcode width
DATA nHeight // barcode height
DATA nColText // pin color
DATA nColPane // background color
DATA lHorizontal // horizontal (.T.) or vertical (.F.)
DATA lTransparent // transparent or not
DATA nPinWidth // barcode pin width
DATA nBCodeType // Barcode type:
// 1 = Code 39
// 2 = Code 39 check digit
// 3 = Code 128 auto select
// 4 = Code 128 mode A
// 5 = Code 128 mode B
// 6 = Code 128 mode C
// 7 = EAN 8
// 8 = EAN 13
// 9 = UPC-A
// 10 = Codabar
// 11 = Suplemento 5
// 12 = Industrial 2 of 5
// 13 = Industrial 2 of 5 check digit
// 14 = Interlaved 2 of 5
// 15 = Interlaved 2 of 5 check digit
// 16 = Matrix 2 of 5
// 17 = Matrix 2 of 5 check digit

METHOD New( hDC, cText, nTop, nLeft, nWidth, nHeight, nBCodeType, ;
nColText, nColPane, lHorz, lTransparent, nPinWidth ) CONSTRUCTOR
METHOD ShowBarcode()
METHOD CreateBarcode( cCode )
METHOD InitCode39( lCheck )
METHOD InitCode128( cMode )
METHOD InitEAN13()
METHOD InitUPC( nLen )
METHOD InitE13BL( nLen )
METHOD InitCodabar()
METHOD InitSub5()
METHOD InitIndustrial25( lCheck )
METHOD InitInterleave25( lCheck )
METHOD InitMatrix25( lCheck )

ENDCLASS

*-- METHOD -------------------------------------------------------------------
* Name: New
* Description:
* Author: Timm Sodtalbers
*-----------------------------------------------------------------------------
METHOD New( hDC, cText, nTop, nLeft, nWidth, nHeight, nBCodeType, ;
nColText, nColPane, lHorz, lTransparent, nPinWidth ) CLASS VRDBarcode

DEFAULT nWidth := 200
DEFAULT nHeight := 20
DEFAULT nColText := 0
DEFAULT nColPane := RGB( 255, 255, 255 )
DEFAULT lHorz := .T.
DEFAULT lTransparent := .F.
DEFAULT nPinWidth := 1

::hDC := hDC
::cText := cText
::nTop := nTop
::nLeft := nLeft
::nWidth := nWidth
::nHeight := nHeight
::nBCodeType := nBCodeType
::nColText := nColText
::nColPane := nColPane
::lHorizontal := lHorz
::lTransparent := lTransparent
::nPinWidth := nPinWidth

RETURN ( Self )

*-- METHOD -------------------------------------------------------------------
* Name: ShowBarcode
* Description:
* Author: Timm Sodtalbers
*-----------------------------------------------------------------------------
METHOD ShowBarcode() CLASS VRDBarCode

LOCAL cCode, cCode2

DO CASE
CASE ::nBCodeType = 1
cCode := ::InitCode39( .F. )
CASE ::nBCodeType = 2
cCode := ::InitCode39( .T. )
CASE ::nBCodeType = 3
cCode := ::InitCode128( "" )
CASE ::nBCodeType = 4
cCode := ::InitCode128( "A" )
CASE ::nBCodeType = 5
cCode := ::InitCode128( "B" )
CASE ::nBCodeType = 6
cCode := ::InitCode128( "C" )
CASE ::nBCodeType = 7
cCode := ::InitUPC( 7 )
cCode2 := ::InitE13BL( 8 )
CASE ::nBCodeType = 8
cCode := ::InitEAN13()
CASE ::nBCodeType = 9
cCode := ::InitUPC( 11 )
cCode2 := ::InitE13BL( 12 )
CASE ::nBCodeType = 10
cCode := ::InitCodabar()
CASE ::nBCodeType = 11
cCode := ::InitSub5()
CASE ::nBCodeType = 12
cCode := ::InitIndustrial25( .F. )
CASE ::nBCodeType = 13
cCode := ::InitIndustrial25( .T. )
CASE ::nBCodeType = 14
cCode := ::InitInterleave25( .F. )
CASE ::nBCodeType = 15
cCode := ::InitInterleave25( .T. )
CASE ::nBCodeType = 16
cCode := ::InitMatrix25( .F. )
CASE ::nBCodeType = 17
cCode := ::InitMatrix25( .T. )
OTHERWISE
cCode := ::InitCode39( .T. )
ENDCASE

::CreateBarcode( cCode )

IF ::nBCodeType = 7 .OR. ::nBCodeType = 9
::CreateBarcode( cCode2 )
ENDIF

RETURN ( NIL )

*-- METHOD -------------------------------------------------------------------
* Name: CreateBarcode
* Description:
* Author: Timm Sodtalbers
*-----------------------------------------------------------------------------
METHOD CreateBarcode( cCode ) CLASS VRDBarCode

LOCAL i, oBrush, hPen, hOldPen, hBrush, hOldBrush
LOCAL nX := ::nTop
LOCAL nY := ::nLeft
LOCAL lHorz := .T.

IF ::lTransparent = .F. .AND. ::nColPane <> RGB( 255, 255, 255 )
hPen := CreatePen( , , ::nColPane )
hOldPen := SelectObject( ::hDC, hPen )
hBrush := CreateSolidBrush( ::nColPane )
hOldBrush := SelectObject( ::hDC, hBrush )
FillRect( ::hDC, { nX, nY, nX + ::nHeight, nY + ::nWidth }, hBrush )
ENDIF

hPen := CreatePen( , , ::nColText )
hOldPen := SelectObject( ::hDC, hPen )
hBrush := CreateSolidBrush( ::nColText )
hOldBrush := SelectObject( ::hDC, hBrush )

IIF( ::nPinWidth < 1, ::nPinWidth := 1, )

FOR i := 1 TO LEN( cCode )

IF SUBSTR( cCode, i, 1 ) = "1"
IF ::lHorizontal = .T.
FillRect( ::hDC, { nX, nY, nX + ::nHeight, ( nY += ::nPinWidth ) }, hBrush)
ELSE
FillRect( ::hDC, { nX, nY, ( nX += ::nPinWidth ), nY + ::nWidth }, hBrush)
ENDIF
ELSE
IF ::lHorizontal = .T.
nY += ::nPinWidth
ELSE
nX += ::nPinWidth
ENDIF
ENDIF

NEXT

SelectObject( ::hDC, hOldPen )
DeleteObject( hPen )
SelectObject( ::hDC, hOldBrush )
DeleteObject( hBrush )

RETURN ( NIL )

*-- METHOD -------------------------------------------------------------------
* Name: InitCode39
* Description:
* Author: Timm Sodtalbers
*-----------------------------------------------------------------------------
METHOD InitCode39( lCheck ) CLASS VRDBarCode

LOCAL cCars := "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ-. *$/+%"
LOCAL aBarras := { '1110100010101110', ;
'1011100010101110', ;
'1110111000101010', ;
'1010001110101110', ;
'1110100011101010', ;
'1011100011101010', ;
'1010001011101110', ;
'1110100010111010', ;
'1011100010111010', ;
'1010001110111010', ;
'1110101000101110', ;
'1011101000101110', ;
'1110111010001010', ;
'1010111000101110', ;
'1110101110001010', ; //E
'1011101110001010', ;
'1010100011101110', ;
'1110101000111010', ;
'1011101000111010', ;
'1010111000111010', ;
'1110101010001110', ; //K
'1011101010001110', ;
'1110111010100010', ;
'1010111010001110', ;
'1110101110100010', ;
'1011101110100010', ; //p
'1010101110001110', ;
'1110101011100010', ;
'1011101011100010', ;
'1010111011100010', ;
'1110001010101110', ;
'1000111010101110', ;
'1110001110101010', ;
'1000101110101110', ;
'1110001011101010', ;
'1000111011101010', ; //Z
'1000101011101110', ;
'1110001010111010', ;
'1000111010111010', ; // ' '
'1000101110111010', ;
'1000100010100010', ;
'1000100010100010', ;
'1000101000100010', ;
'1010001000100010'}

LOCAL cCar, m, n, n1, n2
LOCAL cBarra := ""
LOCAL cCode := ::cText
LOCAL nCheck := 0

DEFAULT lCheck := .F.

cCode := UPPER( cCode )

IF LEN( cCode ) > 32
cCode := LEFT( cCode, 32 )
ENDIF

cCode := "*" + cCode + "*"

FOR n := 1 to LEN( cCode )
cCar := SUBSTR( cCode, n, 1 )
m := AT( cCar, cCars )
IF n > 0
cBarra := cBarra + aBarras[m]
nCheck += ( m - 1 )
END
NEXT

if lCheck = .T.
cBarra += aBarras[ nCheck%43 + 1 ]
end

RETURN ( cBarra )

*-- METHOD -------------------------------------------------------------------
* Name: InitCode128
* Description:
* Author: Timm Sodtalbers
*-----------------------------------------------------------------------------
METHOD InitCode128( cMode ) CLASS VRDBarCode

LOCAL aCode :={ "212222", "222122", "222221", "121223", "121322", "131222", ;
"122213", "122312", "132212", "221213", "221312", "231212", ;
"112232", "122132", "122231", "113222", "123122", "123221", ;
"223211", "221132", "221231", "213212", "223112", "312131", ;
"311222", "321122", "321221", "312212", "322112", "322211", ;
"212123", "212321", "232121", "111323", "131123", "131321", ;
"112313", "132113", "132311", "211313", "231113", "231311", ;
"112133", "112331", "132131", "113123", "113321", "133121", ;
"313121", "211331", "231131", "213113", "213311", "213131", ;
"311123", "311321", "331121", "312113", "312311", "332111", ;
"314111", "221411", "431111", "111224", "111422", "121124", ;
"121421", "141122", "141221", "112214", "112412", "122114", ;
"122411", "142112", "142211", "241211", "221114", "213111", ;
"241112", "134111", "111242", "121142", "121241", "114212", ;
"124112", "124211", "411212", "421112", "421211", "212141", ;
"214121", "412121", "111143", "111341", "131141", "114113", ;
"114311", "411113", "411311", "113141", "114131", "311141", ;
"411131", "211412", "211214", "211232", "2331112" }

LOCAL cBarra, cCar, cTemp, n, nCar
LOCAL cCode := ::cText
LOCAL lCodeC := .F.
LOCAL lCodeA := .F.
LOCAL nSum := 0
LOCAL nCount := 0

// Errors
IF VALTYPE( cCode ) <> "C"
MsgInfo( "Barcode Code 128 requires a character value." )
RETURN NIL
ENDIF

IF .NOT. EMPTY( cMode )
IF VALTYPE( cMode ) = "C" .AND. UPPER( cMode )$"ABC"
cMode := UPPER( cMode )
ELSE
MsgInfo( "Code 128 modes are A,B o C. Character values." )
ENDIF
ENDIF

IF EMPTY( cMode )
// autodetect mode
IF STR(VAL( cCode ), LEN( cCode ) ) = cCode
lCodeC := .T.
cTemp := aCode[106]
nSum := 105
ELSE
FOR n := 1 TO LEN( cCode )
nCount += IF( ASC(SUBSTR( cCode, n, 1 )) > 31, 1, 0 ) // no cars. de control
NEXT
IF nCount < LEN( cCode ) / 2
lCodeA := .T.
cTemp := aCode[104]
nSum := 103
ELSE
cTemp := aCode[105]
nSum := 104
ENDIF
ENDIF
ELSE
IF cMode == "C"
lCodeC := .T.
cTemp := aCode[106]
nSum := 105
ELSEIF cMode == "A"
lCodeA := .T.
cTemp := aCode[104]
nSum := 103
ELSE
cTemp := aCode[105]
nSum := 104
ENDIF
ENDIF

// caracter registrado
nCount := 0

FOR n := 1 to LEN( cCode )

nCount++
cCar := SUBSTR( cCode, n, 1 )

IF lCodeC
IF len(cCode)=n // ultimo caracter
CTemp += aCode[101] // SHIFT Code B
nCar := ASC( cCar ) - 31
ELSE
nCar := Val(substr(cCode,n,2))+1
n++
ENDIF
ELSEIF lCodeA
IF cCar> "_" // Shift Code B
cTemp += aCode[101]
nCar := ASC( cCar ) - 31
ELSEIF cCar <= " "
nCar := ASC( cCar ) + 64
ELSE
nCar := ASC( cCar ) - 31
ENDIF
ELSE // code B standard
IF cCar <= " " // shift code A
cTemp += aCode[102]
nCar := ASC( cCar ) + 64
ELSE
nCar := ASC( cCar ) - 31
ENDIF
ENDIF

nSum += ( nCar - 1 ) * nCount
cTemp := cTemp + aCode[nCar]

NEXT

nSum := nSum%103 + 1
cTemp := cTemp + aCode[nSum] + aCode[107]
cBarra := ""

FOR n:=1 to LEN( cTemp ) STEP 2
cBarra += REPLICATE( '1', VAL(SUBSTR( cTemp, n, 1 )) )
cBarra += REPLICATE( '0', VAL(SUBSTR( cTemp, n+1, 1 )) )
NEXT

RETURN ( cBarra )

*-- METHOD -------------------------------------------------------------------
* Name: InitEAN13
* Description:
* Author: Timm Sodtalbers
*-----------------------------------------------------------------------------
METHOD InitEAN13() CLASS VRDBarCode

LOCAL derecha := [1110010110011011011001000010101110010011101010000100010010010001110100]
LOCAL izda1 := [0001101001100100100110111101010001101100010101111011101101101110001011]
LOCAL izda2 := [0100111011001100110110100001001110101110010000101001000100010010010111]
LOCAL primero := [ooooooooeoeeooeeoeooeeeooeooeeoeeooeoeeeoooeoeoeoeoeeooeeoeo]

LOCAL l, s1, s2, control, n, ac, cad, cadena, cadena2, n1, n2, NUmero
LOCAL Izda, Dcha, String, Mascara, k
LOCAL cCode := ::cText

k := LEFT(ALLTRIM( cCode ) + "000000000000", 12 ) // padding with '0'

// calculo del digito de control
// suma de impares
s1 := 0
// suma de pares
s2 := 0

FOR n := 1 TO 6
s1 := s1 + VAL(SUBSTR( k, ( n * 2 ) -1, 1 ))
s2 := s2 + VAL(SUBSTR( k, ( n * 2 ), 1 ))
NEXT

control := ( s2 * 3 ) + s1
l := 10
DO WHILE control > l
l := l + 10
ENDDO

control := l - control
k := k + STR( control, 1, 0 )

// preparacion de la cadena de impresion
cadena := []
dcha := SUBSTR( k, 8, 6 )
izda := SUBSTR( k, 2, 6 )
mascara := SUBSTR( primero, ( VAL(SUBSTR( k, 1, 1 )) * 6 ) + 1, 6 )

// barra de delimitacion
cadena := [101]

// parte izda
FOR n := 1 TO 6
numero := VAL(SUBSTR( izda, n, 1 ))
IF SUBSTR( mascara, n, 1 ) = [o]
string := SUBSTR( izda1, numero * 7 + 1, 7 )
ELSE
string := SUBSTR( izda2, numero * 7 + 1, 7 )
ENDIF
cadena := cadena + string
NEXT

cadena := cadena + [01010]

// Lado derecho
FOR n := 1 TO 6
numero := VAL(SUBSTR( dcha, n, 1 ))
string := SUBSTR( derecha, numero * 7 + 1, 7 )
cadena := cadena + string
NEXT

cadena := cadena + [101]

RETURN ( Cadena )

*-- METHOD -------------------------------------------------------------------
* Name: InitUPC
* Description:
* Author: Timm Sodtalbers
*-----------------------------------------------------------------------------
METHOD InitUPC( nLen ) CLASS VRDBarCode

LOCAL derecha := [1110010110011011011001000010101110010011101010000100010010010001110100]
LOCAL izda1 := [0001101001100100100110111101010001101100010101111011101101101110001011]

LOCAL l, s1, s2, control, n, ac, cad, cadena, n1, n2, Numero
LOCAL Izda, Dcha, String, Mascara, k
LOCAL cCode := ::cText

// valid values for nLen are 11,7
k := LEFT(ALLTRIM( cCode ) + "000000000000", nLen ) // padding with '0'
// calculo del digito de control
// suma de impares
s1 := 0
// suma de pares
s2 := 0

FOR n := 1 TO nLen STEP 2
s1 := s1 + VAL(SUBSTR( k, n, 1 ) )
s2 := s2 + VAL(SUBSTR( k, n + 1, 1 ) )
NEXT

control := ( s1 * 3 ) + s2
l := 10
DO WHILE control > l
l := l + 10
ENDDO

control := l - control
k := k + STR( control, 1, 0 )
nLen++

// preparacion de la cadena de impresion
cadena := []
dcha := RIGHT(k, nLen/2 )
izda := LEFT( k, nLen/2 )

// barra de delimitacion
cadena := [101]
// parte izda
FOR n := 1 TO nlen/2
numero := VAL( SUBSTR( izda, n, 1 ) )
cadena += SUBSTR( izda1, numero * 7 + 1, 7 )
NEXT

cadena := cadena + [01010]

// Lado derecho
FOR n := n To LEN( k )
numero := VAL(SUBSTR( dcha, n, 1 ))
cadena += SUBSTR( derecha, numero * 7 + 1, 7 )
NEXT

cadena := cadena + [101]

RETURN ( Cadena )

*-- METHOD -------------------------------------------------------------------
* Name: InitE13BL
* Description:
* Author: Timm Sodtalbers
*-----------------------------------------------------------------------------
METHOD InitE13BL( nLen ) CLASS VRDBarCode

nLen := INT( nLen / 2 )

RETURN "101" + REPLICATE( "0", nLen * 7 ) + "01010" + REPLICATE( "0", nLen * 7 ) + "101"

*-- METHOD -------------------------------------------------------------------
* Name: InitCodabar
* Description:
* Author: Timm Sodtalbers
*-----------------------------------------------------------------------------
METHOD InitCodabar() CLASS VRDBarCode

//this system not test the start/end code

LOCAL cChar := "0123456789-$:/.+ABCDTN*E"
LOCAL abar := { "101010001110", "101011100010", "101000101110", "111000101010", ;
"101110100010", "111010100010", "100010101110", "100010111010", ;
"100011101010", "111010001010", "101000111010", "101110001010", ;
"11101011101110", "11101110101110", "11101110111010", "10111011101110", ;
"10111000100010", "10001000101110", '10100011100010', '10111000100010', ;
'10001000101110', '10100010001110', '10100011100010'}

LOCAL n, nCar
LOCAL cBarra := ""
LOCAL cCode := UPPER( ::cText )

FOR n := 1 to LEN( cCode )
IF ( nCar := AT( SUBSTR( cCode, n, 1 ), cChar ) ) > 0
cBarra += aBar[nCar]
ENDIF
NEXT

RETURN ( cBarra )

*-- METHOD -------------------------------------------------------------------
* Name: InitSup5
* Description:
* Author: Timm Sodtalbers
*-----------------------------------------------------------------------------
METHOD InitSub5() CLASS VRDBarCode

LOCAL izda1 := [0001101001100100100110111101010001101100010101111011101101101110001011]
LOCAL izda2 := [0100111011001100110110100001001110101110010000101001000100010010010111]
LOCAL primero := [ooooooooeoeeooeeoeooeeeooeooeeoeeooeoeeeoooeoeoeoeoeeooeeoeo]
LOCAL parity := [eeoooeoeooeooeoeoooeoeeooooeeooooeeoeoeooeooeooeoe]

LOCAL l, k, control, n, nCar
LOCAL cCode := ::cText
LOCAL cBarras := "1011"

k := LEFT(ALLTRIM( cCode ) + "00000", 5 ) // padding with '0'

control := RIGHT(STR(VAL(SUBSTR( k, 1, 1 )) * 3 + VAL(SUBSTR( k, 3, 1 )) * 3 + ;
VAL(SUBSTR( k, 5, 1 )) * 3 + VAL(SUBSTR( k, 2, 1 )) * 9 + ;
VAL(SUBSTR( k, 4, 1 )) * 9, 5, 0 ), 1 )
control := SUBSTR( primero, VAL( control ) * 6 + 2, 5 )

FOR n := 1 TO 5
nCar := VAL(SUBSTR( k, n, 1 ))
IF SUBSTR( control, n, 1 ) = "o"
cBarras += SUBSTR( Izda2, nCar * 7 + 1, 7 )
ELSE
cBarras += SUBSTR( Izda1, nCar * 7 + 1, 7 )
ENDIF
IF n < 5
cBarras += "01"
ENDIF
NEXT

RETURN ( cBarras )

*-- METHOD -------------------------------------------------------------------
* Name: InitIndustrial25
* Description:
* Author: Timm Sodtalbers
*-----------------------------------------------------------------------------
METHOD InitIndustrial25( lCheck ) CLASS VRDBarCode

LOCAL n
LOCAL aBar := { "00110", "10001", "01001", "11000", "00101", ;
"10100", "01100", "00011", "10010", "01010" }
LOCAL cInStart := "110" // industrial 2 of 5 start
LOCAL cInStop := "101" // industrial 2 of 5 stop
LOCAL cBar := ""
LOCAL cBarra := ""
LOCAL nCheck := 0
LOCAL cCode := trans( ::cText, "@9" ) // only digits

DEFAULT lCheck := .F.

IF lCheck
FOR n := 1 TO LEN( cCode ) STEP 2
nCheck += VAL(SUBSTR( cCode, n, 1 )) * 3 + VAL(SUBSTR( cCode, n + 1, 1 ))
NEXT
cCode += RIGHT(STR( nCheck, 10, 0 ), 1 )
ENDIF

cBar := cInStart

FOR n := 1 TO LEN( cCode )
cBar += aBar[ VAL(SUBSTR( cCode, n, 1 )) + 1 ] + "0"
NEXT

cBar += cInStop

FOR n := 1 TO LEN( cBar )
IF SUBSTR( cBar, n, 1 ) = "1"
cBarra += "1110"
ELSE
cBarra += "10"
ENDIF
NEXT

RETURN ( cBarra )

*-- METHOD -------------------------------------------------------------------
* Name: InitInterleave25
* Description:
* Author: Timm Sodtalbers
*-----------------------------------------------------------------------------
METHOD InitInterleave25( lMode ) CLASS VRDBarCode

LOCAL n, m
LOCAL aBar := { "00110", "10001", "01001", "11000", "00101", ;
"10100", "01100", "00011", "10010", "01010" }
LOCAL cStart := "0000"
LOCAL cStop := "100"
LOCAL cBar := ""
LOCAL cIz := ""
LOCAL cBarra := ""
LOCAL cDer := ""
LOCAL nLen := 0
LOCAL nCheck := 0
LOCAL cCode := trans( ::cText, "@9" ) // only digits

DEFAULT lMode := .F.

IF ( nLen%2 = 1 .AND. !lMode )
nLen++
cCode += "0"
ENDIF
IF lMode
FOR n := 1 TO LEN( cCode ) STEP 2
nCheck += VAL(SUBSTR( cCode, n, 1 )) * 3 + VAL(SUBSTR( cCode, n + 1, 1 ))
NEXT
cCode += RIGHT( STR( nCheck, 10, 0 ), 1 )
ENDIF

nLen := LEN( cCode )
cBarra := cStart

// preencoding .. interlaving
FOR n := 1 TO nLen STEP 2
cIz := aBar[ VAL(SUBSTR( cCode, n, 1 )) + 1 ]
cDer := aBar[ VAL(SUBSTR( cCode, n + 1,1 )) + 1 ]
FOR m := 1 TO 5
cBarra += SUBSTR( cIz, m, 1 ) + SUBSTR( cDer, m, 1 )
NEXT
NEXT

cBarra += cStop

FOR n := 1 TO LEN( cBarra ) STEP 2
IF SUBSTR( cBarra, n, 1 ) = "1"
cBar += "111"
ELSE
cBar += "1"
ENDIF
IF SUBSTR( cBarra, n + 1, 1 ) = "1"
cBar += "000"
ELSE
cBar += "0"
ENDIF
NEXT

RETURN ( cBar )

*-- METHOD -------------------------------------------------------------------
* Name: InitIndust25
* Description:
* Author: Timm Sodtalbers
*-----------------------------------------------------------------------------
METHOD InitMatrix25( lCheck ) CLASS VRDBarCode

LOCAL n
LOCAL aBar := { "00110", "10001", "01001", "11000", "00101", ;
"10100", "01100", "00011", "10010", "01010" }
LOCAL cMtSt := "10000" // matrix start/stop
LOCAL cBar := ""
LOCAL cBarra := ""
LOCAL nCheck := 0
LOCAL cCode := trans( ::cText, "@9" ) // only digits

DEFAULT lCheck := .F.

IF lCheck
FOR n := 1 TO LEN( cCode ) STEP 2
nCheck += VAL(SUBSTR( cCode, n, 1 )) * 3 + VAL(SUBSTR( cCode, n + 1, 1 ))
NEXT
cCode += RIGHT(STR( nCheck, 10, 0 ), 1 )
ENDIF

cBar := cMtSt

FOR n := 1 TO LEN( cCode )
cBar += aBar[ VAL(SUBSTR( cCode, n, 1 )) + 1 ] + "0"
NEXT

cBar += cMtSt

FOR n := 1 TO LEN( cBar ) STEP 2
IF SUBSTR( cBar, n, 1 ) = "1"
cBarra += "111"
ELSE
cBarra += "1"
ENDIF
IF SUBSTR( cBar, n + 1, 1 ) = "1"
cBarra += "000"
ELSE
cBarra += "0"
ENDIF
NEXT

RETURN ( cBarra )
/////////////////////////////////////////////////////////////////////////////
e aproveitando o Bctest.prg do mesmo autor

#INCLUDE "FWCE.ch"

FUNCTION Main()

// SET RESOURCES TO "BCTEST.DLL"

DEFINE WINDOW oWnd TITLE "Barcode Test"

oWnd:bPainted = {| hDC | DrawTestBarcode( hDC ) }

@ 20, 20 BUTTON "Barcodes in a Dialog" OF oWnd SIZE 160, 24 PIXEL ;
ACTION BarcodeDlgTest()

ACTIVATE WINDOW oWnd

// SET RESOURCES TO

RETURN (.T.)

*-- FUNCTION -----------------------------------------------------------------
* Name........: DrawTestBarcode
* Beschreibung:
* Argumente...: None
* Rückgabewert: .T.
* Author......: Timm Sodtalbers
*-----------------------------------------------------------------------------
FUNCTION DrawTestBarcode( hDC )

LOCAL oBC3
LOCAL oBC1 := VRDBarcode():New( hDC, "000000017646", 05, 10, 150, 30, 8 )
//LOCAL oBC2 := VRDBarcode():New( hDC, "12345678", 80, 250, 40, 300, 8, CLR_BLUE,, .F. )

oBC1:ShowBarcode()
//oBC2:ShowBarcode()

RETURN (.T.)

*-- FUNCTION -----------------------------------------------------------------
* Name........: BarcodeTestDlg
* Beschreibung:
* Argumente...: None
* Rückgabewert: .T.
* Author......: Timm Sodtalbers
*-----------------------------------------------------------------------------
FUNCTION BarcodeDlgTest()

LOCAL oDlg, hDCDlg
LOCAL cBarra := space(0)

DEFINE DIALOG oDlg NAME "BARCODETEST"

REDEFINE GET oSay VAR cBarra ID 102 OF oDlg

hDCDlg = oSay:GetDC()

oDlg:bPainted = { | | DrawTestBarcode( hDCDlg ),oSay:SaveToBmp(CurDir() + "\teste.bmp"),msginfo("Salvei") }

REDEFINE BUTTON ID 101 OF oDlg ACTION oDlg:End()

ACTIVATE DIALOG oDlg CENTER

RETURN (.T.)

#INCLUDE "VRDBCODE.PRG"

/////////////////////////////////////////////////////////////////
bctest.rc

#ifdef _CE
#include "c:\vce\include\arm\windows.h"
#include "c:\vce\include\arm\commctrl.h"
#endif

BARCODETEST DIALOG 11, 7, 252, 135
STYLE DS_MODALFRAME | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "Barcodes in a Dialog"
FONT 6, "MS Sans Serif"
{
PUSHBUTTON "&Cancel", 101, 192, 4, 54, 14
EDITTEXT 102, 11, 27, 94, 26
}

/////////////////////////////////////////////////////////////////////////

Não tive sucesso em slavar com bitmap, para emitir etiqueta como
HTML, usando o Bitmap como imagem
Alguma idéia ?

Saludos
Mauro - Brasilia - Brasil

Post by **Antonio Linares** » Tue Apr 17, 2007 2:55 pm

Mauro,

Usa

oDlg:SaveToBmp(CurDir() + "\teste.bmp")

en vez de:

oSay:SaveToBmp(CurDir() + "\teste.bmp"),

Post by **Antonio Linares** » Tue Apr 17, 2007 2:58 pm

Mejor prueba a cambiar esto:

hDCDlg = oSay:GetDC()

oDlg:bPainted = { | | DrawTestBarcode( hDCDlg ),oSay:SaveToBmp(CurDir() + "\teste.bmp"),msginfo("Salvei") }

por:

oDlg:bPainted = { | | DrawTestBarcode( oSay:GetDC() ), oSay:ReleaseDC(), oSay:SaveToBmp(CurDir() + "\teste.bmp"), msginfo("Salvei") }

Mauro · Post by **Mauro** » Tue Apr 17, 2007 5:43 pm

Prezado Antonio

Testei esta nova opção, mas infelizmente somente salva o box do
objeto SAY em branco, e eu precisava salvar o codigo de barras em bitmap, para poder imprimir via Poocket Internet Explorer, no formato html,

Grato

Um saludo a todos

Mauro - Brasilia - Brasil

Mauro · Post by **Mauro** » Tue Apr 17, 2007 7:40 pm

Antonio

Funcionou assim, alterei a Dialog para não ter bordas e coloquei esta dialog no tamanho do código desejado e salvei, fecho a janela e tenho meu codigo de barras salvo e posso agora imprimir....

funcionou, obrigado

oDlg:bPainted = { | hDC | DrawTestBarcode( hDC ), oDlg:SaveToBmp(CurDir() + "\teste.bmp"), oDlg:End() }

Saludos

Mauro - Brasilia - Brasil

KRCNET · Post by **KRCNET** » Wed Apr 18, 2007 11:30 am

Mauro,

Como vc esta imprimindo , pois tenho urgencia em montar impressao no pocket e nao tenho ideia de como comecar.

1) Vc esta utilizando via Infravermelho ou Bluetooth
2) Qual tipo de impressora vc esta imprimindo

Se puder dar uma dicas,

Ate mais

Mauro · Post by **Mauro** » Wed Apr 18, 2007 2:04 pm

Olá Cleber

Gero um HTML, carrego o Pocket Internet Explorer e com o PiePrint ou outro software que acompanha a impressora bluetooth gero etiquetas,
relatórios, etc.
Impresora CPM-10 da CITZEN - Bluetooth

Saludos
Mauro - Brasilia - Brasil