リファクタリング

README.md

@@ -81,16 +81,16 @@ Set sbls = CreateSymbols()
 sbls.AppendText "012345abcdefg"
     
 ' 24bpp DIB
-sbls(0).SaveBitmap "D:\QRcode.bmp"
+sbls(0).SaveBitmap "QRcode.bmp"
     
 ' 10 pixels per module
-sbls(0).SaveBitmap "D:\QRcode.bmp", moduleSize:=10
+sbls(0).SaveBitmap "QRcode.bmp", moduleSize:=10
     
 ' Specify foreground and background colors.
-sbls(0).SaveBitmap "D:\QRcode.bmp", foreRgb:="#0000FF", backRgb:="#FFFF00"
+sbls(0).SaveBitmap "QRcode.bmp", foreRgb:="#0000FF", backRgb:="#FFFF00"
     
 ' 1bpp DIB
-sbls(0).SaveBitmap "D:\QRcode.bmp", monochrome:=True
+sbls(0).SaveBitmap "QRcode.bmp", monochrome:=True
 ```
 
 ### 例７．SVGファイルへ保存する
@@ -101,7 +101,7 @@ Dim sbls As Symbols
 Set sbls = CreateSymbols()
 sbls.AppendText "012345abcdefg"
     
-sbls(0).SaveSvg "D:\QRcode.svg"    
+sbls(0).SaveSvg "QRcode.svg"    
 ```
 
 ### 例８．SVGデータを取得する

source/QRCodeLib/AlignmentPattern.cls

@@ -8,7 +8,7 @@ Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
 Option Explicit
-
+ 
 Private m_centerPosArrays(40) As Variant
 
 Private Sub Class_Initialize()

source/QRCodeLib/AlphanumericEncoder.cls

@@ -14,6 +14,12 @@ Private m_data()        As Long
 Private m_charCounter   As Long
 Private m_bitCounter    As Long
 
+Private m_numericEncoder As New IQRCodeEncoder
+
+Private Sub Class_Initialize()
+    Set m_numericEncoder = New NumericEncoder
+End Sub
+
 Private Property Get IQRCodeEncoder_BitCount() As Long
     IQRCodeEncoder_BitCount = m_bitCounter
 End Property
@@ -34,8 +40,6 @@ Private Function IQRCodeEncoder_Append(ByVal c As String) As Long
     Dim wd As Long
     wd = ConvertCharCode(c)
 
-    Dim ret As Long
-
     If m_charCounter Mod 2 = 0 Then
         If m_charCounter = 0 Then
             ReDim m_data(0)
@@ -44,16 +48,16 @@ Private Function IQRCodeEncoder_Append(ByVal c As String) As Long
         End If
 
         m_data(UBound(m_data)) = wd
-        ret = 6
     Else
         m_data(UBound(m_data)) = m_data(UBound(m_data)) * 45
         m_data(UBound(m_data)) = m_data(UBound(m_data)) + wd
-        ret = 5
     End If
-
-    m_charCounter = m_charCounter + 1
+
+    Dim ret As Long
+    ret = IQRCodeEncoder_GetCodewordBitLength(c)
     m_bitCounter = m_bitCounter + ret
-
+    m_charCounter = m_charCounter + 1
+
     IQRCodeEncoder_Append = ret
 End Function
 
@@ -66,8 +70,7 @@ Private Function IQRCodeEncoder_GetCodewordBitLength(ByVal c As String) As Long
 End Function
 
 Private Function IQRCodeEncoder_GetBytes() As Byte()
-    Dim bs As BitSequence
-    Set bs = New BitSequence
+    Dim bs As New BitSequence
 
     Dim bitLength As Long
     bitLength = 11
@@ -89,43 +92,42 @@ Private Function IQRCodeEncoder_GetBytes() As Byte()
     IQRCodeEncoder_GetBytes = bs.GetBytes()
 End Function
 
-Private Function IQRCodeEncoder_InSubset(ByVal c As String) As Boolean
-    Dim ret As Boolean
+Private Function ConvertCharCode(ByVal c As String) As Long
+    Dim code As Long
+    code = Asc(c)
 
-    Select Case Asc(c)
+    Select Case code
         ' (Space)
         Case 32
-            ret = True
+            ConvertCharCode = 36
         ' $ %
         Case 36, 37
-            ret = True
+            ConvertCharCode = code + 1
         ' * +
         Case 42, 43
-            ret = True
+            ConvertCharCode = code - 3
         ' - .
         Case 45, 46
-            ret = True
+            ConvertCharCode = code - 4
         ' /
         Case 47
-            ret = True
+            ConvertCharCode = 43
         ' 0 - 9
         Case 48 To 57
-            ret = True
+            ConvertCharCode = code - 48
         ' :
         Case 58
-            ret = True
+            ConvertCharCode = 44
         ' A - Z
         Case 65 To 90
-            ret = True
+            ConvertCharCode = code - 55
 
         Case Else
-            ret = False
+            ConvertCharCode = -1
     End Select
-
-    IQRCodeEncoder_InSubset = ret
 End Function
 
-Private Function IQRCodeEncoder_InExclusiveSubset(ByVal c As String) As Boolean
+Private Function IQRCodeEncoder_InSubset(ByVal c As String) As Boolean
     Dim ret As Boolean
 
     Select Case Asc(c)
@@ -144,51 +146,28 @@ Private Function IQRCodeEncoder_InExclusiveSubset(ByVal c As String) As Boolean
         ' /
         Case 47
             ret = True
+        ' 0 - 9
+        Case 48 To 57
+            ret = True
         ' :
         Case 58
             ret = True
         ' A - Z
         Case 65 To 90
             ret = True
-
         Case Else
             ret = False
     End Select
 
-    IQRCodeEncoder_InExclusiveSubset = ret
+    IQRCodeEncoder_InSubset = ret
 End Function
 
-Private Function ConvertCharCode(ByVal c As String) As Long
-    Dim code As Long
-    code = Asc(c)
-
-    Select Case code
-        ' (Space)
-        Case 32
-            ConvertCharCode = 36
-        ' $ %
-        Case 36, 37
-            ConvertCharCode = code + 1
-        ' * +
-        Case 42, 43
-            ConvertCharCode = code - 3
-        ' - .
-        Case 45, 46
-            ConvertCharCode = code - 4
-        ' /
-        Case 47
-            ConvertCharCode = 43
-        ' 0 - 9
-        Case 48 To 57
-            ConvertCharCode = code - 48
-        ' :
-        Case 58
-            ConvertCharCode = 44
-        ' A - Z
-        Case 65 To 90
-            ConvertCharCode = code - 55
-
-        Case Else
-            ConvertCharCode = -1
-    End Select
+Private Function IQRCodeEncoder_InExclusiveSubset(ByVal c As String) As Boolean
+    If m_numericEncoder.InSubset(c) Then
+        IQRCodeEncoder_InExclusiveSubset = False
+        Exit Function
+    End If
+
+    IQRCodeEncoder_InExclusiveSubset = IQRCodeEncoder_InSubset(c)
 End Function
+

source/QRCodeLib/ByteEncoder.cls

@@ -49,7 +49,6 @@ Private Function IQRCodeEncoder_Append(ByVal c As String) As Long
     Dim charBytes() As Byte
     charBytes = m_textEncoding.GetBytes(c)
 
-    Dim ret As Long
     Dim v   As Variant
 
     For Each v In charBytes
@@ -60,11 +59,13 @@ Private Function IQRCodeEncoder_Append(ByVal c As String) As Long
         End If
 
         m_data(UBound(m_data)) = v
-        m_charCounter = m_charCounter + 1
-        m_bitCounter = m_bitCounter + 8
-        ret = ret + 8
     Next
-
+
+    Dim ret As Long
+    ret = 8 * (UBound(charBytes) + 1)
+    m_bitCounter = m_bitCounter + ret
+    m_charCounter = m_charCounter + (UBound(charBytes) + 1)
+
     IQRCodeEncoder_Append = ret
 End Function
 

source/QRCodeLib/Encoder.bas

@@ -3,7 +3,7 @@ Option Private Module
 Option Explicit
 
 Public Function Create(ByVal encMode As EncodingMode, _
-                       ByVal byteModeEncoding As String) As IQRCodeEncoder
+                       Optional ByVal byteModeEncoding As String = "Shift_JIS") As IQRCodeEncoder
     Dim ret As IQRCodeEncoder
     Dim enc As ByteEncoder
 
@@ -13,6 +13,7 @@ Public Function Create(ByVal encMode As EncodingMode, _
         Case EncodingMode.ALPHA_NUMERIC
             Set ret = New AlphanumericEncoder
         Case EncodingMode.EIGHT_BIT_BYTE
+            If Len(byteModeEncoding) = 0 Then Call Err.Raise(5)
             Set ret = New ByteEncoder
             Set enc = ret
             Call enc.Init(byteModeEncoding)

source/QRCodeLib/Factory.bas

@@ -17,8 +17,17 @@ Public Function CreateSymbols( _
     Optional ByVal allowStructuredAppend As Boolean = False, _
     Optional ByVal byteModeCharsetName As String = "Shift_JIS") As Symbols
 
-    Dim sbls As New Symbols
+    Select Case ecLevel
+        Case ErrorCorrectionLevel.L To ErrorCorrectionLevel.H
+            ' NOP
+        Case Else
+            Call Err.Raise(5)
+    End Select
+
+    If Not (1 <= maxVer And maxVer <= 40) Then Call Err.Raise(5)
 
+    Dim sbls As New Symbols
     Call sbls.Init(ecLevel, maxVer, allowStructuredAppend, byteModeCharsetName)
+
     Set CreateSymbols = sbls
 End Function

source/QRCodeLib/GraphicPath.bas

@@ -12,9 +12,8 @@ End Enum
 Public Function FindContours(ByRef img() As Variant) As Variant()
     Const MAX_VALUE As Long = &H7FFFFFFF
 
-    Dim gps As List
-    Set gps = New List
-    Dim gp As List
+    Dim gPaths As New List
+    Dim gPath As List
 
     Dim st As Point
     Dim dr As Direction
@@ -31,8 +30,8 @@ Public Function FindContours(ByRef img() As Variant) As Variant()
             img(y)(x) = MAX_VALUE
             Set st = New Point
             Call st.Init(x, y)
-            Set gp = New List
-            Call gp.Add(st)
+            Set gPath = New List
+            Call gPath.Add(st)
 
             dr = Direction.UP
             Set p = st.Clone()
@@ -48,15 +47,15 @@ Public Function FindContours(ByRef img() As Variant) As Variant()
                                 Set p = p.Clone()
                                 p.y = p.y - 1
                             Else
-                                Call gp.Add(p)
+                                Call gPath.Add(p)
                                 dr = Direction.Right
                                 Set p = p.Clone()
                                 p.x = p.x + 1
                             End If
                         Else
                             Set p = p.Clone()
                             p.y = p.y + 1
-                            Call gp.Add(p)
+                            Call gPath.Add(p)
 
                             dr = Direction.Left
                             Set p = p.Clone()
@@ -71,7 +70,7 @@ Public Function FindContours(ByRef img() As Variant) As Variant()
                                 Set p = p.Clone()
                                 p.y = p.y + 1
                             Else
-                                Call gp.Add(p)
+                                Call gPath.Add(p)
 
                                 dr = Direction.Left
                                 Set p = p.Clone()
@@ -80,7 +79,7 @@ Public Function FindContours(ByRef img() As Variant) As Variant()
                         Else
                             Set p = p.Clone()
                             p.y = p.y - 1
-                            Call gp.Add(p)
+                            Call gPath.Add(p)
 
                             dr = Direction.Right
                             Set p = p.Clone()
@@ -95,7 +94,7 @@ Public Function FindContours(ByRef img() As Variant) As Variant()
                                 Set p = p.Clone()
                                 p.x = p.x - 1
                             Else
-                                Call gp.Add(p)
+                                Call gPath.Add(p)
 
                                 dr = Direction.UP
                                 Set p = p.Clone()
@@ -104,7 +103,7 @@ Public Function FindContours(ByRef img() As Variant) As Variant()
                         Else
                             Set p = p.Clone()
                             p.x = p.x + 1
-                            Call gp.Add(p)
+                            Call gPath.Add(p)
 
                             dr = Direction.DOWN
                             Set p = p.Clone()
@@ -119,7 +118,7 @@ Public Function FindContours(ByRef img() As Variant) As Variant()
                                 Set p = p.Clone()
                                 p.x = p.x + 1
                             Else
-                                Call gp.Add(p)
+                                Call gPath.Add(p)
 
                                 dr = Direction.DOWN
                                 Set p = p.Clone()
@@ -128,7 +127,7 @@ Public Function FindContours(ByRef img() As Variant) As Variant()
                         Else
                             Set p = p.Clone()
                             p.x = p.x - 1
-                            Call gp.Add(p)
+                            Call gPath.Add(p)
 
                             dr = Direction.UP
                             Set p = p.Clone()
@@ -139,12 +138,12 @@ Public Function FindContours(ByRef img() As Variant) As Variant()
                 End Select
             Loop While Not p.Equals(st)
 
-            Call gps.Add(gp.Items())
+            Call gPaths.Add(gPath.Items())
 Continue:
         Next
     Next
 
-    FindContours = gps.Items()
+    FindContours = gPaths.Items()
 End Function