條碼產生程式

<%@ Import Namespace="System.drawing" %>

<script runat='server'>

'--------- Anfang Barcode39.vb ---------

Function MD_Barcode39(ByVal Barcode As String, _

ByVal mLeft As Single, ByVal mTop As Single, _

ByVal mWidth As Single, ByVal mHeight As Single) _

as System.Drawing.Bitmap

Dim Nbar As Integer, Wbar As Integer, Qbar As Integer, NextBar As Integer

Dim CountX As Single, CountY As Single, CountR As Single

Dim Parts As Single, Pix As Single, BarCodePlus As String

Dim Stripes As String, BarType As String

Dim Mx As Single, my As Single, Sx As Single, Sy As Single

Const Nratio = 20, Wratio = 55, Qratio = 35

'Get control size and location properties.

Sx = mLeft

Sy = mTop

Mx = mWidth

my = mHeight

'Calculate actual and relative pixels values.

Parts = (Barcode.Length + 2) * ((6 * Nratio) + (3 * Wratio) + (1 * Qratio))

Pix = (Mx / Parts)

Nbar = (Nratio * Pix)

Wbar = (Wratio * Pix)

Qbar = (Qratio * Pix)

Dim g As System.Drawing.Graphics

Dim pB As New System.Drawing.SolidBrush(System.Drawing.Color.Black)

Dim pW As New System.Drawing.SolidBrush(System.Drawing.Color.White)

Dim color As System.Drawing.SolidBrush

Dim cFont As Font = New Font("Arial", 9)

Dim cbrush As Brush = New SolidBrush(System.Drawing.Color.Black)

Dim BMP As Bitmap = New Bitmap(mWidth, mHeight+13, Imaging.PixelFormat.Format32bppPArgb)

Try

g = Graphics.FromImage(BMP)

' g = PaintObj.CreateGraphics()

' g.Clear(System.Drawing.Color.LightYellow)

g.Clear(System.Drawing.Color.White)

'Initialize bar index and color.

NextBar = Sx

color = pW

'Pad each end of string with start/stop characters.

BarCodePlus = "*" & Barcode.ToUpper & "*"

dim cx

'Walk through each character of the barcode contents.

For CountX = 0 To BarCodePlus.Length - 1

'Get Barcode 1/0 string for indexed character.

Stripes = MD_BC39(BarCodePlus.Substring(CountX, 1))

cx = NextBar

For CountY = 0 To 8

'For each 1/0, draw a wide/narrow bar.

BarType = Stripes.Substring(CountY, 1)

'Toggle the color (black/white).

color = iif( color Is pW, pB, pW)

Select Case BarType

Case "1"

'Draw a wide bar.

g.FillRectangle(color, NextBar, Sy, Wbar + NextBar, my + Sy)

NextBar = NextBar + Wbar

Case "0"

'Draw a narrow bar.

g.FillRectangle(color, NextBar, Sy, Nbar + NextBar, my + Sy)

NextBar = NextBar + Nbar

End Select

Next CountY

'Toggle the color (black/white).

color = iif( color Is pW, pB, pW)

'Draw intermediate "quiet" bar.

g.FillRectangle(color, NextBar, Sy, Qbar + NextBar, my + Sy)

NextBar = NextBar + Qbar

g.DrawString(BarCodePlus.Substring(CountX, 1), cFont, cbrush, cx, my+sy)

Next CountX

Catch ex As Exception

NextBar = NextBar + Qbar

' Response.Write(ex.StackTrace)

End Try

return BMP

End Function

Function MD_BC39(ByVal CharCode As String) As String

Dim BC39(90) As String

Try

BC39(32) = "011000100" ' space

BC39(36) = "010101000" ' $

BC39(37) = "000101010" ' %

BC39(42) = "010010100" ' * Start/Stop

BC39(43) = "010001010" ' +

BC39(45) = "010000101" ' |

BC39(46) = "110000100" ' .

BC39(47) = "010100010" ' /

BC39(48) = "000110100" ' 0

BC39(49) = "100100001" ' 1

BC39(50) = "001100001" ' 2

BC39(51) = "101100000" ' 3

BC39(52) = "000110001" ' 4

BC39(53) = "100110000" ' 5

BC39(54) = "001110000" ' 6

BC39(55) = "000100101" ' 7

BC39(56) = "100100100" ' 8

BC39(57) = "001100100" ' 9

BC39(65) = "100001001" ' A

BC39(66) = "001001001" ' B

BC39(67) = "101001000" ' C

BC39(68) = "000011001" ' D

BC39(69) = "100011000" ' E

BC39(70) = "001011000" ' F

BC39(71) = "000001101" ' G

BC39(72) = "100001100" ' H

BC39(73) = "001001100" ' I

BC39(74) = "000011100" ' J

BC39(75) = "100000011" ' K

BC39(76) = "001000011" ' L

BC39(77) = "101000010" ' M

BC39(78) = "000010011" ' N

BC39(79) = "100010010" ' O

BC39(80) = "001010010" ' P

BC39(81) = "000000111" ' Q

BC39(82) = "100000110" ' R

BC39(83) = "001000110" ' S

BC39(84) = "000010110" ' T

BC39(85) = "110000001" ' U

BC39(86) = "011000001" ' V

BC39(87) = "111000000" ' W

BC39(88) = "010010001" ' X

BC39(89) = "110010000" ' Y

BC39(90) = "011010000" ' Z

Catch ex As Exception

Response.Write("")

End Try

Return BC39(Asc(CharCode))

End Function

</script>

<%

dim mtxt = Request("text")

if mtxt="" then

mtxt = "00000"

end if

dim barBmp = MD_Barcode39(mtxt, 0, 0, 150, 25)

Response.ContentType = "image/gif"

barBmp.Save(Response.OutputStream, Imaging.ImageFormat.Gif)

%>