Ir para conteúdo
Fórum Script Brasil
  • 0

(Resolvido)Código de barras

Matheus-vb6

Perguntado por Matheus-vb6,

 Share

Pergunta

Matheus-vb6

Matheus-vb6

Postado
Postado (editado)

Boa tarde...

Estou tentando desenvolver um gerador de código de barras para ser lido por um leitor, porém, só utilizando fontes, o leitor não reconhece, precisa de uns separadores (segundo li no macoratti)

alguém tem ideia de como faço os separadores? ou como faço um codigo de barras q possa ser lido??

abraços

Editado por Matheus-vb6
Link para o comentário
Compartilhar em outros sites

1 resposta a esta questão

Posts Recomendados

  • 0
Matheus-vb6

Matheus-vb6

Postado
  • Autor
Postado

Resolvido depois de muitas e muitas pesquisas... fica o código pra quem quiser...

adicione um picture box com o nome pean e a propriedade autoredraw true... depois adicione 2 botões, 1 chamado cimprimir e o outro cguardar, por fim um textbox chamado txtean...


Dim W As String 'a cor W é a cor do picture1
Private Const N As String = &H0&
Private Const A As String = "A"
Private Const B As String = "B"
Private Const C As String = "C"

Private Function CorLinha(Digito As Integer, Numero As Integer, Posicion As Integer, NumeroLinea As Integer)
Dim Sequencia As Variant, SequenciaCor As Variant, Tipo As String

    Select Case Digito
        Case 0
            Sequencia = Array(12, A, A, A, A, A, A, C, C, C, C, C, C)
        Case 1
            Sequencia = Array(12, A, A, B, A, B, B, C, C, C, C, C, C)
        Case 2
            Sequencia = Array(12, A, A, B, B, A, B, C, C, C, C, C, C)
        Case 3
            Sequencia = Array(12, A, A, B, B, B, A, C, C, C, C, C, C)
        Case 4
            Sequencia = Array(12, A, B, A, A, B, B, C, C, C, C, C, C)
        Case 5
            Sequencia = Array(12, A, B, B, A, A, B, C, C, C, C, C, C)
        Case 6
            Sequencia = Array(12, A, B, B, B, A, A, C, C, C, C, C, C)
        Case 7
            Sequencia = Array(12, A, B, A, B, A, B, C, C, C, C, C, C)
        Case 8
            Sequencia = Array(12, A, B, A, B, B, A, C, C, C, C, C, C)
        Case 9
            Sequencia = Array(12, A, B, B, A, B, A, C, C, C, C, C, C)
    End Select

            Tipo = Sequencia(Posicion)

    Select Case Numero
        Case 0
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, W, W, N, N, W, N)
                Case B
                    SequenciaCor = Array(7, W, N, W, W, N, N, N)
                Case C
                    SequenciaCor = Array(7, N, N, N, W, W, N, W)
            End Select
        Case 1
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, W, N, N, W, W, N)
                Case B
                    SequenciaCor = Array(7, W, N, N, W, W, N, N)
                Case C
                    SequenciaCor = Array(7, N, N, W, W, N, N, W)
            End Select
        Case 2
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, W, N, W, W, N, N)
                Case B
                    SequenciaCor = Array(7, W, W, N, N, W, N, N)
                Case C
                    SequenciaCor = Array(7, N, N, W, N, N, W, W)
            End Select
        Case 3
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, N, N, N, N, W, N)
                Case B
                    SequenciaCor = Array(7, W, N, W, W, W, W, N)
                Case C
                    SequenciaCor = Array(7, N, W, W, W, W, N, W)
            End Select
        Case 4
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, N, W, W, W, N, N)
                Case B
                    SequenciaCor = Array(7, W, W, N, N, N, W, N)
                Case C
                    SequenciaCor = Array(7, N, W, N, N, N, W, W)
            End Select
        Case 5
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, N, N, W, W, W, N)
                Case B
                    SequenciaCor = Array(7, W, N, N, N, W, W, N) ' Array(7, W, W, N, N, W, W, N)
                Case C
                    SequenciaCor = Array(7, N, W, W, N, N, N, W)
            End Select
        Case 6
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, N, W, N, N, N, N)
                Case B
                    SequenciaCor = Array(7, W, W, W, W, N, W, N)
                Case C
                    SequenciaCor = Array(7, N, W, N, W, W, W, W)
            End Select
        Case 7
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, N, N, N, W, N, N)
                Case B
                    SequenciaCor = Array(7, W, W, N, W, W, W, N)
                Case C
                    SequenciaCor = Array(7, N, W, W, W, N, W, W)
            End Select
        Case 8
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, N, N, W, N, N, N)
                Case B
                    SequenciaCor = Array(7, W, W, W, N, W, W, N)
                Case C
                    SequenciaCor = Array(7, N, W, W, N, W, W, W)
            End Select
        Case 9
            Select Case Tipo
                Case A
                    SequenciaCor = Array(7, W, W, W, N, W, N, N)
                Case B
                    SequenciaCor = Array(7, W, W, N, W, N, N, N)
                Case C
                    SequenciaCor = Array(7, N, N, N, W, N, W, W)
            End Select

    End Select
    CorLinha = SequenciaCor(NumeroLinea)
End Function


Private Function EndsWith(ByVal Texto As String, ByVal caracter As String) As Boolean
    If Len(Texto) > 0 Then
        If Mid(Texto, Len(Texto), 1) = caracter Then
            EndsWith = True
        Else
            EndsWith = False
        End If
    Else
        EndsWith = False
    End If
End Function

Private Function FormatoEan(EAN As String) As String

Dim Sequencia As Variant, i As Integer, Total As Integer, DigitoDeControle As Integer

    If Len(EAN) < 13 Then
        EAN = String(12 - Len(EAN), "0") & EAN
    Else
        EAN = Mid(EAN, 1, 12)
    End If

    Sequencia = Array(13, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3, 1, 3)

    For i = 1 To 12
        Total = Total + Mid(EAN, i, 1) * Sequencia(i)
    Next i

        DigitoDeControle = IIf(Right(Total, 1) = 0, 0, 10 - Val(Right(Total, 1)))


        FormatoEan = EAN & DigitoDeControle

End Function

Private Sub CGuardar_Click()

On Error GoTo trataerro

    SavePicture PEan.Image, IIf(EndsWith(App.Path, "\"), App.Path & TxtEan.Text, App.Path & "\" & TxtEan.Text) & ".bmp"
    MsgBox ("Imagem do código EAN salva com sucesso.")
    Exit Sub

trataerro:
    MsgBox Err.Description

End Sub

Private Sub CImprimir_Click()
    PEan.Picture = PEan.Image
    Printer.PaintPicture PEan.Picture, 1000, 1000, PEan.Width * 2, PEan.Height * 2
    Printer.EndDoc
End Sub

Private Sub Form_Activate()
    TxtEan.SetFocus
End Sub

Private Sub Form_Load()
    PEan.AutoRedraw = True
End Sub

Private Sub TxtEan_KeyPress(KeyAscii As Integer)
On Error Resume Next
Dim x As Integer, x1 As Integer, Columna As Integer, NumeroDeGrupo As Integer, Grupo As Integer
Dim Inicial As Integer, Resto As String, NNumero As Integer, PPosicion As Integer
    If KeyAscii = 13 Then
        PEan.Cls
        If IsNumeric(TxtEan.Text) Then
        TxtEan.Text = FormatoEan(TxtEan.Text)
        W = PEan.BackColor
        Inicial = Mid(TxtEan, 1, 1)
        Resto = Mid(TxtEan, 2, 12)
                        PEan.Line (135, 90)-(135, 840), &H0&
                        PEan.Line (165, 90)-(165, 840), &H0&
                            If Inicial <> "0" Then
                                PEan.CurrentX = -20
                                PEan.CurrentY = 700
                                PEan.Print Inicial
                            End If
            For Grupo = 1 To 2
                Select Case Grupo
                    Case 1
                        x = 165
                        x1 = 165
                    Case 2
                        x = 870
                        x1 = 870
                End Select
                    For NumeroDeGrupo = 1 To 6
                        PPosicion = IIf(Grupo = 1, NumeroDeGrupo, NumeroDeGrupo + 6)
                        NNumero = IIf(Grupo = 1, Mid(Resto, NumeroDeGrupo, 1), Mid(Resto, NumeroDeGrupo + 6, 1))
                            For Columna = 1 To 7
                                If Columna = 1 Then 'desenho o numero no picturebox
                                    PEan.CurrentY = 700
                                    If Grupo = 1 Then PEan.CurrentX = x - 15 Else PEan.CurrentX = x - 30
                                    PEan.Print NNumero
                                End If
                                'desenha a linha no picturebox
                                PEan.Line (x + (15 * Columna), 90)-(x1 + (15 * Columna), 690), CorLinha(Inicial, NNumero, PPosicion, Columna), BF
                            Next Columna
                        x = (x + (7 * 15))
                        x1 = (x1 + (7 * 15))
                    Next NumeroDeGrupo
                Select Case Grupo
                    Case 1
                        PEan.Line (x + 30, 90)-(x + 30, 765), &H0&
                        PEan.Line (x + 60, 90)-(x + 60, 765), &H0&
                    Case 2
                        PEan.Line (x + 15, 90)-(x + 15, 840), &H0&
                        PEan.Line (x + 45, 90)-(x + 45, 840), &H0&
                End Select
            Next Grupo
        End If
    End If

End Sub
[/codebox]

Abraço :D

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...