This code is used to generate QR code that can be used to initiate SEPA credit transfer.
The QRCode can be saved as BMP or JPG.
![Name: Snap1.png
Views: 16
Size: 11.7 KB]()
The code is using the DLL qrcodelib.dll.
The QrCode generated in the sample allows you to make a gift of 10 to the Red Cross of Belgium (it is mandatory of cours, and only if you validate it)
The QRCode must read in your mobile app and needs of course a human validation.
Main routine
Full projectQRCodeSEPA.zip
The QRCode can be saved as BMP or JPG.
The code is using the DLL qrcodelib.dll.
The QrCode generated in the sample allows you to make a gift of 10 to the Red Cross of Belgium (it is mandatory of cours, and only if you validate it)
The QRCode must read in your mobile app and needs of course a human validation.
Code:
Dim sQRCode As String
sQRCode = QRCode_SEPA_Payment("BE72000000001616", "BPOTBEB1", "Croix-Rouge de Belgique", 10, "Gift", False)
Picture1.Picture = LoadPicture(sQRCode)
Code:
Public Function QRCode_SEPA_Payment(sIBAN As String, sBic As String, sNom As String, dMontant As Double, sCommunication As String, Optional bJPG As Boolean = False) As String
' #VBIDEUtils#************************************************************
' * Author :
' * Web Site :
' * E-Mail :
' * Date : 11/01/2021
' * Time : 13:15
' * Module Name : Module1
' * Module Filename : Main.bas
' * Procedure Name : QRCode_SEPA_Payment
' * Purpose :
' * Parameters :
' * sIBAN As String
' * sBic As String
' * sNom As String
' * dMontant As Double
' * sCommunication As String
' * Optional bJPG As Boolean = False
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
Dim sQRCode As String
Dim sReturn As String
Dim sBMPFile As String
Dim sTmpJPG As String
sQRCode = vbNullString
sQRCode = sQRCode & "BCD" & vbCrLf
sQRCode = sQRCode & "1" & vbCrLf
sQRCode = sQRCode & "1" & vbCrLf
sQRCode = sQRCode & "SCT" & vbCrLf
sQRCode = sQRCode & sBic & vbCrLf
sQRCode = sQRCode & sNom & vbCrLf
sQRCode = sQRCode & Replace(sIBAN, " ", vbNullString) & vbCrLf
sQRCode = sQRCode & "EUR" & Format$(dMontant, "0.00") & vbCrLf
sQRCode = sQRCode & "GDDS" & vbCrLf
sQRCode = sQRCode & sCommunication & vbCrLf
sQRCode = sQRCode & "" & vbCrLf
sQRCode = sQRCode & "MyApp" & vbCrLf
sBMPFile = GetTempFileName(sExtension:="bmp")
Call FastQRCode(sQRCode, sBMPFile)
sReturn = sBMPFile
If FileLen(sBMPFile) > 20 Then
If bJPG Then
sTmpJPG = GetTempFileName(sExtension:="jpg")
Call ResampleImage(sBMPFile, sTmpJPG, 80, 80, 100)
If FileExist(sTmpJPG) Then
QRCode_SEPA_Payment = sTmpJPG
End If
End If
End If
QRCode_SEPA_Payment = sReturn
End Function