29 March 2008, 13:03 | Mesaj No:1 |
Durumu:
Papatyam No :
1196
Üyelik T.:
09 December 2007
Arkadaşları:0
Cinsiyet:
Yaş:34
|
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") '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!.." 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!.." 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" Case 1 strExit &= IIf(Mid(strCode, K, 1) = "0", "0011001", "0110011" Case 2 strExit &= IIf(Mid(strCode, K, 1) = "0", "0010011", "0011011" Case 3 strExit &= IIf(Mid(strCode, K, 1) = "0", "0111101", "0100001" Case 4 strExit &= IIf(Mid(strCode, K, 1) = "0", "0100011", "0011101" Case 5 strExit &= IIf(Mid(strCode, K, 1) = "0", "0110001", "0111001" Case 6 strExit &= IIf(Mid(strCode, K, 1) = "0", "0101111", "0000101" Case 7 strExit &= IIf(Mid(strCode, K, 1) = "0", "0111011", "0010001" Case 8 strExit &= IIf(Mid(strCode, K, 1) = "0", "0110111", "0001001" Case 9 strExit &= IIf(Mid(strCode, K, 1) = "0", "0001011", "0010111" 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 |
Bookmarks |
Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir) | |
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 |
Tefekküre Davet Köşesi |
|
Papatyam Sosyal Medya Guruplarımıza Katılın |