I'm trying to generate a Code 128 Barcode using Micorosft Word 2013 or 2019 and VBA using the following function:
Public Function GenerateCode128B(SourceStruing As String)
Dim checkDigitValue As Integer
Dim barcodeString As String
Dim startSign As String
Dim endSign As String
Dim index As Integer
Dim c As Integer
checkDigitValue = 104
startSign = Chr(204)
endSign = Chr(206)
index = 1
barcodeString = startSign
For c = 1 To Len(SourceString) Step 1
Dim currentSign As String
currentSign = Asc(Mid(SourceString, c, 1))
If Asc(currentSign) < 32 Or Asc(currentSign) > 126 Then
GenerateCode128B = Empty
Else
barcodeString = barcodeString & Mid(SourceString, c, 1)
checkDigitValue = checkDigitValue + (Asc(currentSign) - 32) * index
index = index + 1
End If
Next
checkDigitValue = checkDigitValue Mod 103
If checkDigitValue > 94 Then
checkDigitValue = checkDigitValue + 100
Else
checkDigitValue = checkDigitValue + 32
End If
barcodeString = barcodeString & Chr(checkDigitValue) & endSign
GenerateCode128B = barcodeString
End Function
Therefore, I'm using this font: https://www.dafont.com/de/code-128.font.
To display the barcode in the word document, I use these two similar lines:
Selection.Font.Name = "Code 128"
Selection.TypeTest GenerateCode128B("ABC12DEF456G")
My current problem:
If I do not install the font under Windows 10, the barcode is correct. If I install the font, the barcode is not readable.
Example:
Plain text: ABC12DEF456F
Barcode without using a specific font: ÌABC12DEF456FNÎ (Correct and readable)
Barcode using the code128.ttf font: ƎΒΧΓƎΑΓ12ΔΕΖ456ΔƎΒΧΓƎ (Incorrect, unreadable!)
What could be the reason why the barcode is displayed with symbols of the greek alphabet?
Related
This is a number #
This is a number or letter?
Separate the random string like ??#?#-???##-#?#???-#???#-##
I need some code that generates the string as shown above. It doesn't have to be complicated.
Expected result example: 2F421-QD421-2W3FY0-3F4L1-37
I've tried using PHP and this example but wasn't able to achieve what I was looking for Generating a random numbers and letters
I am looking for a vb.net project to handle the generation so i can submit the serial into a database manually.
I quite like this approach:
Dim characters = "0123456789ABCDEFGHIJKLOMNOPQRSTUVWXYZ"
Dim template = "??#?#-???##-#?#???-#???#-##"
Dim rnd = New Random()
Dim query =
From t In template
Select If(t = "-", "-", characters(rnd.Next(If(t = "?", characters.Length, 10))))
Dim result = String.Join("", query)
Console.WriteLine(result)
It gives me output like this:
RC2C9-DHB47-1Q07RL-8BIF7-57
Create 2 functions 1 for letters GRL (Generate Random Letter) 1 for numbers GRN (Generate Random Number) like so:
Result of what i called is: W96-GKlF6
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Console.WriteLine(GRL(1) + GRN(2) + "-" + GRL(4) + GRN(1))
End Sub
Public Function GRL(ByRef iLength As Integer) As String
Static rdm As New Random()
Dim allowChrs() As Char = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLOMNOPQRSTUVWXYZ".ToCharArray()
Dim sResult As String = String.Empty
For i As Integer = 0 To iLength - 1
sResult += allowChrs(rdm.Next(0, allowChrs.Length))
Next
Return sResult
End Function
Public Function GRN(ByRef iLength As Integer) As String
Static rdm As New Random()
Dim allowChrs() As Char = "0123456789".ToCharArray()
Dim sResult As String = String.Empty
For i As Integer = 0 To iLength - 1
sResult += allowChrs(rdm.Next(0, allowChrs.Length))
Next
Return sResult
End Function
Easy, random numbers to use as ASCII codes, then check the position to delimit if its going to be just a number or a character that can be number or letter.
When is a position that can be number or letter, analyze the random number and split it. If the number is less than 11 that means is a number then add 47 and use the result as ASCII code (random create numbers from 1 to 36) so for example if the random is 1, we say 47 + 1 = 48, 48 is the ASCII code of 0.
If the number is 11 or more we add 54, so for example if random is 11 then we have 11 + 54 = 65. 65 is the ASCII code for the letter A.
Dim Key As String = ""
Dim N As Integer
Randomize()
For t = 1 To 23
If t = 3 Or t = 5 Or t = 9 Or t = 10 Or t = 11 Or t = 13 Or t = 17 Or t >= 21 Then
N = 10
Else
N = 36
End If
Dim value As Integer = CInt(Int(N * Rnd() + 1))
If value < 11 Then
Key = Key & Chr(value + 47)
Else
Key = Key & Chr(value + 54)
End If
If t = 5 Or t = 10 Or t = 16 Or t = 21 Then
Key = Key & "-"
End If
Next
I have this function to decode the DigitalProductId from the registry, the same code is all over the internet but is not returning the expected product key in my Windows Server 2012, i have the product key and this code is supposed to find it for me, but it returns a different key:
Shared Function DecodeProductKey(digitalProductId As Byte()) As String
Const keyStartIndex As Integer = 52
Const keyEndIndex As Integer = keyStartIndex + 15
Dim digits As Char() = New Char() {"B"c, "C"c, "D"c, "F"c, "G"c, "H"c,
"J"c, "K"c, "M"c, "P"c, "Q"c, "R"c,
"T"c, "V"c, "W"c, "X"c, "Y"c, "2"c,
"3"c, "4"c, "6"c, "7"c, "8"c, "9"c}
Const decodeLength As Integer = 29
Const decodeStringLength As Integer = 15
Dim decodedChars As Char() = New Char(decodeLength - 1) {}
Dim hexPid As New ArrayList()
For i As Integer = keyStartIndex To keyEndIndex
hexPid.Add(digitalProductId(i))
Next
For i As Integer = decodeLength - 1 To 0 Step -1
If (i + 1) Mod 6 = 0 Then
decodedChars(i) = "-"c
Else
Dim digitMapIndex As Integer = 0
For j As Integer = decodeStringLength - 1 To 0 Step -1
Dim byteValue As Integer = (digitMapIndex << 8) Or CByte(hexPid(j))
hexPid(j) = CByte(byteValue \ 24)
digitMapIndex = byteValue Mod 24
decodedChars(i) = digits(digitMapIndex)
Next
End If
Next
Return New String(decodedChars)
End Function
Is there a new decode method for the Windows Server 2012?
Has anyone work with this code in this operating system?
Edit:
I get the DigitalProductId from the Registry. What value is supposed to have the product key?
Registry values
I am using a Zebra iMZ320 printer, a windows mobile device, CPCL and vb.net.
I am trying to get the code to load a bitmap image and then to print this using CPCL
I have previoulsy had a similar piece of code to that contaibed below working with no issue. I must be missing something obvious, but for the life of me I cannot see it.
My problem is the printer will only printout HEX instead of the image ! Has anyone come across this before ? Can you help ?
Public Sub DrawBitmap(ByVal xPosition As Integer, ByVal yPosition As Integer)
Dim bmp As Bitmap
bmp = New System.Drawing.Bitmap(GetLogo)
If bmp Is Nothing Then
Throw New ArgumentNullException("bmp")
End If
'Make sure the width is divisible by 8
Dim loopWidth As Integer = 8 - (bmp.Width Mod 8)
If loopWidth = 8 Then
loopWidth = bmp.Width
Else
loopWidth += bmp.Width
End If
cpclData = ""
cpclData = cpclData & "! 0 200 200 300 1 " & vbCr & vbLf
cpclData = cpclData & (String.Format("EG {0} {1} {2} {3} ", loopWidth \ 8, bmp.Height, xPosition, yPosition))
For y As Integer = 0 To bmp.Height - 1
Dim bit As Integer = 128
Dim currentValue As Integer = 0
For x As Integer = 0 To loopWidth - 1
Dim intensity As Integer
If x < bmp.Width Then
Dim color As Color = bmp.GetPixel(x, y)
Dim MyR As Integer = color.R
Dim MyG As Integer = color.G
Dim MyB As Integer = color.B
intensity = 255 - ((MyR + MyG + MyB) / 3)
Else
intensity = 0
End If
If intensity >= 128 Then
currentValue = currentValue Or bit
End If
bit = bit >> 1
If bit = 0 Then
cpclData = cpclData & (currentValue.ToString("X2"))
bit = 128
currentValue = 0
End If
'x
Next
Next
'y
cpclData = cpclData & vbCr & vbLf
cpclData = cpclData & "PRINT"
Print_Invoice()
End Sub
Public Shared Function StrToByteArray(ByVal str As String) As Byte()
Dim encoding As New System.Text.ASCIIEncoding()
Return encoding.GetBytes(str)
End Function
Private Sub Print_Invoice()
' Instantiate a connection
Dim thePrinterConn As ZebraPrinterConnection = New BluetoothPrinterConnection(MyMacAddress)
' Open the connection - physical connection is established here.
thePrinterConn.Open()
' Send the data to the printer as a byte array
thePrinterConn.Write(StrToByteArray(cpclData))
' Make sure the data got to the printer before closing the connection
Thread.Sleep(500)
' Close the connection to release resources.
thePrinterConn.Close()
' Debug output
txt_TestPrint.Text = cpclData.ToString
Dim objStreamWriter As StreamWriter
Dim file_name As String
'open dialog box for new file
SaveFileDialog1.InitialDirectory = "\Storage Card\"
If SaveFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then
file_name = SaveFileDialog1.FileName
If Len(file_name) > 0 Then
objStreamWriter = New StreamWriter(file_name & ".txt")
'Write a line of text from list box.
objStreamWriter.WriteLine(txt_TestPrint.Text)
'Close the file.
objStreamWriter.Close()
Exit Sub
End If
End If
End Sub
The code produce this file as output if it helps.
! 0 200 200 300 1
EG 10 80 10 10 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF7FFFFFFFFFFF800FFF8001FFFFFFFFFE0001FC00007FFFFFFFF800007000001FFFFFFFF01F80703FF80FFFFFFFE07FF800FFFE07FFFFFFC1FFFC01FFFF87FFFFFFC3FFFC01FFFF83FFFFFF87FFFC01FFFFC3FFFFFF87FFFC11FFFFC3FFFFFF87FFFC39FFFFC1FFFFFF87FFFC7FFFFFC1FFFFFF87FFFCFFFFFFC1FFFFFF87FFFFFFFFFFC1FFFFFFC3FFFFFFFFFFC3FFFFFFC1FFFFFFFFFF83FFFFFFE1FFFFFFFFFF07FFFFFFE1FFFFFFFFFE07FFFFFFE1FFFFFFFFFC0FFFFFFFE1FFFFCF0FF81FFFFFFFC3FFFF8001C03FFFFFFFC3FFCF800000FFFFFFFFC1FF87C04003FFFFFFFFE0FF07FFF81FFFFFFFFFE0780FFFFC3FFFFFFFFFF0001FFFF83FFFFFFFFFFC003FFFF87FFFFFFFFFFF803FFFF87FFFFFFFFFFFFC1FFFF87FFFFFFFFFFFFC1FFFF07FFFFFFFFFFFFE0FFFF0FFFFFFFFFFFFFE0FC020FFFFFFFFFFFFFF000000FFFFFFFFFFFFFF000001FFFFFFFFFFFFFF8001C1FFFFFFFFFFFFFF83E3F9FFFFFFFFFFFFFFCFE3FFFFFFFFFFFFFFFFF9C39FFFFFFFFFFFFFFFF8C70FFFFFFFFFFFFFFFF9879FFFFFFFFFFFFFFFFF8FFFFFFFFFFFFFFFF7FF807FFFFFFFFFFFFFEFFF00FFF7FFFFFFFFFFCFFF03FFF3FFFFFFFFFFCFFFFFFFF3FFFFFFFFFFCFFC001FF3FFFFFFFFFFC7F8000FE3FFFFFFFFFFC1F0000783FFFFFFFFFFC000FF0003FFFFFFFFFFE001FF8007FFFFFFFFFFF003FFC00FFFFF3FFFFFFC07FFF03FFFFE1FFF7FFFFFFFFFFFFFC61FFE0FFFFFFFFFFFFC023FFE01FFFFFFFFFFF803FFFF003FFFFFFFFF0C0FFFFF800FFFFFFFF00C1FFFFF02041FFC7FE00C3FFFFF070000E001E0183FFFFE070400C001F4183FFFFE000F008001FE001FFFFE001F0783C1FE000FFFFC083F0783C1FF0003FFC01C1E0F07E3FF03007FC01E1E0F0700FF83803FE00C1E0F06007F80C07FF0001E0F06007F8043FFFF003E0F83C1FF007FFFFFE0700F83C1FE00FFFFFFFFE0038001FF0FFFFFFFFFF003C001FFFFFFFFFFFFFE03E001FFFFFFFFFFFFFFFFFCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
PRINT
The iMZ printer comes pre configured to be in line mode. You have to change it to zpl mode so that it would parse either zpl or cpcl
Send this SGD to change the language of the printer.
! U1 setvar "device.languages" "zpl"
You convert the bitmap to a hex string
cpclData = cpclData & (currentValue.ToString("X2"))
then you encode this as byte[]
Return encoding.GetBytes(str)
end send the data to the printer:
thePrinterConn.Write(StrToByteArray(cpclData))
But I assume you have to encode the hex data string back to a byte array with the coresponding hex values converted back to a byte. In example a hex string of "FFFFFFFF" has to be converted back to byte[]{0xff,0xff,0xff,0xff}, exxcpet the printer language (CPCL?) reads hex string data and converts that back to byte itself.
I have a document template which is auto populated via an external web service. The incoming data exists as a currency (e.g. 3.10) but when it is passed into the Word Document template the variable is truncated to remove any trailing 0's. I need the number to always appear with 2 decimals, even if they are both 0's.
This is with the 2003 version of Word, I have not tested with other versions since all of our document templates need to be generated using that version of Word.
You should be able to utilize the Format function in a macro to do this:
Format(yourValue, "Currency")
To have a user entered text box that can only accept currency formatted values, I've used macros like this:
Private Function getValue(text As String) As Currency
If text = "" Then
getValue = 0
Else
getValue = CCur(Val(RemoveNonNumeric(text)))
End If
End Function
Private Function RemoveNonNumeric(inputStr As String) As String
Const NUMERIC_CHARS = "0123456789."
Dim result As String
Dim currCharIndex As Long
Dim currentString As String
Dim deciCount As Integer
Dim afterDeciCount As Integer
deciCount = 0
afterDeciCount = 0
For currCharIndex = 1 To Len(inputStr)
currentString = Mid$(inputStr, currCharIndex, 1)
If currentString = "." Then deciCount = deciCount + 1
If InStr(1, NUMERIC_CHARS, currentString) > 0 And deciCount < 2 And afterDeciCount < 3 Then
result = result + currentString
If deciCount > 0 Then afterDeciCount = afterDeciCount + 1
End If
Next
result = result
RemoveNonNumeric = result
End Function
I have a SQLite database which is running on a handheld which is capturing signatures using OpenNetCF's Smart Device Framework 2.1 running under Windows Mobile 6.1. The signatures are captured from the Signature control using the GetSignatureEx method and stored in the database.
What I want to do now is reconstitute the signatures on the desktop, but the desktop does not have a similar control. I looked at the data and it looks like a bunch of vectors, which explains why the data is so compact.
Does anyone have any idea how I can convert the data into a bitmap on the desktop using VB.NET. Thanks.
Found what I wanted on an OpenNetCF forum. The code was originally in C#, but didn't take too long to convert it to VB.NET. This code has been tested on version 2.0 and 2.1 of the OpenNetCF framework, but it will apparently work with version 1.4. Colin
Public Function GetSignature(ByVal arrsig As Byte(), ByVal backcolor As System.Drawing.Color)
Dim pic As System.Windows.Forms.PictureBox
Dim word As Integer
Dim lngIndex As Integer
Dim lngPointsToRead As Integer = 0
Dim lngCurrX As Integer = -1
Dim lngCurrY As Integer = -1
Dim lngPrevX As Integer = -1
Dim lngPrevY As Integer = -1
Dim lngWidth As Integer = 1
Dim lngHeight As Integer
Dim bit As New System.Drawing.Bitmap(1, 1)
Dim g As Graphics = Graphics.FromImage(bit)
pic = New picturebox()
Dim blackpen As New Pen(Color.Black)
If arrsig.Length < 3 Then
Return Nothing
End If
word = arrsig(0)
word = word + System.Convert.ToInt32(arrsig(1)) * 256
lngWidth = word
word = arrsig(2)
word = word + System.Convert.ToInt32(arrsig(3)) * 256
lngHeight = word
bit = New Bitmap(lngWidth, lngHeight)
g = Graphics.FromImage(bit)
g.Clear(backcolor)
lngIndex = 4
While (True)
If (lngIndex >= arrsig.Length) Then
Exit While
End If
If (lngPointsToRead = 0) Then
word = arrsig(lngIndex)
lngIndex = lngIndex + 1
word = word + System.Convert.ToInt32(arrsig(lngIndex)) * 256
lngPointsToRead = word
lngPrevX = -1
lngPrevY = -1
Else
If (lngCurrX = -1) Then
word = arrsig(lngIndex)
If (lngWidth > 255) Then
lngIndex = lngIndex + 1
word = word + System.Convert.ToInt32(arrsig(lngIndex)) * 256
End If
lngCurrX = word
ElseIf (lngCurrY = -1) Then
word = arrsig(lngIndex)
If (lngHeight > 255) Then
lngIndex = lngIndex + 1
word = word + System.Convert.ToInt32(arrsig(lngIndex)) * 256
End If
lngCurrY = word
lngPointsToRead = lngPointsToRead - 1
If (lngPrevX <> -1) Then
g.DrawLine(blackpen, lngPrevX, lngPrevY, lngCurrX, lngCurrY)
End If
lngPrevX = lngCurrX
lngPrevY = lngCurrY
lngCurrX = -1
lngCurrY = -1
End If
End If
lngIndex = lngIndex + 1
End While
pic.Image = bit
Return pic.Image
End Function