Programming QRCode VB.Net

untuk membuat qrcode dengan VB.net, begini caranya :

download dulu MessagingToolkit.ORcode.Codec di sini

tambahkan library itu di vb.net 2010 (case ini menggunakan vb.net 2010)

tambahkan impoert QRcode.Codec dulu

buat function untuk create QRcode

Private Sub createQRCODE()
        'CREATE QRCODE
        Dim generate As New MessagingToolkit.QRCode.Codec.QRCodeEncoder

        Try
            PictureBox1.Image = generate.Encode(Me.txtfaktur.Text)
            PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage
        Catch ex As Exception
            MsgBox(ex.Message)
            Exit Sub
        End Try
    End Sub

buat function untuk simpanqrcode

Private Sub simpanQRCODE()
        'SIMPAN QRCODE
        Try
            'cek dulu apakah sudah ada nama file di ceo
            If Not File.Exists("D:\GAMBARQR" & Me.txtfaktur.Text & ".png") Then
                PictureBox1.Image.Save("D:\GAMBARQR" & Me.txtfaktur.Text & ".png")
                PictureBox1.Image = Nothing
            Else
                'My.Computer.FileSystem.DeleteFile("\CEO\" & TextBox1.Text & ".png")
                'PictureBox1.Image.Save("\CEO\" & TextBox1.Text & ".png")
                'PictureBox1.Image = Nothing

            End If

        Catch ee As Exception
            MsgBox(ee.Message)
        Catch ex As SqlClient.SqlException
            MsgBox(ex.Message)
        Finally
            If cnSQL.State = ConnectionState.Open Then
                cnSQL.Close()
            End If
        End Try
    End Sub

buat function untuk openfileQRcode

 Private Sub openfileQRCODE()
        'OPEN FILE DI PICTURE BOX
        Try

            PictureBox1.Image = Image.FromFile("D:\GAMBARQR" & Me.txtfaktur.Text & ".png")
            PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage
            'End If

        Catch ee As Exception
            MsgBox(ee.Message)
        Catch ex As SqlClient.SqlException
            MsgBox(ex.Message)
        Finally
            If cnSQL.State = ConnectionState.Open Then
                cnSQL.Close()
            End If
        End Try
    End Sub

jalankan dengan menjalankan function dengan urutan ini

 Me.createQRCODE() 
simpanQRCODE()
  openfileQRCODE()

tahap selanjutnya cara cetak di report (case ini cetak qrcode dengan crystal report)

add new item dulu di projek

pilih Data > Dataset , nama file DataSet1.xsd misalnya

double klik di Dataset1.xsd, akan terbuka seperti di gambar

klik kanan di tempat kosong, kemudian pilih Add > DataTable

klik kanan Add > Column

beri nama Column : Pic

masuk di properties Pic bagian DataType sesuaikan seperti di gambar

di crystal report ikuti langkah-langkah berikut ini :

tempatkan Pic di crystal report, Pic inilah nanti yang akan menampilkan gambar qrcode nya

oke menambahkan datatable di crystal report sudah berhasil, sekarang coding di vb.net nya supaya bisa tampil gambar qrcode di crystal report

 'CETAK KEPLEK YANG ADA QRCODE NYA....
        Dim pvCollection As New CrystalDecisions.Shared.ParameterValues()
        Dim pdvData As New CrystalDecisions.Shared.ParameterDiscreteValue()

        Try
            '------------ini harus diketikkan supaya bisa cetak gambar qrcode
            Dim ds As New DataSet1
            Dim ms As New System.IO.MemoryStream

            PictureBox1.Image.Save(ms, PictureBox1.Image.RawFormat)

            Dim byt() As Byte = ms.ToArray

            ds.DataTable1.Rows.Add(byt)
            Dim rpt As New crt_keplekQR
            rpt.SetDataSource(ds.Tables("DataTable1"))
            '----------------------------------------------------------------


            pvCollection.Clear()
            pdvData.Value = Me.txtNoMember.Text
            pvCollection.Add(pdvData)
            rpt.DataDefinition.ParameterFields("@nomember").ApplyCurrentValues(pvCollection)

            pvCollection.Clear()
            pdvData.Value = Me.txtnama.Text
            pvCollection.Add(pdvData)
            rpt.DataDefinition.ParameterFields("@namamember").ApplyCurrentValues(pvCollection)

            pvCollection.Clear()
            pdvData.Value = Me.txtcatatan.Text
            pvCollection.Add(pdvData)
            rpt.DataDefinition.ParameterFields("@catatan").ApplyCurrentValues(pvCollection)


            pvCollection.Clear()
            pdvData.Value = Me.txtfaktur.Text
            pvCollection.Add(pdvData)
            rpt.DataDefinition.ParameterFields("@faktur").ApplyCurrentValues(pvCollection)

            If Me.cmbluntur.SelectedValue = "T" Then
                pvCollection.Clear()
                pdvData.Value = Me.cmbluntur.Text
                pvCollection.Add(pdvData)
                rpt.DataDefinition.ParameterFields("@luntur").ApplyCurrentValues(pvCollection)
            Else
                pvCollection.Clear()
                pdvData.Value = ""
                pvCollection.Add(pdvData)
                rpt.DataDefinition.ParameterFields("@luntur").ApplyCurrentValues(pvCollection)
            End If


            Dim urutan As String
            urutan = Mid(Me.txtnourut.Text, 5, 5)
            pvCollection.Clear()
            pdvData.Value = urutan
            pvCollection.Add(pdvData)
            rpt.DataDefinition.ParameterFields("@urut").ApplyCurrentValues(pvCollection)


            pvCollection.Clear()
            pdvData.Value = Format(Me.dtptgltransaksi.Value, "dd/MMMM/yyyy")
            pvCollection.Add(pdvData)
            rpt.DataDefinition.ParameterFields("@tgl").ApplyCurrentValues(pvCollection)

            pvCollection.Clear()
            pdvData.Value = Format(Me.dtptglselesai.Value, "dd/MMMM/yyyy")
            pvCollection.Add(pdvData)
            rpt.DataDefinition.ParameterFields("@tglselesai").ApplyCurrentValues(pvCollection)


            Dim strDefaultPrinter As String = "kwitansi"
            Dim strPrinter As String
            For Each strPrinter In PrinterSettings.InstalledPrinters
                If strPrinter = strDefaultPrinter Then
                    rpt.PrintOptions.PrinterName = strDefaultPrinter
                    rpt.PrintToPrinter(1, False, 0, 0)
                End If
            Next


            Dim frm1 As New frmcetakkplekQR

            frm1.CrystalReportViewer1.ReportSource = rpt
            frm1.ShowDialog()
            PictureBox1.Image = Nothing
            '----ini juga harus diketik supaya Picturebox1.image jadinya nothing


        Catch ex As Exception
            MsgBox(ex.Message)
        End Try


        '---------BATAS CETAK KEPLEK YANG ADA QRCODENYA