다음을 통해 공유

VB.Net - QR Code Creator

  • 아티클

Overview

QR code (abbreviated from Quick Response Code) is the trademark for a type of matrix barcode (or two-dimensional barcode) first designed for the automotive industry in Japan. 
This is a QR code creator application, that can create dynamic QR Codes in three sizes (150px, 200px, 250px). The QR Code can contain a URL, an email address, or simple text (Alphanumeric Max. 4,296 characters). This application utilises googleapis.

 


Contains fissues@microsoft.com


Contains a link to my profile


Contains some quoted text

↑ Back to top

The code

 

Form code

 

The form contains code for printing or saving the QR Code, and general GUI handling code...

Public Class  Form1
 
    Private WithEvents  pd As  New Printing.PrintDocument
    Private ppd As New PrintPreviewDialog
 
    Private QR_Image As Bitmap
 
    Private Sub Button1_Click_1(sender As  Object, e As EventArgs) Handles Button1.Click
        'generate
        If TextBox1.Text <> "" Then
            TableLayoutPanel1.ColumnStyles(2).Width = 81
            TableLayoutPanel1.ColumnStyles(3).Width = 81
            TableLayoutPanel1.SetCellPosition(Button2, New  TableLayoutPanelCellPosition(2, 0))
            TableLayoutPanel1.SetCellPosition(Button3, New  TableLayoutPanelCellPosition(3, 0))
        Else
            TableLayoutPanel1.ColumnStyles(2).Width = 0
            TableLayoutPanel1.ColumnStyles(3).Width = 0
        End If
        QrBox1.Data = TextBox1.Text
        QrBox1.Refresh()
    End Sub
 
    Private Sub Button2_Click(sender As  Object, e As EventArgs) Handles Button2.Click
        'save
        QR_Image = New  Bitmap(QrBox1.ClientSize.Width, QrBox1.ClientSize.Height)
        Dim gr As Graphics = Graphics.FromImage(QR_Image)
        gr.CopyFromScreen(QrBox1.PointToScreen(Point.Empty), Point.Empty, QrBox1.ClientSize)
 
        Dim sfd As New SaveFileDialog
        sfd.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
        sfd.Filter = "PNG (*.png)|*.png"
        sfd.FilterIndex = 0
        sfd.AddExtension = True
 
        If sfd.ShowDialog = DialogResult.OK Then
            QR_Image.Save(sfd.FileName, Drawing.Imaging.ImageFormat.Png)
        End If
    End Sub
 
    Private Sub Button3_Click(sender As  Object, e As EventArgs) Handles Button3.Click
        'print
        QR_Image = New  Bitmap(QrBox1.ClientSize.Width, QrBox1.ClientSize.Height)
        Dim gr As Graphics = Graphics.FromImage(QR_Image)
        gr.CopyFromScreen(QrBox1.PointToScreen(Point.Empty), Point.Empty, QrBox1.ClientSize)
        ppd.Document = pd
        ppd.ShowDialog()
    End Sub
 
    Private Sub pd_PrintPage(sender As  Object, e As Printing.PrintPageEventArgs) Handles pd.PrintPage
        e.Graphics.DrawImage(QR_Image, Point.Empty)
    End Sub
 
    Private Sub ToolStripComboBox1_SelectedIndexChanged(sender As  Object, e As EventArgs) Handles ToolStripComboBox1.SelectedIndexChanged
        QrBox1.Size = New  Size(150 + (ToolStripComboBox1.SelectedIndex * 50), 150 + (ToolStripComboBox1.SelectedIndex * 50))
        TextBox1.Left = QrBox1.Right + 6
        TextBox1.Size = New  Size(QrBox1.Width * 2, QrBox1.Height)
        Me.Size = New  Size(494 + (ToolStripComboBox1.SelectedIndex * 150), 267 + (ToolStripComboBox1.SelectedIndex * 50))
        QrBox1.Refresh()
    End Sub
 
    Private Sub Form1_Load(sender As  Object, e As EventArgs) Handles MyBase.Load
        ToolStripComboBox1.SelectedIndex = 0
        QrBox1.Data = "http://social.technet.microsoft.com/wiki/contents/articles/17641.technet-guru-contributions.aspx"
        QrBox1.Refresh()
    End Sub
 
End Class

 ↑ Back to top

The QRBox custom control

 

The creation of the QR Code (through googleapis) is encapsulated in the custom control...

Imports System.Net
 
Public Class  QRBox
 
    Const _GOOGLE_URL As String  = "http://chart.googleapis.com/chart?chs={WIDTH}x{HEIGHT}&cht=qr&chl={DATA}"
 
    Dim _DATA As String  = String.Empty
 
    Property Data() As String
        Get
            Return _DATA
        End Get
        Set(ByVal value As String)
            _DATA = value
        End Set
    End Property
 
    Private Function  getQRURI() As  String
        Dim _qrAddr As String  = _GOOGLE_URL.Replace("{WIDTH}", Me.Width.ToString).Replace("{HEIGHT}", Me.Height.ToString)
        _qrAddr = _qrAddr.Replace("{DATA}", WebUtility.UrlEncode(Me.Data))
 
        Return _qrAddr
    End Function
 
    Protected Overrides  Sub OnPaint(ByVal e As PaintEventArgs)
        MyBase.OnPaint(e)
 
        If Me.Data Is  Nothing Then  Exit Sub
 
        Dim client As New WebClient()
        Dim bytes() As Byte  = client.DownloadData(getQRURI())
        client.Dispose()
 
        Dim memStream As New IO.MemoryStream(bytes)
        Dim bmp As Bitmap = CType(Bitmap.FromStream(memStream), Bitmap)
        memStream.Dispose()
 
        e.Graphics.DrawImage(bmp, 0, 0)
    End Sub
 
    Public Sub  New()
        InitializeComponent()
    End Sub
 
End Class

 

↑ Back to top

Other Resources