How to create a 3D Terrain with Google Maps and height maps in Photoshop - 3D Map Generator Terrain - Duration: 20:32. Orange Box Ceo 8,345,336 views.
Kode di bawah ini akan menunjukkan cara untuk input data ke dalam kotak teks dan mendapatkan barcode dari gambar itu. Anda juga akan mempelajari bagaimana untuk bekerja dengan clipboard checksum dan kontrol.Untuk menggunakan, baru memulai Visual Basic Proyek, menambahkan formulir untuk proyek dan paste kode di bawah ini ke dalamnya. Anda akan memiliki visual untuk membuat kotak (qty4), tombol perintah, frame (qty2), label, tombol pilihan (qty4), gambar kotak (qty2) dan kotak teks.
Berikut tampilan preview dari program barcode maker yang kita akan buat.Untuk desain anda bisa membuat sesuai dengan
Option Explicit
Dim BCtype As Long
Dim BCtype As Long
Private Sub makeBC()
Select Case BCtype
Case 0
make39
Case 1
makei25
Case 2
make128
Case 3
makeCodabar
End Select
End Sub
Private Sub make39()
Dim x As Long, y As Long, pos As Long
Dim Bardata As String
Dim Cur As String
Dim CurVal As Long
Dim chksum As Long
Dim chkchr As String
Dim temp As String
Dim BC(43) As String
'3 of the 9 elements are wide: 0=narrow, 1=wide
BC(0) = '000110100' '0
BC(1) = '100100001' '1
BC(2) = '001100001' '2
BC(3) = '101100000' '3
BC(4) = '000110001' '4
BC(5) = '100110000' '5
BC(6) = '001110000' '6
BC(7) = '000100101' '7
BC(8) = '100100100' '8
BC(9) = '001100100' '9
BC(10) = '100001001' 'A
BC(11) = '001001001' 'B
BC(12) = '101001000' 'C
BC(13) = '000011001' 'D
BC(14) = '100011000' 'E
BC(15) = '001011000' 'F
BC(16) = '000001101' 'G
BC(17) = '100001100' 'H
BC(18) = '001001100' 'I
BC(19) = '000011100' 'J
BC(20) = '100000011' 'K
BC(21) = '001000011' 'L
BC(22) = '101000010' 'M
BC(23) = '000010011' 'N
BC(24) = '100010010' 'O
BC(25) = '001010010' 'P
BC(26) = '000000111' 'Q
BC(27) = '100000110' 'R
BC(28) = '001000110' 'S
BC(29) = '000010110' 'T
BC(30) = '110000001' 'U
BC(31) = '011000001' 'V
BC(32) = '111000000' 'W
BC(33) = '010010001' 'X
BC(34) = '110010000' 'Y
BC(35) = '011010000' 'Z
BC(36) = '010000101' '-
BC(37) = '110000100' '.
BC(38) = '011000100' '
BC(39) = '010101000' '$
BC(40) = '010100010' '/
BC(41) = '010001010' '+
BC(42) = '000101010' '%
BC(43) = '010010100' '* (used for start/stop character only)
Picture1.Cls
If Text1.Text = ' Then Exit Sub
pos = 20
Bardata = UCase(Text1.Text)
'Check for invalid characters, build temp string & calculate check sum
For x = 1 To Len(Bardata)
Cur = Mid$(Bardata, x, 1)
Select Case Cur
Case '0' To '9'
CurVal = Val(Cur)
Case 'A' To 'Z'
CurVal = Asc(Cur) - 55
Case '-'
CurVal = 36
Case '.'
CurVal = 37
Case ' '
CurVal = 38
Case '$'
CurVal = 39
Case '/'
CurVal = 40
Case '+'
CurVal = 41
Case '%'
CurVal = 42
Case Else 'oops!
Picture1.Print Cur & ' is Invalid'
Exit Sub
End Select
temp = temp & BC(CurVal) & '0' '0'= add intercharactor gap (1 narrow space)
chksum = chksum + CurVal
Next
'Add Check Character? (rarely used, but i put it here anyway...)
If Check1(2).Value Then
chksum = chksum Mod 43
temp = temp & BC(chksum) & '0'
chkchr = Mid$('0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%*', chksum + 1, 1)
End If
'Add Start & Stop characters (must have 'em for valid barcodes)
temp = BC(43) & '0' & temp & BC(43)
'Generate Barcode
For x = 1 To Len(temp)
If x Mod 2 = 0 Then
'SPACE
pos = pos + 1 + (2 * Val(Mid$(temp, x, 1))) + Check1(0).Value
Else
'BAR
For y = 1 To 1 + (2 * Val(Mid$(temp, x, 1)))
Picture1.Line (pos, 1)-(pos, 58 - Check1(1) * 8)
pos = pos + 1
Next
End If
Next
'Add Label?
If Check1(1).Value Then
Picture1.CurrentX = 35 + Len(Bardata) * (5 + Check1(0).Value * 2) 'kinda center
Picture1.CurrentY = 50
Picture1.Print Bardata & chkchr;
End If
End Sub
If Check1(1).Value Then
Picture1.CurrentX = 35 + Len(Bardata) * (5 + Check1(0).Value * 2) 'kinda center
Picture1.CurrentY = 50
Picture1.Print Bardata & chkchr;
End If
End Sub
Private Sub makei25()
Dim x As Long, y As Long, pos As Long
Dim Bardata As String
Dim Cur As String
Dim temp As String
Dim chksum As Long
Dim BC(11) As String
'2 of the 5 elements are wide: 0=narrow, 1=wide
BC(0) = '00110' '0
BC(1) = '10001' '1
BC(2) = '01001' '2
BC(3) = '11000' '3
BC(4) = '00101' '4
BC(5) = '10100' '5
BC(6) = '01100' '6
BC(7) = '00011' '7
BC(8) = '10010' '8
BC(9) = '01010' '9
BC(10) = '0000' 'Start chr
BC(11) = '100' 'Stop chr
Picture1.Cls
If Text1.Text = ' Then Exit Sub
pos = 20
Bardata = Text1.Text
'make even num of digits by adding a leading 0
If Len(Bardata) Mod 2 And Not Check1(2).Value Then Bardata = '0' & Bardata
If Not (Len(Bardata) Mod 2) And Check1(2).Value Then Bardata = '0' & Bardata
'Check for invalid characters and calculate check sum
For x = 1 To Len(Bardata)
Cur = Mid$(Bardata, x, 1)
If Cur < '0' Or Cur > '9' Then
Picture1.Print Cur & ' is Invalid'
Exit Sub
End If
'make checksum
If x Mod 2 Then
chksum = chksum + CLng(Cur) * 3
Else
chksum = chksum + CLng(Cur)
End If
Next
'add check chr to bardata (if selected)
If Check1(2).Value Then
chksum = (10 - chksum Mod 10) Mod 10
Bardata = Bardata & Chr$(48 + chksum)
End If
'interleave the code into a temp string - what'd you think the name meant?
For x = 1 To Len(Bardata) Step 2
For y = 1 To 5
temp = temp & Mid$(BC(Val(Mid$(Bardata, x, 1))), y, 1)
temp = temp & Mid$(BC(Val(Mid$(Bardata, x + 1, 1))), y, 1)
Next
Next
'add Start & Stop characters
temp = BC(10) & temp & BC(11)
'Generate Barcode
For x = 1 To Len(temp)
If x Mod 2 = 0 Then
'SPACE
pos = pos + 1 + (2 * Val(Mid$(temp, x, 1))) + Check1(0).Value
Else
'BAR
For y = 1 To 1 + (2 * Val(Mid$(temp, x, 1)))
Picture1.Line (pos, 1)-(pos, 58 - Check1(1) * 8)
pos = pos + 1
Next
End If
Next
'Add Label?
If Check1(1).Value Then
Picture1.CurrentX = 20 + Len(Bardata) * (2 + Check1(0).Value * 1.3) 'kinda center
Picture1.CurrentY = 50
Picture1.Print Bardata;
End If
End Sub
If Check1(1).Value Then
Picture1.CurrentX = 20 + Len(Bardata) * (2 + Check1(0).Value * 1.3) 'kinda center
Picture1.CurrentY = 50
Picture1.Print Bardata;
End If
End Sub
Private Sub make128()
Dim x As Long, y As Long, pos As Long
Dim Bardata As String
Dim Cur As String
Dim CurVal As Long
Dim chksum As Long
Dim temp As String
Dim BC(106) As String
'code 128 is basically the ASCII chr set.
'4 element sizes : 1=narrowest, 4=widest
BC(0) = '212222' '
BC(1) = '222122' '!
BC(2) = '222221' '
BC(3) = '121223' '#
BC(4) = '121322' '$
BC(5) = '131222' '%
BC(6) = '122213' '&
BC(7) = '122312' '
BC(8) = '132212' '(
BC(9) = '221213' ')
BC(10) = '221312' '*
BC(11) = '231212' '+
BC(12) = '112232' ',
BC(13) = '122132' '-
BC(14) = '122231' '.
BC(15) = '113222' '/
BC(16) = '123122' '0
BC(17) = '123221' '1
BC(18) = '223211' '2
BC(19) = '221132' '3
BC(20) = '221231' '4
BC(21) = '213212' '5
BC(22) = '223112' '6
BC(23) = '312131' '7
BC(24) = '311222' '8
BC(25) = '321122' '9
BC(26) = '321221' ':
BC(27) = '312212' ';
BC(28) = '322112' '<>
BC(31) = '212321' '?
BC(32) = '232121' '@
BC(33) = '111323' 'A
BC(34) = '131123' 'B
BC(35) = '131321' 'C
BC(36) = '112313' 'D
BC(37) = '132113' 'E
BC(38) = '132311' 'F
BC(39) = '211313' 'G
BC(40) = '231113' 'H
BC(41) = '231311' 'I
BC(42) = '112133' 'J
BC(43) = '112331' 'K
BC(44) = '132131' 'L
BC(45) = '113123' 'M
BC(46) = '113321' 'N
BC(47) = '133121' 'O
BC(48) = '313121' 'P
BC(49) = '211331' 'Q
BC(50) = '231131' 'R
BC(51) = '213113' 'S
BC(52) = '213311' 'T
BC(53) = '213131' 'U
BC(54) = '311123' 'V
BC(55) = '311321' 'W
BC(56) = '331121' 'X
BC(57) = '312113' 'Y
BC(58) = '312311' 'Z
BC(59) = '332111' '[
BC(60) = '314111' '
BC(61) = '221411' ']
BC(62) = '431111' '^
BC(63) = '111224' '_
BC(64) = '111422' '`
BC(65) = '121124' 'a
BC(66) = '121421' 'b
BC(67) = '141122' 'c
BC(68) = '141221' 'd
BC(69) = '112214' 'e
BC(70) = '112412' 'f
BC(71) = '122114' 'g
BC(72) = '122411' 'h
BC(73) = '142112' 'i
BC(74) = '142211' 'j
BC(75) = '241211' 'k
BC(76) = '221114' 'l
BC(77) = '413111' 'm
BC(78) = '241112' 'n
BC(79) = '134111' 'o
BC(80) = '111242' 'p
BC(81) = '121142' 'q
BC(82) = '121241' 'r
BC(83) = '114212' 's
BC(84) = '124112' 't
BC(85) = '124211' 'u
BC(86) = '411212' 'v
BC(87) = '421112' 'w
BC(88) = '421211' 'x
BC(89) = '212141' 'y
BC(90) = '214121' 'z
BC(91) = '412121' '{
BC(92) = '111143' '|
BC(93) = '111341' '}
BC(94) = '131141' '~
BC(95) = '114113' '
BC(96) = '114311' 'FNC 3 *not used in this sub
BC(97) = '411113' 'FNC 2 *not used in this sub
BC(98) = '411311' 'SHIFT *not used in this sub
BC(99) = '113141' 'CODE C *not used in this sub
BC(100) = '114131' 'FNC 4 *not used in this sub
BC(101) = '311141' 'CODE A *not used in this sub
BC(102) = '411131' 'FNC 1 *not used in this sub
BC(103) = '211412' 'START A *not used in this sub
BC(104) = '211214' 'START B
BC(105) = '211232' 'START C *not used in this sub
BC(106) = '2331112' 'STOP
If Text1.Text = ' Then Exit Sub
pos = 20
Bardata = Text1.Text
For x = 1 To Len(Bardata)
Cur = Mid$(Bardata, x, 1)
If Cur < ' ' Or Cur > '~' Then
Picture1.Print 'Invalid Character(s)'
Exit Sub
End If
CurVal = Asc(Cur) - 32
temp = temp + BC(CurVal)
chksum = chksum + CurVal * x
Next
'Add start, stop & check characters
chksum = (chksum + 104) Mod 103
temp = BC(104) & temp & BC(chksum) & BC(106)
For x = 1 To Len(temp)
If x Mod 2 = 0 Then
'SPACE
pos = pos + (Val(Mid$(temp, x, 1))) + Check1(0).Value
Else
'BAR
For y = 1 To (Val(Mid$(temp, x, 1)))
Picture1.Line (pos, 1)-(pos, 58 - Check1(1) * 8)
pos = pos + 1
Next
End If
Next
If Check1(1).Value Then
Picture1.CurrentX = 30 + Len(Bardata) * (3 + Check1(0).Value * 2) 'kinda center
Picture1.CurrentY = 50
Picture1.Print Bardata;
End If
End Sub
Private Sub makeCodabar()
Dim x As Long, y As Long, pos As Long
Dim Bardata As String
Dim Cur As String
Dim CurVal As Long
Dim temp As String
Dim BC(19) As String
'Codabar, also known as NW-7
BC(0) = '0000011' '0
BC(1) = '0000110' '1
BC(2) = '0001001' '2
BC(3) = '1100000' '3
BC(4) = '0010010' '4
BC(5) = '1000010' '5
BC(6) = '0100001' '6
BC(7) = '0100100' '7
BC(8) = '0110000' '8
BC(9) = '1001000' '9
BC(10) = '0001100' '-
BC(11) = '0011000' '$
BC(12) = '1000101' ':
BC(13) = '1010001' '/
BC(14) = '1010100' '.
BC(15) = '0010101' '+
BC(16) = '0011010' 'start/stop A
BC(17) = '0101001' 'start/stop B
BC(18) = '0001011' 'start/stop C
BC(19) = '0001110' 'start/stop D
Picture1.Cls
If Text1.Text = ' Then Exit Sub
pos = 20
Bardata = Text1.Text
Cur = Mid$(Bardata, x, 1)
Select Case Cur
Case '0' To '9'
CurVal = Val(Cur)
Case 'a' To 'd'
CurVal = Asc(Cur) - 81
Case '-'
CurVal = 10
Case '$'
CurVal = 11
Case ':'
CurVal = 12
Case '/'
CurVal = 13
Case '.'
CurVal = 14
Case '+'
CurVal = 15
Case Else 'oops!
Picture1.Print Cur & ' is Invalid'
Exit Sub
End Select
temp = temp & BC(CurVal) & '0' '0'= add intercharactor gap (1 narrow space)
Next
temp = BC(16) & '0' & temp & BC(16)
'Generate Barcode
For x = 1 To Len(temp)
If x Mod 2 = 0 Then
'SPACE
pos = pos + 1 + (2 * Val(Mid$(temp, x, 1))) + Check1(0).Value
Else
'BAR
For y = 1 To 1 + (2 * Val(Mid$(temp, x, 1)))
Picture1.Line (pos, 1)-(pos, 58 - Check1(1) * 8)
pos = pos + 1
Next
End If
Next
![Cara Membuat Program Barcode Dengan Visual Basic Cara Membuat Program Barcode Dengan Visual Basic](http://softwaretokoprogramkasirterbaik.indoprogram.com/wp-content/uploads/2012/10/software-toko-program-kasir-terbaik-di-indonesia.jpg)
If Check1(1).Value Then
Picture1.CurrentX = 30 + Len(Bardata) * (3 + Check1(0).Value * 2) 'kinda center
Picture1.CurrentY = 50
Picture1.Print Bardata;
End If
End Sub
Private Sub Form_Resize()
Picture1.Width = Form1.Width - 360
makeBC
End Sub
Private Sub Option1_Click(Index As Integer)
Select Case Index
Case 0
Check1(2).ToolTipText = 'Optional'
Check1(2).Value = 0
Check1(2).Enabled = True
Case 1
Check1(2).ToolTipText = 'Optional'
Check1(2).Value = 0
Check1(2).Enabled = True
Case 2
Check1(2).ToolTipText = 'Not optional'
Check1(2).Value = 1
Check1(2).Enabled = False
Case 3
Check1(2).ToolTipText = 'Not used'
Check1(2).Value = 0
Check1(2).Enabled = False
End Select
BCtype = Index
makeBC
End Sub
Private Sub Text1_Change()
makeBC
End Sub
Private Sub Check1_Click(Index As Integer)
makeBC
End Sub
Private Sub Command1_Click()
Clipboard.Clear
Clipboard.SetData Picture1.Image
End Sub
Cara Membuat Barcode di VB 6.0 - Pada pertemuan kali ini kita akan membuat sebuah Barcode yang yang dibuat dengan menggunakan Visual Basic. Mungkin suatu saat kita akan membutuhkan kode ini untuk inputan barang yang kita buat di program kita.
Barcode menurut pendapat saya adalah salah satu alat input yang berisi kode tertentu yang berbentuk batang dengan garis-garis vertikal atau sejenisnya yang berwarna hitam-putih.Kita pasti tau dan melihat bagaimana bentuk barcode. Barcode banyak kita temukan di luar suatu kemasan produk yang biasanya berada di toko swalayan.Untuk mengaplikasikan barcode ini biasanya menggunakan alat lain yang namanya Barcode Reader sebagai alat pembacanya.
Barcode adalah kode-kode angka dan huruf yang terdiri dari kombinasi bar (garis) dengan berbagai jarak. Hal ini merupakan salah satu cara untuk memasukan data ke dalam komputer.Dalam Barcode tidak berisi barang deskriptif suatu barang namun hanya enkripsi daru jumlah digit angka.
Bagi Anda yang penasaran bagaimana cara membuatnya mari kita ikuti langkah-langkah berikut dibawah ini:
Barcode menurut pendapat saya adalah salah satu alat input yang berisi kode tertentu yang berbentuk batang dengan garis-garis vertikal atau sejenisnya yang berwarna hitam-putih.Kita pasti tau dan melihat bagaimana bentuk barcode. Barcode banyak kita temukan di luar suatu kemasan produk yang biasanya berada di toko swalayan.Untuk mengaplikasikan barcode ini biasanya menggunakan alat lain yang namanya Barcode Reader sebagai alat pembacanya.
Barcode adalah kode-kode angka dan huruf yang terdiri dari kombinasi bar (garis) dengan berbagai jarak. Hal ini merupakan salah satu cara untuk memasukan data ke dalam komputer.Dalam Barcode tidak berisi barang deskriptif suatu barang namun hanya enkripsi daru jumlah digit angka.
Bagi Anda yang penasaran bagaimana cara membuatnya mari kita ikuti langkah-langkah berikut dibawah ini:
Cara Membuat Barcode di VB 6.0
Pada kesempatan ini Saya ingin bagikan kepada para pembaca setia Tip dan trik VB 6.0, bagaimana cara membuat Barcode di VB 6.0 :
1. Buka Form Visual Basic 6.0 Anda
2. Tanamkan bebrapa Label, 1 TextBox dan 1 PictureBox
Desain Form Barcode |
4. Setelah selesai mendesain form, sekarang Tambahkan Module pada form Anda, lalu ketik kode
berikut di Module:
berikut di Module:
Sub DrawBarcode(ByVal bc_string As String, obj As Object)
Dim xpos!
Dim Y1!
Dim Y2!
Dim dw%
Dim Th!
Dim tw
Dim new_string$
If bc_string = ' Then obj.Cls: Exit Sub
Dim BC(90) As String
BC(1) = '1 1221'
BC(2) = '1 1221'
BC(48) = '11 221'
BC(49) = '21 112'
BC(50) = '12 112'
BC(51) = '22 111'
BC(52) = '11 212'
BC(53) = '21 211'
BC(54) = '12 211'
BC(55) = '11 122'
BC(56) = '21 121'
BC(57) = '12 121'
BC(65) = '211 12'
BC(66) = '121 12'
BC(67) = '221 11'
BC(68) = '112 12'
BC(69) = '212 11'
BC(70) = '122 11'
BC(71) = '111 22'
BC(72) = '211 21'
BC(73) = '121 21'
BC(74) = '112 21'
BC(75) = '2111 2'
BC(76) = '1211 2'
BC(77) = '2211 1'
BC(78) = '1121 2'
BC(79) = '2121 1'
BC(80) = '1221 1'
BC(81) = '1112 2'
BC(82) = '2112 1'
BC(83) = '1212 1'
BC(84) = '1122 1'
BC(85) = '2 1112'
BC(86) = '1 2112'
BC(87) = '2 2111'
BC(88) = '1 1212'
BC(89) = '2 1211'
BC(90) = '1 2211'
BC(32) = '1 2121'
BC(35) = '
BC(36) = '1 1 1 11'
BC(37) = '11 1 1 1'
BC(43) = '1 11 1 1'
BC(45) = '1 1122'
BC(47) = '1 1 11 1'
BC(46) = '2 1121'
BC(64) = '
BC(42) = '1 1221'
bc_string = UCase(bc_string)
obj.ScaleMode = 3
obj.Cls
obj.Picture = Nothing
dw = CInt(obj.ScaleHeight / 40)
If dw < 1 Then dw = 1
Th = obj.TextHeight(bc_string)
tw = obj.TextWidth(bc_string)
new_string = Chr$(1) & bc_string & Chr$(2)
Y1 = obj.ScaleTop + 13
Y2 = obj.ScaleTop + obj.ScaleHeight - 1 * Th
obj.Width = 1.1 * Len(new_string) * (15 * dw) * obj.Width / obj.ScaleWidth
xpos = obj.ScaleLeft
For n = 1 To Len(new_string)
c = Asc(Mid$(new_string, n, 1))
If c > 90 Then c = 0
bc_pattern$ = BC(c)
For i = 1 To Len(bc_pattern$)
Select Case Mid$(bc_pattern$, i, 1)
Case ' '
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
xpos = xpos + dw
Case '1'
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
xpos = xpos + dw
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &H0&, BF
xpos = xpos + dw
Case '2'
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
xpos = xpos + dw
obj.Line (xpos, Y1)-(xpos + 2 * dw, Y2), &H0&, BF
xpos = xpos + 2 * dw
End Select
Next
Next
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
xpos = xpos + dw
obj.Width = (xpos + dw) * obj.Width / obj.ScaleWidth
obj.CurrentX = (obj.ScaleWidth - tw) / 2
obj.CurrentY = Y2 + 0.1 * Th
obj.Print bc_string
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
xpos = xpos + dw
obj.Width = (xpos + dw) * obj.Width / obj.ScaleWidth
obj.CurrentX = 0 '(obj.ScaleWidth - tw) / 2
obj.CurrentY = 0 'Y2 - 3.25 * Th
obj.Print 'Tipandtrickunikvb.blogspot.com'
End Sub
Dim xpos!
Dim Y1!
Dim Y2!
Dim dw%
Dim Th!
Dim tw
Dim new_string$
If bc_string = ' Then obj.Cls: Exit Sub
Dim BC(90) As String
BC(1) = '1 1221'
BC(2) = '1 1221'
BC(48) = '11 221'
BC(49) = '21 112'
BC(50) = '12 112'
BC(51) = '22 111'
BC(52) = '11 212'
BC(53) = '21 211'
BC(54) = '12 211'
BC(55) = '11 122'
BC(56) = '21 121'
BC(57) = '12 121'
BC(65) = '211 12'
BC(66) = '121 12'
BC(67) = '221 11'
BC(68) = '112 12'
BC(69) = '212 11'
BC(70) = '122 11'
BC(71) = '111 22'
BC(72) = '211 21'
BC(73) = '121 21'
BC(74) = '112 21'
BC(75) = '2111 2'
BC(76) = '1211 2'
BC(77) = '2211 1'
BC(78) = '1121 2'
BC(79) = '2121 1'
BC(80) = '1221 1'
BC(81) = '1112 2'
BC(82) = '2112 1'
BC(83) = '1212 1'
BC(84) = '1122 1'
BC(85) = '2 1112'
BC(86) = '1 2112'
BC(87) = '2 2111'
BC(88) = '1 1212'
BC(89) = '2 1211'
BC(90) = '1 2211'
BC(32) = '1 2121'
BC(35) = '
BC(36) = '1 1 1 11'
BC(37) = '11 1 1 1'
BC(43) = '1 11 1 1'
BC(45) = '1 1122'
BC(47) = '1 1 11 1'
BC(46) = '2 1121'
BC(64) = '
BC(42) = '1 1221'
bc_string = UCase(bc_string)
obj.ScaleMode = 3
obj.Cls
obj.Picture = Nothing
dw = CInt(obj.ScaleHeight / 40)
If dw < 1 Then dw = 1
Th = obj.TextHeight(bc_string)
tw = obj.TextWidth(bc_string)
new_string = Chr$(1) & bc_string & Chr$(2)
Y1 = obj.ScaleTop + 13
Y2 = obj.ScaleTop + obj.ScaleHeight - 1 * Th
obj.Width = 1.1 * Len(new_string) * (15 * dw) * obj.Width / obj.ScaleWidth
xpos = obj.ScaleLeft
For n = 1 To Len(new_string)
c = Asc(Mid$(new_string, n, 1))
If c > 90 Then c = 0
bc_pattern$ = BC(c)
For i = 1 To Len(bc_pattern$)
Select Case Mid$(bc_pattern$, i, 1)
Case ' '
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
xpos = xpos + dw
Case '1'
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
xpos = xpos + dw
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &H0&, BF
xpos = xpos + dw
Case '2'
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
xpos = xpos + dw
obj.Line (xpos, Y1)-(xpos + 2 * dw, Y2), &H0&, BF
xpos = xpos + 2 * dw
End Select
Next
Next
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
xpos = xpos + dw
obj.Width = (xpos + dw) * obj.Width / obj.ScaleWidth
obj.CurrentX = (obj.ScaleWidth - tw) / 2
obj.CurrentY = Y2 + 0.1 * Th
obj.Print bc_string
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
xpos = xpos + dw
obj.Width = (xpos + dw) * obj.Width / obj.ScaleWidth
obj.CurrentX = 0 '(obj.ScaleWidth - tw) / 2
obj.CurrentY = 0 'Y2 - 3.25 * Th
obj.Print 'Tipandtrickunikvb.blogspot.com'
End Sub
5. Setelah itu kembali ke Form Anda, buka jendela kode dengan F7 lalu ketikan di TextBox kode berikut :
Private Sub Text1_Change()
Call DrawBarcode(Text1, Picture1)
End Sub
Call DrawBarcode(Text1, Picture1)
End Sub
6. Simpan hasil pekerjaan Anda dan jalankan Program.
Demikian tip Cara Membuat Barcode di VB 6.0. Selamat mencoba semoga berhasil.