Dear gurus,
I try to make barcode report, I can generate barcode from module got from pscode, and show the barcode on picturebox control
Now problem :
I try to save the picturebox to BMP file so I can generate report with BMP barcode, but the BMP blank, just white blank.
So, I think what about I try to use barcode font 128, but nothing the freeware font 128 can be scanned (i am trying to use android apk). While the barcode I generated from pscode easily scanned by android apk.
I know, the premium 128 barcode font need to be bought, because the free font 128 out there, none is working.
Conclusion :
1. If someone can direct me the working free font barcode 128, that will be nice :)
2. Or can someone help me why I save picturebox to BMP not working.
Here is my barcode module code
Example : Call codePrint(picSample1, txtbarcode.Text)
And don't forget set the picturebox to Pixel instead Twips.
I try to save using this :
Help..help
thanks
I try to make barcode report, I can generate barcode from module got from pscode, and show the barcode on picturebox control
Now problem :
I try to save the picturebox to BMP file so I can generate report with BMP barcode, but the BMP blank, just white blank.
So, I think what about I try to use barcode font 128, but nothing the freeware font 128 can be scanned (i am trying to use android apk). While the barcode I generated from pscode easily scanned by android apk.
I know, the premium 128 barcode font need to be bought, because the free font 128 out there, none is working.
Conclusion :
1. If someone can direct me the working free font barcode 128, that will be nice :)
2. Or can someone help me why I save picturebox to BMP not working.
Here is my barcode module code
Code:
Option Explicit
'BarcodeTest: A barcode printer. Right now only accepts a subset of
'Code128B (A-Z & 0-9) but can print all that is required by the check character.
'Output is correct using my Argox barcode scanner. Uses the "Start B" set.
'If you want to test it, do a print screen and paste the generated barcode
'into MS Word. Then print using the "High Quality" setting
'Created to ease data storage
Private Type CodeInfo
Char As String
Location As Long
End Type
'Data is stored here
Public auCode() As CodeInfo
Public asBinary() As String
Public Sub codeLoadData()
'This sub loads Code128 data into memory
Dim sFilePath As String, sFilename As String
Dim iFN As Integer, lX As Long, lCount As Long
Dim sData As String, asData() As String, asElement() As String
'Specify the 1st data file (several available chars (I didn't include all chars) and the location of it's binary code)
sFilePath = App.Path
If Not Right(sFilePath, 1) = "\" Then sFilePath = sFilePath & "\"
sFilename = "char.txt"
'Make space for data
sData = Space$(FileLen(sFilePath & sFilename))
'Open data file, load into memory
iFN = FreeFile
Open sFilePath & sFilename For Binary As iFN
Get iFN, 1, sData
Close iFN
'Store data it into arrays
asData = Split(sData, vbCrLf) 'Each line is split
lCount = UBound(asData)
ReDim auCode(lCount)
For lX = 0 To lCount
asElement = Split(asData(lX), vbTab)
auCode(lX).Location = CLng(asElement(0))
auCode(lX).Char = asElement(1)
Next lX
'Specify the 2nd data file (binary code of all 107 chars in Start A / Start B)
sFilename = "binary.txt"
'Make space for data
sData = Space$(FileLen(sFilePath & sFilename))
'Open data file, load into memory
iFN = FreeFile
Open sFilePath & sFilename For Binary As iFN
Get iFN, 1, sData
Close iFN
'Store data it into arrays
asData = Split(sData, vbCrLf)
lCount = UBound(asData)
ReDim asBinary(lCount)
For lX = 0 To lCount
asBinary(lX) = asData(lX)
Next lX
End Sub
Private Function codeCharToBinary(sChar As String) As String
'Returns the binary code of sChar
codeCharToBinary = asBinary(codeGetCharID(sChar))
End Function
Private Function codeGetCharID(sChar As String) As Long
'Returns the location of sChar in asBinary
Dim lX As Long
'Loop through array to find matching sChar
For lX = 0 To UBound(auCode, 1)
If StrComp(auCode(lX).Char, sChar, vbTextCompare) = 0 Then
'Found. Return the location
codeGetCharID = auCode(lX).Location
Exit For
End If
Next lX
End Function
Private Function codeCheck(sText As String) As String
'Returns the binary code of the check char
'Used to generate the check character. Search google for a better description of the process
Dim lX As Long, lCodeCheck As Long
'The process here is "(start char value) + Sum(value * weight of all chars)"
lCodeCheck = 103
For lX = 1 To Len(sText)
lCodeCheck = lCodeCheck + lX * codeGetCharID(Mid(sText, lX, 1))
Next lX
'The total is divided by 103, and the remainder is used as the check char. Or in other words, "Total Mod 103"
'Get the binary code and return it
codeCheck = asBinary(lCodeCheck Mod 103)
End Function
Public Sub codePrint(oDevice As Object, sText As String, Optional isPrinter As Boolean = False)
'Print the whole code
Const lPosY As Long = 10
Const lBarDist As Long = 1
Const lBarWidth As Long = 0
Const lBarHeight As Long = 50
Dim lPosX As Long
Dim lX As Long, lY As Long
Dim sPrint As String, sCurBinary As String, sCurChar As String
'Clear the picBox. I used "oDevice As Object" because I'm going to add printer
'support sooner of later (maybe much much later...)
oDevice.Cls
'The starting "X" position
lPosX = 10
'Print the starting char first
codePrintChar oDevice, asBinary(codeGetCharID("<")), lPosX, lPosY, lBarDist, lBarWidth, lBarHeight
'The loop through the whole message and print each one
For lX = 1 To Len(sText)
sCurChar = Mid(sText, lX, 1)
sCurBinary = asBinary(codeGetCharID(sCurChar))
codePrintChar oDevice, sCurBinary, lPosX, lPosY, lBarDist, lBarWidth, lBarHeight
Next lX
'Next is the check char
codePrintChar oDevice, codeCheck(sText), lPosX, lPosY, lBarDist, lBarWidth, lBarHeight
'Finally the stop char
codePrintChar oDevice, asBinary(codeGetCharID(">")), lPosX, lPosY, lBarDist, lBarWidth, lBarHeight
End Sub
Private Sub codePrintChar(oDevice As Object, sBinary As String, ByRef lPosX As Long, lPosY As Long, lBarDist As Long, lBarWidth As Long, lBarHeight As Long)
'Prints one individual char barcode. Only accepts binary code
Dim lY As Long
For lY = 1 To Len(sBinary)
'If the current bit is 1, print a line at the X position
If StrComp(Mid(sBinary, lY, 1), "1", vbTextCompare) = 0 Then oDevice.Line (lPosX, lPosY)-(lPosX + lBarWidth, lPosY + 50), , BF
'Move X position a certain distance
lPosX = lPosX + lBarDist + lBarWidth
Next lY
End Sub
Public Sub InitcodeData()
'This sub loads Code128 data into memory
Dim sFilePath As String, sFilename As String
Dim iFN As Integer, lX As Long, lCount As Long
Dim sData As String, asData() As String, asElement() As String
'Make space for data
'sData = Space$(FileLen(sFilePath & sFilename))
sData = "16" & vbTab & "0" & vbCrLf & "17" & vbTab & "1" & vbCrLf & "18" & vbTab & "2" & vbCrLf & "19" & vbTab & "3" & vbCrLf & "20" & vbTab & "4" & vbCrLf & "21" & vbTab & "5" & vbCrLf & "22" & vbTab & "6" & vbCrLf & "23" & vbTab & "7" & vbCrLf & "24" & vbTab & "8" & vbCrLf & "25" & vbTab & "9" & vbCrLf & "33" & vbTab & "A" & vbCrLf & "34" & vbTab & "B" & vbCrLf & "35" & vbTab & "C" & vbCrLf & "36" & vbTab & "D" & vbCrLf & "37" & vbTab & "E" & vbCrLf & _
"38" & vbTab & "F" & vbCrLf & "39" & vbTab & "G" & vbCrLf & "40" & vbTab & "H" & vbCrLf & "41" & vbTab & "I" & vbCrLf & "42" & vbTab & "J" & vbCrLf & "43" & vbTab & "K" & vbCrLf & "44" & vbTab & "L" & vbCrLf & "45" & vbTab & "M" & vbCrLf & "46" & vbTab & "N" & vbCrLf & "47" & vbTab & "O" & vbCrLf & "48" & vbTab & "P" & vbCrLf & "49" & vbTab & "Q" & vbCrLf & "50" & vbTab & "R" & vbCrLf & "51" & vbTab & "S" & vbCrLf & "52" & vbTab & "T" & vbCrLf & "53" & vbTab & "U" & vbCrLf & "54" & vbTab & "V" & vbCrLf & _
"55" & vbTab & "W" & vbCrLf & "56" & vbTab & "X" & vbCrLf & "57" & vbTab & "Y" & vbCrLf & "58" & vbTab & "Z" & vbCrLf & "103" & vbTab & "<" & vbCrLf & "106" & vbTab & ">"
'Store data it into arrays
asData = Split(sData, vbCrLf) 'Each line is split
lCount = UBound(asData)
ReDim auCode(lCount)
For lX = 0 To lCount
asElement = Split(asData(lX), vbTab)
auCode(lX).Location = CLng(asElement(0))
auCode(lX).Char = asElement(1)
Next lX
'Specify the 2nd data file (binary code of all 107 chars in Start A / Start B)
sFilename = "binary.txt"
'Make space for data
'sData = Space$(FileLen(sFilePath & sFilename))
sData = "11011001100" & vbCrLf & "11001101100" & vbCrLf & "11001100110" & vbCrLf & "10010011000" & vbCrLf & "10010001100" & vbCrLf & "10001001100" & vbCrLf & "10011001000" & vbCrLf & "10011000100" & vbCrLf & "10001100100" & vbCrLf & "11001001000" & vbCrLf & "11001000100" & vbCrLf & "11000100100" & vbCrLf & "10110011100" & vbCrLf & "10011011100" & vbCrLf & "10011001110" & vbCrLf & "10111001100" & vbCrLf & "10011101100" & vbCrLf & "10011100110" & _
vbCrLf & "11001110010" & vbCrLf & "11001011100" & vbCrLf & "11001001110" & vbCrLf & "11011100100" & vbCrLf & "11001110100" & vbCrLf & "11101101110" & vbCrLf & "11101001100" & vbCrLf & "11100101100" & vbCrLf & "11100100110" & vbCrLf & "11101100100" & vbCrLf & "11100110100" & vbCrLf & "11100110010" & vbCrLf & "11011011000" & vbCrLf & "11011000110" & vbCrLf & "11000110110" & vbCrLf & "10100011000" & vbCrLf & "10001011000" & vbCrLf & "10001000110" & _
vbCrLf & "10110001000" & vbCrLf & "10001101000" & vbCrLf & "10001100010" & vbCrLf & "11010001000" & vbCrLf & "11000101000" & vbCrLf & "11000100010" & vbCrLf & "10110111000" & vbCrLf & "10110001110" & vbCrLf & "10001101110" & vbCrLf & "10111011000" & vbCrLf & "10111000110" & vbCrLf & "10001110110" & vbCrLf & "11101110110" & vbCrLf & "11010001110" & vbCrLf & "11000101110" & vbCrLf & "11011101000" & vbCrLf & "11011100010" & vbCrLf & "11011101110" & _
vbCrLf & "11101011000" & vbCrLf & "11101000110" & vbCrLf & "11100010110" & vbCrLf & "11101101000" & vbCrLf & "11101100010" & vbCrLf & "11100011010" & vbCrLf & "11101111010" & vbCrLf & "11001000010" & vbCrLf & "11110001010" & vbCrLf & "10100110000" & vbCrLf & "10100001100" & vbCrLf & "10010110000" & vbCrLf & "10010000110" & vbCrLf & "10000101100" & vbCrLf & "10000100110" & vbCrLf & "10110010000" & vbCrLf & "10110000100" & vbCrLf & "10011010000" & _
vbCrLf & "10011000010" & vbCrLf & "10000110100" & vbCrLf & "10000110010" & vbCrLf & "11000010010" & vbCrLf & "11001010000" & vbCrLf & "11110111010" & vbCrLf & "11000010100" & vbCrLf & "10001111010" & vbCrLf & "10100111100" & vbCrLf & "10010111100" & vbCrLf & "10010011110" & vbCrLf & "10111100100" & vbCrLf & "10011110100" & vbCrLf & "10011110010" & vbCrLf & "11110100100" & vbCrLf & "11110010100" & vbCrLf & "11110010010" & vbCrLf & "11011011110" & _
vbCrLf & "11011110110" & vbCrLf & "11110110110" & vbCrLf & "10101111000" & vbCrLf & "10100011110" & vbCrLf & "10001011110" & vbCrLf & "10111101000" & vbCrLf & "10111100010" & vbCrLf & "11110101000" & vbCrLf & "11110100010" & vbCrLf & "10111011110" & vbCrLf & "10111101110" & vbCrLf & "11101011110" & vbCrLf & "11110101110" & vbCrLf & "11010000100" & vbCrLf & "11010010000" & vbCrLf & "11010011100" & vbCrLf & "1100011101011"
'Store data it into arrays
asData = Split(sData, vbCrLf)
lCount = UBound(asData)
ReDim asBinary(lCount)
For lX = 0 To lCount
asBinary(lX) = asData(lX)
Next lX
End SubAnd don't forget set the picturebox to Pixel instead Twips.
I try to save using this :
Code:
SavePicture Picture1.Image, App.Path & "\a.bmp"Help..help
thanks