Favorilerine Ekle | Giriş Sayfan Yap | Tavsiye Et

 

Kurs Tanıtım Sayfası | Süper Üye Kimdir? | Menü Tasarımı Konulu Örnek Ders
Kod İndir| Hazır Kodlar | Makaleler| İpuçları | VB .NET Kursu | Dersler | Forum | Alt Bölümler | Servisler
    Merhaba Misafir
    anasayfa » visual basic hazır kodlar » Code128' e göre barcode generate
Üye Girişi
Kullanıcı Adı:  
Şifre : 
Kaydet ?
Siteden tam olarak faydalanabilmek için üye olmalısınız.
Unuttuğunuz şifrenizi öğrenebilmek için kayıt sırasında verdiğiniz Hatırlatma Cevabı'nı bilmeniz gereklidir.
Şifre hatırlatma işlevini sadece 3 defa kullanma hakkınız vardır.
Kullanıcı adını ve şifresini unutan üyelere email ile yardım verilmez.

Aktivasyon Gelmedi mi?Aktivasyon mesajınız email adresinize gelmedi mi?
Buraya tıklayarak bir kez daha aktivasyon mesajı gönderilmesini sağlayabilirsiniz.
Lütfen email hesabınızın BULK ve SPAM klasörlerini de kontrol ediniz.
Rastgele Makale

common dialog ile help dosyası açmak

Yazar: Mukan_Tr

Webmasterlar
Sitenize Ekleyin!
Sitenizde "Son Eklenen 10 Visual Basic Yazısı"'nı göstermek ve içeriğini zenginleştirmek için buraya tıklayınız.

Vbasicmaster.com'a link verin!
Aşağıdaki minik banneri sitenize eklemek için tıklayın!

Üye Sayısı:
Ziyaretçiler nerede?
Yayın № : 7740
Yayın Tar:22.09.2006
Yazar : erkans
Hit :2200

Bu Yazarın Yazıları Sadece bu yazarın  göster
Bu Yazıyı Tavsiye Et

Arkadaşlar selam

code128 icin barcode generate etmek artık cok kolay aşağıdaki funtion basmak istediğiniz değeri gonderiyorsunuz o sizin içIn etiket strin'ini hazırlıyor. Görebilir isterseniz basabilirsiniz
hadi kolay gelsin

'-------------- ACIKLAMA
' Programınıza
'text2 ve key isminde 2 adet Text box ilave edininiz. Text2 nin fontunu Code 128 olarak ayarlayınız
' Command1 ve Command2 isminde 2 adet buton ilave ediniz.

'- aşağıdaki functionu programınızın icine kopyalayınız
'- normal koşullarda herhangi bir değişiklik yapmanıza gerekyok
'- basılmak istenen değer DonenDeger=Code128$("basılacakdeğer") şelinde gönderilir
'- Aşağıdaki koddaki yeri asy = Code128$(Trim(Key.Text))
'- Key.Text Text box'a bizim tarafımızdan girilen bir String
'- key textBox a herhangi bir değer gidiğimizde program otomatik olarak barcodu ceviri ve text2 ye yazar
'- Command2 butonuna bastığımızdada etiketi basar
'- Fontlarınız icinde Code128 olmalı

'---------------------------------------------------------------------
Public asy As String

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Command2_Click()
Printer.Orientation = 2 ' 2 degeri ile etiketi yan cevirdim
Printer.CurrentX = 150 ' X başlangıc noktası
Printer.CurrentY = 150 ' Y başlangıc noktası
Printer.FontName = "Code 128" ' basılacak Barcode fontu
Printer.FontSize = 55 ' font ölcüsü
Printer.Print asy ' ehetiketi basalım artık
Printer.EndDoc ' Bitti
End Sub

Private Sub Key_KeyPress(KeyAscii As Integer)
asy = Code128$(Trim(Key.Text)) ' String i giriyoruz, ve basılacak deger Generate
' edilmek üzere Code128$ functionuna gidip, asy
' değişkenine atanıyor
Text2.Text = asy ' girdiğimiz String artık generate edilmiş halde ve
' nasıl baskı ön izleme şeklinde text2 nin içinde
' görebiliyoruz. ÖNEMLİ text2 nin fontu CODE128
' yani barcode fontu olmazsa barcode olarak
' göremeyiz.
End Sub


Public Function Code128$(chaine)
Dim i, checksum, mini, dummy, tableB As Boolean
Code128$ = ""
If Len(chaine) > 0 Then
For i = 1 To Len(chaine)
Select Case Asc(Mid$(chaine, i, 1))
Case 32 To 126
Case Else
i = 0
Exit For
End Select
Next

Code128$ = ""
tableB = True
If i > 0 Then
i = 1
Do While i <= Len(chaine)
If tableB Then
mini = IIf(i = 1 Or i + 3 = Len(chaine), 4, 6)
GoSub testnum
If mini < 0 Then
If i = 1 Then
Code128$ = Chr$(205)
Else
Code128$ = Code128$ & Chr$(199)
End If
tableB = False
Else
If i = 1 Then Code128$ = Chr$(204)
End If
End If
If Not tableB Then
mini = 2
GoSub testnum
If mini < 0 Then
dummy = Val(Mid$(chaine, i, 2))
dummy = IIf(dummy < 95, dummy + 32, dummy + 100)
Code128$ = Code128$ & Chr$(dummy)
i = i + 2
Else
Code128$ = Code128$ & Chr$(200)
tableB = True
End If
End If
If tableB Then
Code128$ = Code128$ & Mid$(chaine, i, 1)
i = i + 1
End If
Loop
For i = 1 To Len(Code128$)
dummy = Asc(Mid$(Code128$, i, 1))
dummy = IIf(dummy < 127, dummy - 32, dummy - 100)
If i = 1 Then checksum = dummy
checksum = (checksum + (i - 1) * dummy) Mod 103
Next

checksum = IIf(checksum < 95, checksum + 32, checksum + 100)

Code128$ = Code128$ & Chr$(checksum) & Chr$(206)
End If
End If
Exit Function
testnum:
mini = mini - 1
If i + mini <= Len(chaine) Then

Do While mini >= 0
If Asc(Mid$(chaine, i + mini, 1)) < 48 Or Asc(Mid$(chaine, i + mini, 1)) > 57 Then Exit Do
mini = mini - 1
Loop

End If
Return
End Function
onaylayan: Webmaster




Yorumlar, eklemeler ve düşünceler
        Ellerinize sağlık deneyeceğim.. code 128 barkod font nereden indirebilirim

   incobilgisayar, 21.12.2011 14:59
© Hakan Ersöz 2000-2013| Üyelik Sözleşmesi | | Ödeme Bildirimi
Sitemizden yenilikleri hemen öğrenin, pop upları engelleyin, chat yapın... ToolBarımızı indirin:
Vasicmaster Toolbar'ı indirin