Barcode en Visual Basic

Iniciado por ANTRAX, Marzo 25, 2012, 10:01:25 AM

Tema anterior - Siguiente tema

0 Miembros y 2 Visitantes están viendo este tema.

Marzo 25, 2012, 10:01:25 AM Ultima modificación: Mayo 12, 2014, 03:33:10 PM por Expermicid
Creamos un proyecto nuevo en VB, y solo necesitaremos 3 controles y un modulo.

Controles:
* Textbox (txtID)
* Picturebox (Picture1)
* CommandButton (cmdPrint)

You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login
Codigo del Modulo:

Código: vb
Sub DrawBarcode(ByVal bc_string As String, obj As Control)
     
    Dim xpos!, Y1!, Y2!, dw%, th!, tw, new_string$
     
    'define barcode patterns
    Dim bc(90) As String
    bc(1) = "1 1221"            'pre-amble
    bc(2) = "1 1221"            'post-amble
    bc(48) = "11 221"           'digits
    bc(49) = "21 112"
    bc(50) = "12 112"
    bc(51) = "22 111"
    bc(52) = "11 212"
    bc(53) = "21 211"
    bc(54) = "12 211"
    bc(55) = "11 122"
    bc(56) = "21 121"
    bc(57) = "12 121"
                                'capital letters
    bc(65) = "211 12"           'A
    bc(66) = "121 12"           'B
    bc(67) = "221 11"           'C
    bc(68) = "112 12"           'D
    bc(69) = "212 11"           'E
    bc(70) = "122 11"           'F
    bc(71) = "111 22"           'G
    bc(72) = "211 21"           'H
    bc(73) = "121 21"           'I
    bc(74) = "112 21"           'J
    bc(75) = "2111 2"           'K
    bc(76) = "1211 2"           'L
    bc(77) = "2211 1"           'M
    bc(78) = "1121 2"           'N
    bc(79) = "2121 1"           'O
    bc(80) = "1221 1"           'P
    bc(81) = "1112 2"           'Q
    bc(82) = "2112 1"           'R
    bc(83) = "1212 1"           'S
    bc(84) = "1122 1"           'T
    bc(85) = "2 1112"           'U
    bc(86) = "1 2112"           'V
    bc(87) = "2 2111"           'W
    bc(88) = "1 1212"           'X
    bc(89) = "2 1211"           'Y
    bc(90) = "1 2211"           'Z
                                'Misc
    bc(32) = "1 2121"           'space
    bc(35) = ""                 '# cannot do!
    bc(36) = "1 1 1 11"         '$
    bc(37) = "11 1 1 1"         '%
    bc(43) = "1 11 1 1"         '+
    bc(45) = "1 1122"           '-
    bc(47) = "1 1 11 1"         '/
    bc(46) = "2 1121"           '.
    bc(64) = ""                 '@ cannot do!
    bc(65) = "1 1221"           '*
     
     
     
    bc_string = UCase(bc_string)
     
     
    'dimensions
    obj.ScaleMode = 3                               'pixels
    obj.Cls
    obj.Picture = Nothing
    dw = CInt(obj.ScaleHeight / 40)                 'space between bars
    If dw < 1 Then dw = 1
    'Debug.Print dw
    th = obj.TextHeight(bc_string)                  'text height
    tw = obj.TextWidth(bc_string)                   'text width
    new_string = Chr$(1) & bc_string & Chr$(2)      'add pre-amble, post-amble
     
    Y1 = obj.ScaleTop
    Y2 = obj.ScaleTop + obj.ScaleHeight - 1.5 * th
    obj.Width = 1.1 * Len(new_string) * (15 * dw) * obj.Width / obj.ScaleWidth
     
     
    'draw each character in barcode string
    xpos = obj.ScaleLeft
    For n = 1 To Len(new_string)
        c = Asc(Mid$(new_string, n, 1))
        If c > 90 Then c = 0
        bc_pattern$ = bc(c)
         
        'draw each bar
        For i = 1 To Len(bc_pattern$)
            Select Case Mid$(bc_pattern$, i, 1)
                Case " "
                    'space
                    obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
                    xpos = xpos + dw
                     
                Case "1"
                    'space
                    obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
                    xpos = xpos + dw
                    'line
                    obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &H0&, BF
                    xpos = xpos + dw
                 
                Case "2"
                    'space
                    obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
                    xpos = xpos + dw
                    'wide line
                    obj.Line (xpos, Y1)-(xpos + 2 * dw, Y2), &H0&, BF
                    xpos = xpos + 2 * dw
            End Select
        Next
    Next
     
    '1 more space
    obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
    xpos = xpos + dw
     
    'final size and text
    obj.Width = (xpos + dw) * obj.Width / obj.ScaleWidth
    obj.CurrentX = (obj.ScaleWidth - tw) / 2
    obj.CurrentY = Y2 + 0.25 * th
    obj.Print bc_string
     
    'copy to clipboard
    obj.Picture = obj.Image
    Clipboard.Clear
    Clipboard.SetData obj.Image, 2

End Sub


Codigo Fuente del CommandButton:

Código: vb
'Impresion del Barcode
Private Sub cmdPrint_Click()

    Printer.PaintPicture Picture1, 100, 100
    Printer.EndDoc
End Sub


Codigo Fuente del TextBox:

Código: vb
'Escritura del barcode
Private Sub txtID_Change()

    Picture1.Height = Picture1.Height * (1.4 * 40 / Picture1.ScaleHeight)
    Picture1.FontSize = 8
    Call DrawBarcode(txtID, Picture1)
    Dim minwidth, pw, fw As Integer
    minwidth = 2 * txtID.Left + txtID.Width
    pw = 2 * Picture1.Left + Picture1.Width
    fw = minwidth
    If pw > fw Then fw = pw
    frmAgregarProd.Width = fw
     
End Sub