Otima rotina para criação da imagem do código de barras Interleaved 2 of 5 para boletos bancários e outros documentos de cobrança

  '==============================================================================================   ' Desenha um Codigo de Barras no padrão Interleaved 2 de 5  para boletos bancários   '==============================================================================================   ' Não esqueça de criar duas imagens gif com as seguintes caracteristicas   ' 1a. COR:     BRANCA             2a. COR:     PRETA   '     TAMANHO: 10 x 80                TAMANHO: 10 x 80   '     NOME:    B.GIF                  NOME:    P.GIF   '   '  Exemplo: DrawBarCode  "12345678901234567890123456789012345678901234",50    '   ' Recomenda-se usar Response.Buffer = True para evitar o efeito de montagem do código.   '==============================================================================================   Sub DrawBarcode( Valor, Altura )     Dim f, f1, f2, i, texto     Const Fino  = 1     Const Largo = 3     Dim BC(99)        if isempty(BC(0)) then          BC(0) = "00110"           BC(1) = "10001"          BC(2) = "01001"           BC(3) = "11000"          BC(4) = "00101"           BC(5) = "10100"          BC(6) = "01100"           BC(7) = "00011"          BC(8) = "10010"           BC(9) = "01010"          for f1 = 9 to 0 step -1            for f2 = 9 to 0 Step -1              f = f1 * 10 + f2              texto = ""              for i = 1 To 5                 texto = texto & mid(BC(f1), i, 1) + mid(BC(f2), i, 1)              next              BC(f) = texto            next          next     end if        Response.Write "<img src=p.gif width=" & fino & " height=" & altura & " border=0>"      Response.Write "<img src=b.gif width=" & fino & " height=" & altura & " border=0>"     Response.Write "<img src=p.gif width=" & fino & " height=" & altura & " border=0>"     Response.Write "<img src=b.gif width=" & fino & " height=" & altura & " border=0>"        texto = valor     if len( texto ) mod 2 <> 0 then texto = "0" & texto        do while len(texto) > 0        i = cint( left( texto, 2) )        texto = right( texto, len( texto ) - 2)        f = BC(i)        for i = 1 to 10 step 2          if mid(f, i, 1) = "0" then f1 = fino else f1 = largo          Response.Write "<img src=p.gif width=" & f1 & " height=" & altura & " border=0>"          if mid(f, i + 1, 1) = "0" Then f2 = fino else f2 = largo          Response.Write "<img src=b.gif width=" & f2 & " height=" & altura & " border=0>"       next     loop        Response.Write "<img src=p.gif width=" & largo & " height=" & altura & " border=0>"     Response.Write "<img src=b.gif width=" & fino  & " height=" & altura & " border=0>"     Response.Write "<img src=p.gif width=" & 1     & " height=" & altura & " border=0>"   End sub

Quebra-Linha

Colaborador..: Adenilton Rodrigues
Categoria(s).: ASP;
Data.........: 11/04/2002 15:23:32
Visualizado..: 1482 vezes
Fonte........: AdeN Knowledge DB