2014年7月28日 星期一

vbnet 製作 Code 39

參考引用來源:[VB.NET] 生成 Code39 码 
--


一,新建 Code39.ashx 文档,代码如下:

Imports System.Web
Imports System.Web.Services
Imports System.Drawing
Imports System.IO

Public Class code39
    Implements System.Web.IHttpHandler

    Sub ProcessRequest(ByVal context As HttpContext) Implements IHttpHandler.ProcessRequest

        Dim sCode As String = String.Empty
        '清除該頁輸出緩存,設置該頁無緩存  
        context.Response.Buffer = True
        context.Response.ExpiresAbsolute = System.DateTime.Now.AddMilliseconds(0)
        context.Response.Expires = 0
        context.Response.CacheControl = "no-cache"
        context.Response.AppendHeader("Pragma", "No-Cache")
        '將Code39條碼寫入記憶體流,並將其以 "image/Png" 格式輸出  
        Dim oStream As MemoryStream = New MemoryStream()
        Try
            Dim oBmp As Bitmap = GetCode39(context.Request.QueryString("id"))
            oBmp.Save(oStream, System.Drawing.Imaging.ImageFormat.Png)
            oBmp.Dispose()
            context.Response.ClearContent()
            context.Response.ContentType = "image/Png"
            context.Response.BinaryWrite(oStream.ToArray())
        Finally
            '釋放資源  
            oStream.Dispose()
        End Try

    End Sub

    ReadOnly Property IsReusable() As Boolean Implements IHttpHandler.IsReusable
        Get
            Return False
        End Get
    End Property

    Private Function GetCode39(ByVal strSource As String) As Bitmap
        Dim x As Integer = 5
        '左邊界
        Dim y As Integer = 0
        '上邊界
        Dim WidLength As Integer = 2
        '粗BarCode長度
        Dim NarrowLength As Integer = 1
        '細BarCode長度
        Dim BarCodeHeight As Integer = 20
        'BarCode高度
        Dim intSourceLength As Integer = strSource.Length
        Dim strEncode As String = "010010100"
        '編碼字串 初值為 起始符號 *
        Dim AlphaBet As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%*"
        'Code39的字母
        'Code39的各字母對應碼
        Dim Code39 As String() = {"000110100", "100100001", "001100001", "101100000", "000110001", "100110000", _
         "001110000", "000100101", "100100100", "001100100", "100001001", "001001001", _
         "101001000", "000011001", "100011000", "001011000", "000001101", "100001100", _
         "001001100", "000011100", "100000011", "001000011", "101000010", "000010011", _
         "100010010", "001010010", "000000111", "100000110", "001000110", "000010110", _
         "110000001", "011000001", "111000000", "010010001", "110010000", "011010000", _
         "010000101", "110000100", "011000100", "010101000", "010100010", "010001010", _
         "000101010", "010010100"}
        strSource = strSource.ToUpper()
        '實作圖片
        Dim objBitmap As New Bitmap(((WidLength * 3 + NarrowLength * 7) * (intSourceLength + 2)) + (x * 2), BarCodeHeight + (y * 2))
        Dim objGraphics As Graphics = Graphics.FromImage(objBitmap)
        '宣告GDI+繪圖介面
        '填上底色
        objGraphics.FillRectangle(Brushes.White, 0, 0, objBitmap.Width, objBitmap.Height)

        Dim i As Integer = 0
        While i < intSourceLength
            '檢查是否有非法字元
            If AlphaBet.IndexOf(strSource(i)) = -1 OrElse strSource(i) = "*"c Then
                objGraphics.DrawString("含有非法字元", SystemFonts.DefaultFont, Brushes.Red, x, y)
                Return objBitmap
            End If
            '查表編碼
            strEncode = String.Format("{0}0{1}", strEncode, Code39(AlphaBet.IndexOf(strSource(i))))
            System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
        End While

        strEncode = String.Format("{0}0010010100", strEncode)
        '補上結束符號 *
        Dim intEncodeLength As Integer = strEncode.Length
        '編碼後長度
        Dim intBarWidth As Integer

        Dim ii As Integer = 0
        While ii < intEncodeLength
            '依碼畫出Code39 BarCode
            intBarWidth = If(strEncode(ii) = "1"c, WidLength, NarrowLength)
            objGraphics.FillRectangle(If(ii Mod 2 = 0, Brushes.Black, Brushes.White), x, y, intBarWidth, BarCodeHeight)
            x += intBarWidth
            System.Math.Max(System.Threading.Interlocked.Increment(ii), ii - 1)
        End While
        Return objBitmap
    End Function

End Class

沒有留言:

張貼留言