PROGRAMLAR SCRIPTLER KODLAR HABERLER İLETİŞİM
Arşivimde ara Program Script Hazırkod
Ara
ÜYELİK AKTİVASYONU HABERLER WEBMASTER ARAÇLARI SİTENE EKLE REKLAM VER İLETİŞİM
    Program : 12799 Adet  |  Script : 5 Adet  |  Hazırkod : 2748 Adet  |  Haber : 211 Adet
HAZIR KODLAR
ADO.NET - ADO
ASP
ASP.NET
C #
C ++
CGI
COMPONENT
DATABASE
DELPHI
FLASH
HTML
JAVA - JSP
JAVA SCRIPT
PASCAL
PERL
PHP
VISUAL BASIC
VISUAL BASIC.NET
WML
XML
 
İNTERNET PAKETLERİ
ADSL BAŞVURU
SMİLE BAŞVURU
TURK.NET BAŞVURU
TELLCOM İNTERNET PAKETİ
SUPERONLİNE BAŞVURU
TTNET İŞYERİM PAKETİ
TTNET VİTAMİN PAKETİ
 
SCRIPTLER
AJAX SCRIPTLERI
ASP SCRIPTLERI
ASP.NET SCRIPTLERI
C # SCRIPTLERI
C ++ SCRIPTLERI
DELPHI SCRIPTLERI
JAVA - JSP SCRIPTLERI
JAVA SCRIPT SCRIPTLERI
MIRC - IRC SCRIPTLERI
PERL SCRIPTLERI
PHP SCRIPTLERI
VISUAL BASIC SCRIPTLERI
 
İSTATİSTİK
Tekil [Bugün] : 31  
Çoğul [Bugün] : 102  
Tekil [Genel] : 232.751  
Çoğul [Genel] : 2.603.481  
 


Font kullanmadan barkod çizin
Açıklama :
digit Font barkod çizimi check ve kontolü kullanmadan
 
ARKADAŞINA GÖNDER HEPSİNİ SEÇ

---HTML Kodu ---

<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

Hazırkod Tanıtımı
digit Font barkod çizimi check ve kontolü kullanmadan
İzlenme  102 Kez
Hit  0 Adet
HAZIRKOD HAKKINDA YAPILAN YORUMLAR
Yorum eklemek için tıklayınız
 
Bu hazırkod hakkında herhangi bir yorum yapılmamış!
 
KULLANICI GİRİŞİ
   
GİRİŞ
   
Yeni Kayıt
Yardım
 
GOOGLE REKLAMLARI
 
ETİKETLER
ILICA TARIM
1041446
ssk prim sorgulama
italyan oturusu frikik
Ehliyet Sınav Sonuçları
ssk isyeri no sorgulama
ne zaman emekli olab
Sayısal Loto Sonuçları
ozdemirler
1110905
ssk isyeri sorgulama
Açık Öğretim Sınav Sonuçları
mert discioglu
21039254
xat chat
1018160
T.C. Kimlik No Sorgulama
zuhal topal frikik
dosya listeleme
denizli bayramyeri surucu...
cm new haber script
emekli oldummu
SSK Prim Sorgulama
golden launcher
1033759
 
Sitede yayınlanan dosya ve dökümanların kullanımları sonucu oluşabilecek zararlardan duzenle.com sorumlu değildir.
duzenle.com sitesinde yayınlanan tüm program, script ve benzeri dökümanları kurmadan yada çalıştırmadan önce virüs taramasından geçiriniz.

PROGRAMLAR SCRIPTLER KODLAR HABERLER İLETİŞİM