纯VB6代码载入并显示 PNG 图片
纯VB6代码载入并显示 PNG 图片窗体代码：
'***********************************************************************
'* *
'* 原作者：601居士，向原作者致敬！ *
'* *
'* 原作者博客地址：http://blog. *
'* *
'* 本代码改编自： *
'* *
'* http://blog. *
'* *
'* 本代码改编时间：2019年5月 *
'* *
'* 本代码功能是用纯VB6代码载入并显示 PNG 图片 *
'* *
'* 使用方法：运行本软件，出现在屏幕左上角，拖拽PNG图片到窗体即可 *
'* *
'* 窗体无标题栏，窗体可拖动，右键点击窗体退出，双击窗体显示帮助 *
'* *
'***********************************************************************
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Dim X0!, Y0!
Dim pngClass As New LoadPNG
Private Sub Form_DblClick()
s = s & "原作者：601居士，向原作者致敬！" & vbCrLf & vbCrLf
s = s & "原作者博客地址：http://blog. & vbCrLf & vbCrLf
s = s & "本代码改编自：" & vbCrLf & vbCrLf
s = s & "http://blog. & vbCrLf & vbCrLf
s = s & "本代码改编时间：2019年5月" & vbCrLf & vbCrLf
s = s & "本代码功能是用纯VB6代码载入并显示 PNG 图片" & vbCrLf & vbCrLf
s = s & "使用方法：运行本软件，出现在屏幕左上角，拖拽PNG图片到窗体即可" & vbCrLf & vbCrLf
s = s & "窗体无标题栏，窗体可拖动，右键点击窗体退出，双击窗体显示帮助"
MsgBox s
End Sub
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo over 'Picture1.Cls 'Text1 = ""
pngClass.OpenPNG Data.Files(1), Form1, , , 1 '参数：(前2个参数必需，后3个参数可选)：1-文件名，2-显示图像的对象，3、4-显示坐标，5-放大倍数
Me.Caption = Mid(Data.Files(1), InStrRev(Data.Files(1), "\") + 1)
If Len(pngClass.Text) Then Text1 = pngClass.Text
over:
End Sub
Private Sub Form_Load()
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then End
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
X0 = x
Y0 = y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Me.Left = Me.Left + x - X0
Me.Top = Me.Top + y - Y0
End If
End Sub
类模块代码：
'****************************************************************************
'**
'*原作者：601居士，向原作者致敬！ *
'**
'*原作者博客地址：http://blog.*
'**
'*本代码改编自：*
'**
'*http://blog.*
'**
'*本代码改编时间：2019年5月 *
'**
'*本代码功能是用纯VB6代码载入并显示 PNG 图片*
'**
'*使用方法：运行本软件，出现在屏幕左上角，拖拽PNG图片到窗体即可 *
'**
'*窗体无标题栏，窗体可拖动，右键点击窗体退出，双击窗体显示帮助*
'**
'****************************************************************************
Private Type RGBTriple 'PNG图片调色板结构
Red As Byte '红色分量
Green As Byte '绿色分量
Blue As Byte '蓝色分量
End Type
Private Type BITMAPINFOHEADER 'BMP位图的信息头结构
Size As Long '信息头长度（固定为40）
Width As Long '图像宽度
Height As Long '图像高度
Planes As Integer '位面板数
BitCount As Integer '每像素所占位数
Compression As Long '压缩类型
SizeImage As Long '图像数据长度
XPelsPerMeter As Long '设备水平分辨率
YPelsPerMeter As Long '设备垂直分辩率
ClrUsed As Long '有效颜色数，O表示全要使用
ClrImportant As Long '重要的颜色索引个数，0表示所有颜色均重要
End Type
Private Type RGBQUAD 'BMP位图调色板结构
rgbBlue As Byte '蓝色分量
rgbGreen As Byte '绿色分量
rgbRed As Byte '红色分量
rgbReserved As Byte '保留的
End Type
Private Type BITMAPINFO_1 '单色BMP位图
bmiHeader As BITMAPINFOHEADER
bmiColors(1) As RGBQUAD
End Type
Private Type BITMAPINFO_2
bmiHeader As BITMAPINFOHEADER
bmiColors(3) As RGBQUAD
End Type
Private Type BITMAPINFO_4 '16色BMP位图
bmiHeader As BITMAPINFOHEADER
bmiColors(15) As RGBQUAD
End Type
Private Type BITMAPINFO_8 '256色BMP位图
bmiHeader As BITMAPINFOHEADER
bmiColors(255) As RGBQUAD
End Type
Private Type BITMAPINFO_24 '24位真彩BMP位图
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Type BITMAPINFO_24a '24位真彩PNG图片
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBTriple
End Type
Private Type IHDR 'PNG文件头（IHDR）中的数据域结构，固定为13
Width As Long '图像宽度
Height As Long '图像高度
BitDepth As Byte '颜色深度
ColorType As Byte '颜色类型
Compression As Byte '压缩方法
Filter As Byte '滤波器方法
Interlacing As Byte '隔行扫描方法
End Type
Private Type CodesType
Lenght() As Long
code() As Long
End Type
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject 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 Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateDIBitmap_1 Lib "gdi32" Alias "CreateDIBitmap" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_1, ByVal wUsage As Long) As Long
Private Declare Function CreateDIBitmap_2 Lib "gdi32" Alias "CreateDIBitmap" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_2, ByVal wUsage As Long) As Long
Private Declare Function CreateDIBitmap_4 Lib "gdi32" Alias "CreateDIBitmap" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_4, ByVal wUsage As Long) As Long
Private Declare Function CreateDIBitmap_8 Lib "gdi32" Alias "CreateDIBitmap" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_8, ByVal wUsage As Long) As Long
Private Declare Function CreateDIBitmap_24 Lib "gdi32" Alias "CreateDIBitmap" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_24, ByVal wUsage As Long) As Long
Private Declare Function CreateDIBitmap_24a Lib "gdi32" Alias "CreateDIBitmap" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_24a, ByVal wUsage 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
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As Any, ByVal wUsage As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (Destination As Any, ByVal length As Long, ByVal Fill As Byte)
Private bm1 As BITMAPINFO_1
Private bm2 As BITMAPINFO_2
Private bm4 As BITMAPINFO_4
Private bm8 As BITMAPINFO_8
Private bm24 As BITMAPINFO_24
Private bm24a As BITMAPINFO_24a
Dim TempLit As CodesType, TempDist As CodesType, Dist As CodesType
Dim LC As CodesType, dc As CodesType, LitLen As CodesType
Dim OutStream() As Byte, InStream() As Byte, Pow2(16) As Long, BitMask(16) As Long, LenOrder(18) As Long
Dim hBmp As Long, OutPos As Long, Inpos As Long, ByteBuff As Long, BitNum As Long
Dim MinLLenght As Long, MaxLLenght As Long, MinDLenght As Long, MaxDLenght As Long
Dim BPPprivat As Long, Colorused As Long
Dim IDATData() As Byte '图像数据
Dim IdataLen As Long '图像数据长度
Dim Palettenbyte() As Byte '调色板数据
Dim IsStaticBuild As Boolean '创建静态结构标记
Dim m_Bgx As Long '用户输入的 X 坐标
Dim m_Bgy As Long '用户输入的 Y 坐标
Dim m_multiple As Long '用户输入的图像放大倍数
Dim m_PicBox As Object '用户输入的显示图像对象
'只读属性值
Dim m_width As Long '图像宽
Dim m_height As Long '图像高
Dim m_bitdepht As Long '颜色深度
Dim m_colortype As Long '颜色类型
Dim m_text As String '文本信息
'方法(前2个参数必需，后3个参数可选)：1-文件名，2-显示图像的对象，3、4-显示坐标，5-放大倍数
Public Sub OpenPNG(Filename As String, ByVal PicBox As Object, Optional x As Long = 0, Optional y As Long = 0, Optional Multiple As Single = 1)
On Error GoTo over
Dim a() As Byte
Dim b(0) As Long
Dim Stand As Long '当前读入的字节位置
Dim Ende As Boolean '数据读完标记
Dim Filenumber As Long
Dim Signature(7) As Byte
Dim Test As Long
Dim Ltge As Long
Dim ChunkName As String * 4 '数据块符号
Dim ChunkInhalt() As Byte '数据域
Dim CRC32Inhalt As Long 'CRC校验码
ReDim IDATData(0)
ReDim a(FileLen(Filename) - 1)
Set m_PicBox = PicBox: m_Bgx = x: m_Bgy = y: BPPprivat = 0: IdataLen = 0: If Multiple > 0 Then m_multiple = Multiple
Filenumber = FreeFile
Open Filename For Binary As Filenumber
Get Filenumber, , a
Test = IsValidSignature(a) '读出前8个字节
If Not Test Then '如果不是PNG标记退出
Close Filenumber
Exit Sub
End If
Stand = 8
Do While Ende = False
CopyMemory Ltge, a(Stand), 4 '读入长整形4个字节，这是数据块的数据域长度
Stand = Stand + 4
SwapBytesLong Ltge
CopyMemory ByVal ChunkName, a(Stand), 4 '读入4个字节字符，这是数据块符号
Stand = Stand + 4 ' Seek(Filenumber)'获取当前读入的字节位置
If Ltge > 0 Then ReDim ChunkInhalt(Ltge - 1) '如果不是结束块，定义数据域长度
If Stand + Ltge + 1 > LOF(Filenumber) Then Stop: Exit Sub '如果当前位置+数据域长度>文件长度，发生错误
CopyMemory ChunkInhalt(0), a(Stand), Ltge '读入数据域
Stand = Stand + Ltge
CopyMemory CRC32Inhalt, a(Stand), 4 '读入CRC校验码
Stand = Stand + 4
Select Case ChunkName
Case "IHDR" '文件头数据块
ReadIHDR ChunkInhalt
Case "PLTE" '调色板数据块
ReDim Palettenbyte(UBound(ChunkInhalt))
CopyMemory Palettenbyte(0), ChunkInhalt(0), UBound(ChunkInhalt) + 1
Case "IDAT" '图像数据块
ReDim Preserve IDATData(IdataLen + UBound(ChunkInhalt))
CopyMemory IDATData(IdataLen), ChunkInhalt(0), UBound(ChunkInhalt) + 1
IdataLen = UBound(IDATData) + 1
Case "IEND" '结束数据块
Ende = True
Case "tEXt" '文本信息数据块
m_text = StrConv(ChunkInhalt, vbUnicode)
End Select
Loop
PicBox.Width = m_width * 15
PicBox.Height = m_height * 15
Close Filenumber
If IdataLen > 0 Then MakePicture '处理图形
over:
End Sub
Private Function IsValidSignature(Signature() As Byte) As Boolean '判断是否PNG标记
If Signature(0) <> 137 Then Exit Function
If Signature(1) <> 80 Then Exit Function
If Signature(2) <> 78 Then Exit Function
If Signature(3) <> 71 Then Exit Function
If Signature(4) <> 13 Then Exit Function
If Signature(5) <> 10 Then Exit Function
If Signature(6) <> 26 Then Exit Function
If Signature(7) <> 10 Then Exit Function
IsValidSignature = True
End Function
Private Sub SwapBytesLong(ByteValue As Long) '转化长整形低位在前高位在后的数据
Dim Tergabe As Long, i As Long
For i = 0 To 3
CopyMemory ByVal VarPtr(Tergabe) + i, ByVal VarPtr(ByteValue) + (3 - i), 1
Next i
ByteValue = Tergabe
End Sub
Private Sub ReadIHDR(Bytefeld() As Byte) '处理文件头数据块
Dim Header As IHDR
CopyMemory ByVal VarPtr(Header), Bytefeld(0), 13
SwapBytesLong Header.Width
SwapBytesLong Header.Height
m_width = Header.Width '图像宽
m_height = Header.Height '图像高
m_bitdepht = Header.BitDepth '颜色深度
m_colortype = Header.ColorType '颜色类型
End Sub
Private Sub MakePicture() '处理图形
Dim Buffer() As Byte '缓冲区
Dim BitCount As Integer, Bitdepht As Long, Drehen As Integer, DataSize As Long
Drehen = 1
DataSize = DataPerRow * m_height '非隔行扫描方法
ReDim Buffer(UBound(IDATData) - 2)
CopyMemory Buffer(0), IDATData(2), UBound(IDATData) - 1
Decompress Buffer, DataSize '使用压缩
Buffer = DeFilter(Buffer)
Drehen = 1
BitCount = m_bitdepht '颜色深度
Select Case m_colortype '根据颜色类型处理
Case 0 '灰度图像
Select Case m_bitdepht '根据颜色深度处理
Case 16
Conv16To8 Buffer
InitColorTable_Grey 8
BitCount = 8
BPPprivat = 8
Case 8, 4, 1
BitCount = m_bitdepht
InitColorTable_Grey m_bitdepht, False
Align32 BitCount, Buffer
Case 2
InitColorTable_Grey 2
Pal2To8 Buffer, DataPerRow
BitCount = 8
BPPprivat = 8
End Select
Case 2 '真彩图像
If m_bitdepht = 16 Then Conv16To8 Buffer
BitCount = 24
BPPprivat = 24
ReverseRGB Buffer
Drehen = 1
BPPprivat = 8
Align32 BitCount, Buffer
BPPprivat = 24
Case 3 '索引彩图
Select Case m_bitdepht
Case 8, 4, 1
BitCount = m_bitdepht
If BitCount >= 8 Then Align32 BitCount, Buffer
Case 2
BitCount = 8
BPPprivat = 8
Align32 BitCount, Buffer
End Select
Case 4 '带α通道数据的灰度图像
If m_bitdepht = 16 Then Conv16To8 Buffer
GrayAToRGBA Buffer
BPPprivat = 32
BitCount = 32
MirrorData Buffer, LineBytes(BitCount)
Drehen = 0
MakeAlpha Buffer
BPPprivat = 24
BitCount = 24
Case 6 '带α通道数据的真彩色图像
If m_bitdepht = 16 Then Conv16To8 Buffer
BitCount = 32
BPPprivat = 32
ReverseRGBA Buffer
MirrorData Buffer, LineBytes(BitCount)
Drehen = 0
MakeAlpha Buffer
BPPprivat = 24
BitCount = 24
End Select
If Not (((m_colortype = 3) And (BitCount = 32)) Or (m_bitdepht = 2)) Then If m_bitdepht = 16 Then Bitdepht = 16
Select Case BitCount '根据颜色深度处理
Case 1
Align32 BitCount, Buffer
Select Case m_colortype
Case 3: InitColorTable_1Palette Palettenbyte
Case Else: InitColorTable_1
End Select
CreateBitmap_1 Buffer, True, Colorused
DrawBitmap
Case 2
Align32 BitCount, Buffer
Case 4
Align32 BitCount, Buffer
Select Case m_colortype
Case 0
Case Else
InitColorTable_4 Palettenbyte
End Select
CreateBitmap_4 Buffer, True, Colorused
DrawBitmap
Case 8
Select Case m_colortype
Case 0, 4
Case Else
InitColorTable_8 Palettenbyte
End Select
Drehen = 1
CreateBitmap_8 Buffer, Drehen, Colorused
DrawBitmap
Case 24
CreateBitmap_24 Buffer, Drehen, 1
DrawBitmap
Case 32
CreateBitmap_24 Buffer, Drehen
DrawBitmap
End Select
End Sub
'解压缩
Private Function Decompress(ByteArray() As Byte, UncompressedSize As Long, Optional ZIP64 As Boolean = False) As Long
Dim IsLastBlock As Boolean, CompType As Long, Char As Long, Nubits As Long
Dim L1 As Long, L2 As Long, x As Long, k As Integer
UncompressedSize = UncompressedSize + 100
InStream = ByteArray
Call Init_Decompress(UncompressedSize)
Do
IsLastBlock = GetBits(1)
CompType = GetBits(2)
If CompType = 0 Then
If Inpos + 4 > UBound(InStream) Then Decompress = -1: Exit Do
Do While BitNum >= 8
Inpos = Inpos - 1
BitNum = BitNum - 8
Loop
CopyMemory L1, InStream(Inpos), 2&
CopyMemory L2, InStream(Inpos + 2), 2&
Inpos = Inpos + 4
If L1 - (Not (L2) And &HFFFF&) Then Decompress = -2
If Inpos + L1 - 1 > UBound(InStream) Then Decompress = -1: Exit Do
If OutPos + L1 - 1 > UBound(OutStream) Then Decompress = -1: Exit Do
CopyMemory OutStream(OutPos), InStream(Inpos), L1
OutPos = OutPos + L1
Inpos = Inpos + L1
ByteBuff = 0
BitNum = 0
ElseIf CompType = 3 Then
Decompress = -1
Exit Do
Else
If CompType = 1 Then
If Create_Static_Tree <> 0 Then
MsgBox "Error in tree creation (Static)"
Exit Function
End If
Else
If Create_Dynamic_Tree <> 0 Then
MsgBox "Error in tree creation (Static)"
Exit Function
End If
End If
Do
NeedBits MaxLLenght
Nubits = MinLLenght
Do While LitLen.Lenght(ByteBuff And BitMask(Nubits)) <> Nubits
Nubits = Nubits + 1
Loop
Char = LitLen.code(ByteBuff And BitMask(Nubits))
DropBits Nubits
If Char < 256 Then
OutStream(OutPos) = Char
OutPos = OutPos + 1
ElseIf Char > 256 Then
Char = Char - 257
L1 = LC.code(Char) + GetBits(LC.Lenght(Char))
If (L1 = 258) And ZIP64 Then L1 = GetBits(16) + 3
NeedBits MaxDLenght
Nubits = MinDLenght
Do While Dist.Lenght(ByteBuff And BitMask(Nubits)) <> Nubits
Nubits = Nubits + 1
Loop
Char = Dist.code(ByteBuff And BitMask(Nubits))
DropBits Nubits
L2 = dc.code(Char) + GetBits(dc.Lenght(Char))
For x = 1 To L1
If OutPos > UncompressedSize Then
OutPos = UncompressedSize
GoTo Stop_Decompression
End If
OutStream(OutPos) = OutStream(OutPos - L2)
OutPos = OutPos + 1
Next x
End If
Loop While Char <> 256 'EOB
End If
Loop While Not IsLastBlock
Stop_Decompression:
If OutPos > 0 Then
ReDim Preserve OutStream(OutPos - 1)
Else
Erase OutStream
End If
Erase InStream, BitMask, Pow2, LC.code, LC.Lenght, dc.code, dc.Lenght
Erase Dist.code, Dist.Lenght, LenOrder, LitLen.code, LitLen.Lenght
ByteArray = OutStream
End Function
Private Function Create_Static_Tree() '创建静态结构
Dim x As Long, Lenght(287) As Long
If IsStaticBuild = False Then
For x = 0 To 143: Lenght(x) = 8: Next
For x = 144 To 255: Lenght(x) = 9: Next
For x = 256 To 279: Lenght(x) = 7: Next
For x = 280 To 287: Lenght(x) = 8: Next
If Create_Codes(TempLit, Lenght, 287, MaxLLenght, MinLLenght) <> 0 Then
Create_Static_Tree = -1
Exit Function
End If
For x = 0 To 31: Lenght(x) = 5: Next
Create_Static_Tree = Create_Codes(TempDist, Lenght, 31, MaxDLenght, MinDLenght)
IsStaticBuild = True
Else
MinLLenght = 7
MaxLLenght = 9
MinDLenght = 5
MaxDLenght = 5
End If
LitLen = TempLit: Dist = TempDist
End Function
Private Function Create_Dynamic_Tree() As Long '创建动态结构
Dim Lenght() As Long
Dim Bl_Tree As CodesType
Dim MinBL As Long, MaxBL As Long, NumLen As Long, Numdis As Long, NumCod As Long
Dim Char As Long, Nubits As Long, LN As Long, Pos As Long, x As Long
NumLen = GetBits(5) + 257
Numdis = GetBits(5) + 1
NumCod = GetBits(4) + 4
ReDim Lenght(18)
For x = 0 To NumCod - 1: Lenght(LenOrder(x)) = GetBits(3): Next
For x = NumCod To 18: Lenght(LenOrder(x)) = 0: Next
If Create_Codes(Bl_Tree, Lenght, 18, MaxBL, MinBL) <> 0 Then Create_Dynamic_Tree = -1: Exit Function
ReDim Lenght(NumLen + Numdis)
Pos = 0
Do While Pos < NumLen + Numdis
NeedBits MaxBL
Nubits = MinBL
Do While Bl_Tree.Lenght(ByteBuff And BitMask(Nubits)) <> Nubits
Nubits = Nubits + 1
Loop
Char = Bl_Tree.code(ByteBuff And BitMask(Nubits))
DropBits Nubits
If Char < 16 Then
Lenght(Pos) = Char
Pos = Pos + 1
Else
If Char = 16 Then
If Pos = 0 Then Create_Dynamic_Tree = -5: Exit Function
LN = Lenght(Pos - 1)
Char = 3 + GetBits(2)
ElseIf Char = 17 Then
Char = 3 + GetBits(3)
LN = 0
Else
Char = 11 + GetBits(7)
LN = 0
End If
If Pos + Char > NumLen + Numdis Then Create_Dynamic_Tree = -6: Exit Function
Do While Char > 0
Char = Char - 1
Lenght(Pos) = LN
Pos = Pos + 1
Loop
End If
Loop
If Create_Codes(LitLen, Lenght, NumLen - 1, MaxLLenght, MinLLenght) <> 0 Then
Create_Dynamic_Tree = -1
Exit Function
End If
For x = 0 To Numdis: Lenght(x) = Lenght(x + NumLen): Next
Create_Dynamic_Tree = Create_Codes(Dist, Lenght, Numdis - 1, MaxDLenght, MinDLenght)
End Function
vb_load_png.zip