📄 clsjpeg.cls
字号:
For f = FirstIndex To SecondIndex '0 To Ns - 1
With Comp(CompIndex(f))
For g = 1 To .Vi
For h = 1 To .Hi
EncodeCoefficients .data, p(f, g - 1), Pred(f), Td(f), Ta(f)
Next
Next
End With
Next
Next
For f = FirstIndex To SecondIndex
With Comp(CompIndex(f))
For g = 1 To .Vi
For h = 1 To .Hi
If h > MCUr(f) Then
Pad64(0) = Pred(f)
EncodeCoefficients Pad64, 0, Pred(f), Td(f), Ta(f)
Else
EncodeCoefficients .data, p(f, g - 1), Pred(f), Td(f), Ta(f)
End If
Next
Next
End With
Next
For f = FirstIndex To SecondIndex
For g = 0 To Comp(CompIndex(f)).Vi - 1
p(f, g) = p(f, g) + pLF(f)
Next
Next
Next
For i = 1 To MCUx
For f = FirstIndex To SecondIndex
With Comp(CompIndex(f))
For g = 1 To .Vi
For h = 1 To .Hi
If p(f, g - 1) > UBound(.data) Or (i = MCUx And h > MCUr(f)) Then
Pad64(0) = Pred(f)
EncodeCoefficients Pad64, 0, Pred(f), Td(f), Ta(f)
Else
EncodeCoefficients .data, p(f, g - 1), Pred(f), Td(f), Ta(f)
End If
Next
Next
End With
Next f
Next i
WriteBitsEnd
End Sub
Private Sub InsertSequentialScans(CompIndex() As Long, Td() As Long, Ta() As Long, FirstIndex As Long, SecondIndex As Long)
Dim f As Long
Dim g As Long
Dim Nb As Long
Const MaxNb As Long = 10
Dim flag As Boolean
f = FirstIndex
g = FirstIndex
Nb = 0
flag = False
While f <= SecondIndex
Nb = Nb + Comp(CompIndex(g)).Hi * Comp(CompIndex(g)).Vi
g = g + 1
If Nb > MaxNb Then
flag = True
If f <> g - 1 Then g = g - 1
Else
If (g - f) = 3 Or g > SecondIndex Then flag = True
End If
If flag Then
If f = g - 1 Then
InsertSOSNonInterleaved CompIndex(f), Td(f), Ta(f)
Else
InsertSOSInterleaved CompIndex, Td, Ta, f, g - 1
End If
Nb = 0
f = g
flag = False
End If
Wend
End Sub
Private Function OptimizeHuffmanTables(CompIndex() As Long, Td() As Long, Ta() As Long, FirstIndex As Long, SecondIndex As Long) As Long
Dim f As Long
Dim g As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim k1 As Long
Dim k2 As Long
Dim Nb As Long
Const MaxNb As Long = 10
Dim freq(256) As Long
Dim freq2() As Long
Dim IsInter() As Boolean
Dim TdUsed() As Boolean
Dim TaUsed() As Boolean
Dim flag As Boolean
ReDim IsInter(FirstIndex To SecondIndex)
ReDim TaUsed(3)
ReDim TdUsed(3)
f = FirstIndex
g = FirstIndex
Nb = 0
flag = False
While f <= SecondIndex
Nb = Nb + Comp(CompIndex(g)).Hi * Comp(CompIndex(g)).Vi
g = g + 1
If Nb > MaxNb Then
flag = True
If f <> g - 1 Then g = g - 1
Else
If (g - f) = 3 Or g > SecondIndex Then flag = True
End If
If flag Then
If f = g - 1 Then
TdUsed(Td(f)) = True
TaUsed(Ta(f)) = True
IsInter(f) = False
Else
For i = f To g - 1
TdUsed(Td(i)) = True
TaUsed(Ta(i)) = True
IsInter(i) = True
Next
End If
Nb = 0
f = g
flag = False
End If
Wend
For i = 0 To 3
If TdUsed(i) Then
For f = FirstIndex To SecondIndex
With Comp(CompIndex(f))
If Td(f) = i Then
If IsInter(f) Then
CollectStatisticsDCInterleaved .data, freq, .Hi, .Vi
Else
CollectStatisticsDCNonInterleaved .data, freq
End If
End If
End With
Next
freq2 = freq
OptimizeHuffman HuffDC(i), freq
ExpandHuffman HuffDC(i), IIf(PP = 12, 15, 11)
For j = 0 To 15
If freq2(j) <> 0 Then
k1 = j + Int(Log(HuffDC(i).EHUFSI(j)) * 1.442695040889) + 1
k2 = k2 + freq2(j) * k1
k = k + k2 \ 8
k2 = k2 Mod 8
End If
Next
End If
If TaUsed(i) Then
For f = FirstIndex To SecondIndex
If Td(f) = i Then CollectStatisticsAC Comp(CompIndex(f)).data, freq
Next
freq2 = freq
OptimizeHuffman HuffAC(i), freq
ExpandHuffman HuffAC(i), 255
For j = 0 To 255
If freq2(j) <> 0 Then
k1 = (j And 15) + Int(Log(HuffAC(i).EHUFSI(j)) * 1.442695040889) + 1
k2 = k2 + freq2(j) * k1
k = k + k2 \ 8
k2 = k2 Mod 8
End If
Next
End If
Next
If (k2 Mod 8) <> 0 Then k = k + 1
OptimizeHuffmanTables = k
End Function
Public Function SaveFile(Filename As String) As Long
Dim CompIndex() As Long
Dim Td() As Long
Dim Ta() As Long
Dim FileNum As Integer
Dim i As Long
If Len(Filename) = 0 Then
SaveFile = 1 '文件名为空
Else
If (Len(Dir(Filename, vbNormal Or vbReadOnly Or vbHidden Or vbSystem Or vbArchive)) > 0) Then
SaveFile = 2 '文件已存在
Else
ReDim CompIndex(Nf - 1)
ReDim Td(Nf - 1)
ReDim Ta(Nf - 1)
For i = 0 To Nf - 1
CompIndex(i) = i
Td(i) = IIf(i = 0, 0, 1)
Ta(i) = IIf(i = 0, 0, 1)
Next i
i = OptimizeHuffmanTables(CompIndex, Td, Ta, 0, Nf - 1)
i = 1.3 * i + 1000 + Len(m_Comment)
ReDim m_Data(i)
m_Ptr = 0
InsertMarker SOI
InsertJFIF
If Len(m_Comment) > 0 Then InsertCOM m_Comment
InsertCOM "JPEG Encoder Class" & vbCrLf & "Written by John Korejwa <korejwa@tiac.net>" & vbCrLf & "Visual Basic sourcecode available at planetsourcecode.com"
InsertDQT m_Ptr, 0
If Nf > 1 Then InsertDQT m_Ptr, 1
InsertSOF SOF0
InsertDHT m_Ptr, 0, False
InsertDHT m_Ptr, 0, True
If Nf > 1 Then
InsertDHT m_Ptr, 1, False
InsertDHT m_Ptr, 1, True
End If
InsertSequentialScans CompIndex, Td, Ta, 0, Nf - 1
InsertMarker EOI
ReDim Preserve m_Data(m_Ptr - 1)
FileNum = FreeFile
Open Filename For Binary Access Write As FileNum
Put #FileNum, , m_Data
Close FileNum
Erase m_Data
End If
End If
End Function
Public Sub Savetobyte(Picbyte() As Byte)
Dim CompIndex() As Long
Dim Td() As Long
Dim Ta() As Long
Dim FileNum As Integer
Dim i As Long
ReDim CompIndex(Nf - 1)
ReDim Td(Nf - 1)
ReDim Ta(Nf - 1)
For i = 0 To Nf - 1
CompIndex(i) = i
Td(i) = IIf(i = 0, 0, 1)
Ta(i) = IIf(i = 0, 0, 1)
Next i
i = OptimizeHuffmanTables(CompIndex, Td, Ta, 0, Nf - 1)
i = 1.3 * i + 1000 + Len(m_Comment)
ReDim m_Data(i)
m_Ptr = 0
InsertMarker SOI
InsertJFIF
If Len(m_Comment) > 0 Then InsertCOM m_Comment
InsertCOM "JPEG Encoder Class" & vbCrLf & "Written by John Korejwa <korejwa@tiac.net>" & vbCrLf & "Visual Basic sourcecode available at planetsourcecode.com"
InsertDQT m_Ptr, 0
If Nf > 1 Then InsertDQT m_Ptr, 1
InsertSOF SOF0
InsertDHT m_Ptr, 0, False
InsertDHT m_Ptr, 0, True
If Nf > 1 Then
InsertDHT m_Ptr, 1, False
InsertDHT m_Ptr, 1, True
End If
InsertSequentialScans CompIndex, Td, Ta, 0, Nf - 1
InsertMarker EOI
ReDim Preserve m_Data(m_Ptr - 1)
Picbyte = m_Data
Erase m_Data
End Sub
Private Sub Class_Initialize()
Dim i As Long
Dim j As Long
Dim dX As Long
Dim zz As Long
i = 0
j = 0
dX = 1
For zz = 0 To 63
ZigZag(i, j) = zz
i = i + dX
j = j - dX
If i > 7 Then ' 0 1 5 6 14 15 27 28
i = 7 ' 2 4 7 13 16 26 29 42
j = j + 2 ' 3 8 12 17 25 30 41 43
dX = -1 ' 9 11 18 24 31 40 44 53
ElseIf j > 7 Then ' 10 19 23 32 39 45 52 54
j = 7 ' 20 22 33 38 46 51 55 60
i = i + 2 ' 21 34 37 47 50 56 59 61
dX = 1 ' 35 36 48 49 57 58 62 63
ElseIf i < 0 Then
i = 0
dX = 1
ElseIf j < 0 Then
j = 0
dX = -1
End If
Next
'量子表 图像质量 Quality = 50
QLumin(0) = 16: QLumin(1) = 11: QLumin(2) = 12: QLumin(3) = 14
QLumin(4) = 12: QLumin(5) = 10: QLumin(6) = 16: QLumin(7) = 14
QLumin(8) = 13: QLumin(9) = 14: QLumin(10) = 18: QLumin(11) = 17
QLumin(12) = 16: QLumin(13) = 19: QLumin(14) = 24: QLumin(15) = 40
QLumin(16) = 26: QLumin(17) = 24: QLumin(18) = 22: QLumin(19) = 22
QLumin(20) = 24: QLumin(21) = 49: QLumin(22) = 35: QLumin(23) = 37
QLumin(24) = 29: QLumin(25) = 40: QLumin(26) = 58: QLumin(27) = 51
QLumin(28) = 61: QLumin(29) = 60: QLumin(30) = 57: QLumin(31) = 51
QLumin(32) = 56: QLumin(33) = 55: QLumin(34) = 64: QLumin(35) = 72
QLumin(36) = 92: QLumin(37) = 78: QLumin(38) = 64: QLumin(39) = 68
QLumin(40) = 87: QLumin(41) = 69: QLumin(42) = 55: QLumin(43) = 56
QLumin(44) = 80: QLumin(45) = 109: QLumin(46) = 81: QLumin(47) = 87
QLumin(48) = 95: QLumin(49) = 98: QLumin(50) = 103: QLumin(51) = 104
QLumin(52) = 103: QLumin(53) = 62: QLumin(54) = 77: QLumin(55) = 113
QLumin(56) = 121: QLumin(57) = 112: QLumin(58) = 100: QLumin(59) = 120
QLumin(60) = 92: QLumin(61) = 101: QLumin(62) = 103: QLumin(63) = 99
'色度量子表,图像质量 Quality = 50
QChrom(0) = 17: QChrom(1) = 18: QChrom(2) = 18: QChrom(3) = 24
QChrom(4) = 21: QChrom(5) = 24: QChrom(6) = 47: QChrom(7) = 26
QChrom(8) = 26: QChrom(9) = 47: QChrom(10) = 99: QChrom(11) = 66
QChrom(12) = 56: QChrom(13) = 66: QChrom(14) = 99: QChrom(15) = 99
QChrom(16) = 99: QChrom(17) = 99: QChrom(18) = 99: QChrom(19) = 99
QChrom(20) = 99: QChrom(21) = 99: QChrom(22) = 99: QChrom(23) = 99
QChrom(24) = 99: QChrom(25) = 99: QChrom(26) = 99: QChrom(27) = 99
QChrom(28) = 99: QChrom(29) = 99: QChrom(30) = 99: QChrom(31) = 99
QChrom(32) = 99: QChrom(33) = 99: QChrom(34) = 99: QChrom(35) = 99
QChrom(36) = 99: QChrom(37) = 99: QChrom(38) = 99: QChrom(39) = 99
QChrom(40) = 99: QChrom(41) = 99: QChrom(42) = 99: QChrom(43) = 99
QChrom(44) = 99: QChrom(45) = 99: QChrom(46) = 99: QChrom(47) = 99
QChrom(48) = 99: QChrom(49) = 99: QChrom(50) = 99: QChrom(51) = 99
QChrom(52) = 99: QChrom(53) = 99: QChrom(54) = 99: QChrom(55) = 99
QChrom(56) = 99: QChrom(57) = 99: QChrom(58) = 99: QChrom(59) = 99
QChrom(60) = 99: QChrom(61) = 99: QChrom(62) = 99: QChrom(63) = 99
FDCTScale(0) = 0.353553390593273 '0.25 / Cos(4 / 16 * PI)
FDCTScale(1) = 0.25489778955208 '0.25 / Cos(1 / 16 * PI)
FDCTScale(2) = 0.270598050073098 '0.25 / Cos(2 / 16 * PI)
FDCTScale(3) = 0.300672443467523 '0.25 / Cos(3 / 16 * PI)
FDCTScale(4) = 0.353553390593273 '0.25 / Cos(4 / 16 * PI)
FDCTScale(5) = 0.449988111568207 '0.25 / Cos(5 / 16 * PI)
FDCTScale(6) = 0.653281482438186 '0.25 / Cos(6 / 16 * PI)
FDCTScale(7) = 1.28145772387074 '0.25 / Cos(7 / 16 * PI)
SetSamplingFrequencies 2, 2, 1, 1, 1, 1
Quality = 75
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -