解读JPEG文件

 

解读JPEG文件

告诉您：JPEG这种压缩标准是如何进行计算的，以及动手压缩图片

 

我们知道，GIF压缩标是基于把图片转化成256色（或以下）位图的基础上进行压缩的，经过压缩的图片，颜色信息大量丢失。那么，有没有在真色彩（24位）下的图片压缩呢？JPEG压缩就能压缩24位图片。JPEG是世界联合图像专家组的缩写，JPEG压缩标准也是该组织制定的，版本有1.1 和1.2两个。

 

JPEG压缩标准：

RGB       分割         FDCT      RLE      哈夫曼        哈夫曼     写入 转化YUV   8*8大小块      量化      0编码     DC编码       AC编码   文件                             量化表               哈夫曼树                                   标准量化表             标准哈夫曼表

 

 

 

 

 

 

 

 

上面表描叙了JPEG的压缩过程：

第一步  它把24位图像的RGB流转化成YUV流（分别代表亮度，色差，色差。也有称Y，Cr，Cb的）：

Y=  0.299 * R + 0.587 * G + 0.114 * B

U=  -0.1687 *R - 0.3313 * G + 0.5 * B +128

V=  0.5 * R - 0.4187 * G - 0.0813 * B +128

亮度，色差这些概念不是和电视机上的概念相似吗？是的，只是电影文件用的是MPEG压缩（动态图像压缩），而JPEG是静态图像压缩。

    第二步  由于人的眼睛对亮度的反应比较敏感，对色差的反应不敏感，因此，对亮度的扫描是逐点逐行、正向进行的（从左上角逐行开始），对色差的扫描可以逐点逐行进行，可以隔点隔行进行（为了提高压缩比），也可以隔点不隔行，或隔行不隔点等形式。由于JPEG是以8*8为单元进行处理图像的，所以就有以下几种情况

16                  16                    16                 8 图像大小： 8             16                 16                    16 UV扫描：逐点逐行      隔点隔行          隔点不隔行            隔行不隔点   Y 和UV  Y：1个        Y：4个           Y：4个                Y：4个     的数量：UV：各1个   UV：各1个        UV：各2个            UV：各2个                                       （上一个下一个）       （左一个右一个）   压缩格式：1：1：1      4：1：1            4：2：2               4：2：2

 

 

 

 

 

 

 

 

 

 

 

 

 

这就要求图像的宽和高必须是8 或16的倍数，如果不是要在RGB流中，在相对于图像的右、下部分，添加颜色值为0的像素，直到8或16的倍数。

因为这样，JPEG就有上叙的4种不同的压缩格式。

第三步    对8*8中的64个值进行FDCT处理，并Z字形重新排列。

64个数值进行FDCT（离散余弦变换）之前，每个值被减去128，变成-128~127之间的数。

FDCT的作用就是把这64个按空间排列的数转化成用频率表示。FDCT的计算量是非常大的，它是整个JPEG压缩过程中最耗时的环节。现在网上有大虾们提供的许多优化算法，其中（AA&N运算）是较普遍的一种，我还无法对各种优化算法进行一一的比较，但是，有一点是肯定的，FDCT算法将直接影响着压缩程序的运行速度，以及计算后所产生的误差值的大小（即图像被解码显示后，发生了失真。失真是在所难免的，关键是失真要小）。

我们平常所叫的软件的优化，FDCT就是JPEG压缩程序优化的切入点，如何在运算速度和产生误差方面进行改进（或是在两者之间寻找平衡点），许许多多的有志之士正乐此不疲地钻研着。而我在后面压缩程序举例中用到的FDCT算法，不管在速度还是误差方面都有些不如意，如有找到更好的，我会补上的。

 

Z字形排列：对这64个数字进行下表列出的顺序进行重新排列，目的是重新排列后的数字，使它们的位置与距离左上角的远近程度成正比（如：2比20距离左上角近，排在前面）以备量化时用

0    1    5    6    14   15   27   28   2    4    7    13   16   26   29   42 3    8    12   17   25   30   41   43 9    11   18   24   31   40   44   53 10   19   23   32   39   45   52   54 20   22   33   38   46   51   55   60 21   34   37   47   50   56   59   61 35   36   48   49   57   58   62   63

 

 

 

 

 

 

 

 

 

 

第四步    量化

在JPEG压缩中有一个影响图像质量和压缩图像文件大小的系数，那就是“品质”，取值范围在0~100之间，标准量化表根据这个系数生成文件的量化表，再由文件量化表生成一个8*8空间的频率变化表，使左上角形成低频区，右下角形成高频区，然后用用排列后的64个数值乘以相应的频率，这样，64个数值中后面排在后面的数就会大量的变成0。而这些0在后面的将被压缩，JPEG的真正意义上的压缩就是从这里开始的。

我们可以换句话说，品质决定着频率，频率决定着0的多少，从而影响着压缩文件的大小，也影响着压缩图像的质量。JPEG压缩造成部分颜色信息的丢失也是在这个过程中。

在这64个数值（0~63）中，由于0处在最低频处，在乘以频率后值的消耗最小，我们把这个值看成是所有64个数值的平均值，称它为DC，也就是直流电平（电流）；其余的63个量化后的数值，称它们为AC，也就是交流电平。

第五步    RLE编码

由于经量化后，64个数值中后面排在后面的数出现大量的0，接下来就对0进行RLE编码。例如：64个数值的后面63个数字（第1 个数是DC，另外分开编码）是

3，0，- 4，0，0，1，0，0   ……

经编码后为（0，2，3）（1，3，- 4）（2，1，1）（EOB）

（0，2，3）说明，0表示3的前面有0个0；2表示3写成二进制有2位，即11；

（1，3，- 4 ）说明，1表示 – 4 的前面有1 个0；3表示4的二进制有3位

（EOB）代表后面的所有0，如果不是以0结束就不用（EOB）

而上面每组中的三个数又被整合成两个Byte，（0~255之间的数字）。前面的两个被写成1 个，第一个（表示0 的个数的值（也称0行程））写在高4位，每二个（表示非0的数（也称振幅）的二进制的长度）写在低4位。

如（0，2，3）中，0和2经过运算（0*16+2）被写成2 ，得到2和3两个Byte。

正因为这样，也带来了许多的问题。

首先，表示0行程的值只有4位（取值范围0~15），如果AC中（排在后面的63个）连续0的个数超过15个，就要写入一组（15，0，0），代表0的前面有15个0，加上本身一共有16个0，然后继续RLE编码。

其次，振幅可能是负值，而Byte只能是正数，怎么表示负值呢？原来，振幅是负值时，要把它转化为反码。反码是这样计算的，如 – 4 先取绝对值4，然后转化为二进制为100，反码就是二进制同位上取反值，变成011，再转化为Byte就是3（但二进制长度仍为3位）。

如（1，3，- 4）转化为19和 – 4 是错的，应为19和3

第六步    哈夫曼编码（Huffman）

上面提到的REL纺码都是从64个中的第2 个开始的，第一个数是DC，它并不直接保存，而是保存它与前面方块（64个数）的DC之间的差异值。如：前一个方块的DC是5，本方块的DC是40，那么就保存成35。实际被保存成（6，35）前面的6 表示35转化成二进制共有6 位（100011）。

JPEG文件中对数值并不是一个Byte接一个Byte地直接保存。我们回看前面生成的每组中的两个数（如DC的（6，5）、AC（2，3）或（19，3）等），第一个数中都有表示第二个数值的二进制长度的成分，JPEG先把第一个数（包含第二个数值的二进制长度信息）经过哈夫曼编码，先保存下来；再保存第二个数值时，就按数值实际的二进制长度进行保存。哈夫曼编码的作用我们可以这样来理解，它把0~255（Byte的取值范围）这256个定长的数字（二进制都是8位），按照它们最容易出现的概率排列，用（二进制）2~16位的不同的变长数值表示，实际的取值为0~65535，这样来达到压缩文件的目的。

我们接着上面举的例子来说明，写入文件的数依次是：

（6  35）       （2  3）（19  3）（33  1）（EOB）

DC差异值          AC的REL编码

拿每组数字的前面的数字去查相对应的哈夫曼表，获得表值，写入文件。再把后面的数字按实际位数写入文件。注意，我这里讲的是相应的哈夫曼表，一个JPEG文件，一般要建立四个哈夫曼表（在后面的文件组成部分会讲到），分别是DC—Y—HT、 DC—UV—HT、 AC—Y—HT、 AC—UV—HT。因为DC和AC要分开，Y和UV也要分开。

我们假设上面举的例子中的流是Y（亮度）流为例，6为索引查DC—Y—HT得到表值14（长4位）；2查 AC—Y—HT得到表值1（长2位）；19查 AC—Y—HT得到表值121（长7位）；33查 AC—Y—HT得到表值28（长5位）；EOB是AC—Y—HT表中第一个（索引为0）的值0（长度2）。这样我们就得到了写入文件的数字流为：

14         35    1    3    121   3    28    1    0

4bit  6bit  2bit  3bit   7bit  2bit  5bit  1bit  2bit 

（第4个和第6个都是3，但第4 个是011（表示 - 4）；第6个是11（表示3））

转化成二进制为：（共 32 位（Bits））

1110 100011 01 011 1111001 11 11100 1 00

每8 位化成一个Byte，就成了：

232  215  231  228

 

到这里，一个单元的Y流终于处理完成了。天哪！是不是脑袋大得不得了？没办法，谁叫JPEG压缩这么优秀呢，吃点苦是必须的。接下来放松一下，我们来举个程序例子，进行图像的JPEG压缩：

 

 

编程举例：利用第三方控件进行JPEG压缩

在这个例子中，我们并不亲自去处理图像数据的压缩，而是交给一个第三方控件去处理，这样，我们利用别人写的这个控件，就能让我们的程序压缩图像了。当然，您如果是DIY的理想主义者，那么，你还得继续受点苦，继续往后面的部分看，最后，你也许不但实现了DIY，可能还能写出一个更优化的第三方控件，能够让更多的人来使用你的控件。

我们使用的控件是 IJL15.dll ，它是Intel公司提供的，如果您没有，就到网上下载一个。由于这个控件无法导入到VB6的工程中，因此必须把它存放在工程的同目录下，这一点千万要记住（如果生成EXE文件，也要把这个控件和EXE文件放在同一个目录下）。

用VB6 建一个工程，窗体名为“BnpToJpeg”， ScaleMode =3-Pixel；一个文本框用来输入要打开的文件名或要保存的文件名；两个按钮；三个标签；图片框Picture1 用来显示打开的位图，Visible=false ，AutoRedraw=true ，AutoSize=true ，ScaleMode =3-Pixel， BorderStyle=0-None。

“Save”按钮初始时Enabled=false ，待按“Open”打开Text1 输入的位图文件完成后，才变为可用状态，单击可以把原位图转换成JPEG文件（自动更换后缀名或另存为Text1中重新输入的文件名）

Option Explicit

 

Private Type RGBQUAD

    rgbBlue As Byte

    rgbGreen As Byte

    rgbRed As Byte

    rgbReserved As Byte

End Type

Private Type BITMAPINFOHEADER '40 bytes

    biSize As Long

    biWidth As Long

    biHeight As Long

    biPlanes As Integer

    biBitCount As Integer

    biCompression As Long

    biSizeImage As Long

    biXPelsPerMeter As Long

    biYPelsPerMeter As Long

    biClrUsed As Long

    biClrImportant As Long

End Type

Private Type BITMAPINFO    '24位位图信息头

    bmiHeader As BITMAPINFOHEADER

    bmiColors As RGBQUAD

End Type

Private Type JPEG_CORE_PROPERTIES_VB '导入控件的参数集

    UseJPEGPROPERTIES As Long

    DIBBytes As Long

    DIBWidth As Long

    DIBHeight As Long

    DIBPadBytes As Long

    DIBChannels As Long

    DIBColor As Long

    DIBSubsampling As Long

    JPGFile As Long

    JPGBytes As Long

    JPGSizeBytes As Long

    JPGWidth As Long

    JPGHeight As Long

    JPGChannels As Long

    JPGColor As Long

    JPGSubsampling As Long

    JPGThumbWidth As Long

    JPGThumbHeight As Long

    cconversion_reqd As Long

    upsampling_reqd As Long

    jquality As Long

    jprops(0 To 19999) As Byte

End Type

 

'控件操作函数（操作命令）

Private Declare Function ijlInit Lib "ijl15.dll" (jcprops As Any) As Long

Private Declare Function ijlFree Lib "ijl15.dll" (jcprops As Any) As Long

Private Declare Function ijlWrite Lib "ijl15.dll" (jcprops As Any, ByVal ioType As Long) As Long

 

'需要的API函数

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long

Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Dim fname As String '打开或保存的文件名

 

 

Private Sub Command1_Click()

Dim m_hDIb As Long

Dim m_hBmpOld As Long

Dim hDC As Long

Dim Ptr As Long

Dim BI As BITMAPINFO

Dim ww, hh As Integer '图像的宽和高

 

ww = Picture1.Width

hh = Picture1.Height

 

  Dim lhDC As Long

  Dim lhDCDesktop As Long

  Dim lhBmpOld As Long

 

    With BI.bmiHeader

        .biSize = Len(BI.bmiHeader)

        .biWidth = ww

        .biHeight = hh

        .biPlanes = 1

        .biBitCount = 24

        .biCompression = 0&

        .biSizeImage = ww * hh * 3

    End With

    hDC = CreateCompatibleDC(0)

    m_hDIb = CreateDIBSection(hDC, BI, 0, Ptr, 0, 0) '创建一幅内存图像并返回图像数据的内存地址

    m_hBmpOld = SelectObject(hDC, m_hDIb)

    BitBlt hDC, 0, 0, ww, hh, Picture1.hDC, 0, 0, vbSrcCopy

    SelectObject lhDC, lhBmpOld

    DeleteObject lhDC

   

   

  Dim tJ As JPEG_CORE_PROPERTIES_VB

  Dim bFile() As Byte

  Dim lptr As Long

  Dim lR As Long

  Dim sFile As String

 

  '检测保存文件名的正确性

fname = Text1.Text

Dim i, j 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 Label1.Caption = "文件路径不存在": Exit Sub

 

If Right(fname, 4) <> ".jpg" Then fname = Mid(fname, 1, Len(fname) - 4) & ".jpg"

    lR = ijlInit(tJ)   '初始化控件

    If lR = 0 Then

        tJ.DIBWidth = ww

        tJ.DIBHeight = -hh

        tJ.DIBBytes = Ptr     '内存中图像数据的内存地址

        tJ.DIBPadBytes = 0

      

        bFile = StrConv(fname, vbFromUnicode)

        ReDim Preserve bFile(0 To UBound(bFile) + 1) As Byte

        bFile(UBound(bFile)) = 0

        lptr = VarPtr(bFile(0))

        CopyMemory tJ.JPGFile, lptr, 4  '把保存文件名导入参数集

        tJ.JPGWidth = ww

        tJ.JPGHeight = hh

        tJ.jquality = 50    '图像品质

 

        lR = ijlWrite(tJ, 8&)   '压缩JPEG文件

       

        ijlFree tJ  '释放控件内部参数

       

        Label1.Caption = "成功保存" & fname

    Else

        Label1.Caption = "没有找到 IJL15.dll 文件"

    End If

End Sub

 

Private Sub Command2_Click()

fname = Text1.Text

If Dir(fname) <> "" And Right(fname, 3) = "bmp" Then

Command1.Enabled = True

Picture1.Picture = LoadPicture(fname)

Else

Label1.Caption = "图片文件不存在或不是位图"

End If

End Sub

 

Private Sub Form_Load()

Text1.Text = App.Path & "/15.bmp"

End Sub

 

 

 

我们为了亲自动手写自己的JPEG压缩程序，还得继续了解JPEG文件的组成。

JPEG文件的组成包含以下几个部分：

组成：开头标志  APPO  DQT0  DQT1  SOFO  DC_Y_NV  AC_Y_NV  DC_UV_NV  AC_UV_NV  大小： 2byte   18byte  69byte  69byte  19byte   33byte      183byte    33byte      183byte 标志：255 216  255 224  255 219        255 192   255 196       组成：   SOS          图像数据             结束标志 大小：   14byte                               2byte 标志：   255 224                              255 217 注：也有把后面这三块当成一块来理解，即SOF块     每个JPEG文件在图像数据的前面就要写上623个字节的各类必须的信息

 

 

 

 

 

 

 

 

 

 

 

 

 

 

JPEG文件中的一些标志是固定的，在解码时就是根据这些标志进行解读，在SOFO中的

HVY的值决定JPEG的压缩格式，在编程举例中会细说，这也是解码时的关键。

我们来看一个最简单的JPEG文件（一个16*16大小的红色方形图案，采用4：1：1的压缩格式，品质为50）

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

255 216 255 224 0 16 74 70 73 70 0 1 1 1 0 72 0 72 0 0 255 219 0 67 0 16 11 12 14 12 10 16 14 13 14 18 17 16 19 24 40 26 24 22 22 24 49 35 37 29 40 58 51 61 60 57 51 56 55 64 72 92 78 64 68 87 69 55 56 80 109 81 87 95 98 103 104 103 62 77 113 121 112 100 120 92 101 103 99 255 219 0 67 1 17 18 18 24 21 24 47 26 26 47 99 66 56 66 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 99 255 192 0 17 8 0 16 0 16 3 1 34 0 2 17 1 3 17 1 255 196 0 31 0 0 1 5 1 1 1 1 1 1 0 0 0 0 0 0 0 0 1 2 3 4 5 6 7 8 9 10 11 255 196 0 181 16 0 2 1 3 3 2 4 3 5 5 4 4 0 0 1 125 1 2 3 0 4 17 5 18 33 49 65 6 19 81 97 7 34 113 20 50 129 145 161 8 35 66 177 193 21 82 209 240 36 51 98 114 130 9 10 22 23 24 25 26 37 38 39 40 41 42 52 53 54 55 56 57 58 67 68 69 70 71 72 73 74 83 84 85 86 87 88 89 90 99 100 101 102 103 104 105 106 115 116 117 118 119 120 121 122 131 132 133 134 135 136 137 138 146 147 148 149 150 151 152 153 154 162 163 164 165 166 167 168 169 170 178 179 180 181 182 183 184 185 186 194 195 196 197 198 199 200 201 202 210 211 212 213 214 215 216 217 218 225 226 227 228 229 230 231 232 233 234 241 242 243 244 245 246 247 248 249 250 255 196 0 31 1 0 3 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 1 2 3 4 5 6 7 8 9 10 11 255 196 0 181 17 0 2 1 2 4 4 3 4 7 5 4 4 0 1 2 119 0 1 2 3 17 4 5 33 49 6 18 65 81 7 97 113 19 34 50 129 8 20 66 145 161 177 193 9 35 51 82 240 21 98 114 209 10 22 36 52 225 37 241 23 24 25 26 38 39 40 41 42 53 54 55 56 57 58 67 68 69 70 71 72 73 74 83 84 85 86 87 88 89 90 99 100 101 102 103 104 105 106 115 116 117 118 119 120 121 122 130 131 132 133 134 135 136 137 138 146 147 148 149 150 151 152 153 154 162 163 164 165 166 167 168 169 170 178 179 180 181 182 183 184 185 186 194 195 196 197 198 199 200 201 202 210 211 212 213 214 215 216 217 218 226 227 228 229 230 231 232 233 234 242 243 244 245 246 247 248 249 250 255 218 0 12 3 1 0 2 17 3 17 0 63 0 197 162 138 43 202 62 240 255 0 255 217

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

大家看到上面文件中的标志了吗，其实真正图像数据只有（197 162 138 43 202 62 240 255 0） 255后面的0 没有意义，有用的只有8个Byte，转化为二进制为：

11000101  10100010  10001010  00101011  11001010  00111110  11110000  11111111

分解成：（查哈夫曼表，得到数值的实际长度）

110  00101  1010 00 1010 00 1010  00 1010   11110 01010 00  111110  111100 00

（5  -26）   E   0   E  0  E    0  E      （5  -21） E   （6   60）   E

           4个Y流U                      1个U流U        1个V流U  

（E代表EBO，即一组64个数（一个U（单位(Unit)））以0结束）由于图像的纯红色的块，所以在U中只有DC，所有的AC都为0。

    以4：1：1压缩格式为例，JPEG是这样来组织图像数据的：一块16*16大小的块中，4个Y流的U（依次是上左，上右，下左，下右）和1个U流的U和1个V流的U，依次处理并写入（Y流的U，U流的U，V流的U组成了一个MCU），再进入第二个16*16大小的块（MCU）中，依次类推。。。。。。

 

    编程举例：（编写JPEG压缩程序）

和上个程序中使用的差不多。用VB6 建一个工程，窗体名为“BnpToJpeg”， ScaleMode =3-Pixel；一个文本框用来输入要打开的文件名或要保存的文件名；两个按钮；三个标签；图片框Picture1 用来显示打开的位图，Visible=false ，AutoRedraw=true ，AutoSize=true ，ScaleMode =3-Pixel， BorderStyle=0-None。

“Save”按钮初始时Enabled=false ，待按“Open”打开Text1 输入的位图文件完成后，才变为可用状态，单击可以把原位图转换成JPEG文件（自动更换后缀名或另存为Text1中重新输入的文件名）

 

'****本例程序采用4：1：1的格式进行JPEG压缩****

Option Explicit

 

Private Type tagHUFFCODE

 code As Long

 length As Byte

 val As Integer

End Type

 

Private Type tagACSYM

 zeroLen As Byte

 codeLen As Byte

 amplitude As Integer

End Type

 

Private Type tagSYM2

 amplitude As Integer

 codeLen As Byte

End Type

 

Private mask(15) As Long

Const maskstr As String = "1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768"

 

Private aanScaleFactor(7) As Single

Const aanScaleFactorstr As String = "1.0, 1.387039845, 1.306562965, 1.175875602,1.0, 0.785694958, 0.541196100, 0.275899379"

 

Private std_Y_QT(63) As Byte

Const std_Y_QTstr = " 16, 11, 10, 16, 24, 40, 51, 61,  12, 12, 14, 19, 26, 58, 60, 55,  14, 13, 16, 24, 40, 57, 69,56,  14, 17, 22, 29, 51, 87, 80, 62, 18, 22, 37, 56, 68, 109,103,77,  24, 35, 55, 64, 81, 104,113,92,  49, 64, 78, 87, 103,121,120,101, 72, 92, 95, 98, 112,100,103,99"

 

Private std_UV_QT(63) As Byte

Const std_UV_QTstr = " 17, 18,  24, 47, 99, 99, 99, 99,  18, 21, 26, 66, 99, 99, 99, 99,  24, 26, 56, 99, 99, 99, 99, 99,  47, 66, 99 ,99, 99, 99, 99, 99,  99, 99, 99, 99, 99, 99, 99, 99,  99, 99, 99, 99, 99, 99, 99, 99,  99, 99, 99, 99, 99, 99, 99, 99,  99, 99, 99, 99, 99, 99, 99, 99"

 

Private FZBT(64) As Byte

Const FZBTstr = " 0, 1, 5, 6, 14,15,27,28,  2, 4, 7, 13,16,26,29,42, 3, 8, 12,17,25,30,41,43,  9, 11,18,24,31,40,44,53,  10,19,23,32,39,45,52,54,  20,22,33,38,46,51,55,60,  21,34,37,47,50,56,59,61,  35,36,48,49,57,58,62,63"

 

Private COLORSPACECOEF(3, 2) As Single

Const COLORSPACECOEFstr As String = "1,0.25,0.25,1,1,1,1,0.5,0.5,1,0.5,0.5"

 

Private MCUIndex(3, 2) As Byte

Const MCUIndexstr As String = "4,1,1,1,1,1,2,1,1,2,1,1"

 

Private STD_DC_Y_NRCODES(15) As Byte

Const STD_DC_Y_NRCODESstr As String = "0,1,5,1,1,1,1,1,1,0,0,0,0,0,0,0"

Private STD_DC_Y_VALUES(11) As Byte

Const STD_DC_Y_VALUESstr As String = "0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11"

Private STD_DC_UV_NRCODES(15) As Byte

Const STD_DC_UV_NRCODESstr As String = "0,3,1,1,1,1,1,1,1,1,1,0,0,0,0,0"

Private STD_DC_UV_VALUES(11) As Byte

Const STD_DC_UV_VALUESstr As String = "0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11"

 

Private STD_AC_Y_NRCODES(15) As Byte

Const STD_AC_Y_NRCODESstr As String = "0,2,1,3,3,2,4,3,5,5,4,4,0,0,1,125"

Private STD_AC_Y_VALUES(161) As Byte

Const STD_AC_Y_VALUESstr As String = "1,2,3,0,4,17,5,18,33,49,65,6,19,81,97,7,34,113,20,50,129,145,161,8,35,66,177,193,21,82,209,240,36,51,98,114,130,9,10,22,23,24,25,26,37,38,39,40,41,42,52,53,54,55,56,57,58,67,68,69,70,71,72,73,74,83,84,85,86,87,88,89,90,99,100,101,102,103,104,105,106,115,116,117,118,119,120,121,122,131,132,133,134,135,136,137,138,146,147,148,149,150,151,152,153,154,162,163,164,165,166,167,168,169,170,178,179,180,181,182,183,184,185,186,194,195,196,197,198,199,200,201,202,210,211,212,213,214,215,216,217,218,225,226,227,228,229,230,231,232,233,234,241,242,243,244,245,246,247,248,249,250"

Private STD_AC_UV_NRCODES(15) As Byte

Const STD_AC_UV_NRCODESstr As String = "0,2,1,2,4,4,3,4,7,5,4,4,0,1,2,119"

Private STD_AC_UV_VALUES(161) As Byte

Const STD_AC_UV_VALUESstr As String = "0,1,2,3,17,4,5,33,49,6,18,65,81,7,97,113,19,34,50,129,8,20,66,145,161,177,193,9,35,51,82,240,21,98,114,209,10,22,36,52,225,37,241,23,24,25,26,38,39,40,41,42,53,54,55,56,57,58,67,68,69,70,71,72,73,74,83,84,85,86,87,88,89,90,99,100,101,102,103,104,105,106,115,116,117,118,119,120,121,122,130,131,132,133,134,135,136,137,138,146,147,148,149,150,151,152,153,154,162,163,164,165,166,167,168,169,170,178,179,180,181,182,183,184,185,186,194,195,196,197,198,199,200,201,202,210,211,212,213,214,215,216,217,218,226,227,228,229,230,231,232,233,234,242,243,244,245,246,247,248,249,250"

 

'***由于JPEG块中Integer值在保存时，高低位互换，为转化方便，这里用两个Byte表示，并注明(是高低位互换的Integer)

Private Type tagJPEGAPP0 '共18 bytes

 segmentTag(1) As Byte   'APP0段标记，必须为 255 224(是高低位互换的Integer)

 length(1) As Byte     '段长度，一般为16，如果没有缩略图(是高低位互换的Integer)

 id(4) As Byte      '文件标记 "JFIF" + "/0",值为 74 70 73 70 0

 ver(1) As Byte        '文件版本，一般为01, 01或01, 02(是高低位互换的Integer)

 densityUnit As Byte  '密度单位，0=无单位 1=点数/英寸 2=点数/厘米

 densityX(1) As Byte    'X轴方向密度,通常写0,72(是高低位互换的Integer)

 densityY(1) As Byte    'Y轴方向密度,通常写0,72(是高低位互换的Integer)

 thp As Byte      '缩略图水平像素数,写0

 tvp As Byte      '缩略图垂直像素数,写0

End Type

 

Private Type tagJPEGDQT_8BITS '共69 bytes

 segmentTag(1) As Byte   'DQT段标记，必须为225,219(是高低位互换的Integer)

 length(1) As Byte     '段长度,这里是 67(是高低位互换的Integer)

 tableInfo As Byte   '量化表信息

 table(63) As Byte   '量化表(8 bits)

End Type

 

Private Type tagJPEGSOF0_24BITS '共19 bytes

 segmentTag(1) As Byte    'SOF段标记，必须为255 192(是高低位互换的Integer)

 length(1) As Byte      '段长度，真彩图为17，灰度图为11(是高低位互换的Integer)

 precision As Byte   '精度，每个信号分量所用的位数，基本系统为0x08

 heights(1) As Byte      '图像高度(是高低位互换的Integer)

 widths(1) As Byte       '图像宽度(是高低位互换的Integer)

 sigNum As Byte    '信号数量，真彩JPEG应该为3，灰度为1

 YID As Byte      '信号编号，亮度Y

 HVY As Byte      '采样方式，0-3位是垂直采样，4-7位是水平采样

 QTY As Byte      '对应量化表号

 UID As Byte      '信号编号，色差U

 HVU As Byte      '采样方式，0-3位是垂直采样，4-7位是水平采样

 QTU As Byte      '对应量化表号

 VID As Byte     '信号编号，色差V

 HVV As Byte      '采样方式，0-3位是垂直采样，4-7位是水平采样

 QTV As Byte      '对应量化表号

End Type

 

Private Type tagJPEGDHT '共 bytes

 segmentTag(1) As Byte    'DHT段标记，必须为255 196(是高低位互换的Integer)

 length(1) As Byte      '段长度(是高低位互换的Integer)

 tableInfo As Byte   '表信息，基本系统中 bit0-3 为Huffman表的数量，bit4 为0指DC的Huffman表 为1指AC的Huffman表，bit5-7保留，必须为0

  '1-16位的Huffman码字的数量，分别存放在数组[1-16]中,BYTE* huffVal依次存放各码字对应的值

End Type

 

Private Type tagJPEGSOS_24BITS '共14 bytes

 segmentTag(1) As Byte    'SOS段标记，必须为255 218(是高低位互换的Integer)

 length(1) As Byte    '段长度，这里是12(是高低位互换的Integer)

 sigNum As Byte    '信号分量数，真彩图为0x03,灰度图为0x01

 YID As Byte      '亮度Y信号ID,这里是1

 HTY As Byte      'Huffman表号，bit0-3为DC信号的表，bit4-7为AC信号的表

 UID As Byte      '亮度Y信号ID,这里是2

 HTU As Byte

 VID As Byte      '亮度Y信号ID,这里是3

 HTV As Byte

 Ss As Byte      '基本系统中为0

 Se As Byte      '基本系统中为63

 Bf As Byte      '基本系统中为0

End Type

 

Private YQT(63) As Byte

Private UVQT(63) As Byte

 

Private YQT_DCT(63) As Single

Private UVQT_DCT(63) As Single

 

Private STD_DC_Y_HT(11) As tagHUFFCODE

Private STD_DC_UV_HT(11) As tagHUFFCODE

Private STD_AC_Y_HT(255) As tagHUFFCODE

Private STD_AC_UV_HT(255) As tagHUFFCODE

 

Dim fname As String

Dim ww, hh As Integer

Dim Ybuf(), Ubuf, Vbuf() As Integer

Dim Q As Integer     '图像品质 0-100

Dim bytepos, bytenew As Byte

 

 

Private Sub splitstring(by() As Byte, str As String) '为Byte数组赋值

Dim st() As String

st = Split(str, ",")

Dim i, l As Integer

l = UBound(st)

For i = 0 To l: by(i) = CByte(st(i)): Next

End Sub

 

Private Sub splitstringB(by() As Single, str As String) '为Single数组赋值

Dim st() As String

st = Split(str, ",")

Dim i, l As Integer

l = UBound(st)

For i = 0 To l: by(i) = CSng(st(i)): Next

End Sub

 

Private Sub splitstringC(by() As Long, str As String) '为Long数组赋值

Dim st() As String

st = Split(str, ",")

Dim i, l As Integer

l = UBound(st)

For i = 0 To l: by(i) = CSng(st(i)): Next

End Sub

 

Private Sub getY_QT_UV_QT()

Dim i, tempV1, tempV2 As Integer

splitstring FZBT, FZBTstr

splitstring std_Y_QT, std_Y_QTstr

splitstring std_UV_QT, std_UV_QTstr

If Q < 50 Then Q = 5000 / Q Else Q = 200 - Q * 2

For i = 0 To 63

tempV1 = std_Y_QT(i) * Q / 100

If tempV1 < 1 Then tempV1 = 1 Else If tempV1 > 255 Then tempV1 = 255

YQT(FZBT(i)) = tempV1

tempV2 = std_UV_QT(i) * Q / 100

If tempV2 < 1 Then tempV2 = 1 Else If tempV2 > 255 Then tempV2 = 255

UVQT(FZBT(i)) = tempV2

Next

End Sub

 

Private Sub InitQTForAANDCT()

splitstringB aanScaleFactor, aanScaleFactorstr

Dim i, j, k As Integer

For i = 0 To 7

For j = 0 To 7

YQT_DCT(k) = CSng(1 / (YQT(k) * aanScaleFactor(i) * aanScaleFactor(j) * 8))

UVQT_DCT(k) = CSng(1 / (UVQT(k) * aanScaleFactor(i) * aanScaleFactor(j) * 8))

k = k + 1

Next

Next

End Sub

 

Private Sub BuildSTDHuffTab(nrcodes() As Byte, stdTab() As Byte, huffCode() As tagHUFFCODE)

Dim i, j, k  As Integer

Dim code As Long

For i = 1 To 16

For j = 1 To nrcodes(i - 1)

    huffCode(stdTab(k)).code = code

    huffCode(stdTab(k)).length = i

    k = k + 1

    code = code + 1

Next

code = code * 2

Next

For i = 0 To k - 1: huffCode(i).val = stdTab(i): Next

 

End Sub

 

Private Sub Command1_Click()

fname = Text1.Text

If Dir(fname) <> "" And Right(fname, 3) = "bmp" Then

Command1.Enabled = True

Picture1.Picture = LoadPicture(fname)

 

ww = Picture1.Width

hh = Picture1.Height

If ww Mod 16 > 0 Then ww = ww + (16 - ww Mod 16) '补足16的倍数

If hh Mod 16 > 0 Then hh = hh + (16 - hh Mod 16)

Q = 50

Else

Label1.Caption = "图片文件不存在或不是位图"

End If

 

End Sub

 

Private Sub Command2_Click()

     '<<< 初始化所需量化表 >>>

getY_QT_UV_QT  'std_Y_QT >>Y_QT, std_UV_QT >>UV_QT

InitQTForAANDCT  'Y_QY >>YQT_DCT, UV_QT >>UVQT_DCT  (as single)

 

'STD_DC_Y_NRCODES,  STD_DC_Y_VALUES >>STD_DC_Y_HT (as tagHUFFCODE)

'STD_AC_Y_NRCODES,  STD_AC_Y_VALUES >>STD_AC_Y_HT

'STD_DC_UV_NRCODES,  STD_DC_UV_VALUES >>STD_DC_UV_HT

'STD_AC_UV_NRCODES,  STD_AC_UV_VALUES >>STD_AC_UV_HT

splitstring STD_DC_Y_NRCODES, STD_DC_Y_NRCODESstr

splitstring STD_DC_Y_VALUES, STD_DC_Y_VALUESstr

splitstring STD_AC_Y_NRCODES, STD_AC_Y_NRCODESstr

splitstring STD_AC_Y_VALUES, STD_AC_Y_VALUESstr

splitstring STD_DC_UV_NRCODES, STD_DC_UV_NRCODESstr

splitstring STD_DC_UV_VALUES, STD_DC_UV_VALUESstr

splitstring STD_AC_UV_NRCODES, STD_AC_UV_NRCODESstr

splitstring STD_AC_UV_VALUES, STD_AC_UV_VALUESstr

BuildSTDHuffTab STD_DC_Y_NRCODES, STD_DC_Y_VALUES, STD_DC_Y_HT

BuildSTDHuffTab STD_AC_Y_NRCODES, STD_AC_Y_VALUES, STD_AC_Y_HT

BuildSTDHuffTab STD_DC_UV_NRCODES, STD_DC_UV_VALUES, STD_DC_UV_HT

BuildSTDHuffTab STD_AC_UV_NRCODES, STD_AC_UV_VALUES, STD_AC_UV_HT

 

splitstringC mask, maskstr   '>>mask  (as long)

 

 

     '<<< 写JPG文件头 >>>

Dim SOIT(1) As Byte

Dim i, j, p, k As Integer

 

'检测保存文件名的正确性

fname = Text1.Text

Dim i, j 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 Label1.Caption = "文件路径不存在": Exit Sub

 

Open fname For Binary As #1

'SOIT

splitstring SOIT, "255,216"  'JPEG文件开始标志 255 216

Put #1, , SOIT

 

'setJPEGAPPO

Dim jappo As tagJPEGAPP0

splitstring jappo.segmentTag, "255,224"

splitstring jappo.length, "0,16"

jappo.id(0) = 74               '"JFIF0"

jappo.id(1) = 70

jappo.id(2) = 73

jappo.id(3) = 70

jappo.id(4) = 0

splitstring jappo.ver, "1,1"            '版本号 1 1

jappo.densityUnit = 1

splitstring jappo.densityX, "0,72"

splitstring jappo.densityY, "0,72"

jappo.thp = 0

jappo.tvp = 0

Put #1, , jappo

 

'setJPEGQT

Dim dqt As tagJPEGDQT_8BITS

splitstring dqt.segmentTag, "255,219"

splitstring dqt.length, "0,67"

dqt.tableInfo = 0

For i = 0 To 63: dqt.table(i) = YQT(i): Next

Put #1, , dqt

splitstring dqt.segmentTag, "255,219"

splitstring dqt.length, "0,67"

dqt.tableInfo = 1

For i = 0 To 63: dqt.table(i) = UVQT(i): Next

Put #1, , dqt

 

'setJPEGSOF0_24BITS

Dim sof As tagJPEGSOF0_24BITS

splitstring sof.segmentTag, "255,192"

splitstring sof.length, "0,17"

sof.precision = 8

splitstring sof.heights, Int(Picture1.Height / 256) & "," & (Picture1.Height Mod 256)

splitstring sof.widths, Int(Picture1.Width / 256) & "," & (Picture1.Width Mod 256)

sof.sigNum = 3

sof.YID = 1

sof.QTY = 0

sof.UID = 2

sof.QTU = 1

sof.VID = 3

sof.QTV = 1

sof.HVU = 17

sof.HVV = 17

sof.HVY = 34

Put #1, , sof

 

'setJPEGDHT

Dim dht As tagJPEGDHT

splitstring dht.segmentTag, "255,196"

splitstring dht.length, "0," & 31

dht.tableInfo = 0

Put #1, , dht

Put #1, , STD_DC_Y_NRCODES

Put #1, , STD_DC_Y_VALUES

 

splitstring dht.length, "0," & 181

dht.tableInfo = 16

Put #1, , dht

Put #1, , STD_AC_Y_NRCODES

Put #1, , STD_AC_Y_VALUES

 

splitstring dht.length, "0," & 31

dht.tableInfo = 1

Put #1, , dht

Put #1, , STD_DC_UV_NRCODES

Put #1, , STD_DC_UV_VALUES

 

splitstring dht.length, "0," & 181

dht.tableInfo = 17

Put #1, , dht

Put #1, , STD_AC_UV_NRCODES

Put #1, , STD_AC_UV_VALUES

 

'setJPEGSOS_24BITS

Dim sos As tagJPEGSOS_24BITS

splitstring sos.segmentTag, "255,218"

splitstring sos.length, "0,12"

sos.sigNum = 3

sos.YID = 1

sos.HTY = 0

sos.UID = 2

sos.HTU = 17

sos.VID = 3

sos.HTV = 17

sos.Se = 63

sos.Ss = 0

sos.Bf = 0

Put #1, , sos

 

 

 

     '<<< 处理图像数据，写入文件 >>>

GetYUVbuf

Get8x8YUVbuf

bytepos = 7: bytenew = 0

 

Dim dctBuf(63) As Integer

Dim dctint(63) As Integer

Dim mcuNum As Integer

Dim ydc, udc, vdc As Integer

mcuNum = ww * hh / 256

ydc = 0

udc = 0

vdc = 0

 

For i = 0 To mcuNum - 1

  For k = 0 To 3

    p = (i * 4 + k) * 64

    For j = 0 To 63: dctBuf(j) = Ybuf(p + j): Next

    FDCT dctBuf, dctint, True            '离散余弦变换并量化

    ydc = ProcessDU(dctint, True, ydc) '压缩处理并写入文件

  Next

 

    p = i * 64

    For j = 0 To 63: dctBuf(j) = Ubuf(p + j): Next

    FDCT dctBuf, dctint, False

    udc = ProcessDU(dctint, False, udc)

 

 

    For j = 0 To 63: dctBuf(j) = Vbuf(p + j): Next

    FDCT dctBuf, dctint, False

    vdc = ProcessDU(dctint, False, vdc)

 

Next

 

WriteEndBits

 

     '<<< 写入文件结束标志 >>>

Dim wbyte As Byte

wbyte = 255

Put #1, , wbyte

wbyte = 217

Put #1, , wbyte '255 217

Close #1

 

Label1.Caption = "成功保存" & fname

End Sub

 

Private Sub GetYUVbuf() '获得图像的YUV流

Dim i, j, poin As Integer

Dim psize, k, kk, col As Long

Dim tempr, tempg, tempb As Byte

Dim tempy, tempu, tempv As Integer

Dim wid0 As Boolean

 

psize = ww * hh

ReDim Ybuf(psize - 1)

ReDim Ubuf(psize / 4 - 1)

ReDim Vbuf(psize / 4 - 1)

 

For i = 0 To hh - 1 '正向读取

'判断是否0，2，4，6...行

If i Mod 2 = 0 Then wid0 = True Else wid0 = False

For j = 0 To ww - 1

col = Picture1.Point(j, i)

Select Case col     '为提高运算速度而写

Case -1, 0

tempr = 0: tempg = 0: tempb = 0

Case 16777215

tempr = 255: tempg = 255: tempb = 255

Case Else

tempb = Int(col / 65536)

col = col Mod 65536

tempg = Int(col / 256)

tempr = col Mod 256

End Select

 

tempy = Int(0.299 * tempr + 0.587 * tempg + 0.114 * tempb) - 128

If tempy < -128 Then tempy = -128 Else If tempy > 127 Then tempy = 127

Ybuf(k) = tempy

k = k + 1

 

If wid0 = True And j Mod 2 = 0 Then

tempu = Int(-0.1687 * tempr - 0.3313 * tempg + 0.5 * tempb)

tempv = Int(0.5 * tempr - 0.4187 * tempg - 0.0813 * tempb)

If tempu < -128 Then tempu = -128 Else If tempu > 127 Then tempu = 127

If tempv < -128 Then tempv = -128 Else If tempv > 127 Then tempv = 127

Ubuf(kk) = tempu

Vbuf(kk) = tempv

kk = kk + 1

End If

Next

Next

 

End Sub

 

Private Sub Get8x8YUVbuf() '把YUV流分割成 8 x 8 的块

Dim i, j, k, x, y As Integer

Dim kid, ws, hs As Integer

Dim poin, p, po, poi, lsize As Integer

Dim tempy(), tempu(), tempv() As Integer

 

'****处理Ybuf流****

ws = ww / 16    '图像宽有几个16*16的块数

hs = hh / 16    '图像高有几个16*16的块数

lsize = ww * 16   '16行像素总数

ReDim tempy(lsize - 1)

For i = 0 To hs - 1

For j = 0 To ws - 1

'设置16*16块中第1 像素个在整个流中的位置

poin = i * lsize + j * 16

For k = 0 To 3  '分别处理16*16块中的4个8*8的块

'设置块8*8中第1 像素个在整个流中的位置

Select Case k

Case 0

poi = poin

Case 1

poi = poin + 8

Case 2

poi = poin + ww * 8

Case 3

poi = poin + ww * 8 + 8

End Select

 

For y = 0 To 7

po = poi + y * ww

For x = 0 To 7: p = (j * 4 + k) * 64 + y * 8 + x: tempy(p) = Ybuf(po + x): Next

Next y

 

Next k

Next j

poin = i * lsize

For x = 0 To lsize - 1:  Ybuf(poin + x) = tempy(x):   Next

Next i

 

 

'****处理Ubuff  Vbuff流****

lsize = ww / 2 * 8 'UV流的长度是Y流的四分之一

ReDim tempu(lsize - 1)

ReDim tempv(lsize - 1)

For i = 0 To hs - 1

poin = lsize * i

For j = 0 To ws - 1

poi = poin + j * 8

 

For y = 0 To 7

po = poi + y * (ww / 2)

For x = 0 To 7

p = j * 64 + y * 8 + x

tempu(p) = Ubuf(po + x)

tempv(p) = Vbuf(po + x)

Next x

Next y

 

Next j

For x = 0 To lsize - 1: Ubuf(poin + x) = tempu(x): Vbuf(poin + x) = tempv(x): Next

Next i

End Sub

 

'图像数据压缩处理并写入文件

Private Function ProcessDU(sigbuf() As Integer, ByVal YorUV As Boolean, ByVal dc As Integer) As Integer

Dim i, j As Integer

Dim diffVal As Integer

Dim acLen As Byte

Dim acSym(63) As tagACSYM

Dim Symbol As tagSYM2

Dim temphuf As tagHUFFCODE

 

 

 

 

  '对DC信号编码，写入文件

  '-------------------------------------------------

  diffVal = sigbuf(0) - dc

  ProcessDU = sigbuf(0)

 

 

  If diffVal = 0 Then

  '选择用STD_DC_Y_HT或STD_DC_UV_HT表进行搜索

  If YorUV = True Then temphuf = STD_DC_Y_HT(0) Else temphuf = STD_DC_UV_HT(0)

   '写入0到位流（写入（0，1），由于是位操作，写入长度1位（Bite），值为0，结果就是写入0到位流）

  WriteBits temphuf.code, temphuf.length

  Else

  'STD_DC_Y_HT(ComputeVLI(diffVal)) ： DC差异值>> 转化为二进制长度值,作为索引>> 哈夫曼表的值

  If YorUV = True Then temphuf = STD_DC_Y_HT(ComputeVLI(diffVal)) Else temphuf = STD_DC_UV_HT(ComputeVLI(diffVal))

  '写入长度为表中 .length位，值为 .code   到位流

  WriteBits temphuf.code, temphuf.length

 

  Symbol.codeLen = ComputeVLI(diffVal)               ' 获取差异值二进制编码长度

  If diffVal >= 0 Then Symbol.amplitude = diffVal Else Symbol.amplitude = pow(diffVal) '计算反码

  WriteBits Symbol.amplitude, Symbol.codeLen   '写入DC差异值或差异值反码到位流

  End If

 

 

  '对AC信号编码并写入文件

  '------------------------------------------------

  For i = 63 To 1 Step -1

      If sigbuf(i) <> 0 Then Exit For

  Next   '判断ac信号是否全为0

  If i > 0 Then

      acLen = RLEComp(sigbuf, acSym)       '对AC进行熵编码

      For j = 0 To acLen - 1         '依次对AC中间符号Huffman编码

          If acSym(j).codeLen = 0 Then          '是否有连续16个0

               If YorUV = True Then temphuf = STD_AC_Y_HT(240) Else temphuf = STD_AC_UV_HT(240)

               WriteBits temphuf.code, temphuf.length       '写入(15,0,0)

          Else

              '以0个数和非0数二进制长度组合起来的值为索引，写入哈夫曼表的值

               If YorUV = True Then temphuf = STD_AC_Y_HT(acSym(j).zeroLen * 16 + acSym(j).codeLen) Else temphuf = STD_AC_UV_HT(acSym(j).zeroLen * 16 + acSym(j).codeLen)

               WriteBits temphuf.code, temphuf.length

    

               '写入非0的值或反码

               Symbol.codeLen = ComputeVLI(acSym(j).amplitude)               '获取编码长度

               If acSym(j).amplitude >= 0 Then Symbol.amplitude = acSym(j).amplitude Else Symbol.amplitude = pow(acSym(j).amplitude) '计算反码

               WriteBits Symbol.amplitude, Symbol.codeLen

          End If

      Next

   End If

     

    '写入块结束标记

    '------------------------------------------------

   If i < 63 Then

   If YorUV = True Then temphuf = STD_AC_Y_HT(0) Else temphuf = STD_AC_UV_HT(0)

   WriteBits temphuf.code, temphuf.length  '写(0,0)

   End If

End Function

 

 ' 8x8的浮点离散余弦变换,并且量化

Private Sub FDCT(lpBuff() As Integer, lpint() As Integer, ByVal YorUV As Boolean)

Dim tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 As Integer

Dim tmp10, tmp11, tmp12, tmp13 As Integer

Dim z1, z2, z3, z4, z5, z11, z13 As Integer

Dim dataptr(7) As Integer

Dim ctr, i, p As Integer

 

'对行进行计算

  For ctr = 7 To 0 Step -1

  p = ctr * 8

  For i = 0 To 7: dataptr(i) = lpBuff(p + i): Next

   tmp0 = dataptr(0) + dataptr(7)

   tmp7 = dataptr(0) - dataptr(7)

   tmp1 = dataptr(1) + dataptr(6)

   tmp6 = dataptr(1) - dataptr(6)

   tmp2 = dataptr(2) + dataptr(5)

   tmp5 = dataptr(2) - dataptr(5)

   tmp3 = dataptr(3) + dataptr(4)

   tmp4 = dataptr(3) - dataptr(4)

   ' 对偶数项进行运算

   tmp10 = tmp0 + tmp3

   tmp13 = tmp0 - tmp3

   tmp11 = tmp1 + tmp2

   tmp12 = tmp1 - tmp2

   dataptr(0) = tmp10 + tmp11

   dataptr(4) = tmp10 - tmp11

   z1 = (tmp12 + tmp13) * 0.707106781

   dataptr(2) = tmp13 + z1

   dataptr(6) = tmp13 - z1

   '对奇数项进行计算

   tmp10 = tmp4 + tmp5

   tmp11 = tmp5 + tmp6

   tmp12 = tmp6 + tmp7

   z5 = (tmp10 - tmp12) * 0.382683433

   z2 = 0.5411961 * tmp10 + z5

   z4 = 1.306562965 * tmp12 + z5

   z3 = tmp11 * 0.707106781

   z11 = tmp7 + z3

   z13 = tmp7 - z3

   dataptr(5) = z13 + z2

   dataptr(3) = z13 - z2

   dataptr(1) = z11 + z4

   dataptr(7) = z11 - z4

   For i = 0 To 7:  lpint(p + i) = dataptr(i): Next

  Next

 

 

'对列进行计算

  For ctr = 7 To 0 Step -1

 

  For i = 0 To 7: dataptr(i) = lpint(i * 8 + ctr): Next

   tmp0 = dataptr(0) + dataptr(7)

   tmp7 = dataptr(0) - dataptr(7)

   tmp1 = dataptr(1) + dataptr(6)

   tmp6 = dataptr(1) - dataptr(6)

   tmp2 = dataptr(2) + dataptr(5)

   tmp5 = dataptr(2) - dataptr(5)

   tmp3 = dataptr(3) + dataptr(4)

   tmp4 = dataptr(3) - dataptr(4)

   ' 对偶数项进行运算

   tmp10 = tmp0 + tmp3

   tmp13 = tmp0 - tmp3

   tmp11 = tmp1 + tmp2

   tmp12 = tmp1 - tmp2

   dataptr(0) = tmp10 + tmp11

   dataptr(4) = tmp10 - tmp11

   z1 = (tmp12 + tmp13) * 0.707106781

   dataptr(2) = tmp13 + z1

   dataptr(6) = tmp13 - z1

   '对奇数项进行计算

   tmp10 = tmp4 + tmp5

   tmp11 = tmp5 + tmp6

   tmp12 = tmp6 + tmp7

   z5 = (tmp10 - tmp12) * 0.382683433

   z2 = 0.5411961 * tmp10 + z5

   z4 = 1.306562965 * tmp12 + z5

   z3 = tmp11 * 0.707106781

   z11 = tmp7 + z3

   z13 = tmp7 - z3

   dataptr(5) = z13 + z2

   dataptr(3) = z13 - z2

   dataptr(1) = z11 + z4

   dataptr(7) = z11 - z4

   For i = 0 To 7:  lpint(i * 8 + ctr) = dataptr(i): Next

  Next

 

 

 

 

  '量化

  '--------------------------------------------------------

  For i = 0 To 63

   '选择用YQT_DCT或UVQT_DCT表进行量化

  If YorUV = True Then

  lpint(FZBT(i)) = CInt(lpint(i) * YQT_DCT(i))

  Else

  lpint(FZBT(i)) = CInt(lpint(i) * UVQT_DCT(i))

  End If

  Next

 

End Sub

 

'使用RLE算法（熵编码）对AC压缩 , 假设输入数据1, 0, 0, 0, 3, 0, 5

'输出为(0,1,1)(3,2,3)(1,1,5)

'左位表示非0的数前面0的个数,中位表示左位值的二进制长度,右位表示非0的值

'0的个数超过表示范围则输出为(15,0) ,其余的0数据在下一个符号中表示.

Private Function RLEComp(lpbuf() As Integer, lpOutBuf() As tagACSYM) As Byte

Dim zeroNum As Byte

Dim EOBPos As Byte

Dim i, j As Byte

EOBPos = 63

For i = 63 To 0 Step -1  '从最后的AC信号数0的个数

If lpbuf(i) = 0 Then EOBPos = EOBPos - 1 Else Exit For

Next

For i = 1 To EOBPos  '从第二个信号，即AC信号开始编码

If lpbuf(i) = 0 And zeroNum < 15 Then

zeroNum = zeroNum + 1

Else

    lpOutBuf(j).zeroLen = zeroNum        '0行程（连续长度）

    lpOutBuf(j).codeLen = ComputeVLI(lpbuf(i))    '振幅编码长度

    lpOutBuf(j).amplitude = lpbuf(i)      '振幅

    zeroNum = 0            '0计数器复位

    j = j + 1         '符号计数

End If

Next

RLEComp = j

End Function

 

'获得数值的二进制长度

Private Function ComputeVLI(ByVal val As Integer) As Byte

val = Abs(val)

Select Case val

Case 0

  ComputeVLI = 0

Case 1

  ComputeVLI = 1

Case Is < 4

  ComputeVLI = 2

Case Is < 8

  ComputeVLI = 3

Case Is < 16

  ComputeVLI = 4

Case Is < 32

  ComputeVLI = 5

Case Is < 64

  ComputeVLI = 6

Case Is < 128

  ComputeVLI = 7

Case Is < 256

  ComputeVLI = 8

Case Is < 512

  ComputeVLI = 9

Case Is < 1024

  ComputeVLI = 10

Case Else

  ComputeVLI = 11

End Select

End Function

 

'获得反码,如：数值为 -5（绝对值的二进制为 101），那么反码为 2（二进制为 010，二进制上同位上取反值）

Private Function pow(ByVal val As Integer) As Integer

Dim i, l As Byte

Dim sz As Integer

val = Abs(val)

l = ComputeVLI(val)

 

For i = l - 1 To 0 Step -1

If val >= mask(i) Then

val = val - mask(i)

Else

sz = sz + mask(i)

End If

Next

pow = sz

End Function

 

'把要写入的值组成 Bit 流，并（每8个）转化成Byte写入文件

Private Sub WriteBits(ByVal value As Long, ByVal codeLen As Byte)

Dim posval As Integer

Dim wbyte As Byte

posval = codeLen - 1

Do While posval >= 0

If (value And mask(posval)) Then bytenew = bytenew + mask(bytepos)

posval = posval - 1

bytepos = bytepos - 1

If bytepos < 0 Then

If bytenew = 255 Then

wbyte = 255

Put #1, , wbyte

wbyte = 0

Put #1, , wbyte

Else

wbyte = bytenew

Put #1, , wbyte

End If

bytepos = 7

bytenew = 0

End If

Loop

End Sub

 

'图像结束时，写入Bit 流中余下的Bit

Private Sub WriteEndBits()

Dim wbyte As Byte

If bytepos > 0 Then

Do While bytepos >= 0

bytenew = bytenew + mask(bytepos)

bytepos = bytepos - 1

If bytepos < 0 Then

If bytenew = 255 Then

wbyte = 255

Put #1, , wbyte

wbyte = 0

Put #1, , wbyte

Else

wbyte = bytenew

Put #1, , wbyte

End If

End If

Loop

End If

End Sub

 

补充说明：灰度JPEG压缩（类似于黑白照片）

灰度JPEG压缩有别于黑和白，它有256个不同程度的灰度色彩。它其实就是在JPEG压缩过程中，只保留Y流的压缩，忽略了U流和V流的压缩。

灰度JPEG文件与彩色JPEG文件的区别：

1．              灰度JPEG文件中也只有Y流的信息，它只支持1：1：1的压缩格式，不支持其他的格式。

2．              在文件头中，SOFO只有 13个字节，仅保留Y的信息，去掉U和V的信息（sigNum=1），SOS只有10个字节（sigNum=1）。

3．              量化表可以去掉一个，哈夫曼表可以去掉两个，不去掉也加以。

4．              在图像数据中每个MCU中只有Y信息。

限于篇幅关系，我就不写源码，有兴趣的朋友可以自己去写。

 

                            

童跃   福建省华安县际头小学

tongyue2007@126.com

2007 年 5 月 1 日