huffman.frm

霍夫曼编码

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   1320
   ClientLeft      =   45
   ClientTop       =   495
   ClientWidth     =   5385
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1320
   ScaleWidth      =   5385
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox P2 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      Height          =   375
      Left            =   2760
      ScaleHeight     =   25
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   166
      TabIndex        =   5
      ToolTipText     =   "单击清除图片框"
      Top             =   120
      Width           =   2490
   End
   Begin VB.CommandButton Command2 
      Caption         =   "DeCompress"
      Enabled         =   0   'False
      Height          =   375
      Left            =   4200
      TabIndex        =   4
      Top             =   720
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Compress"
      Height          =   375
      Left            =   3000
      TabIndex        =   1
      Top             =   720
      Width           =   1095
   End
   Begin VB.PictureBox P1 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   375
      Left            =   120
      Picture         =   "Huffman.frx":0000
      ScaleHeight     =   25
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   166
      TabIndex        =   0
      Top             =   120
      Width           =   2490
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "Label3"
      Height          =   180
      Left            =   120
      TabIndex        =   6
      Top             =   1080
      Width           =   540
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Label2"
      Height          =   180
      Left            =   120
      TabIndex        =   3
      Top             =   840
      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Label1"
      Height          =   180
      Left            =   120
      TabIndex        =   2
      Top             =   600
      Width           =   540
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function GetBitmapBits Lib "gdi32.dll" (ByVal hBitmap As Long, ByVal dwCount As Long, ByRef lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32.dll" (ByVal hBitmap As Long, ByVal dwCount As Long, ByRef lpBits As Any) As Long

Private PicBits() As Byte

Private Sub Command1_Click()
Dim nt As Single
ReDim PicBits(P1.ScaleWidth * P1.ScaleHeight * 2) As Byte
GetBitmapBits P1.Image, UBound(PicBits) + 1, PicBits(0)
Label1 = "压缩前图片的大小为：" & UBound(PicBits) + 1 & " 字节"
nt = Timer
Call Compress_Huffman_Dynamic(PicBits)
Label3 = "压缩用时 " & (Timer - nt) & " 秒"
Label2 = "压缩后图片的大小为：" & UBound(PicBits) + 1 & " 字节"
Command1.Enabled = False: Command2.Enabled = True
End Sub

Private Sub Command2_Click()
Dim nt As Single
Label1 = "已压缩图片的大小为：" & UBound(PicBits) + 1 & " 字节"
nt = Timer
Call DeCompress_Huffman_Dynamic(PicBits)
Label3 = "解压缩用时 " & (Timer - nt) & " 秒"
SetBitmapBits P2.Image, UBound(PicBits) + 1, PicBits(0)
P2.Refresh
Label2 = "解压缩后图片的大小为：" & UBound(PicBits) + 1 & " 字节"
Command2.Enabled = False: Command1.Enabled = True
End Sub

Private Sub P2_Click()
P2.Picture = LoadPicture
End Sub