Font kullanmadan barkod çizimi ve check digit kontolü - Papatyam Forum

Papatyam Forum

Go Back   Papatyam Forum > ..::.BİLGİSAYAR & TEKNOLOJİ.::. > Web Master > asp.net

Yeni Konu aç  Cevapla
 
Seçenekler
Alt 29 March 2008, 13:03   Mesaj No:1

tamerr89

Papatyam Paylaşımcı Üyesi
Avatar Otomotik
Durumu:tamerr89 isimli Üye şimdilik offline konumundadır
Papatyam No : 1196
Üyelik T.: 09 December 2007
Arkadaşları:0
Cinsiyet:
Yaş:34
Mesaj: 212
Konular:
Beğenildi:
Beğendi:
Takdirleri:10
Takdir Et:
Konu Bu  Üyemize Aittir!
Standart Font kullanmadan barkod çizimi ve check digit kontolü

Font kullanmadan barkod çizimi ve check digit kontolü



<form id="Form1" method="post" runat="server">
<asp:textbox id="txtBarkod" style="Z-INDEX: 106; LEFT: 220px; POSITION: absolute; TOP: 145px"
runat="server" MaxLength="13" AutoPostBack="True"></asp:textbox>
<asp:image id="imgBarkod" style="Z-INDEX: 102; LEFT: 220px; POSITION: absolute; TOP: 205px"
runat="server" Visible="False" Width="120px" ImageUrl="../Images/NoBarcode.jpg" ImageAlign="AbsMiddle"
Height="60px"></asp:image>
<asp:label id="Label21" style="Z-INDEX: 103; LEFT: 125px; POSITION: absolute; TOP: 150px" runat="server"
Font-Bold="True" Font-Size="11px" Font-Names="Verdana">EAN Barcode :</asp:label>
<asp:Button id="btnTestDraw" style="Z-INDEX: 104; LEFT: 375px; POSITION: absolute; TOP: 145px"
runat="server" Text="Test & Draw Barcode"></asp:Button>
<asp:Label id="lblMessage" style="Z-INDEX: 105; LEFT: 220px; POSITION: absolute; TOP: 180px"
runat="server" Font-Bold="True" Font-Size="12px" Font-Names="Verdana" ForeColor="Red"></asp:Label>

</form>

---VB Kodu---

Imports System.IO
Imports System.Drawing
Imports System.Drawing.Text
Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D

Public EANimgUrl As String

Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

EANimgUrl = "EAN/"

If Me.IsPostBack = True Then
DrawCommand()
End If

End Sub

Private Sub DrawCommand()

Dim strEANCode, imgUrl As String

strEANCode = txtBarkod.Text
imgUrl = EANimgUrl & strEANCode & ".jpg"

'Check exists EAN image file
If Not File.Exists(Server.MapPath(imgUrl)) Then

'Check Digit Control
If CheckDigit(strEANCode) = True Then
DrawEANBarCode(strEANCode, imgBarkod.Width.Value, imgBarkod.Height.Value)
lblMessage.Text = ""
imgBarkod.Visible = True
imgBarkod.ImageUrl = imgUrl
Else
lblMessage.Text = "Invalid EAN Code!.."
imgBarkod.Visible = False
End If

Else

lblMessage.Text = ""
imgBarkod.Visible = True
imgBarkod.ImageUrl = imgUrl

End If

End Sub

Public Sub DrawEANBarCode(ByVal strEANCode As String, _
ByVal imgWidth As Integer, _
ByVal imgHeight As Integer)

Dim oGraphics As Graphics
Dim oBitmap As Bitmap
Dim K As Single
Dim PosX As Single
Dim PosY As Single
Dim ScaleX As Single
Dim strEANBin As String
Dim strFormat As New StringFormat

Dim FontForText As Font = New Font("Courier New", 10)

strEANBin = EAN2Bin(strEANCode)

Dim X1 As Single = 0
Dim Y1 As Single = 0
Dim X2 As Single = imgWidth
Dim Y2 As Single = imgHeight

PosX = X1
PosY = Y2 - CSng(1.2 * FontForText.Height)

'Draw new bitmap and clear area with white color
oBitmap = New Bitmap(imgWidth, imgHeight, PixelFormat.Format24bppRgb)
oGraphics = Graphics.FromImage(oBitmap)
oGraphics.Clear(Color.White)

ScaleX = (X2 - X1) / strEANBin.Length

'Draw the BarCode lines
For K = 1 To Len(strEANBin)
If Mid(strEANBin, K, 1) = "1" Then
oGraphics.FillRectangle(New System.Drawing.SolidBrush(Color.Black), PosX, Y1, ScaleX, PosY)
End If
PosX = X1 + (K * ScaleX)
Next K

'Draw strEAN Code text
strFormat.Alignment = StringAlignment.Center
strFormat.FormatFlags = StringFormatFlags.NoWrap
oGraphics.DrawString(strEANCode, FontForText, New System.Drawing.SolidBrush(Color.Black), CSng((X2 - X1) / 2), CSng(Y2 - FontForText.Height), strFormat)

'Save Bitmap to jpeg file
oBitmap.Save(Server.MapPath(EANimgUrl & strEANCode & ".jpg&quot)

'If u don't want to save image file use this line
'oBitmap.Save(Response.OutputStream, ImageFormat.Jpeg)

'Kill objects
FontForText.Dispose()
oGraphics.Dispose()
oBitmap.Dispose()

End Sub

Public Function CheckDigit(ByVal strEANCode As String) As Boolean

Dim Nums(12), i, k As Integer
Dim ck As String = Right(strEANCode, 1)
Dim realCK As String

'If not is numeric EAN code Return False
If Not IsNumeric(strEANCode) Then Return False

i = 1
If strEANCode.Length = 8 Then
'Check Digit For EAN 8
Do While i < 8
Nums(i) = CType(Mid(strEANCode, i, 1), Integer)
i += 1
Loop

k = (Nums(7) * 3)
k += (Nums(6) * 1)
k += (Nums(5) * 3)
k += (Nums(4) * 1)
k += (Nums(3) * 3)
k += (Nums(2) * 1)
k += (Nums(1) * 3)
k = k Mod 10
k = 10 - k

realCK = k.ToString

ElseIf strEANCode.Length = 13 Then
'Check Digit For EAN 13
Do While i < 13
Nums(i) = CType(Mid(strEANCode, i, 1), Integer)
i += 1
Loop

k = (Nums(12) * 3)
k += (Nums(11) * 1)
k += (Nums(10) * 3)
k += (Nums(9) * 1)
k += (Nums(8) * 3)
k += (Nums(7) * 1)
k += (Nums(6) * 3)
k += (Nums(5) * 1)
k += (Nums(4) * 3)
k += (Nums(3) * 1)
k += (Nums(2) * 3)
k += (Nums(1) * 1)
k = k Mod 10
k = 10 - k

realCK = k.ToString

Else
'Nothing EAN 8 or EAN 13 Code
Return False

End If

If ck = realCK Then
Return True
Else
Return False
End If

End Function

Public Function EAN2Bin(ByVal strEANCode As String) As String

Dim K As Integer
Dim strAux As String
Dim strExit As String
Dim strCode As String

strEANCode = Trim(strEANCode)
strAux = strEANCode

'Check EAN code (EAN8 or EAN13)
If (strAux.Length <> 13) And (strAux.Length <> 8) Then
Err.Raise(5, "EAN2Bin", "Invalid EAN Code!..&quot
End If

'Check numbers only
For K = 0 To strEANCode.Length - 1
Select Case (strAux.Chars(K).ToString)
Case Is < "0", Is > "9"
Err.Raise(5, "EAN2Bin", "Please don't use any number characters!..&quot
End Select
Next

'For EAN13
If (strAux.Length = 13) Then

strAux = Mid(strAux, 2)

Select Case CInt(Left(strEANCode, 1))
Case 0
strCode = "000000"
Case 1
strCode = "001011"
Case 2
strCode = "001101"
Case 3
strCode = "001110"
Case 4
strCode = "010011"
Case 5
strCode = "011001"
Case 6
strCode = "011100"
Case 7
strCode = "010101"
Case 8
strCode = "010110"
Case 9
strCode = "011010"
End Select
Else 'For EAN8
strCode = "0000"
End If

strExit = "000101"

For K = 1 To Len(strAux) \ 2
Select Case CInt(Mid(strAux, K, 1))
Case 0
strExit &= IIf(Mid(strCode, K, 1) = "0", "0001101", "0100111&quot
Case 1
strExit &= IIf(Mid(strCode, K, 1) = "0", "0011001", "0110011&quot
Case 2
strExit &= IIf(Mid(strCode, K, 1) = "0", "0010011", "0011011&quot
Case 3
strExit &= IIf(Mid(strCode, K, 1) = "0", "0111101", "0100001&quot
Case 4
strExit &= IIf(Mid(strCode, K, 1) = "0", "0100011", "0011101&quot
Case 5
strExit &= IIf(Mid(strCode, K, 1) = "0", "0110001", "0111001&quot
Case 6
strExit &= IIf(Mid(strCode, K, 1) = "0", "0101111", "0000101&quot
Case 7
strExit &= IIf(Mid(strCode, K, 1) = "0", "0111011", "0010001&quot
Case 8
strExit &= IIf(Mid(strCode, K, 1) = "0", "0110111", "0001001&quot
Case 9
strExit &= IIf(Mid(strCode, K, 1) = "0", "0001011", "0010111&quot
End Select
Next K

strExit &= "01010"

For K = Len(strAux) \ 2 + 1 To Len(strAux)
Select Case CInt(Mid(strAux, K, 1))
Case 0
strExit &= "1110010"
Case 1
strExit &= "1100110"
Case 2
strExit &= "1101100"
Case 3
strExit &= "1000010"
Case 4
strExit &= "1011100"
Case 5
strExit &= "1001110"
Case 6
strExit &= "1010000"
Case 7
strExit &= "1000100"
Case 8
strExit &= "1001000"
Case 9
strExit &= "1110100"
End Select
Next K

strExit &= "101000"

EAN2Bin = strExit

End Function

Alıntı ile Cevapla
Cevapla

Bookmarks

Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir)
 
Seçenekler

Benzer Konular
Konu Başlıkları Konuyu Başlatan

Papatyam Forum Ana Kategori Başlıkları

Cevaplar Son Mesajlar
Tek damla yakıt kullanmadan Fas'a uçacak! umut Teknoloji Son Haberler 0 29 March 2012 17:57
İlaç kullanmadan ağrımı nasıl geçirebilirim? PESTEMAL Tamamlayıcı Tıp 0 02 November 2010 12:46
Font Arşivi (Yazı Arşivi) CoNQueRoR_61 Web Master 0 20 January 2009 15:39
Ağzınıza da "check up" yaptırın! PESTEMAL Sağlık ve Hastalıklar 0 10 March 2008 14:56

Yeni Sayfa 1

www.papatyam.org Ana Sayfa

Tefekküre Davet Köşesi

Papatyam Sosyal Medya Guruplarımıza Katılın

                       Instagram         

Papatyam alemdarhost.com sunucularında barındırılmaktadır.