Poor quality barcode using drawsting function

[youngster94]

Hey all,

I've written a VB.Net app that creates picture badges complete with
barcodes. The problem is that the barcode quality is not good enough
to be read by scanners. I'm using the DRAWSTRING function to place
the barcode on the image, but no matter what graphics settings
(.InterpolationMode/.CompositingQuality etc.) I manipulate, the barcode
image remains poor quality. For exaple I'm using a solidbrush that
is black, but some of the bars of the barcode show as a light gray.
I've even increased the fontsize of the barcode as much as I
reasonably could and the problem is still there. Any ideas or
suggestions on how to fix this would be greatly appreciated.

Thanks for your time.

 

[steve]

what code type are you using? are you using a barcode font?

if you're comfortable using graphics functions, i can email you some code
that converts your input to a string representation of the barcode ("0"s and
"1"s)...from there, you could just directly draw a white or black bar to
your desired height and narrow/wide aspect ratio.

i believe you're using a barcode font...the above approach would save you
research/troubleshooting on that end and would allow you to directly render
and test the output.

i believe http://www.renderbar.com is going open source with an activex
barcoding control...that may be worth a free try too.

anyway, hth.


| Hey all,
|
| I've written a VB.Net app that creates picture badges complete with
| barcodes. The problem is that the barcode quality is not good enough
| to be read by scanners. I'm using the DRAWSTRING function to place
| the barcode on the image, but no matter what graphics settings
| (.InterpolationMode/.CompositingQuality etc.) I manipulate, the barcode
| image remains poor quality. For exaple I'm using a solidbrush that
| is black, but some of the bars of the barcode show as a light gray.
| I've even increased the fontsize of the barcode as much as I
| reasonably could and the problem is still there. Any ideas or
| suggestions on how to fix this would be greatly appreciated.
|
| Thanks for your time.
|

 

[youngster94]

Steve,

You're correct about me using a barcode font. The font itself works
like a champ if, for example I create the barcode using Word. It seems
to be the DrawString function giving me all the headaches.
I'm interested in checking out your code. That's a different
approach I didn't think of. It may work for me if I can figure out
the relationship between the characters and the pattern generated by
the font.

Thanks a lot

 

[steve]

| You're correct about me using a barcode font. The font itself works
| like a champ if, for example I create the barcode using Word. It seems
| to be the DrawString function giving me all the headaches.
| I'm interested in checking out your code. That's a different
| approach I didn't think of. It may work for me if I can figure out
| the relationship between the characters and the pattern generated by
| the font.

my second guess is that you are using code 3 of 9...

well, the fonts are going to simply associate a character with a
gliph...that gliph will have the bars for that character...when put
together, you've got your encoded data in barcode format. anyway, barcode
fonts (imho) are the *worst* solution i can think of to get a barcode. they
aren't easily portable, they don't sustain desired quality, and if you want
a check-digit included, you still have to program that yourself anyway! but
then again, sometimes the quick/easy approach is all that's called for.

below is some old vb 6 code (easily converted) i came up with that takes a
string value and outputs a string of 1's and 0's. a 0 is a white bar and a 1
is a black bar. all you have to do is run through each character in the
output string and draw a vertical line (black or white based on the
character [1 or 0])...you control the height and width of each bar...if you
want a check digit, just set that arg to true.

hth:

Private Function Code39(ByVal strDataToEncode As String, Optional ByVal
blnAddCheckDigit As Boolean) As String
Dim ary3of9CharSet(0 To 43) As String * 9
Dim strChar As String * 1
Dim lngCheckDigitSum As Long
Dim lngCharIndex As Long
Dim strEncode As String
Dim strEncodeFormat As String
Dim i As Long
Dim j As Long

Const cstrGuard As String * 9 = "010010100" 'asterisk
character
Const cstrPadd As String * 1 = "0"

'initial validation for encode data length

If Len(strDataToEncode) > 32 Then
Err.Raise vbObjectError + 600, "3 of 9", "3 of 9 barcodes are
limited to 32 characters."
' not really by specification but anything larger is
impractical...32 is standard.
End If

'populate the 3 of 9 character set
'numbers 0 to 9

ary3of9CharSet(0) = "000110100" '0
ary3of9CharSet(1) = "100100001" '1
ary3of9CharSet(2) = "001100001" '2
ary3of9CharSet(3) = "101100000" '3
ary3of9CharSet(4) = "000110001" '4
ary3of9CharSet(5) = "100110000" '5
ary3of9CharSet(6) = "001110000" '6
ary3of9CharSet(7) = "000100101" '7
ary3of9CharSet(8) = "100100100" '8
ary3of9CharSet(9) = "001100100" '9

'letters A to Z

ary3of9CharSet(10) = "100001001" 'A
ary3of9CharSet(11) = "001001001" 'B
ary3of9CharSet(12) = "101001000" 'C
ary3of9CharSet(13) = "000011001" 'D
ary3of9CharSet(14) = "100011000" 'E
ary3of9CharSet(15) = "001011000" 'F
ary3of9CharSet(16) = "000001101" 'G
ary3of9CharSet(17) = "100001100" 'H
ary3of9CharSet(18) = "001001100" 'I
ary3of9CharSet(19) = "000011100" 'J
ary3of9CharSet(20) = "100000011" 'K
ary3of9CharSet(21) = "001000011" 'L
ary3of9CharSet(22) = "101000010" 'M
ary3of9CharSet(23) = "000010011" 'N
ary3of9CharSet(24) = "100010010" 'O
ary3of9CharSet(25) = "001010010" 'P
ary3of9CharSet(26) = "000000111" 'Q
ary3of9CharSet(27) = "100000110" 'R
ary3of9CharSet(28) = "001000110" 'S
ary3of9CharSet(29) = "000010110" 'T
ary3of9CharSet(30) = "110000001" 'U
ary3of9CharSet(31) = "011000001" 'V
ary3of9CharSet(32) = "111000000" 'W
ary3of9CharSet(33) = "010010001" 'X
ary3of9CharSet(34) = "110010000" 'Y
ary3of9CharSet(35) = "011010000" 'Z

'allowed symbols

ary3of9CharSet(36) = "010000101" '-
ary3of9CharSet(37) = "110000100" '.
ary3of9CharSet(38) = "011000100" 'space
ary3of9CharSet(39) = "010101000" '$
ary3of9CharSet(40) = "010100010" '/
ary3of9CharSet(41) = "010001010" '+
ary3of9CharSet(42) = "000101010" '%

'validate data to encode

strDataToEncode = UCase(strDataToEncode)

'represent spaces with underscores

strDataToEncode = Replace(Replace(strDataToEncode, Chr(32), "_"), "*",
vbNullString)

For i = 1 To Len(strDataToEncode)
strChar = Mid$(strDataToEncode, i, 1)
Select Case strChar
Case 0 To 9, "A" To "Z", "-", ".", "$", "/", "+", "%", "_"
Case Else: Err.Raise vbObjectError + 600, "3 of 9", "Invalid
Character Specified"
End Select
Next

'encode data using character set
'get the check digit calculation while we're at it

For i = 1 To Len(strDataToEncode)
strChar = Mid$(strDataToEncode, i, 1)
'off-set alpha chars to ary index by 55, i.e. A = 65 - 55 = 10
lngCharIndex = Switch(strChar Like "#", strChar, _
strChar Like "[A-Z]", Asc(strChar) - 55, _
strChar = "-", 36, _
strChar = ".", 37, _
strChar = "_", 38, _
strChar = "$", 39, _
strChar = "/", 40, _
strChar = "+", 41, _
strChar = "%", 42)
'check digit sum
lngCheckDigitSum = lngCheckDigitSum + lngCharIndex
'get the encode string for the character
strEncode = strEncode & ary3of9CharSet(lngCharIndex)
Next

'should we incorporate the check digit?

If blnAddCheckDigit Then strEncode = strEncode &
ary3of9CharSet(lngCheckDigitSum Mod 43)
mintCheckDigit = lngCheckDigitSum Mod 43

'add start/stop characters

strEncode = cstrGuard & strEncode & cstrGuard

'now, format the output
'the aspect ratio is 3:1 per spec
For i = 1 To Len(strEncode) Step 9
strEncodeFormat = Mid$(strEncode, i, 9)
For j = 1 To 9
'odd position is a bar, else space
If j Mod 2 Then
If CLng(Mid$(strEncodeFormat, j, 1)) Then Code39 = Code39 &
"111" Else Code39 = Code39 & "1"
Else
If CLng(Mid$(strEncodeFormat, j, 1)) Then Code39 = Code39 &
"000" Else Code39 = Code39 & "0"
End If
Next
'add character padding
Code39 = Code39 & cstrPadd
Next
hErr:
If Err.Number Then
RaiseEvent Error(Err.Number, TypeName(Me) & "." & Err.Source,
Err.Description, mblnCancel)
If Not mblnCancel Then Resume Next Else Code39 = vbNullString
End If
Erase ary3of9CharSet
End Function

 

[steve]

how did it turn out?


| Steve,
|
| You're correct about me using a barcode font. The font itself works
| like a champ if, for example I create the barcode using Word. It seems
| to be the DrawString function giving me all the headaches.
| I'm interested in checking out your code. That's a different
| approach I didn't think of. It may work for me if I can figure out
| the relationship between the characters and the pattern generated by
| the font.
|
| Thanks a lot
|

 

[youngster94]

Steve,

Thanks for your time an your code. I was able improve the font barcode
enough to get the scanners to read them, however this is just a
bandaid for now until I get more time. I will sit down this weekend
and give your code a go. I'll let you know how it works out.

Thanks again.

 

[steve]

cool.

i'll check back.


| Steve,
|
| Thanks for your time an your code. I was able improve the font barcode
| enough to get the scanners to read them, however this is just a
| bandaid for now until I get more time. I will sit down this weekend
| and give your code a go. I'll let you know how it works out.
|
| Thanks again.
|

 

[youngster94]

Steve,
My "Upgrade VB6 code wizard" didn't go so smoothly. I was able to
manually fix some of the code, but there are two lines that I don't
know how to resolve (I identified them with "---->") and both problems
are towards the bottom of the function. Maybe you know how to fix
this. I think I came close, but I'm far from being an expert with
VB.NET and I know even less about VB6.

Thanks again



Private Function Code39(ByVal strDataToEncode As String, Optional ByVal
blnAddCheckDigit As Boolean = False) As String
Dim mblnCancel As Object
'Dim Me As Object
Dim mintCheckDigit As Object
'UPGRADE_ISSUE: Declaration type not supported: Array of
fixed-length strings. Click for more:
'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1051"'
Dim ary3of9CharSet(43) As String '*9
Dim strChar As New VB6.FixedLengthString(1)
Dim lngCheckDigitSum As Integer
Dim lngCharIndex As Integer
Dim strEncode As String
Dim strEncodeFormat As String
Dim i As Integer
Dim j As Integer


'UPGRADE_NOTE: cstrGuard was changed from a Constant to a
Variable. Click for more:
'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1053"'
Dim cstrGuard As New VB6.FixedLengthString(9, "010010100")
'asterisk character
'UPGRADE_NOTE: cstrPadd was changed from a Constant to a
Variable. Click for more:
'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1053"'
Dim cstrPadd As New VB6.FixedLengthString(1, "0")


'initial validation for encode data length


If Len(strDataToEncode) > 32 Then
Err.Raise(vbObjectError + 600, "3 of 9", "3 of 9 barcodes
are limited to 32 characters.")
'UPGRADE_ISSUE: The preceding line couldn't be parsed.
Click for more:
'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1010"'
' not really by specification but anything larger is
impractical...32 is standard.
End If


'populate the 3 of 9 character set
'numbers 0 to 9


ary3of9CharSet(0) = "000110100" '0
ary3of9CharSet(1) = "100100001" '1
ary3of9CharSet(2) = "001100001" '2
ary3of9CharSet(3) = "101100000" '3
ary3of9CharSet(4) = "000110001" '4
ary3of9CharSet(5) = "100110000" '5
ary3of9CharSet(6) = "001110000" '6
ary3of9CharSet(7) = "000100101" '7
ary3of9CharSet(8) = "100100100" '8
ary3of9CharSet(9) = "001100100" '9


'letters A to Z


ary3of9CharSet(10) = "100001001" 'A
ary3of9CharSet(11) = "001001001" 'B
ary3of9CharSet(12) = "101001000" 'C
ary3of9CharSet(13) = "000011001" 'D
ary3of9CharSet(14) = "100011000" 'E
ary3of9CharSet(15) = "001011000" 'F
ary3of9CharSet(16) = "000001101" 'G
ary3of9CharSet(17) = "100001100" 'H
ary3of9CharSet(18) = "001001100" 'I
ary3of9CharSet(19) = "000011100" 'J
ary3of9CharSet(20) = "100000011" 'K
ary3of9CharSet(21) = "001000011" 'L
ary3of9CharSet(22) = "101000010" 'M
ary3of9CharSet(23) = "000010011" 'N
ary3of9CharSet(24) = "100010010" 'O
ary3of9CharSet(25) = "001010010" 'P
ary3of9CharSet(26) = "000000111" 'Q
ary3of9CharSet(27) = "100000110" 'R
ary3of9CharSet(28) = "001000110" 'S
ary3of9CharSet(29) = "000010110" 'T
ary3of9CharSet(30) = "110000001" 'U
ary3of9CharSet(31) = "011000001" 'V
ary3of9CharSet(32) = "111000000" 'W
ary3of9CharSet(33) = "010010001" 'X
ary3of9CharSet(34) = "110010000" 'Y
ary3of9CharSet(35) = "011010000" 'Z


'allowed symbols


ary3of9CharSet(36) = "010000101" '-
ary3of9CharSet(37) = "110000100" '.
ary3of9CharSet(38) = "011000100" 'space
ary3of9CharSet(39) = "010101000" '$
ary3of9CharSet(40) = "010100010" '/
ary3of9CharSet(41) = "010001010" '+
ary3of9CharSet(42) = "000101010" '%


'validate data to encode


strDataToEncode = UCase(strDataToEncode)


'represent spaces with underscores


strDataToEncode = Replace(Replace(strDataToEncode, Chr(32),
"_"), "*", vbNullString)


For i = 1 To Len(strDataToEncode)
strChar.Value = Mid(strDataToEncode, i, 1)
Select Case strChar.Value
Case CStr(0) To CStr(9), "A" To "Z", "-", ".", "$",
"/", "+", "%", "_"
Case Else : Err.Raise(vbObjectError + 600, "3 of 9",
"Invalid Character Specified")
'UPGRADE_ISSUE: The preceding line couldn't be
parsed. Click for more:
'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1010"'
End Select
Next


'encode data using character set
'get the check digit calculation while we're at it


For i = 1 To Len(strDataToEncode)
strChar.Value = Mid(strDataToEncode, i, 1)
'off-set alpha chars to ary index by 55, i.e. A = 65 - 55 =
10
'UPGRADE_WARNING: Couldn't resolve default property of
object Switch(). Click for more:
'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
---->lngCharIndex = VB.switch(strChar.Value Like "#",
strChar.Value, strChar.Value Like "[A-Z]", Asc(strChar.Value) - 55,
strChar.Value = "-", 36, strChar.Value = ".", 37, strChar.Value = "_",
38, strChar.Value = "$", 39, strChar.Value = "/", 40, strChar.Value =
"+", 41, strChar.Value = "%", 42)
'check digit sum
lngCheckDigitSum = lngCheckDigitSum + lngCharIndex
'get the encode string for the character
strEncode = strEncode & ary3of9CharSet(lngCharIndex)
Next


'should we incorporate the check digit?


If blnAddCheckDigit Then strEncode = strEncode & mintCheckDigit
= lngCheckDigitSum Mod 43
'UPGRADE_ISSUE: The preceding line couldn't be parsed. Click
for more:
'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1010"'
'UPGRADE_WARNING: Untranslated statement in Code39. Please
check source code.
'UPGRADE_WARNING: Couldn't resolve default property of object
mintCheckDigit. Click for more:
'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'



'add start/stop characters


strEncode = cstrGuard.Value & strEncode & cstrGuard.Value


'now, format the output
'the aspect ratio is 3:1 per spec
For i = 1 To Len(strEncode) Step 9
strEncodeFormat = Mid(strEncode, i, 9)
For j = 1 To 9
'odd position is a bar, else space
If j Mod 2 Then
If CInt(Mid(strEncodeFormat, j, 1)) Then Code39 =
Code39 & "111" Else Code39 = Code39 & "1"
Else
If CInt(Mid(strEncodeFormat, j, 1)) Then Code39 =
Code39 & "000" Else Code39 = Code39 & "0"
End If
Next
'add character padding
Code39 = Code39 & cstrPadd.Value
Next
hErr:
If Err.Number Then
'UPGRADE_WARNING: TypeName has a new behavior. Click for
more:
'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1041"'
---->RaiseEvent ErrorToString(Err.Number, TypeName(Me) &
"." & Err.Source, Err.Description, mblnCancel)
If Not mblnCancel Then Resume Next Else Code39 =
vbNullString
End If
'UPGRADE_NOTE: Erase was upgraded to System.Array.Clear. Click
for more:
'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1061"'
System.Array.Clear(ary3of9CharSet, 0, ary3of9CharSet.Length)
End Function

 

[steve]

ok...i did this in about 5 minutes but *did* give it a test for compiling
and a very short value to encode.

again, just set a string to the function's return value...finally, draw a
white line for every 0 and a black line for every 1 in the string. vioala.

anyway, hth...let me know how it goes...

Imports System.Text

Class BarCode

Class BarCodeException
Inherits Exception
Friend Sub New(ByVal message As String)
MyBase.New(message)
End Sub
End Class

Public Shared Function Code39(ByVal dataToEncode As String, Optional ByVal
addCheckDigit As Boolean = False) As String
Dim code39CharSet(43) As String
Dim encodedOutput As New StringBuilder()
Dim guardPattern As String = "010010100"
Dim padding As String = "0"
If dataToEncode Is Nothing Then dataToEncode = ""
If dataToEncode.Length > 32 Then Throw New BarCodeException("3 of 9
barcodes are limited to 32 currentCharacters.")
' numbers 0 to 9
code39CharSet(0) = "000110100" '0
code39CharSet(1) = "100100001" '1
code39CharSet(2) = "001100001" '2
code39CharSet(3) = "101100000" '3
code39CharSet(4) = "000110001" '4
code39CharSet(5) = "100110000" '5
code39CharSet(6) = "001110000" '6
code39CharSet(7) = "000100101" '7
code39CharSet(8) = "100100100" '8
code39CharSet(9) = "001100100" '9
'letters A to Z
code39CharSet(10) = "100001001" 'A
code39CharSet(11) = "001001001" 'B
code39CharSet(12) = "101001000" 'C
code39CharSet(13) = "000011001" 'D
code39CharSet(14) = "100011000" 'E
code39CharSet(15) = "001011000" 'F
code39CharSet(16) = "000001101" 'G
code39CharSet(17) = "100001100" 'H
code39CharSet(18) = "001001100" 'I
code39CharSet(19) = "000011100" 'J
code39CharSet(20) = "100000011" 'K
code39CharSet(21) = "001000011" 'L
code39CharSet(22) = "101000010" 'M
code39CharSet(23) = "000010011" 'N
code39CharSet(24) = "100010010" 'O
code39CharSet(25) = "001010010" 'P
code39CharSet(26) = "000000111" 'Q
code39CharSet(27) = "100000110" 'R
code39CharSet(28) = "001000110" 'S
code39CharSet(29) = "000010110" 'T
code39CharSet(30) = "110000001" 'U
code39CharSet(31) = "011000001" 'V
code39CharSet(32) = "111000000" 'W
code39CharSet(33) = "010010001" 'X
code39CharSet(34) = "110010000" 'Y
code39CharSet(35) = "011010000" 'Z
'allowed symbols
code39CharSet(36) = "010000101" '-
code39CharSet(37) = "110000100" '.
code39CharSet(38) = "011000100" 'space
code39CharSet(39) = "010101000" '$
code39CharSet(40) = "010100010" '/
code39CharSet(41) = "010001010" '+
code39CharSet(42) = "000101010" '%
'validate data to encode
dataToEncode = dataToEncode.ToUpper
'represent spaces with underscores
dataToEncode = Replace(Replace(dataToEncode, Chr(32), "_"), "*", "")
Try
Dim charIndex As Integer
Dim checkDigit As Integer
Dim checkDigitSum As Integer
Dim currentChar As Char
Dim encoded As New StringBuilder()
Dim i As Integer
Dim j As Integer
For i = 0 To dataToEncode.Length - 1
currentChar = dataToEncode.Substring(i, 1)
Select Case currentChar
Case "0"c To "9"c, "A"c To "Z"c, "-"c, "."c, "$"c, "/"c, "+"c,
"%"c, "_"c
Case Else : Throw New BarCodeException("Invalid character
specified")
End Select
Select Case True
Case currentChar Like "[A-Z]" : charIndex = Asc(currentChar) - 55
Case currentChar Like "#" : charIndex = CInt(currentChar.ToString)
Case currentChar = "-" : charIndex = 36
Case currentChar = "." : charIndex = 37
Case currentChar = "_" : charIndex = 38
Case currentChar = "$" : charIndex = 39
Case currentChar = "/" : charIndex = 40
Case currentChar = "+" : charIndex = 41
Case currentChar = "%" : charIndex = 42
End Select
checkDigitSum += charIndex
encoded.Append(code39CharSet(charIndex))
Next
checkDigit = checkDigitSum Mod 43
'should we incorporate the check digit?
If addCheckDigit Then encoded.Append(code39CharSet(checkDigit))
'add start/stop currentCharacters
encoded.Insert(0, guardPattern)
encoded.Append(guardPattern)
'now, format the output
'the aspect ratio is 3:1 per spec (2:1 minimum)
Dim encodedFormat As String
For i = 0 To encoded.Length - 1 Step 9
encodedFormat = encoded.ToString.Substring(i, 9)
For j = 0 To 8
'odd position is a bar, else space
If j Mod 2 Then
If CInt(encodedFormat.Substring(j, 1)) Then
encodedOutput.Append("111") Else encodedOutput.Append("1")
Else
If CInt(encodedFormat.Substring(j, 1)) Then
encodedOutput.Append("000") Else encodedOutput.Append("0")
End If
Next
'add currentCharacter padding
encodedOutput.Append(padding)
Next
Catch ex As BarCodeException
Throw New BarCodeException(ex.Message)
Catch ex As Exception
Throw New BarCodeException(ex.Message)
Finally
Array.Clear(code39CharSet, 0, code39CharSet.Length)
End Try
Return encodedOutput.ToString
End Function

End Class

 

[steve]

hey...i need to change this snippet a bit since i'm using substring rather
than mid...which indexes at 0 rather than 1. i tested the change and it
should give the correct representation.


| For i = 0 To encoded.Length - 1 Step 9
| encodedFormat = encoded.ToString.Substring(i, 9)
| For j = 0 To 8
| 'odd position is a bar, else space
| If j Mod 2 Then
| If CInt(encodedFormat.Substring(j, 1)) Then
| encodedOutput.Append("111") Else encodedOutput.Append("1")
| Else
| If CInt(encodedFormat.Substring(j, 1)) Then
| encodedOutput.Append("000") Else encodedOutput.Append("0")
| End If
| Next
| 'add character padding
| encodedOutput.Append(padding)
| Next

change to reflect the below:

'EVEN position is a bar, else space
If j Mod 2 Then
If CInt(encodedFormat.Substring(j, 1)) Then
encodedOutput.Append("000") Else encodedOutput.Append("0")
Else
If CInt(encodedFormat.Substring(j, 1)) Then
encodedOutput.Append("111") Else encodedOutput.Append("1")
End If
Next