Cara mudah mencetak kode barcode
Senang banget akhirnya bisa posting artikel coding lagi :)
Sesuai judulnya jadi kita akan mencetak kode barcode, jadi bukan membuat kode barcode karena coding untuk membuat kode barcode lumayan menyita waktu dan tenaga (asalkan buatnya dari nol bukan copas source code )
Beberapa waktu yang lalu saya sudah membahas bagaimana membuat form input hari libur yang diambil dari salah satu fitur Smart Library School, kali ini saya membahas fitur lainnya yaitu pencetakan kode barcode yang tentunya dengan cara yang instan
Ada 2 mode pencetakan yang akan saya share disini :
-
Cetak barcode tunggal, sesuai namanya kita akan mencetak 1 kode barcode dengan posisi yang bisa kita atur sendiri.
-
Cetak barcode kelompok, mencetak beberapa kode barcode sekaligus
Proses pembuatan barcodenya sendiri tidak perlu koding khusus, yang diperlukan hanya kode untuk mencetaknya itulah mudahnya klo menggunakan komponen pihak ke tiga he he he .
Ingat komponen ini adalah shareware, segala resiko (kemudahan dalam mencetak kode barcode) ditanggung sendiri
, saya disini hanya share dan tidak terikat kerja sama dengan pihak ketiga tersebut.
Oke langsung saja kita akan buat rancangan tampilannya seperti berikut :
Adapun kode pencetakannya adalah sebagai berikut :
Private Sub cmdCetak_Click()
Dim batasKiri As Single
Dim batasAtas As Single
Dim posisi As Integer
If MsgBox("Apakah proses pencetakan kode barcode ingin dilanjutkan ?", vbExclamation + vbYesNo, "Konfirmasi") = vbYes Then
Screen.MousePointer = vbHourglass
DoEvents
Printer.PSet (0, 0), vbWhite
Printer.ScaleMode = vbPixels
batasKiri = 0
batasAtas = 2.5
posisi = 0
Do While posisi < 30
If Check1(posisi).Value = Checked Then
If posisi >= 0 And posisi <= 5 Then
batasKiri = 0
ElseIf posisi >= 6 And posisi <= 11 Then
batasKiri = 4
ElseIf posisi >= 12 And posisi <= 17 Then
batasKiri = 8
ElseIf posisi >= 18 And posisi <= 23 Then
batasKiri = 12
Else
batasKiri = 16
End If
Select Case posisi
Case 0, 6, 12, 18, 24
batasAtas = 0.5
Case 1, 7, 13, 19, 25
batasAtas = 3.2
Case 2, 8, 14, 20, 26
batasAtas = 5.8
Case 3, 9, 15, 21, 27
batasAtas = 8.4
Case 4, 10, 16, 22, 28
batasAtas = 11.2
Case 5, 11, 17, 23, 29
batasAtas = 13.9
End Select
TBarCode51.Text = txtKodeBarcode.Text
TBarCode51.BackStyle = BKS_Transparent
TBarCode51.BCDraw Printer.hDC, Printer.ScaleX(batasKiri, vbCentimeters), Printer.ScaleY(batasAtas, vbCentimeters), Printer.ScaleX(3, vbCentimeters), Printer.ScaleY(1.5, vbCentimeters)
End If
posisi = posisi + 1
Loop
Printer.EndDoc
Screen.MousePointer = vbDefault
End If
End Sub
dan terakhir kode untuk mencetak barcode kelompok :
Private Sub cmdCetak_Click()
Dim x As Long
Dim y As Long
Dim Index As Integer
Dim sgLeft1 As Single
Dim sgleft2 As Single
Dim sgTop As Single
Dim fExit As Boolean
If MsgBox("Apakah proses pencetakan kode barcode ingin dilanjutkan ?", vbExclamation + vbYesNo, "Konfirmasi") = vbYes Then
Screen.MousePointer = vbHourglass
DoEvents
Printer.PSet (0, 0), vbWhite
Printer.ScaleMode = vbPixels
sgTop = Printer.ScaleY(2.5, vbCentimeters)
sgLeft1 = Printer.ScaleX(1, vbCentimeters)
While fExit = False
x = 1
While fExit = False And x <= 3
y = 1
While fExit = False And y <= 4
'top margin
If y > 1 Then
sgTop = sgTop + Printer.ScaleY(3.5, vbCentimeters)
Else
sgTop = Printer.ScaleY(2.5, vbCentimeters)
End If
'left margin
If x = 1 Then
sgleft2 = Printer.ScaleX(1, vbCentimeters)
ElseIf x = 2 Then
sgleft2 = sgLeft1 + Printer.ScaleX(6.79, vbCentimeters)
Else
sgleft2 = sgLeft1 + Printer.ScaleX(6.64, vbCentimeters)
End If
If Not ((Index + 1) > lstDaftarBarcode.ListCount) Then
TBarCode51.Text = lstDaftarBarcode.List(Index)
TBarCode51.BackStyle = BKS_Transparent
TBarCode51.BCDraw Printer.hDC, sgleft2, sgTop, Printer.ScaleX(4.4, vbCentimeters), Printer.ScaleY(1, vbCentimeters)
End If
If (Index + 1) > lstDaftarBarcode.ListCount Then
fExit = True
Else
Index = Index + 1
End If
y = y + 1
Wend
sgLeft1 = sgleft2
x = x + 1
Wend
If Not fExit Then
Printer.NewPage
sgTop = Printer.ScaleY(2, vbCentimeters)
sgLeft1 = Printer.ScaleX(1.5, vbCentimeters)
End If
Wend
Printer.EndDoc
Screen.MousePointer = vbDefault
End If
End Sub
Selamat MENCOBA
Comments