前端之家收集整理的这篇文章主要介绍了
VB6实现哈夫曼编码,
前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。
Private ContentString As String
Private ItemCount As Long
Private Nodes() As Node
Private Type Node
preID As Long
leftID As Long
leftValue As Long
rightID As Long
rightValue As Long
selfValue As Long
selfContent As Integer
visited As Integer
binCode As Integer
End Type
Public Function Retrace(ByVal i As Long) As String
Dim rStr As String
Dim nP As Long 'now pointer
Dim lastID As Long
Dim c As Integer
nP = getStartID(i)
c = Nodes(nP).visited
Do
lastID = nP
nP = Nodes(lastID).preID
If Nodes(nP).leftID = lastID Then
rStr = "0" & rStr
ElseIf Nodes(nP).rightID = lastID Then
rStr = "1" & rStr
End If
c = Nodes(nP).visited
Loop While c <> 2
Retrace = rStr
End Function
Public Function ShowTable() As String
Dim i As Long
Dim outStr As String
For i = 1 To ItemCount
If Nodes(i).selfContent = -1 Then
Else
outStr = outStr & "Char:" & Chr(Nodes(i).selfContent) & " Code:" & Retrace(Nodes(i).selfContent) & vbCrLf
End If
Next i
ShowTable = outStr
End Function
Private Function getStartID(ByVal k As Integer)
Dim i As Long
For i = 1 To ItemCount
If Nodes(i).selfContent = k Then
getStartID = i
Exit Function
End If
Next i
getStartID = 0
End Function
Public Sub SetString(ByVal srcString As String)
ContentString = srcString
End Sub
Public Function CreatHuffmanString()
Dim minID1 As Long,minID2 As Long
Call ScanString(ContentString)
Do While CountNodes > 1
minID1 = GetMin
Nodes(minID1).visited = 1
minID2 = GetMin
Nodes(minID2).visited = 1
'Stop
'mark two of them as walked points
ItemCount = ItemCount + 1
'add point
ReDim Preserve Nodes(ItemCount)
'add information
Nodes(ItemCount).leftID = minID1
Nodes(ItemCount).leftValue = Nodes(minID1).selfValue
Nodes(ItemCount).rightID = minID2
Nodes(ItemCount).rightValue = Nodes(minID2).selfValue
Nodes(ItemCount).selfContent = -1 '因为这个是创建的节点
Nodes(ItemCount).selfValue = Nodes(ItemCount).leftValue + Nodes(ItemCount).rightValue
Nodes(ItemCount).visited = 0
'modify min1 and min2
Nodes(minID1).preID = ItemCount
Nodes(minID2).preID = ItemCount
Debug.Print "ItemCount:" & ItemCount
Debug.Print "Count Unvisited Nodes:" & CountNodes
'
Loop
Debug.Print "ItemCount=" & ItemCount & " GetFirstUnvisitID=" & GetFirstUnvisitID
Nodes(GetFirstUnvisitID).visited = 2 '表示这个是最终节点
End Function
Private Sub ScanString(ByRef strContent As String)
Dim i As Long
Dim k() As Byte
Dim s(255) As Long
k = StrConv(strContent,vbFromUnicode)
For i = 0 To UBound(k)
s(k(i)) = s(k(i)) + 1
Next i
For i = 0 To 255
If s(i) > 0 Then
ItemCount = ItemCount + 1
ReDim Preserve Nodes(ItemCount)
Nodes(ItemCount).selfContent = i 'i是Ascii码,所以也是自己的信息
Nodes(ItemCount).selfValue = s(i) '这里是重复次数,也就是权重
Nodes(ItemCount).visited = 0 '初次创建,设置为未访问过
Debug.Print "Ascii:" & i & " Weight:" & s(i)
End If
Next i
End Sub
Private Sub ByteFilter(ByRef j() As Byte)
Dim i As Long
Dim k As Long
For k = 0 To UBound(j)
Next k
End Sub
Private Function GetMin() As Long '没问题
Dim i As Long
Dim minValue As Long,minID As Long,visTime As Long
minValue = GetFirstUnvisitValue + 1
minID = GetFirstUnvisitID
For i = 1 To ItemCount
If Nodes(i).selfValue < minValue And Nodes(i).visited = 0 Then
minValue = Nodes(i).selfValue
minID = i
visTime = visTime + 1 '记录可以访问的次数
End If
Next i
If visTime = 0 Then
GetMin = -1
Exit Function
End If
GetMin = minID
Debug.Print "getmin:" & GetMin
End Function
Private Function GetFirstUnvisitValue()
Dim i As Long
For i = 1 To ItemCount
If Nodes(i).visited = 0 Then
GetFirstUnvisitValue = Nodes(i).selfValue
Exit Function
End If
Next i
GetFirstUnvisitValue = -1
End Function
Private Function GetFirstUnvisitID()
Dim i As Long
For i = 1 To ItemCount
If Nodes(i).visited = 0 Then
GetFirstUnvisitID = i
Exit Function
End If
Next i
GetFirstUnvisitID = 0
End Function
Private Function CountNodes() 'return all avaliable nodes
Dim i As Long
Dim lngCount As Long
If ItemCount < 1 Then CountNodes = 0: Exit Function
For i = 1 To ItemCount
If Nodes(i).visited = 0 Then
lngCount = lngCount + 1
End If
Next i
CountNodes = lngCount
End Function
Private Sub Class_Initialize()
ItemCount = 0
ReDim Nodes(ItemCount)
End Sub
Public Sub InitHuffman()
ItemCount = 0
ContentString = ""
ReDim Nodes(ItemCount)
End Sub