Cok kısa bir şekilde EAN barkod hazırlayalım
Bir cok profesyonel otomasyon programlarında kullanılan barkod sistemini biz de yapalım
Hazırlık
--------------------------------------------------------------------------------
Oncelikle 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 icine 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

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

Kod:
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 icine hemde bmp dosyası olarak ean barkodumuz hazır.
Kolay gelsin
__________________