Active X Code 39 Source Code

Dari flowchart tsb, saya nyoba bkin programnya...! Mngkn msh ada yg error...emang sengaja c..klo gk error ntar gk mau mempelajari source codenya. Source Codenya aq bentuk jd kumpulan-kumpulan prosedur:

'FUNGSI & Prosedur Code39
'++++++++++++++++++++++++++++++++++++++++++++++++++++++
Private Function KodeCode39(ByVal Kodenya As String) As String
  Dim hasil As String
  Dim Karakter As String
  Dim i As Integer
  For i = 1 To Len(Kodenya)
      Karakter = Mid(Kodenya, i, 1)
      Select Case Karakter
             Case "0": hasil = hasil & Ubah("000110100") & "0"
             Case "1": hasil = hasil & Ubah("100100001") & "0"
             Case "2": hasil = hasil & Ubah("001100001") & "0"
             Case "3": hasil = hasil & Ubah("101100000") & "0"
             Case "4": hasil = hasil & Ubah("000110001") & "0"
             Case "5": hasil = hasil & Ubah("100110000") & "0"
             Case "6": hasil = hasil & Ubah("001110000") & "0"
             Case "7": hasil = hasil & Ubah("000100101") & "0"
             Case "8": hasil = hasil & Ubah("100100100") & "0"
             Case "9": hasil = hasil & Ubah("001100100") & "0"
             Case "A": hasil = hasil & Ubah("100001001") & "0"
             Case "B": hasil = hasil & Ubah("001001001") & "0"
             Case "C": hasil = hasil & Ubah("101001000") & "0"
             Case "D": hasil = hasil & Ubah("000011001") & "0"
             Case "E": hasil = hasil & Ubah("100011000") & "0"
             Case "F": hasil = hasil & Ubah("001011000") & "0"
             Case "G": hasil = hasil & Ubah("000001101") & "0"
             Case "H": hasil = hasil & Ubah("100001100") & "0"
             Case "I": hasil = hasil & Ubah("001001100") & "0"
             Case "J": hasil = hasil & Ubah("000011100") & "0"
             Case "K": hasil = hasil & Ubah("100000011") & "0"
             Case "L": hasil = hasil & Ubah("001000011") & "0"
             Case "M": hasil = hasil & Ubah("101000010") & "0"
             Case "N": hasil = hasil & Ubah("000010011") & "0"
             Case "O": hasil = hasil & Ubah("100010010") & "0"
             Case "P": hasil = hasil & Ubah("001010010") & "0"
             Case "Q": hasil = hasil & Ubah("000000111") & "0"
             Case "R": hasil = hasil & Ubah("100000110") & "0"
             Case "S": hasil = hasil & Ubah("001000110") & "0"
             Case "T": hasil = hasil & Ubah("000010110") & "0"
             Case "U": hasil = hasil & Ubah("110000001") & "0"
             Case "V": hasil = hasil & Ubah("011000001") & "0"
             Case "W": hasil = hasil & Ubah("111000000") & "0"
             Case "X": hasil = hasil & Ubah("010010001") & "0"
             Case "Y": hasil = hasil & Ubah("110010000") & "0"
             Case "Z": hasil = hasil & Ubah("011010000") & "0"
             Case "-": hasil = hasil & Ubah("010000101") & "0"
             Case ".": hasil = hasil & Ubah("110000100") & "0"
             Case " ": hasil = hasil & Ubah("011000100") & "0"
             Case "*": hasil = hasil & Ubah("010010100") & "0"
             Case "$": hasil = hasil & Ubah("010101000") & "0"
             Case "/": hasil = hasil & Ubah("010100010") & "0"
             Case "+": hasil = hasil & Ubah("010001010") & "0"
             Case "%": hasil = hasil & Ubah("000101010") & "0"
      End Select
  Next i
  KodeCode39 = hasil
End Function

Private Function Ubah(KodeC39 As String) As String
  Dim i As Integer
  Dim Kar As String
  Dim hasil As String
  For i = 1 To Len(KodeC39)
      Kar = Mid(KodeC39, i, 1)
      If (i Mod 2) = 0 Then
      'jika posisi genap (spasi)
           If Kar = "1" Then
           'jika 1 berarti garis lebar
                hasil = hasil & "00"
           Else
                hasil = hasil & "0"
           End If
     Else
      'jika posisi ganjil (baris)
       If Kar = "1" Then
      'jika 1 berarti garis lebar
           hasil = hasil & "11"
       Else
           hasil = hasil & "1"
       End If
    End If
  Next i
  Ubah = hasil
End Function


Private Sub Code39()
  Dim kodeBinernya As String
  Pr_Value = UCase(Pr_Value)
  kodeBinernya = KodeCode39("*" & Pr_Value & "*")
  UserControl.Width = (TPX * Pr_Lebar * (Len(kodeBinernya) + 15))
  GambarCode39 kodeBinernya, Pr_Lebar, UserControl.ScaleHeight - 30, Pr_WarnaBar
End Sub

Private Sub GambarCode39(KodeBiner As String, ByVal lebar As Integer, Tinggi As Integer, Warna As ColorConstants)
Dim x As Long, y As Long
  UserControl.Cls
  x = (TPX * lebar) * 9
  y = UserControl.Height * 0.1

  Garis KodeBiner, x, y, lebar, Warna

'jika label tidak ingin ditampilkan
  If Pr_ShowLabel = False Then Exit Sub

'tempat buat tulisan
  UserControl.Line (x, UserControl.Height * 0.8)-Step(Len(KodeBiner) * lebar * TPX, UserControl.Height), UserControl.Backcolor, BF
'tulis tulisan
  UserControl.ForeColor = Warna
  UserControl.CurrentX = x + (Len(KodeBiner) * lebar * TPX) - ((Len(KodeBiner) * lebar * TPX) \ 2) - (Len(Pr_Value) * 3 * lebar * TPX)
  UserControl.CurrentY = UserControl.Height * 0.8
  UserControl.FontSize = 8 * lebar '* TPX
  UserControl.Print Pr_Value
End Sub

========================
NB:
*** Klo ada variabel yang depannya Pr_ (mis: Pr_Value) itu artinya..variabel tsb digunakan untuk menampung hasil dari inputan user....source code diatas aku comot dari komponen activeX Control yang aq buat.

(Sumber:
Tugas Akhir: M.Akroma, Perancangan dan Pembuatan ActiveX Control Pembuat label barcode satu dimensi.2007:STT Stikma Internasional, Malang)