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 mailto: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.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