Encode - Decode QR CODE With Visual Basic

 SCAN ME

 

QR Code

QR code stands for quick response code. This code is a two-dimensional barcode that can provide various types of information directly. To open it, it takes a scan or scanning with various scanning tools.

QR codes are usually capable of storing 2089 digits or 4289 characters, including punctuation marks and special characters.

This allows the QR code to display text to the user, open URLs, save contacts to the phone book, and much more.

QR codes are considered more practical than barcodes because they are able to store more data.

A QR code consists of black dots and white spaces arranged in a square shape, and each element has its own meaning.

Create Project QR Code With Visual Basic - Simple For Beginner...

 

 

1. Create Project 

2. Source FrmQRCode

Option Explicit

Dim CN As New ADODB.Connection
Dim rs As New ADODB.Recordset

Dim SQL As String
Dim FileName As String

Private Sub CmdQR_Click()
    Me.txtEncodeData.Text = "NOID :" + Me.TNOID.Text + vbLf + "NAME : " + Me.TNAME.Text
    Dim qrEncoder As New QRCodeEncoder
    qrEncoder.QRCodeEncodeMode = ENCODE_MODE.ENCODE_MODE_BYTE
    qrEncoder.QRCodeScale = 4
    qrEncoder.QRCodeVersion = 7
    qrEncoder.QRCodeErrorCorrect = ERROR_CORRECTION.ERROR_CORRECTION_M
    picEncode.Picture = qrEncoder.EncodeVB6(txtEncodeData.Text)   
    SavePicture picEncode.Picture, App.Path & "\" & TNOID.Text & ".bmp"
End Sub

Private Sub Command1_Click()
    Dim decoder As New QRCodeDecoder   
    Dim decodedString As String   
    Dim qrCodeImage As New QRCodeBitmapImage
    qrCodeImage.SetBitmap = picEncode.Picture   
    decodedString = decoder.decodeVB6(qrCodeImage)   
    MsgBox "QR Decode : " & vbCrLf & decodedString, vbInformation, "Informasi"
End Sub    
    

3. Module API

Option Explicit
Public Const LWA_COLORKEY = 1
Public Const LWA_ALPHA = 2
Public Const LWA_BOTH = 3
Public Const WS_EX_LAYERED = &H80000
Public Const GWL_EXSTYLE = -20
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal color As Long, ByVal x As Byte, ByVal alpha As Long) As Boolean
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

4. Module Misc

Option Explicit

Sub SetTranslucent(ThehWnd As Long, nTrans As Integer)
    On Error GoTo ErrorRtn

    'SetWindowLong and SetLayeredWindowAttributes are API functions, see MSDN for details
    Dim attrib As Long
    attrib = GetWindowLong(ThehWnd, GWL_EXSTYLE)
    SetWindowLong ThehWnd, GWL_EXSTYLE, attrib Or WS_EX_LAYERED
    SetLayeredWindowAttributes ThehWnd, RGB(255, 255, 0), nTrans, LWA_ALPHA
    Exit Sub
ErrorRtn:
    MsgBox Err.Description & " Source : " & Err.Source
    
End Sub

Simple Web Cam Capture Form With Visual Basic

 

 

SIMPLE PROJECT WEB CAM CAPTURE WITH FORM VISUAL BASIC

 

1. Design Form Capture Web Cam Visual Basic

 

2. Source Code FrmCam

 Option Explicit
Dim hCap As Long

Private Sub CmdClose_Click()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
Unload Me
End Sub

Private Sub CmdMulai_Click()
hCap = capCreateCaptureWindow("Take a Camera Shot" _
, WS_CHILD Or WS_VISIBLE, 0, 0, gbrWebcam.Width _
, gbrWebcam.Height, gbrWebcam.hWnd, 0)
If hCap <> 0 Then
Call SendMessage(hCap, WM_CAP_DRIVER_CONNECT, 0, 0)
Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 66, 0&)
Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
End If
End Sub

Private Sub CmdSetting_Click()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
End Sub

Private Sub CmdSimpan_Click()
Dim sFileName As String
Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)
With CDialog
.CancelError = True
.Flags = cdlOFNPathMustExist Or cdlOFNOverwritePrompt
.Filter = "JPEG Picture(*.jpg)|*.jpg|All Files|*.*"
.ShowSave
sFileName = .FileName
End With
Call SendMessage(hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(sFileName))
DoFinally:
Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
End Sub
 

3. Source Module

 Option Explicit

Public Const WS_CHILD As Long = &H40000000
Public Const WS_VISIBLE As Long = &H10000000
Public Const WM_USER As Long = &H400
Public Const WM_CAP_START As Long = WM_USER
Public Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Public Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Public Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Public Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Public Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41
Public Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25
Public Declare Function capCreateCaptureWindow _
Lib "avicap32.dll" Alias "capCreateCaptureWindowA" _
(ByVal lpszWindowName As String, ByVal dwStyle As Long _
, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long _
, ByVal nHeight As Long, ByVal hwndParent As Long _
, ByVal nID As Long) As Long
Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long _
, ByVal wParam As Long, ByRef lParam As Any) As Long