PrintBarCode

Sub TextBox1_Change()
if OptionButton1.value <> 0 then orient = 1 else orient = 2
if OptionButton3.value <> 0 then typeb = 1 else typeb = 2
Barcode1.text = TextBox1.text
Label2.caption = Barcode1.barcode(cint(typeb))
Barcode1.drawbar Barcode1.barcode(cint(typeb)),20,cint(orient)
End Sub

'cint() Serve a convertire le variant in Integer.

Private codes(100) As String
Private Sub UserControl_Initialize()
'Carica tutti i codice

codes(Asc("0")) = "00110 01000"
codes(Asc("1")) = "10001 01000"
codes(Asc("2")) = "01001 01000"
codes(Asc("3")) = "11000 01000"
codes(Asc("4")) = "00101 01000"
codes(Asc("5")) = "10100 01000"
codes(Asc("6")) = "01100 01000"
codes(Asc("7")) = "00011 01000"
codes(Asc("8")) = "10010 01000"
codes(Asc("9")) = "01010 01000"
codes(Asc("A")) = "10001 00100"
codes(Asc("B")) = "01001 00100"
codes(Asc("C")) = "11000 00100"
codes(Asc("D")) = "00101 00100"
codes(Asc("E")) = "10100 00100"
codes(Asc("F")) = "01100 00100"
codes(Asc("G")) = "00011 00100"
codes(Asc("H")) = "10010 00100"
codes(Asc("I")) = "01010 00100"
codes(Asc("J")) = "00110 00100"
codes(Asc("K")) = "10001 00010"
codes(Asc("L")) = "01001 00010"
codes(Asc("M")) = "11000 00010"
codes(Asc("N")) = "00101 00010"
codes(Asc("O")) = "10100 00010"
codes(Asc("P")) = "01100 00010"
codes(Asc("Q")) = "00011 00010"
codes(Asc("R")) = "10010 00010"
codes(Asc("S")) = "01010 00010"
codes(Asc("T")) = "00110 00010"
codes(Asc("U")) = "10001 10000"
codes(Asc("V")) = "01001 10000"
codes(Asc("W")) = "11000 10000"
codes(Asc("X")) = "00101 10000"
codes(Asc("Y")) = "10100 10000"
codes(Asc("Z")) = "01100 10000"
codes(Asc("-")) = "00011 10000"
codes(Asc(".")) = "10010 10000"
codes(Asc(" ")) = "01010 10000"
codes(Asc("*")) = "00110 10000"
codes(Asc("$")) = "00000 11100"
codes(Asc("/")) = "00000 11010"
codes(Asc("+")) = "00000 10110"
codes(Asc("%")) = "00000 01110"
End Sub

Public Property Get Barcode(type_of As Integer) As String
'Cerca la stringa del codice a barre

Dim decode As String, code As String
Dim a As Integer, b As Integer
Dim char As Integer
Dim char1 As Integer, char2 As Integer

decode = UCase$(m_Text) 'barcode solo in uppercase
Select Case type_of
Case 1 '3 of 9 (standard)
decode = "*" & decode & "*" 'aggiungi codici start e end
For a = 1 To Len(decode)
char = Asc(Mid$(decode, a%, 1))
If codes(char) = "" Then char = 32
'se il carattere non e' valido lo sostituisce

'con lo spazio

For b% = 1 To 5
code = code & (Mid$(codes(char), b%, 1))
code = code & (Mid$(codes(char), b% + 6, 1))
Next
Next
Barcode = code
Case 2 '2 of 5 ( solo numerico )
code = "0000"
decode = m_Text
If Len(decode) \ 2 <> Len(decode) / 2 Then
decode = decode & "0"

For a = 1 To Len(decode) Step 2
char1 = Asc(Mid$(decode, a%, 1))
If char1 > 58 Then char1 = 0 'no alpha
If codes(char1) = "" Then char1 = 48 '0 invalido
char2 = Asc(Mid$(decode, a% + 1, 1))
If char2 > 58 Then char2 = 0 'no alpha
If codes(char2) = "" Then char2 = 48 '0 invalido
For b% = 1 To 5
code$ = code$ & (Mid$(codes(char1), b%, 1))
code$ = code$ & (Mid$(codes(char2), b%, 1))
Next
Next
Barcode = code & "100" 'aggiunge codice terminazione
End Select
End Property

Public Sub drawbar(bin As String,
barheight As Integer, orient As Integer)
Dim cbpos As Integer 'posizione corrente
Dim a As Integer
Dim draw As Integer
Dim barwidth As Integer
Dim thickbar_ratio As Integer

barwidth = 1
thickbar_ratio = 2
cbpos = 0

Cls
draw = True 'avvia il disegno delle linee
For a = 1 To Len(bin)
If Mid$(bin, a, 1) = "1" Then
wid% = barwidth% * thickbar_ratio%
Else
wid% = barwidth%
End If
If draw% Then 'disegna una linea nera
If orient% = 1 Then 'orizontale
Line (cbpos, 0)-Step(wid - 1, barheight), , BF
Else 'verticale
Line (0, cbpos)-Step(barheight, wid - 1), , BF
End If
draw% = False
Else 'disegna una linea bianca
draw% = True
End If
cbpos% = cbpos% + wid%
Next
End Sub