繼上篇文章：VB6 切割圖形中的文字，接著對圖形中的文字進行細化 (Thinning)。

採用9宮格算法，只以9宮格中心點為準，進行消去。

判斷條件如下：

紅色方框為9宮格，中心點與其縱橫軸成直角，則消去中心點。若直角反方向有邊角，則不消去。

原始圖形文字為：

進行細化後，為：

副程式原始碼如下：

Public Sub Thining(ByRef vNums())
Dim iX As Integer: Dim iY As Integer
Dim iB1 As Integer: Dim iB2 As Integer
Dim iL1 As Integer: Dim iL2 As Integer
Dim i As Integer: Dim j As Integer: Dim k As Integer
Dim iNums As Integer: Dim iPrevious As Integer
Dim aMagicCube() As Boolean
ReDim aMagicCube(2, 2) As Boolean
Dim aPixTEMP() As Boolean
Text1.Text = ""
    
For k = LBound(vNums) To UBound(vNums)
    iB1 = UBound(vNums(k), 1)
    iB2 = UBound(vNums(k), 2)
    iL1 = LBound(vNums(k), 1)
    iL2 = LBound(vNums(k), 2)
    For iY = iL2 + 1 To iB2 - 1
        For iX = iL1 + 1 To iB1 - 1
            'initial the MagicCube
            For j = LBound(aMagicCube, 2) To UBound(aMagicCube, 2)
                For i = LBound(aMagicCube, 1) To UBound(aMagicCube, 1)
                    aMagicCube(i, j) = vNums(k)(iX - 1 + i, iY - 1 + j)
                    'Debug.Print aMagicCube(i, j),
                Next
                'Debug.Print
            Next
            'Debug.Print
            'if the Center is True, then begin
            If aMagicCube(1, 1) Then
                'MsgBox "HERE"
                If aMagicCube(1, 0) And aMagicCube(0, 1) Then
                    If Not aMagicCube(2, 2) Then vNums(k)(iX, iY) = False
                ElseIf aMagicCube(2, 1) And aMagicCube(1, 2) Then
                    If Not aMagicCube(0, 0) Then vNums(k)(iX, iY) = False
                ElseIf aMagicCube(1, 0) And aMagicCube(2, 1) Then
                    If Not aMagicCube(0, 2) Then vNums(k)(iX, iY) = False
                ElseIf aMagicCube(0, 1) And aMagicCube(1, 2) Then
                    If Not aMagicCube(2, 0) Then vNums(k)(iX, iY) = False
                End If
                
            End If
        Next
    Next
    Erase aPixTEMP
    ReDim aPixTEMP(iB1, iB2)
    For iY = iL2 + 1 To iB2 - 1
        For iX = iL1 + 1 To iB1 - 1
            aPixTEMP(iX, iY) = vNums(k)(iX, iY)
        Next
    Next
    
    Call ToTextBox(aPixTEMP)
Next

End Sub

主程式呼叫

Dim aNums(3) As Variant                             'array for cutted number, it will be a jagged array
    Call Thining(aNums)