Codigo de barras

jhony1004
30 de Enero del 2005
Hola amigos.. necesito crear e imprimir codigo de barras en VB o PB.. por favor, ojala alguien pueda ayudarme o darme alguna referancia.. gracias

Javi
30 de Enero del 2005
Esto lo uso en access, imagino que en VB valdrá igual:
En el informe, creas un control, y en la sección, en el evento imprimir, llamas a la función, pasandole el nombre del control y del report:
Dim Result
Result = MD_Barcode39(BarNroOt, Me)
Modulo:
Function MD_Barcode39(Ctrl As Control, rpt As Report)

On Error GoTo ErrorTrap_BarCode39

Dim Nbar As Single, Wbar As Single, Qbar As Single, Nextbar As Single
Dim CountX As Single, CountY As Single, CountR As Single
Dim Parts As Single, Pix As Single, Color As Long, BarCodePlus As Variant
Dim Stripes As String, BarType As String, Barcode As String
Dim Mx As Single, my As Single, Sx As Single, Sy As Single
Const White = 16777215: Const Black = 0
Const Nratio = 20, Wratio = 55, Qratio = 35

'Get control size and location properties.
Sx = Ctrl.Left: Sy = Ctrl.Top: Mx = Ctrl.Width: my = Ctrl.Height

'Set handle on control.
Barcode = Ctrl

'Calculate actual and relative pixels values.
Parts = (Len(Barcode) + 2) * ((6 * Nratio) + (3 * Wratio) + (1 * Qratio))
Pix = (Mx / Parts):
Nbar = (20 * Pix): Wbar = (55 * Pix): Qbar = (35 * Pix)

'Initialize bar index and color.
Nextbar = Sx
Color = White

'Pad each end of string with start/stop characters.
BarCodePlus = "*" & UCase(Barcode) & "*"

'Walk through each character of the barcode contents.
For CountX = 1 To Len(BarCodePlus)

'Get Barcode 1/0 string for indexed character.
Stripes = MD_BC39(Mid$(BarCodePlus, CountX, 1))
For CountY = 1 To 9

'For each 1/0, draw a wide/narrow bar.
BarType = Mid$(Stripes, CountY, 1)

'Toggle the color (black/white).
If Color = White Then Color = Black Else Color = White
Select Case BarType

Case "1"
'Draw a wide bar.
rpt.Line (Nextbar, Sy)-Step(Wbar, my), Color, BF
Nextbar = Nextbar + Wbar

Case "0"
'Draw a narrow bar.
rpt.Line (Nextbar, Sy)-Step(Nbar, my), Color, BF
Nextbar = Nextbar + Nbar

End Select
Next CountY

'Toggle the color (black/white).
If Color = White Then Color = Black Else Color = White

'Draw intermediate "quiet" bar.
rpt.Line (Nextbar, Sy)-Step(Qbar, my), Color, BF
Nextbar = Nextbar + Qbar

Next CountX

Exit_BarCode39:
Exit Function

ErrorTrap_BarCode39:
Resume Exit_BarCode39

End Function

Function MD_BC39(CharCode As String) As String

On Error GoTo ErrorTrap_BC39

ReDim BC39(90)

BC39(32) = "011000100" ' space
BC39(36) = "010101000" ' $
BC39(37) = "000101010" ' %
BC39(42) = "010010100" ' * Start/Stop
BC39(43) = "010001010" ' +
BC39(45) = "010000101" ' |
BC39(46) = "110000100" ' .
BC39(47) = "010100010" ' /
BC39(48) = "000110100" ' 0
BC39(49) = "100100001" ' 1
BC39(50) = "001100001" ' 2
BC39(51) = "101100000" ' 3
BC39(52) = "000110001" ' 4
BC39(53) = "100110000" ' 5
BC39(54) = "001110000" ' 6
BC39(55) = "000100101" ' 7
BC39(56) = "100100100" ' 8
BC39(57) = "001100100" ' 9
BC39(65) = "100001001" ' A
BC39(66) = "001001001" ' B
BC39(67) = "101001000" ' C
BC39(68) = "000011001" ' D
BC39(69) = "100011000" ' E
BC39(70) = "001011000" ' F
BC39(71) = "000001101" ' G
BC39(72) = "100001100" ' H
BC39(73) = "001001100" ' I
BC39(74) = "000011100" ' J
BC39(75) = "100000011" ' K
BC39(76) = "001000011" ' L
BC39(77) = "101000010" ' M
BC39(78) = "000010011" ' N
BC39(79) = "100010010" ' O
BC39(80) = "001010010" ' P
BC39(81) = "000000111" ' Q
BC39(82) = "100000110" ' R
BC39(83) = "001000110" ' S
BC39(84) = "000010110" ' T
BC39(85) = "110000001" ' U
BC39(86) = "011000001" ' V
BC39(87) = "111000000" ' W
BC39(88) = "010010001" ' X
BC39(89) = "110010000" ' Y
BC39(90) = "011010000" ' Z

MD_BC39 = BC39(Asc(CharCode))

Exit_BC39:
Exit Function

ErrorTrap_BC39:
MD_BC39 = ""
Resume Exit_BC39

End Function

SuperBeto
30 de Enero del 2005
Necesito programar un barcode Scanner de una tienda para un sistema en VB, alguien me podria ayudar o darme un tip de como funcionan y como se programa, escribanme a mi mail , gracias!!!