[VB.NET] การพิมพ์ QR Code ลงในรายงาน RDLC และแสดงผลบน ReportViewer
การสร้างรายงาน (Report) หรือไฟล์ที่มีนามสกุล RDLC เพื่อแสดงผลบน ReportViewer ซึ่งพวกนี้เป็น Control มาตรฐานที่ทางไมโครซอฟท์แถมติดมาให้ด้วย โดยโค้ดชุดนี้ไม่ได้ว่าถึงเรื่องของฐานข้อมูล แต่จะเป็นการส่งค่าพารามิเตอร์ (Parameter) ไปยังเอกสาร RDLC คือชื่อไฟล์ภาพ และตำแหน่งที่เก็บภาพ เพื่อนำมาแสดงผลในรายงาน ...http://www.g2gsoft.com/webboard/images/VBNet/rdlcreportviewer.png
หน้าจอหลัก
http://www.g2gsoft.com/webboard/images/VBNet/rdlcparameter.png
การ Add Parameters
http://www.g2gsoft.com/webboard/images/VBNet/rdlcdata.png
การกำหนด Parameter
http://www.g2gsoft.com/webboard/images/VBNet/rdlcreference.png
Add References ...
bW8hksxTUHk
https://www.youtube.com/watch?v=bW8hksxTUHk
คลิปวิดีโอการสร้าง Parameter ที่จะต้องใช้งานในโปรเจค ...
มาดูโค้ดต้นฉบับกันเถอะ ...
Imports ZXing.Common
Imports ZXing
Imports ZXing.Rendering
Imports ZXing.QrCode
Imports System.IO
Imports System.Drawing.Imaging
Imports Microsoft.Reporting.WinForms
Public Class frmZXingReportViewer
'// Images Path
Private strPathImages As String = MyPath(Application.StartupPath) & "Images" & Chr(92)
' / --------------------------------------------------------------------------------
Private Sub frmZXingReportViewer_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
txtURL.Text = "ทดสอบภาษาไทยสำหรับ ZXing QR Code เพื่อพิมพ์รายงานใน RDLC (Report Viewer)"
'txtURL.Text = "http://www.g2gsoft.com/"
End Sub
' / --------------------------------------------------------------------------------
'// Generate QR Barcodes based on the specified text.
' / --------------------------------------------------------------------------------
Private Sub txtURL_TextChanged(sender As Object, e As System.EventArgs) Handles txtURL.TextChanged
If String.IsNullOrWhiteSpace(txtURL.Text) Then
picBarcode.Image = Nothing
Return
End If
'//
Dim options As EncodingOptions = New QrCodeEncodingOptions
With options
.Margin = 1
.NoPadding = True
.Width = picBarcode.Width
.Height = picBarcode.Height
.Hints.Add(EncodeHintType.CHARACTER_SET, "UTF-8")
.PureBarcode = False
End With
'//
Dim objWriter As BarcodeWriter = New BarcodeWriter With {
.Format = BarcodeFormat.QR_CODE,
.Options = options,
.Renderer = New BitmapRenderer
}
picBarcode.Image = New Bitmap(objWriter.Write(txtURL.Text))
picBarcode.SizeMode = PictureBoxSizeMode.StretchImage
End Sub
' / --------------------------------------------------------------------------------
'// Print QR Code into RDLC.
' / --------------------------------------------------------------------------------
Private Sub btnPrintQRCode_Click(sender As System.Object, e As System.EventArgs) Handles btnPrintQRCode.Click
If String.IsNullOrWhiteSpace(txtURL.Text) Then
picBarcode.Image = Nothing
Return
End If
Try
Dim imageFullPath As String = strPathImages & "temp.png"
'// Save picture.
'//Dim FileToSaveAs As String = System.IO.Path.Combine(My.Computer.FileSystem.SpecialDirectories.Temp, imageFullPath)
Dim FileToSaveAs As String = System.IO.Path.Combine(My.Application.Info.DirectoryPath, imageFullPath)
picBarcode.Image.Save(FileToSaveAs, System.Drawing.Imaging.ImageFormat.Png)
'// Parameter names in RDLC, uppercase and lowercase affect functionality. (picname not the same as PicName)
Dim pictureName As ReportParameter = New ReportParameter("picName", imageFullPath)
Dim picturePath As ReportParameter = New ReportParameter("picPath", New Uri(imageFullPath).AbsoluteUri)
With ReportViewer1
.LocalReport.EnableExternalImages = True
.LocalReport.SetParameters(New ReportParameter() {pictureName, picturePath})
.RefreshReport()
End With
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
' / --------------------------------------------------------------------------------
'// Copy image to clipboard.
' / --------------------------------------------------------------------------------
Private Sub btnCopyClipboard_Click(sender As System.Object, e As System.EventArgs) Handles btnCopyClipboard.Click
If picBarcode.Image Is Nothing Then
MessageBox.Show("There is no QR Code.", "Report Status", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Return
End If
'/ Add it as an image
Clipboard.SetImage(picBarcode.Image)
'/ Create a PNG on disk and add the location to the clipboard.
Dim TempName As String = "TempName.jpg"
Dim TempPath As String = System.IO.Path.Combine(My.Computer.FileSystem.SpecialDirectories.Temp, TempName)
Using FS As New System.IO.FileStream(TempPath, IO.FileMode.Create, IO.FileAccess.Write, IO.FileShare.Read)
picBarcode.Image.Save(FS, System.Drawing.Imaging.ImageFormat.Png)
End Using
Dim Paths As New System.Collections.Specialized.StringCollection()
Paths.Add(TempPath)
Clipboard.SetFileDropList(Paths)
End Sub
Private Sub btnExit_Click(sender As System.Object, e As System.EventArgs) Handles btnExit.Click
Me.Close()
End Sub
Private Sub frmZXingReportViewer_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
Me.Dispose()
GC.SuppressFinalize(Me)
Application.Exit()
End Sub
#Region "FUNCTION"
' / --------------------------------------------------------------------------------
' / Get my project path
' / AppPath = C:\My Project\bin\debug
' / Replace "\bin\debug" with "\"
' / Return : C:\My Project\
Function MyPath(AppPath As String) As String
'/ Return Value
MyPath = AppPath.ToLower.Replace("\bin\debug", "\").Replace("\bin\release", "\").Replace("\bin\x86\debug", "\")
'// If not found folder then put the \ (BackSlash) at the end.
If Microsoft.VisualBasic.Right(MyPath, 1) <> Chr(92) Then MyPath = MyPath & Chr(92)
End Function
#End Region
End Class
ดาวน์โหลดโค้ดต้นฉบับ VB.NET (2010) ได้ที่นี่ ...
หน้า:
[1]