EAN Barkod Yaratıcısı

ByToluidin · 8 Ağu 2007

Çok kısa bir şekilde EAN barkod hazırlayalım
Bir çok profesyonel otomasyon programlarında kullanılan barkod sistemini biz de yapalım
Hazırlık
--------------------------------------------------------------------------------
Öncelikle formumuza "txtean" isminde textbox, 1 adet "PEan" isminde picture box ve bir adet command butonu. Ayrıca pean.autoredraw = true olacak.

Kodlar
--------------------------------------------------------------------------------
Aşağıdaki kodu formun içine rastgele bir yere yapıştırıyoruz.

Kod:

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 ColorLinea(Digito As Integer, Numero As Integer, Posicion As Integer, NumeroLinea As Integer)
Dim Sequencia As Variant, SequenciaColor 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
                    SequenciaColor = Array(7, W, W, W, N, N, W, N)
                Case B
                    SequenciaColor = Array(7, W, N, W, W, N, N, N)
                Case C
                    SequenciaColor = Array(7, N, N, N, W, W, N, W)
            End Select
        Case 1
            Select Case Tipo
                Case A
                    SequenciaColor = Array(7, W, W, N, N, W, W, N)
                Case B
                    SequenciaColor = Array(7, W, N, N, W, W, N, N)
                Case C
                    SequenciaColor = Array(7, N, N, W, W, N, N, W)
            End Select
        Case 2
            Select Case Tipo
                Case A
                    SequenciaColor = Array(7, W, W, N, W, W, N, N)
                Case B
                    SequenciaColor = Array(7, W, W, N, N, W, N, N)
                Case C
                    SequenciaColor = Array(7, N, N, W, N, N, W, W)
            End Select
        Case 3
            Select Case Tipo
                Case A
                    SequenciaColor = Array(7, W, N, N, N, N, W, N)
                Case B
                    SequenciaColor = Array(7, W, N, W, W, W, W, N)
                Case C
                    SequenciaColor = Array(7, N, W, W, W, W, N, W)
            End Select
        Case 4
            Select Case Tipo
                Case A
                    SequenciaColor = Array(7, W, N, W, W, W, N, N)
                Case B
                    SequenciaColor = Array(7, W, W, N, N, N, W, N)
                Case C
                    SequenciaColor = Array(7, N, W, N, N, N, W, W)
            End Select
        Case 5
            Select Case Tipo
                Case A
                    SequenciaColor = Array(7, W, N, N, W, W, W, N)
                Case B
                    SequenciaColor = Array(7, W, W, N, N, W, W, N)
                Case C
                    SequenciaColor = Array(7, N, W, W, N, N, N, W)
            End Select
        Case 6
            Select Case Tipo
                Case A
                    SequenciaColor = Array(7, W, N, W, N, N, N, N)
                Case B
                    SequenciaColor = Array(7, W, W, W, W, N, W, N)
                Case C
                    SequenciaColor = Array(7, N, W, N, W, W, W, W)
            End Select
        Case 7
            Select Case Tipo
                Case A
                    SequenciaColor = Array(7, W, N, N, N, W, N, N)
                Case B
                    SequenciaColor = Array(7, W, W, N, W, W, W, N)
                Case C
                    SequenciaColor = Array(7, N, W, W, W, N, W, W)
            End Select
        Case 8
            Select Case Tipo
                Case A
                    SequenciaColor = Array(7, W, N, N, W, N, N, N)
                Case B
                    SequenciaColor = Array(7, W, W, W, N, W, W, N)
                Case C
                    SequenciaColor = Array(7, N, W, W, N, W, W, W)
            End Select
        Case 9
            Select Case Tipo
                Case A
                    SequenciaColor = Array(7, W, W, W, N, W, N, N)
                Case B
                    SequenciaColor = Array(7, W, W, N, W, N, N, N)
                Case C
                    SequenciaColor = Array(7, N, N, N, W, N, W, W)
            End Select
        
    End Select
    ColorLinea = SequenciaColor(NumeroLinea)
End Function

Devam...
--------------------------------------------------------------------------------
Aşağıdaki kodları ise command butonumuzun clik olayına yapıştırıyoruz

Kod:

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
 
        PEan.Cls
        If IsNumeric(TxtEan.Text) Then
        
        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
                                    PEan.CurrentY = 700
                                    If Grupo = 1 Then PEan.CurrentX = X - 15 Else PEan.CurrentX = X - 30
                                    PEan.Print NNumero
                                End If
                                
                                PEan.Line (X + (15 * Columna), 90)-(x1 + (15 * Columna), 690), ColorLinea(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
    SavePicture PEan.Image, App.Path &  TxtEan & ".bmp"

Kullanımı
--------------------------------------------------------------------------------
textboxumuza bir sayı girdikten sonra butonumuza basınca hem picture box'ın içine hemde bmp dosyası olarak ean barkodumuz hazır.
Kolay gelsin

VBasicMaster_MYY · 21 Eyl 2007

süper paylaşım sağolasın....

undertakerefe01 · 21 Eyl 2007

payLaşım için saol üstad

chnchn1 · 1 Eki 2007

paylaşım için teşekkürler fakat bir sorum olacak

kodları yazdığın üzere yerleştirdim dediklerini aynen uyguladım fakat üretilen barkodu resim olarak bir türlü kaydedemedim.

snipergiz · 22 Eki 2007

paylaşım güzel eline sağlık

EAN Barkod Yaratıcısı

ByToluidin

Kıdemli Üye

VBasicMaster_MYY

Üye

undertakerefe01

Katılımcı Üye

chnchn1

Yeni üye

snipergiz

Yeni üye

Sosyal medya sayfalarımız