📄 cjpeg.cls
字号:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "cJpeg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Option Base 0
'Class Name: cJpeg.cls "JPEG Encoder Class"
'Author: John Korejwa <korejwa@tiac.net>
'Version: 0.9 beta [26 / November / 2003]
'
'
'Legal:
' This class is intended for and was uploaded to www.planetsourcecode.com
'
' This product includes JPEG compression code developed by John Korejwa. <korejwa@tiac.net>
' Source code, written in Visual Basic, is freely available for non-commercial,
' non-profit use at www.planetsourcecode.com.
'
'
'Credits:
' Special thanks to Barry G., a government research scientist who took an interest in my
' steganography software and research in late 1999. I never met Barry in person, but he
' was kind enough to buy and mail me a book with the ISO DIS 10918-1 JPEG standard.
'
'
'Description: This class contains code for compressing pictures, sampled via hDC, into
' baseline .JPG files. Please report any errors or unusual behavior to the email
' address above.
'
'Dependencies: None
'
'JPEG Marker Constants (Note: VB compiler does not compile unused constants)
'Non-Differential Huffman Coding
Private Const SOF0 As Long = &HC0& 'Baseline DCT
Private Const SOF1 As Long = &HC1& 'Extended sequential DCT
Private Const SOF2 As Long = &HC2& 'Progressive DCT
Private Const SOF3 As Long = &HC3& 'Spatial (sequential) lossless
'Differential Huffman coding
Private Const SOF5 As Long = &HC5& 'Differential sequential DCT
Private Const SOF6 As Long = &HC6& 'Differential progressive DCT
Private Const SOF7 As Long = &HC7& 'Differential spatial
'Non-Differential arithmetic coding
Private Const JPG As Long = &HC8& 'Reserved for JPEG extentions
Private Const SOF9 As Long = &HC9& 'Extended sequential DCT
Private Const SOF10 As Long = &HCA& 'Progressive DCT
Private Const SOF11 As Long = &HCB& 'Spatial (sequential) lossless
'Differential arithmetic coding
Private Const SOF13 As Long = &HCD& 'Differential sequential DCT
Private Const SOF14 As Long = &HCE& 'Differential progressive DCT
Private Const SOF15 As Long = &HCF& 'Differential Spatial
'Other Markers
Private Const DHT As Long = &HC4& 'Define Huffman tables
Private Const DAC As Long = &HCC& 'Define arithmetic coding conditioning(s)
Private Const RSTm As Long = &HD0& 'Restart with modulo 8 count "m"
Private Const RSTm2 As Long = &HD7& 'to 'Restart with modulo 8 count "m"
Private Const SOI As Long = &HD8& 'Start of image
Private Const EOI As Long = &HD9& 'End of image
Private Const SOS As Long = &HDA& 'Start of scan
Private Const DQT As Long = &HDB& 'Define quantization table(s)
Private Const DNL As Long = &HDC& 'Define number of lines
Private Const DRI As Long = &HDD& 'Define restart interval
Private Const DHP As Long = &HDE& 'Define hierarchical progression
Private Const EXP As Long = &HDF& 'Expand reference components
Private Const APP0 As Long = &HE0& 'Reserved for application segments
Private Const APPF As Long = &HEF& ' to Reserved for application segments
Private Const JPGn As Long = &HF0& 'Reserved for JPEG Extentions
Private Const JPGn2 As Long = &HFD& ' to Reserved for JPEG Extentions
Private Const COM As Long = &HFE& 'Comment
Private Const RESm As Long = &H2& 'Reserved
Private Const RESm2 As Long = &HBF& ' to Reserved
Private Const TEM As Long = &H1& 'For temporary use in arithmetic coding
'Consider these arrays of constants.
'They are initialized with the class and do not change.
Private QLumin(63) As Integer 'Standard Luminance Quantum (for 50% quality)
Private QChrom(63) As Integer 'Standard Chrominance Quantum (for 50% quality)
Private FDCTScale(7) As Double 'Constants for scaling FDCT Coefficients
Private IDCTScale(7) As Double 'Constants for scaling IDCT Coefficients
Private ZigZag(7, 7) As Long 'Zig Zag order of 8X8 block of samples
'API constants
Private Const BLACKONWHITE As Long = 1 'nStretchMode constants for
Private Const COLORONCOLOR As Long = 3 ' SetStretchBltMode() API function
Private Const HALFTONE As Long = 4 'HALFTONE not supported in Win 95, 98, ME
Private Const BI_RGB As Long = 0
Private Const DIB_RGB_COLORS As Long = 0
'Variable types needed for DIBSections.
Private Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Private Type SAFEARRAY2D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 1) As SAFEARRAYBOUND
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFOHEADER
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
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
'API needed for creating DIBSections for sampling and pixel access.
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateDIBSection2 Lib "gdi32" Alias "CreateDIBSection" (ByVal hDC As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long 'lplpVoid changed to ByRef
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
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 DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hDC As Long, ByVal nStretchMode As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hDC 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
'Custom variable types used for this JPEG encoding implementation
Private Type QUANTIZATIONTABLE
Qk(63) As Integer 'Quantization Values
FScale(63) As Single 'Multiplication values to scale and Quantize FDCT output
IScale(63) As Single 'Multiplication values to scale and DeQuantize IDCT input
End Type
Private Type HUFFMANTABLE
BITS(15) As Byte 'Number of huffman codes of length i+1
HUFFVAL(255) As Byte 'Huffman symbol values
EHUFSI(255) As Long 'Huffman code size for symbol i
EHUFCO(255) As Long 'Huffman code for symbol i
MINCODE(15) As Long '
MAXCODE(15) As Long 'Largest code value for length i+1
End Type
Private Type COMPONENT
Ci As Long 'Component ID [0-255]
Hi As Long 'Horizontal Sampling Factor [1-4]
Vi As Long 'Vertical Sampling Factor [1-4]
Tqi As Long 'Quantization Table Select [0-3]
data() As Integer 'DCT Coefficients
End Type
Private PP As Long 'Sample Precision [8, 12]
Private YY As Long 'Number of lines [Image Height]
Private XX As Long 'Number of samples per line [Image Width]
Private Nf As Long 'Number of components in Frame
Private HMax As Long 'Maximum horizontal sampling frequency
Private VMax As Long 'Maximum vertical sampling frequency
Private m_Data() As Byte 'JPEG File Data
Private m_Chr As Long 'Current Character in m_Data
Private m_Ptr As Long 'Byte index in m_Data
Private m_Bit As Long 'Bit index in m_Chr
Private m_Block(7, 7) As Single 'Buffer for calculating DCT
Private QTable(3) As QUANTIZATIONTABLE '4 Quantization Tables
Private HuffDC(3) As HUFFMANTABLE '4 DC Huffman Tables
Private HuffAC(3) As HUFFMANTABLE '4 AC Huffman Tables
Private Comp() As COMPONENT 'Scan Components
Private m_Quality As Long
Private m_Comment As String
'========================================================================================
' D I S C R E T E C O S I N E T R A N S F O R M A T I O N
'========================================================================================
Private Sub FDCT()
Static t0 As Single 'Given an 8X8 block of discretely sampled values [m_Block(0-7, 0-7)],
Static t1 As Single 'replace them with their (scaled) Forward Discrete Cosine Transformation values.
Static t2 As Single '80 (+64) multiplications and 464 additions are needed.
Static t3 As Single 'Values are scaled on output, meaning that each of the 64 elements must be
Static t4 As Single 'multiplied by constants for a final FDCT. These final constants are combined
Static t5 As Single 'with Quantization constants, so a final 64 multiplications combine the
Static t6 As Single 'completion of the FDCT and Quantization in one step.
Static t7 As Single
Static t8 As Single
Static i As Long
For i = 0 To 7 'Process 1D FDCT on each row
t0 = m_Block(i, 0) + m_Block(i, 7)
t1 = m_Block(i, 0) - m_Block(i, 7)
t2 = m_Block(i, 1) + m_Block(i, 6)
t3 = m_Block(i, 1) - m_Block(i, 6)
t4 = m_Block(i, 2) + m_Block(i, 5)
t5 = m_Block(i, 2) - m_Block(i, 5)
t6 = m_Block(i, 3) + m_Block(i, 4)
t7 = m_Block(i, 3) - m_Block(i, 4)
t7 = t7 + t5
t8 = t0 - t6
t6 = t6 + t0
t0 = t2 + t4
t2 = (t2 - t4 + t8) * 0.707106781186548 'Cos(2# * PI / 8#)
t4 = t1 + t3
t3 = (t3 + t5) * 0.707106781186548 'Cos(2# * PI / 8#)
t5 = (t4 - t7) * 0.382683432365091 'Cos(3# * PI / 8#)
t7 = t7 * 0.541196100146196 - t5 'Cos(PI / 8#) - Cos(3# * PI / 8#)
t4 = t4 * 1.30656296487638 - t5 'Cos(PI / 8#) + Cos(3# * PI / 8#)
t5 = t1 + t3
t1 = t1 - t3
m_Block(i, 0) = t6 + t0
m_Block(i, 4) = t6 - t0
m_Block(i, 1) = t5 + t4
m_Block(i, 7) = t5 - t4
m_Block(i, 2) = t8 + t2
m_Block(i, 6) = t8 - t2
m_Block(i, 5) = t1 + t7
m_Block(i, 3) = t1 - t7
Next i
For i = 0 To 7 'Process 1D FDCT on each column
t0 = m_Block(0, i) + m_Block(7, i)
t1 = m_Block(0, i) - m_Block(7, i)
t2 = m_Block(1, i) + m_Block(6, i)
t3 = m_Block(1, i) - m_Block(6, i)
t4 = m_Block(2, i) + m_Block(5, i)
t5 = m_Block(2, i) - m_Block(5, i)
t6 = m_Block(3, i) + m_Block(4, i)
t7 = m_Block(3, i) - m_Block(4, i)
t7 = t7 + t5
t8 = t0 - t6
t6 = t6 + t0
t0 = t2 + t4
t2 = (t2 - t4 + t8) * 0.707106781186548 'Cos(2# * PI / 8#)
t4 = t1 + t3
t3 = (t3 + t5) * 0.707106781186548 'Cos(2# * PI / 8#)
t5 = (t4 - t7) * 0.382683432365091 'Cos(3# * PI / 8#)
t7 = t7 * 0.541196100146196 - t5 'Cos(PI / 8#) - Cos(3# * PI / 8#)
t4 = t4 * 1.30656296487638 - t5 'Cos(PI / 8#) + Cos(3# * PI / 8#)
t5 = t1 + t3
t1 = t1 - t3
m_Block(0, i) = t6 + t0
m_Block(4, i) = t6 - t0
m_Block(1, i) = t5 + t4
m_Block(7, i) = t5 - t4
m_Block(2, i) = t8 + t2
m_Block(6, i) = t8 - t2
m_Block(5, i) = t1 + t7
m_Block(3, i) = t1 - t7
Next i
End Sub
'================================================================================
' H U F F M A N T A B L E G E N E R A T I O N
'================================================================================
Private Sub OptimizeHuffman(TheHuff As HUFFMANTABLE, freq() As Long)
'Generate optimized values for BITS and HUFFVAL in a HUFFMANTABLE
'based on symbol frequency counts. freq must be dimensioned freq(0-256)
'and contain counts of symbols 0-255. freq is destroyed in this procedure.
Dim i As Long
Dim j As Long
Dim k As Long
Dim n As Long
Dim V1 As Long
Dim V2 As Long
Dim others(256) As Long
Dim codesize(256) As Long
Dim BITS(256) As Long
Dim swp As Long
Dim swp2 As Long
For i = 0 To 256 'Initialize others to -1, (this value terminates chain of indicies)
others(i) = -1
Next i
freq(256) = 1 'Add dummy symbol to guarantee no code will be all '1' bits
'Generate codesize() [find huffman code sizes]
Do 'do loop for (#non-zero-frequencies - 1) times
V1 = -1 'find highest v1 for least value of freq(v1)>0
V2 = -1 'find highest v2 for next least value of freq(v2)>0
swp = 2147483647 'Max Long variable
swp2 = 2147483647
For i = 0 To 256
If freq(i) <> 0 Then
If (freq(i) <= swp2) Then
If (freq(i) <= swp) Then
swp2 = swp
V2 = V1
swp = freq(i)
V1 = i
Else
swp2 = freq(i)
V2 = i
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -