Search code examples
vb.nettiffzpl

How to convert TIFF File to ASCII Hex to send ZPL to a Zebra Printer


I am creating an application to dynamically print Labels to a networked Zebra printer. I can easily send text values but also need to include a logo at the bottom of the label. The logo(s) are stored on a network location and are tiff files.

I am struggling to find a good example of how to do this. The following code does print, but the returned string I receive from the file is purely FFFFF.... So all I am getting is a black rectangle.

Protected Sub Print()
    Dim IP As String = "172.16.132.92"
    Dim clientSocket As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
    clientSocket.Connect(New IPEndPoint(IPAddress.Parse(IP), 9100))

    Dim bitmapFilePath As String = "\\SomeServer\Advertising\Artwork\Trademarks\Packaging Label Trademarks 8919\Betaplug.tif"
    Dim bitmapFileData As Byte() = System.IO.File.ReadAllBytes(bitmapFilePath)
    Dim fileSize As Integer = bitmapFileData.Length

    Dim bitmapDataOffset As Integer = 0
    Dim width As Integer = 50 '255
    Dim height As Integer = 50 '255
    Dim bitsPerPixel As Integer = 1
    Dim bitmapDataLength As Integer = 400
    Dim widthInBytes As Double = Math.Ceiling(width / 8.0)

    Dim bitmap(bitmapDataLength) As Byte

    For i As Integer = 0 To bitmapDataLength Step 1
        bitmap(i) = bitmap(i) Xor &HFF
    Next

    Dim ZPLImageDataString As String = BitConverter.ToString(bitmap)
    ZPLImageDataString = Replace(ZPLImageDataString, "-", String.Empty)

    Dim ZPL As String = "~DGR:SAMPLE.GRF," & bitmapDataLength & ",018," & _
                        ZPLImageDataString & _
                        "^XA" & _
                        "^F100,200^XGR:SAMPLE.GRF,2,2^FS" & _
                        "^XZ^"
    Dim Label As String = ZPL
    clientSocket.Send(Encoding.UTF8.GetBytes(Label))
    clientSocket.Close()
End Sub

Solution

  • Here's how I tackled this in the past. This code was pulled out of a drag&drop label designer so it has some conversions in it for handling differences in DPI which you'll have to remove if not needed. But the basic process was to get a bitmap, resize it so its width is divisible by 8 for encoding, make it monochrome since this was an on/off pixel thermal printer, convert its bits to a hex string, and then use ZPL's compression map to compress it (less we end up with a ridiculously long string that takes forever to send to the printer).

    The 0.8 threshold is just a number I found to work pretty reliably, it is the cut-off value for deciding whether a bit is on/off depending on how dark it is, you may need to adjust that to suit your needs.

    Input Image was:

    enter image description here

    Output using Labelary's online ZPL viewer (http://labelary.com/viewer.html):

    enter image description here

    Public Class Form1
        Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
            Dim imgZpl As String = TiffToZpl("C:\Users\sooho\Desktop\so.tif", 0.8)
            Debug.Print(imgZpl)
        End Sub
    
        Public Function TiffToZpl(tiffFilePath As String, grayscaleThreshold As Single) As String
    
            Dim ms As New System.IO.MemoryStream
            System.Drawing.Bitmap.FromFile(tiffFilePath).Save(ms, System.Drawing.Imaging.ImageFormat.Png)
            Dim bmp = New System.Drawing.Bitmap(ms)
    
            ResizeBitmapMod8(bmp)
            bmp = Monochrome(bmp, grayscaleThreshold)
    
            Return BitmapToZpl(bmp, 0, 0)
    
        End Function
    
        Private Function BitmapToZpl(ByRef bm As Bitmap, top As Integer, left As Integer) As String
            Dim ret As New System.Text.StringBuilder
            Dim lastHexChar As Nullable(Of Char) = Nothing
            Dim hexCharCount As Integer = 0
            Dim finalHex As New System.Text.StringBuilder
            Dim bitCount As Integer = 0
            Dim binaryCount As Integer = 0
            For r As Integer = 0 To bm.Height - 1
                For c As Integer = 0 To bm.Width - 1
                    bitCount += 1
                    If Not bm.GetPixel(c, r).Name.Equals("ffffffff") Then
                        Select Case bitCount
                            Case 1 : binaryCount += 8
                            Case 2 : binaryCount += 4
                            Case 3 : binaryCount += 2
                            Case 4 : binaryCount += 1
                        End Select
                    End If
                    If bitCount = 4 Then
                        If lastHexChar Is Nothing Then
                            lastHexChar = CChar(hexMap(binaryCount))
                            hexCharCount = 1
                        Else
                            If CChar(hexMap(binaryCount)) = lastHexChar Then
                                hexCharCount += 1
                            Else
                                While hexCharCount > 0
                                    Dim maxKey As Integer = 0
                                    For Each key As Integer In zplHexCompressionMap.Keys
                                        If key <= hexCharCount Then
                                            maxKey = key
                                        Else
                                            Exit For
                                        End If
                                    Next
                                    finalHex.Append(zplHexCompressionMap(maxKey) & lastHexChar)
                                    hexCharCount -= maxKey
                                End While
                                lastHexChar = CChar(hexMap(binaryCount))
                                hexCharCount = 1
                            End If
                        End If
                        bitCount = 0
                        binaryCount = 0
                    End If
                Next c
            Next r
            While hexCharCount > 0
                Dim maxKey As Integer = 0
                For Each key As Integer In zplHexCompressionMap.Keys
                    If key <= hexCharCount Then
                        maxKey = key
                    Else
                        Exit For
                    End If
                Next
                finalHex.Append(zplHexCompressionMap(maxKey) & lastHexChar)
                hexCharCount -= maxKey
            End While
    
            Dim totalBytes As Integer = CInt((bm.Height * bm.Width) / 8)
            Dim byteWidth As Integer = CInt(bm.Width / 8)
            Dim adjustedLeft As Integer = CInt(left * dpiMultiplier_ScreenToPrinter)
            Dim adjustedTop As Integer = CInt(top * dpiMultiplier_ScreenToPrinter)
    
            ret.Append("^FO" & adjustedLeft.ToString & "," & adjustedTop.ToString)
            ret.Append("^GFA," & totalBytes.ToString & "," & totalBytes.ToString & "," & byteWidth.ToString & ",,")
            ret.Append(finalHex.ToString)
            ret.Append("^FS")
    
            Return ret.ToString
        End Function
    
        Private Sub ResizeBitmapMod8(ByRef bm As Bitmap)
            'Resizes a bitmap to its nearest width multiple of 8. Images must be hex-encoded
            'to be send to the printer, and hex encoding requires pairs of 4 bits, so the
            'the image's width must be divisible by 8 or the resulting image will have a black
            'strip down the side once it's decoded by the zpl printer
            If bm.Width Mod 8 <> 0 Then
                Dim width As Integer = bm.Width
                Dim height As Integer = bm.Height
                Dim aspectRatio As Double = width / height
                Dim lowMultiplier As Integer = CInt(Int(width / 8))
                Dim highMultiplier As Integer = lowMultiplier + 1
                Dim diffBelow As Integer = width - (lowMultiplier * 8)
                Dim diffAbove As Integer = (highMultiplier * 8) - width
                If diffBelow < diffAbove Then
                    width = lowMultiplier * 8
                Else
                    width = highMultiplier * 8
                End If
                height = CInt(width / aspectRatio)
                Dim bmResized As New Bitmap(width, height)
                Dim gfxResized As Graphics = Graphics.FromImage(bmResized)
                gfxResized.DrawImage(bm, 0, 0, bmResized.Width + 1, bmResized.Height + 1)
                bm = bmResized
            End If
        End Sub
    
        Private Function Monochrome(ByVal bmOriginal As Bitmap, grayscaleThreshold As Single) As Bitmap
            Dim gsBitmap As New Bitmap(bmOriginal)
    
            Try
                'Convert image to grayscale
                Dim gfxSource As Graphics = Graphics.FromImage(gsBitmap)
                Dim imgAttr As New System.Drawing.Imaging.ImageAttributes
                Dim imgRec As Rectangle = New Rectangle(0, 0, gsBitmap.Width, gsBitmap.Height)
                imgAttr.SetColorMatrix(New System.Drawing.Imaging.ColorMatrix(grayMatrix))
                imgAttr.SetThreshold(grayscaleThreshold)
                gfxSource.DrawImage(gsBitmap, imgRec, 0, 0, gsBitmap.Width, gsBitmap.Height, GraphicsUnit.Pixel, imgAttr)
            Catch ex As Exception
                'image already has an indexed color matrix
            End Try
    
            'Convert format to 1-index monochrome
            Dim mcBitmap As Bitmap = New Bitmap(gsBitmap.Width, gsBitmap.Height, Imaging.PixelFormat.Format1bppIndexed)
            Dim mcBmData As Imaging.BitmapData = mcBitmap.LockBits(
                New Rectangle(0, 0, mcBitmap.Width, mcBitmap.Height),
                Imaging.ImageLockMode.ReadWrite,
                Imaging.PixelFormat.Format1bppIndexed)
            For y As Integer = 0 To gsBitmap.Height - 1
                For x As Integer = 0 To gsBitmap.Width - 1
                    Dim pixelColor As Color = gsBitmap.GetPixel(x, y)
                    If pixelColor.Name = "ffffffff" Then
                        Dim index As Integer = y * mcBmData.Stride + (x >> 3)
                        Dim p As Byte = Runtime.InteropServices.Marshal.ReadByte(mcBmData.Scan0, index)
                        Dim mask As Byte = CByte(&H80 >> (x And &H7))
                        p = p Or mask
                        Runtime.InteropServices.Marshal.WriteByte(mcBmData.Scan0, index, p)
                    End If
                Next x
            Next y
            mcBitmap.UnlockBits(mcBmData)
    
            Return mcBitmap
        End Function
    
        Public Const DPI_Screen As Double = 96
        Public Const DPI_Printer As Double = 203
        Public Const dpiMultiplier_ScreenToPrinter As Double = DPI_Printer / DPI_Screen
        Public grayMatrix()() As Single = {
            New Single() {0.299F, 0.299F, 0.299F, 0, 0},
            New Single() {0.587F, 0.587F, 0.587F, 0, 0},
            New Single() {0.114F, 0.114F, 0.114F, 0, 0},
            New Single() {0, 0, 0, 1, 0},
            New Single() {0, 0, 0, 0, 1}}
        Private hexMap() As String = {
            "0", "1", "2", "3", "4", "5", "6", "7",
            "8", "9", "A", "B", "C", "D", "E", "F"}
        Private zplHexCompressionMap As New SortedDictionary(Of Integer, Char) From {
            {1, "G"c}, {2, "H"c}, {3, "I"c}, {4, "J"c}, {5, "K"c},
            {6, "L"c}, {7, "M"c}, {8, "N"c}, {9, "O"c}, {10, "P"c},
            {11, "Q"c}, {12, "R"c}, {13, "S"c}, {14, "T"c}, {15, "U"c},
            {16, "V"c}, {17, "W"c}, {18, "X"c}, {19, "Y"c}, {20, "g"c},
            {40, "h"c}, {60, "i"c}, {80, "j"c}, {100, "k"c}, {120, "l"c},
            {140, "m"c}, {160, "n"c}, {180, "o"c}, {200, "p"c}, {220, "q"c},
            {240, "r"c}, {260, "s"c}, {280, "t"c}, {300, "u"c}, {320, "v"c},
            {340, "w"c}, {360, "x"c}, {380, "y"c}, {400, "z"c}}
    
    End Class