Selasa, 06 Desember 2011

Cara mudah mencetak kode barcode

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 :D )
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 :D
Ada 2 mode pencetakan yang akan saya share disini :

1. Cetak barcode tunggal, sesuai namanya kita akan mencetak 1 kode barcode dengan posisi yang bisa kita atur sendiri.

2. 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 :D .
Ingat komponen ini adalah shareware, segala resiko (kemudahan dalam mencetak kode barcode) ditanggung sendiri :D , saya disini hanya share dan tidak terikat kerja sama dengan pihak ketiga tersebut.
:evil:
Oke langsung saja kita akan buat rancangan tampilannya seperti berikut :

Adapun kode pencetakannya adalah sebagai berikut :
01Private Sub cmdCetak_Click()
02    Dim batasKiri   As Single
03    Dim batasAtas   As Single
04 
05    Dim posisi      As Integer
06 
07    If MsgBox("Apakah proses pencetakan kode barcode ingin dilanjutkan ?", vbExclamation + vbYesNo, "Konfirmasi") = vbYes Then
08        Screen.MousePointer = vbHourglass
09        DoEvents
10 
11        Printer.PSet (0, 0), vbWhite
12        Printer.ScaleMode = vbPixels
13 
14        batasKiri = 0
15        batasAtas = 2.5
16        posisi = 0
17 
18        Do While posisi < 30
19            If Check1(posisi).Value = Checked Then
20                If posisi >= 0 And posisi <= 5 Then
21                    batasKiri = 0
22 
23                ElseIf posisi >= 6 And posisi <= 11 Then
24                    batasKiri = 4
25 
26                ElseIf posisi >= 12 And posisi <= 17 Then
27                    batasKiri = 8
28 
29                ElseIf posisi >= 18 And posisi <= 23 Then
30                    batasKiri = 12
31 
32                Else
33                    batasKiri = 16
34                End If
35 
36                Select Case posisi
37                    Case 0, 6, 12, 18, 24
38                        batasAtas = 0.5
39                    Case 1, 7, 13, 19, 25
40                        batasAtas = 3.2
41                    Case 2, 8, 14, 20, 26
42                        batasAtas = 5.8
43                    Case 3, 9, 15, 21, 27
44                        batasAtas = 8.4
45                    Case 4, 10, 16, 22, 28
46                        batasAtas = 11.2
47                    Case 5, 11, 17, 23, 29
48                        batasAtas = 13.9
49                End Select
50 
51                TBarCode51.Text = txtKodeBarcode.Text
52                TBarCode51.BackStyle = BKS_Transparent
53                TBarCode51.BCDraw Printer.hDC, Printer.ScaleX(batasKiri, vbCentimeters), Printer.ScaleY(batasAtas, vbCentimeters), Printer.ScaleX(3, vbCentimeters), Printer.ScaleY(1.5, vbCentimeters)
54            End If
55            posisi = posisi + 1
56        Loop
57        Printer.EndDoc
58 
59        Screen.MousePointer = vbDefault
60    End If
61End Sub

dan terakhir kode untuk mencetak barcode kelompok :
01Private Sub cmdCetak_Click()
02    Dim x           As Long
03    Dim y           As Long
04    Dim Index       As Integer
05 
06    Dim sgLeft1     As Single
07    Dim sgleft2     As Single
08    Dim sgTop       As Single
09 
10    Dim fExit       As Boolean
11 
12    If MsgBox("Apakah proses pencetakan kode barcode ingin dilanjutkan ?", vbExclamation + vbYesNo, "Konfirmasi") = vbYes Then
13        Screen.MousePointer = vbHourglass
14        DoEvents
15 
16        Printer.PSet (0, 0), vbWhite
17        Printer.ScaleMode = vbPixels
18        sgTop = Printer.ScaleY(2.5, vbCentimeters)
19        sgLeft1 = Printer.ScaleX(1, vbCentimeters)
20 
21        While fExit = False
22            x = 1
23            While fExit = False And x <= 3
24                y = 1
25                While fExit = False And y <= 4
26                    'top margin
27                    If y > 1 Then
28                        sgTop = sgTop + Printer.ScaleY(3.5, vbCentimeters)
29                    Else
30                        sgTop = Printer.ScaleY(2.5, vbCentimeters)
31                    End If
32 
33                    'left margin
34                    If x = 1 Then
35                        sgleft2 = Printer.ScaleX(1, vbCentimeters)
36                    ElseIf x = 2 Then
37                        sgleft2 = sgLeft1 + Printer.ScaleX(6.79, vbCentimeters)
38                    Else
39                        sgleft2 = sgLeft1 + Printer.ScaleX(6.64, vbCentimeters)
40                    End If
41 
42                    If Not ((Index + 1) > lstDaftarBarcode.ListCount) Then
43                        TBarCode51.Text = lstDaftarBarcode.List(Index)
44                        TBarCode51.BackStyle = BKS_Transparent
45                        TBarCode51.BCDraw Printer.hDC, sgleft2, sgTop, Printer.ScaleX(4.4, vbCentimeters), Printer.ScaleY(1, vbCentimeters)
46                    End If
47 
48                    If (Index + 1) > lstDaftarBarcode.ListCount Then
49                        fExit = True
50                    Else
51                        Index = Index + 1
52                    End If
53 
54                    y = y + 1
55                Wend
56 
57                sgLeft1 = sgleft2
58                x = x + 1
59            Wend
60 
61            If Not fExit Then
62                Printer.NewPage
63                sgTop = Printer.ScaleY(2, vbCentimeters)
64                sgLeft1 = Printer.ScaleX(1.5, vbCentimeters)
65            End If
66 
67        Wend
68 
69        Printer.EndDoc
70        Screen.MousePointer = vbDefault
71    End If
72End Sub
Selamat MENCOBA

Tidak ada komentar:

Posting Komentar