form1.frm

数据结构程序设计——哈夫曼编码

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "哈夫曼编码"
   ClientHeight    =   5220
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9630
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   12
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   ScaleHeight     =   5220
   ScaleWidth      =   9630
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command3 
      Caption         =   "译码"
      Height          =   615
      Left            =   4200
      TabIndex        =   12
      Top             =   3960
      Width           =   1335
   End
   Begin VB.TextBox Text5 
      BackColor       =   &H8000000F&
      Height          =   1695
      Left            =   5880
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   11
      Top             =   3000
      Width           =   3255
   End
   Begin VB.CommandButton Command2 
      Caption         =   "编码"
      Height          =   615
      Left            =   4200
      TabIndex        =   9
      Top             =   3120
      Width           =   1335
   End
   Begin VB.TextBox Text4 
      BackColor       =   &H8000000F&
      Height          =   1695
      Left            =   480
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   7
      Top             =   3000
      Width           =   3255
   End
   Begin VB.TextBox Text3 
      BackColor       =   &H8000000F&
      Height          =   1695
      Left            =   6960
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   4
      Top             =   480
      Width           =   2175
   End
   Begin VB.TextBox Text2 
      BackColor       =   &H8000000F&
      Height          =   1695
      Left            =   5400
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   3
      Top             =   480
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "生成哈夫曼编码"
      Height          =   735
      Left            =   3840
      TabIndex        =   2
      Top             =   960
      Width           =   1335
   End
   Begin VB.TextBox Text1 
      BackColor       =   &H8000000F&
      Height          =   1815
      Left            =   480
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   480
      Width           =   3255
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "原文"
      Height          =   240
      Left            =   1920
      TabIndex        =   10
      Top             =   2640
      Width           =   480
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "电文"
      Height          =   240
      Left            =   7560
      TabIndex        =   8
      Top             =   2640
      Width           =   480
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "哈夫曼编码"
      Height          =   240
      Left            =   7320
      TabIndex        =   6
      Top             =   120
      Width           =   1200
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "权值"
      Height          =   240
      Left            =   5760
      TabIndex        =   5
      Top             =   120
      Width           =   480
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "请输入字符串"
      Height          =   240
      Left            =   1200
      TabIndex        =   0
      Top             =   120
      Width           =   1440
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim str As String, code() As String, dt As String, index As Integer, i%, j%, ht() As HTNode, hc() As Integer, w() As Integer, n As Integer

Private Sub Command1_Click()
Text2 = "": Text3 = "": Text4 = "": Text5 = "": str = ""
If Text1 = "" Then
MsgBox "请输入字符串", vbOKOnly + 32, "提示": Text1.SetFocus
Else
Command2.Enabled = True: Command3.Enabled = True
n = Len(Text1.Text)
For i = 1 To n
dt = Mid$(Text1.Text, i, 1)
index = InStr(str, dt)
If index = 0 Then
str = str + dt
End If
Next i
n = Len(str): j = Len(Text1.Text)
ReDim w(n)
For i = 1 To n
w(i) = 0
Next i
For i = 1 To j
dt = Mid$(Text1.Text, i, 1)
index = InStr(str, dt)
w(index) = w(index) + 1
Next i
For i = 1 To n
Text2 = Text2 & Mid$(str, i, 1) & ":" & w(i)
Text2 = Text2 + Chr$(13) + Chr$(10)
Next i

Call HuffmanCoding(ht(), hc(), w(), n)
ReDim code(n)
For i = 1 To n
Text3 = Text3 + Mid$(str, i, 1) + ":"
j = 0
Do While hc(i, j) <> "2"
code(i) = code(i) & hc(i, j)
j = j + 1
Loop
Text3 = Text3 & code(i)
Text3 = Text3 + Chr$(13) + Chr$(10)
Next i

For i = 1 To Len(Text1)
index = InStr(str, Mid$(Text1.Text, i, 1))
Text5 = Text5 + code(index)
Next i
End If
End Sub

Private Sub Command2_Click()
Text5 = ""
If Text4 = "" Then
MsgBox "请输入原文！", vbOKOnly + 32, "提示": Text4.SetFocus
Else
For i = 1 To Len(Text4)
dt = Mid$(Text4, i, 1)
index = InStr(str, dt)
If index = 0 Then
MsgBox "原文中含有未编码字符，无法编码！", vbOKOnly + 32, "提示": Text4 = "": Text5 = ""
Exit For
End If
Text5 = Text5 + code(index)
Next i
End If
End Sub

Private Sub Command3_Click()
Dim sum As Integer
sum = 0
Text4 = "": index = 2 * n - 1
If Text5 = "" Then
MsgBox "请输入电文！", vbOKOnly + 32, "提示": Text5.SetFocus
Else
For i = 1 To Len(Text5)
dt = Mid$(Text5, i, 1)
If dt = "0" Then
index = ht(index).lchild
If ht(index).lchild = 0 Then
Text4 = Text4 + Mid$(str, index, 1): index = 2 * n - 1: sum = 0
Else: sum = sum + 1
End If
Else
index = ht(index).rchild
If ht(index).lchild = 0 Then
Text4 = Text4 + Mid$(str, index, 1): index = 2 * n - 1: sum = 0
Else: sum = sum + 1
End If
End If
Next i
If sum > 0 Then
MsgBox "电文中含有未知的编码，无法译码！", vbOKOnly + 32, "提示": Text5 = "": Text4 = ""
End If
End If
End Sub

Private Sub Form_Load()
Command2.Enabled = False: Command3.Enabled = False
End Sub

Private Sub Text1_Change()
Command2.Enabled = False: Command3.Enabled = False
Text2 = "": Text3 = "": Text4 = "": Text5 = ""
End Sub