QRMaker生成二维码,支持中文

时间:2021-01-18 14:55:28

QRMaker如果想支持中文,可以将中文转为UTF8,然后用InputDateB直接传入Byte()

Option Explicit

Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Const CP_UTF8 = 65001

Public Function UTF8_Encode(ByVal strUnicode As String) As Byte()
'UTF-8 编码

    Dim TLen As Long
    Dim lngBufferSize As Long
    Dim lngResult As Long
    Dim bytUtf8() As Byte

    TLen = Len(strUnicode)
    If TLen = 0 Then Exit Function

    lngBufferSize = TLen * 3 + 1
    ReDim bytUtf8(lngBufferSize - 1)

    lngResult = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUnicode), TLen, bytUtf8(0), lngBufferSize, vbNullString, 0)

    If lngResult <> 0 Then
        lngResult = lngResult - 1
        ReDim Preserve bytUtf8(lngResult)
    End If

    UTF8_Encode = bytUtf8
End Function

Private Sub Command1_Click()
On Error GoTo Err_Exit

With QRmaker1
    .ModelNo = 2
    .CellPitch = 5
    .CellUnit = 203
    .QuietZone = 0
    .InputDataB = UTF8_Encode(Text1.Text) '转为UTF8编码输入可以处理中文
    .Refresh
End With

Exit Sub
Err_Exit:
    'Err.Raise Err.Number, Err.Source, Err.Description
    MsgBox Err.Number & "|" & Err.Source & "|" & Err.Description
End Sub