告诉您：GIF这种压缩标准是如何进行计算的，以及动手压缩图片
我们知道，位图文件和图标文件都是以像素为单位进行图像信息记录的，这样的记录方式生成的文件十分庞大，称为未压缩文件，在单机上使用是可以的，如果要在网上传播是不受欢迎的。如何对图像进一步压缩呢？GIF就是常用的压缩技术，也是网上流行的图像文件格式。
GIF压缩标准：
GIF作为一种压缩标准，受到了很多软件公司的普遍支持，当然也包含微软公司。GIF有GIF87a 和GIF89a两种版本，而且是早期动画使用的格式。
GIF是如何进行压缩的？它首先把图像转化成8位的256色图像（或128色、64色、32色、16色、8 色、4色、2色都可以），以256色为例，表示一个像素就需要8位的二进制信息，即1个字节Byte。接着GIF根据图像中像素的排列规律，建立一个类似于颜色排列表，用一个个9位的整数值（Integer）来表示像素的排列规律，达到压缩的目的（它的名字叫LZW 压缩算法）。听起来是不是不好理解，后面我会举例来说明的。最后在保存到文件时，再把9位的整数（表示范围为0~511）转换成8位的Byte类型的值，保存到GIF文件中。
颜色排列表：
假设有一串图像的像素流（存储在byte数值类型的buf () 数组中）进行GIF压缩，这串数据流的前20个，即buf (0) ~ buf (19) 的值分别为：
8 8 8 8 99 99 8 8 8 8
8 8 8 99 99 8 99 8 99 8
数据流的第一个数值被记录在文件的信息部分，真正的压缩计算都是从第二个开始的：
运算的程序代码：
bint(0) = 256
sP = Right$("00" & buf(0), 3)
iCode = buf(0)
For i = 1 To 19
…
…
sB = Right$("00" & buf(i), 3)
sP = sP & sB
On Error Resume Next
iCode = colTable(sP) ’ 集合中是否已经保存了需要的成员
If Err <> 0 Then ’没有找到时
n = colTable.Count
colTable.Add n + 258, sP ’ 添加成员及索引
j = j + 1
bint(j) = iCode ’保存转化后的值到要保存的整数集合中
sP = sB
iCode = buf(i)
Err.Clear
End If
Next
运算过程中各变量的变化为：
buf()序号 colTable bint()值
成员 索引
256
1 258 008008 8
3 259 008008008 258
4 260 008099 8
5 261 099099 99
6 262 099008 99
9 263 008008008008 259
13 264 008008008008099 263
15 265 099099008 261
17 266 008099008 260
260
由上面计算的结果看，可以说明几个问题：
1． 文件被压缩了，20个byte 被压缩成10个9位的Integer ，这是因为颜色的规律被保存在颜色排列表的集合中，用一个数值就能同时表示几个像素的信息。
2． 压缩后的文件大小除了和图像的尺寸（像素流的长短）有关系以外，图像本身的复杂程度也影响着压缩文件的大小，图像越简单（相同颜色的块越大），压缩文件就越小。
3． 为了确保转换后的整数值不超过9 位，因此颜色排列表中的成员只能是256~511 ，又因为256 ，257 被保留为特殊标志，实际上可用的只有258~511 共254个，如果超过，就要清除旧表，重新建立（256是重新初始化颜色排列表的标志，257是像素流结束的标志）
4． 有一点必须说明，在转换256色像素流时，与位图不同的是，它是从图像的左上角开始，遂行向下扫描的。如果是用API函数来获得像素流时，必须把流重新排列。
GIF压缩的特点：
GIF压缩前必须把图像转换成256色以下的图像，因此图像的质量大打折扣，但是，我们从上面的压缩结果来看，原图像像素流中的每一个值都能被准确地描叙、保存下来。也就是说，在GIF解压缩时，能准确无误地还原出图像上的每个像素（如果原图为256色以下图像时）。因此GIF压缩也被称为无损压缩，这种压缩能准确地体现图形的清晰的边缘，如果图形是以文字扫描为主，GIF压缩绝对是最佳的首选。
GIF文件的组成：
GIF文件的组成包含以下几个部分：
版本 文件头 系统调色盘 [辅助信息] 图片头信息 图片压缩信息 结束标志
(6bytes) (7bytes) (8bytes) (11bytes) ((255+255+ +n )bytes) (2bytes)
版本：GIF89a 或 GIF87a
辅助信息：只有在GIF透明显示或GIF动画文件中才有。也是为了实现这些特性而设置的。
系统调色盘：位图和图标文件的调色盘中每个颜色是4个字节，而GIF文件中每个颜色是3个字节。
图片压缩信息：因为图像压缩后信息量的大小与图像本身的复杂程度有关，它不像位图一样，只要知道图像的大小，就能计算出文件大小来，而是要等到像素流全部压缩完才能知道文件的大小。因此，GIF文件中的图片压缩信息部分，是以254字节大小为单元，向后申请的（每个单元再前面加上一个字节表示本单元的长度，实际每单元共255个字节），最后一单元是以实际大小来申请的。
结束标志：以0 59 作为文件结束标志。
编程举例：
为了实现GIF的压缩，用VB6 建一个工程，窗体名为“BnpToGif”， ScaleMode =3-Pixel；一个文本框用来输入要打开的文件名或要保存的文件名；两个按钮；三个标签；两个图片框，Picture2 用来显示文件压缩的完成进度，Width :400 ，Height:13。Picture1 用来显示打开的位图，Visible=false ，AutoRedraw=true ，AutoSize=true ，ScaleMode =3-Pixel， BorderStyle=0-None。
“Save”按钮初始时Enabled=false ，待按“Open”打开Text1 输入的位图文件完成后，才变为可用状态，单击可以把原位图转换成256色GIF文件（自动更换后缀名或另存为Text1中重新输入的文件名）
程序代码
Option Explicit
Private Type RGBTRIPLE ’调色盘
rgbRed As Byte
rgbGreen As Byte
rgbBlue As Byte
End Type
Private Type GifScreenDescriptor ’文件头
logical_screen_width As Integer ’图像宽
logical_screen_height As Integer ’图像高
Flags As Byte ’文件的质量（调色盘中颜色多少）的标志
background_color_index As Byte ’保存像素流第一个像素的值
pixel_aspect_ratio As Byte ’为0
End Type
’文件头中Flags 在256色时为231；128色时为198；64色时为165；32色时为132；16色时为227；8色时为194；4色时为161
Private Type GifImageDescriptor ’图片信息头
ImageSeparator As Byte ’为44
Left As Integer ’左
Top As Integer ’右
Width As Integer ’宽
Height As Integer ’高
Format As Byte ’为0
data As Byte ’为每个像素占的位数
End Type
Private Type GifImageEnd ’文件结束标志
dat1 As Byte ’为0
dat2 As Byte ’为59
End Type
Private Const GIF89a = "GIF89a"
Dim colTable As New Collection '用于LZW压缩时的颜色排列表
Dim bitpos, bitval As Byte '用于位运算时的位定位及转化后的Byte值，并把该值写入gfbyt(p255)中
Dim p255 As Long '写入文件的总字节数（定位）
Dim gfbyt() As Byte '写入文件的字节流
Dim buf() As Byte '图像像素流（256色或以下）
Dim bpos(12) As Long '用于位比较时的数1，2，4，8。。。。
Dim fname As String
'把gfbyt()分段（254个为一段）并写入文件
Private Sub putByte()
Dim i, k As Integer
Dim j As Long
k = Int(p255 / 254)
Dim sz() As Byte
ReDim sz(k)
sz(k) = p255 Mod 254
For i = k - 1 To 0 Step -1: sz(i) = 254: Next
k = 0
For j = 0 To p255
If j Mod 254 = 0 Then Put #1, , sz(k): k = k + 1
Put #1, , gfbyt(j)
Next
End Sub
'把压缩后的表值写入gfbyt()
'在256色时，表值为变长（9-12位）的Integer，256为清除旧表，257为图像结束，表项为258—4095共3837个
'在4色时，表值为变长（3-12位）的Integer，4为清除旧表,5为图像结束，表项为6—4095共4089个
Private Sub AddByte(ByVal bVal As Long, ByVal vLen As Byte)
Dim i As Byte
For i = 0 To vLen - 1
If (bVal And bpos(i)) Then bitval = bitval + bpos(bitpos)
bitpos = bitpos + 1
If bitpos = 8 Then
bitpos = 0
gfbyt(p255) = bitval
bitval = 0
p255 = p255 + 1
ReDim Preserve gfbyt(p255) '再申请一个Byte并保留原来数据
gfbyt(p255) = 0
End If
Next
End Sub
Private Sub Command1_Click()
fname = Text1.Text
If Right(fname, 3) <> "bmp" Then Label3.Caption = "文件不是 .bmp 文件": Exit Sub
If Dir(fname) = "" Then Label3.Caption = "文件不存在": Exit Sub
Picture1.Picture = LoadPicture(fname)
Command2.Enabled = True
End Sub
Private Sub Command2_Click()
'检测保存文件名的正确性
fname = Text1.Text
Dim i, j As Integer
Dim pw, ph As Integer
i = InStr(1, fname, "/")
Do While i > 0: j = i: i = InStr(1, fname, "/"): Loop
If Dir(Mid(fname, 1, j), vbDirectory) = "" Then Label3.Caption = "文件路径不存在": Exit Sub
If Right(fname, 4) <> ".gif" Then fname = Mid(fname, 1, Len(fname) - 4) & ".gif"
DoEvents
jindu 10
'转换图像为256色，并存入buf ()像素流中
Dim r, g, b, rA, gA, bA, lIndex As Integer
Dim col As Long
Dim k, kk As Long
ph = Picture1.Height - 1
pw = Picture1.Width - 1
kk = (ph + 1) * (pw + 1) - 1
ReDim buf(kk) As Byte
'转换时使用的计算方法要和建立调色盘的算法相一致
For i = 0 To ph
For j = 0 To pw
col = Picture1.Point(j, i)
If col = 16777215 Then
buf(k) = 215
Else
b = Int(col / 65536)
col = col - b * 65536
g = Int(col / 256)
r = col Mod 256
rA = CInt(r / 51)
gA = CInt(g / 51)
bA = CInt(b / 51)
buf(k) = bA * 36 + gA * 6 + rA
End If
k = k + 1
Next
Next
DoEvents
jindu 50
'写入GIF文件
Dim scr As GifScreenDescriptor
Dim im As GifImageDescriptor
Dim gifPalette(0 To 255) As RGBTRIPLE
Dim gend As GifImageEnd
Dim sPrefix As String
Dim sByte As String
Dim intCode As Integer
Dim nCount As Byte
’建立系统调色盘中的颜色，创建216个，前面转换256色像素的计算方法要和这里的创建方法相一致！
For b = 0 To 255 Step 51
For g = 0 To 255 Step 51
For r = 0 To 255 Step 51
gifPalette(lIndex).rgbBlue = b
gifPalette(lIndex).rgbGreen = g
gifPalette(lIndex).rgbRed = r
lIndex = lIndex + 1
Next
Next
Next
scr.background_color_index = 215
scr.Flags = 231
scr.pixel_aspect_ratio = 0
scr.logical_screen_width = Picture1.Width
scr.logical_screen_height = Picture1.Height
im.ImageSeparator = 44
im.data = 8
im.Format = 0
im.Height = Picture1.Height
im.Width = Picture1.Width
'写入GIF文件头
Open fname For Binary As #1
Put #1, , GIF89a
Put #1, , scr
Put #1, , gifPalette
Put #1, , im
'进行GIF压缩，从 buf() 到 gfbyt()
Dim l As Integer
ReDim gfbyt(0)
gfbyt(0) = 0
l = 9
AddByte 256, l
sPrefix = Right$("00" & buf(0), 3)
intCode = buf(0)
r = 0
For k = 1 To bufsize - 1
sByte = Right$("00" & buf(k), 3)
sPrefix = sPrefix & sByte
On Error Resume Next
intCode = colTable(sPrefix)
If Err <> 0 Then
nCount = colTable.Count
If nCount = 3837 Then
AddByte intCode, l
Set colTable = Nothing
Set colTable = New Collection
AddByte 256, l
l = 9
sPrefix = sByte
intCode = buf(k)
GoTo 10
End If
colTable.Add nCount + 258, sPrefix
If getlen(nCount + 257) > l Then l = l + 1 '根据需要增加字节位数
AddByte intCode, l
sPrefix = sByte
intCode = buf(k)
Err.Clear
End If
10:
Next
AddByte intCode, l '把最后一个压缩值写入
nCount = colTable.Count
If nCount > 3837 Then AddByte 256, 9
AddByte 257, 9 '写入结束标志
putByte '写入文件
gend.dat1 = 0
gend.dat2 = 59
Put #1, , gend
Close #1
Erase buf
Erase gfbyt
Label3.Caption = "成功写入" & fname & "文件"
jindu 100
End Sub
Private Sub jindu(ByVal vol As Integer) ’用于显示进度
Picture2.Cls
Label2.Caption = vol & " %"
Picture2.Line (0, 0)-Step(vol * 4, 13), , BF
DoEvents
End Sub
Private Function getlen(ByVal bVal As Long) As Byte
Select Case bVal
Case 0, 1
getlen = 1
Case Is < 4
getlen = 2
Case Is < 8
getlen = 3
Case Is < 16
getlen = 4
Case Is < 32
getlen = 5
Case Is < 64
getlen = 6
Case Is < 128
getlen = 7
Case Is < 256
getlen = 8
Case Is < 512
getlen = 9
Case Is < 1024
getlen = 10
Case Is < 2048
getlen = 11
Case Else
getlen = 12
End Select
End Function
Private Sub Form_Load()
Text1.Text = App.Path & "\yeye.bmp"
Dim i As Integer
For i = 0 To 12: bpos(i) = 2 ^ i: Next '初始化用于位运算的数
End Sub
编程举例： 电子图书格式（4色GIF）：
系统调色盘中颜色的多少，直接影响着转化后图片的质量，同时也影响着压缩文件的大小，如果图片是以文字的扫描为主，我就可以用2色（黑和白）来进行压缩，就能获得最大的压缩率且不影响图片的阅读。文件头中Flags=161 （4色），调色盘中4个颜色仅设置1个（255，255，255）即可，其余3个不赋值为（0，0，0），在转换图像像素流时，转化为2色，这样就能获得最高的压缩率。现在有许多电子图书都使用这种格式（4色GIF）的压缩。
我曾用一幅B4大小（1150*800像素），约1000个字的图片，进行4色GIF压缩，我们来看下面一组数字：24位位图约2630 K；256色GIF约45 K；4色GIF约24 K。由此可见，4色GIF压缩可以获得最大的压缩比，约100 ：1，而且图像质量非常好，用看图工具放大数倍后，仍然清晰。这也是GIF成为独步电子图书王国的原因。下面我就再举一个例子来展示4色GIF压缩。
在前面的程序中添加一个Command3，编写代码：
Private Sub Command3_Click()
'检测保存文件名的正确性
fname = Text1.Text
Dim i, j As Integer
Dim pw, ph As Integer
i = InStr(1, fname, "/")
Do While i > 0: j = i: i = InStr(1, fname, "/"): Loop
If Dir(Mid(fname, 1, j), vbDirectory) = "" Then Label3.Caption = "文件路径不存在": Exit Sub
If Right(fname, 4) <> ".gif" Then fname = Mid(fname, 1, Len(fname) - 4) & ".gif"
DoEvents
jindu 10
'转换图像为256色，并存入buf ()像素流中
Dim col As Long
Dim k, kk As Long
ph = Picture1.Height - 1
pw = Picture1.Width - 1
kk = (ph + 1) * (pw + 1) - 1
ReDim buf(kk) As Byte
'转换时使用的计算方法要和建立调色盘的算法相一致
For i = 0 To ph
For j = 0 To pw
col = Picture1.Point(j, i)
If col = 16777215 Then
buf(k) = 1 '这里只取两色，黑和白
Else
buf(k) = 0
End If
k = k + 1
Next
Next
DoEvents
jindu 50
'写入GIF文件
Dim scr As GifScreenDescriptor
Dim im As GifImageDescriptor
Dim gifPalette(3) As RGBTRIPLE
Dim gend As GifImageEnd
Dim sPrefix As String
Dim sByte As String
Dim intCode As Long
Dim nCount As Long
gifPalette(0).rgbBlue = 0
gifPalette(0).rgbGreen = 0
gifPalette(0).rgbRed = 0
gifPalette(1).rgbBlue = 255
gifPalette(1).rgbGreen = 255
gifPalette(1).rgbRed = 255
scr.background_color_index = 0
scr.Flags = 161
scr.pixel_aspect_ratio = 0
scr.logical_screen_width = pw
scr.logical_screen_height = ph
im.ImageSeparator = 44
im.data = 2
im.Format = 0
im.Height = ph
im.Width = pw
'写入GIF文件头
Open fname For Binary As #1
Put #1, , GIF89a
Put #1, , scr
Put #1, , gifPalette
Put #1, , im
Dim l As Integer
'进行GIF压缩，从 buf() 到 gfbyt()
ReDim gfbyt(0)
gfbyt(0) = 0
l = 3
AddByte 4, l
sPrefix = CStr(buf(0))
intCode = buf(0)
For k = 1 To bufsize - 1
sByte = buf(k)
sPrefix = sPrefix & sByte
On Error Resume Next
intCode = colTable(sPrefix)
If Err <> 0 Then
nCount = colTable.Count
If nCount = 4089 Then '表值满9位，清除旧表
AddByte intCode, l
'注意！重新颜色排列表时添加的标志“4”要写12位，而不是3位
'即 000000000100
AddByte 4, l
Set colTable = Nothing
Set colTable = New Collection
l = 3
nCount = 0
sPrefix = buf(k)
intCode = buf(k)
GoTo 10
End If
colTable.Add nCount + 6, sPrefix
If getlen(nCount + 5) > l Then l = l + 1 '根据需要增加字节位数
AddByte intCode, l
sPrefix = sByte
intCode = buf(k)
Err.Clear
End If
10:
Next
AddByte intCode, l '把最后一个压缩值写入
'写入文件
AddByte 5, l
putByte
gend.dat1 = 0
gend.dat2 = 59
Put #1, , gend
Close #1
Erase buf
Erase gfbyt
Label3.Caption = "成功写入" & fname & "文件"
jindu 100
End Sub
