如何在vb.net中生成Code39条形码

我想从我的应用程序创建Code39编码的条形码.

我知道我可以使用这种字体,但是我不想像在服务器上注册字体那样,我已经有了一些不好的经历.

在提出这个问题之后,我提出的一个例子就是答案

这是我目前的codebehind,有很多评论
Option Explicit On
Option Strict On

Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Drawing.Bitmap
Imports System.Drawing.Graphics
Imports System.IO

Partial Public Class Barcode
    Inherits System.Web.UI.Page
    'Sebastiaan Janssen - 20081001 - TINT-30584
    'Most of the code is based on this example: 
    'http://www.atalasoft.com/cs/blogs/loufranco/archive/2008/04/25/writing-code-39-barcodes-with-javascript.aspx-generation.aspx
    'With a bit of this thrown in:
    'http://www.atalasoft.com/cs/blogs/loufranco/archive/2008/03/24/code-39-barcode

    Private _encoding As Hashtable = New Hashtable
    Private Const _wideBarWidth As Short = 8
    Private Const _narrowBarWidth As Short = 2
    Private Const _barHeight As Short = 100

    Sub BarcodeCode39()
        _encoding.Add("*","bWbwBwBwb")
        _encoding.Add("-","bWbwbwBwB")
        _encoding.Add("$","bWbWbWbwb")
        _encoding.Add("%","bwbWbWbWb")
        _encoding.Add(" ","bWBwbwBwb")
        _encoding.Add(".","BWbwbwBwb")
        _encoding.Add("/","bWbWbwbWb")
        _encoding.Add("+","bWbwbWbWb")
        _encoding.Add("0","bwbWBwBwb")
        _encoding.Add("1","BwbWbwbwB")
        _encoding.Add("2","bwBWbwbwB")
        _encoding.Add("3","BwBWbwbwb")
        _encoding.Add("4","bwbWBwbwB")
        _encoding.Add("5","BwbWBwbwb")
        _encoding.Add("6","bwBWBwbwb")
        _encoding.Add("7","bwbWbwBwB")
        _encoding.Add("8","BwbWbwBwb")
        _encoding.Add("9","bwBWbwBwb")
        _encoding.Add("A","BwbwbWbwB")
        _encoding.Add("B","bwBwbWbwB")
        _encoding.Add("C","BwBwbWbwb")
        _encoding.Add("D","bwbwBWbwB")
        _encoding.Add("E","BwbwBWbwb")
        _encoding.Add("F","bwBwBWbwb")
        _encoding.Add("G","bwbwbWBwB")
        _encoding.Add("H","BwbwbWBwb")
        _encoding.Add("I","bwBwbWBwb")
        _encoding.Add("J","bwbwBWBwb")
        _encoding.Add("K","BwbwbwbWB")
        _encoding.Add("L","bwBwbwbWB")
        _encoding.Add("M","BwBwbwbWb")
        _encoding.Add("N","bwbwBwbWB")
        _encoding.Add("O","BwbwBwbWb")
        _encoding.Add("P","bwBwBwbWb")
        _encoding.Add("Q","bwbwbwBWB")
        _encoding.Add("R","BwbwbwBWb")
        _encoding.Add("S","bwBwbwBWb")
        _encoding.Add("T","bwbwBwBWb")
        _encoding.Add("U","BWbwbwbwB")
        _encoding.Add("V","bWBwbwbwB")
        _encoding.Add("W","BWBwbwbwb")
        _encoding.Add("X","bWbwBwbwB")
        _encoding.Add("Y","BWbwBwbwb")
        _encoding.Add("Z","bWBwBwbwb")
    End Sub

    Protected Sub Page_Load(ByVal sender As Object,ByVal e As System.EventArgs) Handles Me.Load
        BarcodeCode39()
        Dim barcode As String = String.Empty
        If Not IsNothing(Request("barcode")) AndAlso Not (Request("barcode").Length = 0) Then
            barcode = Request("barcode")
            Response.ContentType = "image/png"
            Response.AddHeader("Content-Disposition",String.Format("attachment; filename=barcode_{0}.png",barcode))

            'TODO: Depending on the length of the string,determine how wide the image will be
            GenerateBarcodeImage(250,140,barcode).WriteTo(Response.OutputStream)
        End If
    End Sub

    Protected Function getBCSymbolColor(ByVal symbol As String) As System.Drawing.Brush
        getBCSymbolColor = Brushes.Black
        If symbol = "W" Or symbol = "w" Then
            getBCSymbolColor = Brushes.White
        End If
    End Function

    Protected Function getBCSymbolWidth(ByVal symbol As String) As Short
        getBCSymbolWidth = _narrowBarWidth
        If symbol = "B" Or symbol = "W" Then
            getBCSymbolWidth = _wideBarWidth
        End If
    End Function

    Protected Overridable Function GenerateBarcodeImage(ByVal imageWidth As Short,ByVal imageHeight As Short,ByVal Code As String) As MemoryStream
        'create a new bitmap
        Dim b As New Bitmap(imageWidth,imageHeight,Imaging.PixelFormat.Format32bppArgb)

        'create a canvas to paint on
        Dim canvas As New Rectangle(0,imageWidth,imageHeight)

        'draw a white background
        Dim g As Graphics = Graphics.FromImage(b)
        g.FillRectangle(Brushes.White,imageHeight)

        'write the unaltered code at the bottom
        'TODO: truely center this text
        Dim textBrush As New SolidBrush(Color.Black)
        g.DrawString(Code,New Font("Courier New",12),textBrush,100,110)

        'Code has to be surrounded by asterisks to make it a valid Code39 barcode
        Dim UseCode As String = String.Format("{0}{1}{0}","*",Code)

        'Start drawing at 10,10
        Dim XPosition As Short = 10
        Dim YPosition As Short = 10

        Dim invalidCharacter As Boolean = False
        Dim CurrentSymbol As String = String.Empty

        For j As Short = 0 To CShort(UseCode.Length - 1)
            CurrentSymbol = UseCode.Substring(j,1)
            'check if symbol can be used
            If Not IsNothing(_encoding(CurrentSymbol)) Then
                Dim EncodedSymbol As String = _encoding(CurrentSymbol).ToString

                For i As Short = 0 To CShort(EncodedSymbol.Length - 1)
                    Dim CurrentCode As String = EncodedSymbol.Substring(i,1)
                    g.FillRectangle(getBCSymbolColor(CurrentCode),XPosition,YPosition,getBCSymbolWidth(CurrentCode),_barHeight)
                    XPosition = XPosition + getBCSymbolWidth(CurrentCode)
                Next

                'After each written full symbol we need a whitespace (narrow width)
                g.FillRectangle(getBCSymbolColor("w"),getBCSymbolWidth("w"),_barHeight)
                XPosition = XPosition + getBCSymbolWidth("w")
            Else
                invalidCharacter = True
            End If
        Next

        'errorhandling when an invalidcharacter is found
        If invalidCharacter Then
            g.FillRectangle(Brushes.White,imageHeight)
            g.DrawString("Invalid characters found,",8),0)
            g.DrawString("no barcode generated",10)
            g.DrawString("Input was: ",30)
            g.DrawString(Code,40)
        End If

        'write the image into a memorystream
        Dim ms As New MemoryStream

        Dim encodingParams As New EncoderParameters
        encodingParams.Param(0) = New EncoderParameter(Encoder.Quality,100)

        Dim encodingInfo As ImageCodecInfo = FindCodecInfo("PNG")

        b.Save(ms,encodingInfo,encodingParams)

        'dispose of the object we won't need any more
        g.Dispose()
        b.Dispose()

        Return ms
    End Function

    Protected Overridable Function FindCodecInfo(ByVal codec As String) As ImageCodecInfo
        Dim encoders As ImageCodecInfo() = ImageCodecInfo.GetImageEncoders
        For Each e As ImageCodecInfo In encoders
            If e.FormatDescription.Equals(codec) Then Return e
        Next
        Return Nothing
    End Function
End Class

相关文章

Format[$] ( expr [ , fmt ] ) format 返回变体型 format$ 强制返回为文本 --------------------------...
VB6或者ASP 格式化时间为 MM/dd/yyyy 格式,竟然没有好的办法, Format 或者FormatDateTime 竟然结果和...
在项目中添加如下代码:新建窗口来显示异常信息。 Namespace My ‘全局错误处理,新的解决方案直接...
转了这一篇文章,原来一直想用C#做k3的插件开发,vb没有C#用的爽呀,这篇文章写与2011年,看来我以前没...
Sub 分列() ‘以空格为分隔符,连续空格只算1个。对所选中的单元格进行处理 Dim m As Range, t...
  窗体代码 1 Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integ...