我就是试试能不能问问题发300分

[咸清]

DGI+画图，谁有好用的类模块。发上来分享一下

[贝隆]

[Quote=引用 23 楼 jhone99 的回复:]
DGI （Direct Gasoline Injection），汽油高压直喷技术。 　　按照可燃混合气形成的控制方式，缸内直喷方式可分为油束控制燃烧、壁面控制燃烧和气流控制燃烧三类。
[/Quote]
强悍

[咸清]

[Quote=引用 24 楼 jhone99 的回复:]

Veron_04审题有问题，俺这个才能得300
[/Quote]
Veron_04 正合我意～～赏
jhone99

[神马被哪个妞占用了呢]

楼上简直一黑哨……

[咸清]

技术贴，顶帖没分的⋯⋯

[贝隆]

'Download:http://www.codefans.net
Option Explicit

Public Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, graphics As Long) As GpStatus
Public Declare Function GdipCreateFromHWND Lib "gdiplus" (ByVal hwnd As Long, graphics As Long) As GpStatus
Public Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As GpStatus
Public Declare Function GdipGetDC Lib "gdiplus" (ByVal graphics As Long, hdc As Long) As GpStatus
Public Declare Function GdipReleaseDC Lib "gdiplus" (ByVal graphics As Long, ByVal hdc As Long) As GpStatus
Public Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal graphics As Long, ByVal image As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As GpStatus
Public Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, image As Long) As GpStatus
Public Declare Function GdipCloneImage Lib "gdiplus" (ByVal image As Long, cloneImage As Long) As GpStatus
Public Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long, Width As Long) As GpStatus
Public Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long, Height As Long) As GpStatus
Public Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hpal As Long, bitmap As Long) As GpStatus
Public Declare Function GdipBitmapGetPixel Lib "gdiplus" (ByVal bitmap As Long, ByVal x As Long, ByVal y As Long, color As Long) As GpStatus
Public Declare Function GdipBitmapSetPixel Lib "gdiplus" (ByVal bitmap As Long, ByVal x As Long, ByVal y As Long, ByVal color As Long) As GpStatus
Public Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As GpStatus
Public Declare Function GdipCreateBitmapFromFile Lib "gdiplus" (ByVal filename As Long, bitmap As Long) As GpStatus

Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const WM_SYSCOMMAND = &H112

Public Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End Type

Public Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
Public Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)

Public Enum GpStatus
   Ok = 0
   GenericError = 1
   InvalidParameter = 2
   OutOfMemory = 3
   ObjectBusy = 4
   InsufficientBuffer = 5
   NotImplemented = 6
   Win32Error = 7
   WrongState = 8
   Aborted = 9
   FileNotFound = 10
   ValueOverflow = 11
   AccessDenied = 12
   UnknownImageFormat = 13
   FontFamilyNotFound = 14
   FontStyleNotFound = 15
   NotTrueTypeFont = 16
   UnsupportedGdiplusVersion = 17
   GdiplusNotInitialized = 18
   PropertyNotFound = 19
   PropertyNotSupported = 20
End Enum

[贝隆]

http://www.programbbs.com/doc/2942.htm

[whatafuckinglongname]

没听过DGi+，只听说过GDI+，呵呵
以前在枕善居上看到一个据说是初中生写的代码，对GDI+很熟悉的样子。

[咸清]

我也写过一个模块，不过不够通用，看看大家有没有更好滴

[神马被哪个妞占用了呢]

小雨可以试试看能不能把300分全部结给5楼……
而且还可以试试看这样做的后果会怎么样……

[神马被哪个妞占用了呢]

[Quote=引用 6 楼 yiguangqiang88 的回复:]
小雨可以试试看能不能把300分全部结给5楼……
而且还可以试试看这样做的后果会怎么样……
[/Quote]
好吧，6楼好了

[帝企鹅已被占用]

升了

[神马被哪个妞占用了呢]

好吧，我知道捣蛋的没分……
恭喜下……

[咸清]

我试过了，结贴失败～

别打岔，技术贴

[lxq19851204]

技术贴就来水一水，小鱼生的好快~~

[孤独剑_LPZ]

试过了

[咸清]

[Quote=引用 12 楼 asftrhgjhkjlkttttttt 的回复:]

试过了
[/Quote]
[Quote=引用 9 楼 yiguangqiang88 的回复:]
好吧，我知道捣蛋的没分……
恭喜下……
[/Quote]

[Quote=引用 11 楼 lxq19851204 的回复:]

技术贴就来水一水，小鱼生的好快~~
[/Quote]

[咸清]

赶紧上好东西，俺好结贴

[贝隆]

赶紧结贴，俺好多接分

[贝隆]

类模块第一部分：

Option Explicit

'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：05/04/18
'描  述：打开并显示PNG图片的源码
'网  站：http://www.mndsoft.com/blog/
'e-mail：[e-mail]
'OICQ  : 88382850
'****************************************************************************
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As Any, 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 CreateCompatibleDC Lib "gdi32" (ByVal hdc 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 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 Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
Private Type BITMAPINFOHEADER
 Size As Long
 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
 ClrImportant As Long
End Type
Private RBD As Long
Private IDATData() As Byte
Dim IdataLen As Long
Private Type IHDR
 Width As Long
 Height As Long
 BitDepth As Byte
 ColorType As Byte
 Compression As Byte
 Filter As Byte
 Interlacing As Byte
End Type
'For Decompression:
Private Type CodesType
 Lenght() As Long
 code() As Long
End Type
Private m_Backcolor As Long
Private Palettenbyte() As Byte
Private OutStream() As Byte
Private OutPos As Long
Private InStream() As Byte
Private Inpos As Long
Private ByteBuff As Long
Private BitNum As Long
Private BitMask(16) As Long
Private Pow2(16) As Long
Private LC As CodesType
Private dc As CodesType
Private LitLen As CodesType
Private Dist As CodesType
Private TempLit As CodesType
Private TempDist As CodesType
Private LenOrder(18) As Long
Private MinLLenght As Long
Private MaxLLenght As Long
Private MinDLenght As Long
Private MaxDLenght As Long
Private IsStaticBuild As Boolean
Private BPPprivat As Long
Private m_width As Long
Private m_height As Long
Private m_bitdepht As Long
Private m_colortype As Long
Private m_compression As Long
Private m_filter As Long
Private m_interlacing As Long
Private m_ErrorNumber As Long
Private m_sAlpha As Boolean
Private m_hAlpha As Boolean
Private trns() As Byte
Private m_hTrans As Boolean
Private m_sTrans As Boolean
Private Colorused As Long
Private bkgd() As Byte
Private m_hbkgd As Boolean
Private m_bkgdColor As Long
Private m_text As String
Private m_Time As String
Private m_ztext As String
Private m_gama As Long
Private m_Bgx As Long
Private m_Bgy As Long
Private m_BGPic As Object
Private m_OwnBkgnd As Boolean
Private m_OBCol As Long
Private m_PicBox As Object
Private m_settoBG As Boolean

Public Function OpenPNG(filename As String) As Long
    Dim Stand As Long
    Dim Ende As Boolean
    Dim Filenumber As Long
    Dim Signature(7) As Byte
    Dim Test As Long
    Dim Lge As Long
    Dim ChunkName As String * 4
    Dim ChunkInhalt() As Byte
    Dim CRC32Inhalt As Long
    Dim Teststring As String
    'Dim crc32test As New clsCRC
    Dim TestCRC32 As Long
    Dim Testint As Integer
    m_hbkgd = False
    m_hTrans = False
    BPPprivat = 0
    ReDim IDATData(0)
    IdataLen = 0
    Filenumber = FreeFile
    Open filename For Binary As Filenumber
    Get Filenumber, , Signature
    Test = IsValidSignature(Signature)
    If Test <> -1 Then
     m_ErrorNumber = 1
     Exit Function
    End If
    Do While Ende = False
    Get Filenumber, , Lge
    SwapBytesLong Lge
    Get Filenumber, , ChunkName
    If Lge > 0 Then ReDim ChunkInhalt(Lge - 1)
    Stand = Seek(Filenumber)
    If Stand + Lge > LOF(Filenumber) Then
     m_ErrorNumber = 3
     Exit Function
    End If
    Get Filenumber, , ChunkInhalt
    Get Filenumber, , CRC32Inhalt
    'SwapBytesLong CRC32Inhalt
    'teststring = ChunkName & StrConv(ChunkInhalt, vbUnicode)
    'Testcrc32 = CRC32(teststring) 'reiner VB-Code
    'crc32test.Algorithm = 1
    'TestCRC32 = crc32test.CalculateString(teststring) 'VB und Assembler
    'If CRC32Inhalt <> 0 Then
    'If CRC32Inhalt <> TestCRC32 Then
    'MsgBox "Bad crc32"
    'm_ErrorNumber = 2
    'Exit Function
    'End If
    'End If
    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 "bKGD"
    bkgd = ChunkInhalt
    ReadBkgd
    m_hbkgd = True
    Case "cHRM"
    Case "oFFs"
    Case "pCaL"
    Case "sCAL"
    Case "gAMA"
    CopyMemory ByVal VarPtr(m_gama), ChunkInhalt(0), 4
    SwapBytesLong m_gama
    Case "hIST"
    Case "pHYs"
    Case "sBIT"
    Case "tEXt"
    m_text = m_text & StrConv(ChunkInhalt, vbUnicode) & Chr(0)
    Case "zTXt"
    DecompressText ChunkInhalt
    Case "gIFg"
    Case "gIFx"
    Case "tIME"
    CopyMemory ByVal VarPtr(Testint), ChunkInhalt(0), 2
    Swap Testint
    m_Time = Format(ChunkInhalt(3), "00") & "." & Format(ChunkInhalt(2), "00") & "." & Testint & " " & Format(ChunkInhalt(4), "00") & ":" & Format(ChunkInhalt(5), "00") & ":" & Format(ChunkInhalt(6), "00")
    Case "tRNS"
    m_hTrans = True
    trns = ChunkInhalt
    Case "cTXt"
    Case Else
    'If Asc(Left(ChunkName, 1)) > 65 Then Exit Function 'kritischer Chunk
    End Select
    Loop
    If IdataLen = 0 Then
    m_ErrorNumber = 4
    Exit Function
    End If
    Close Filenumber
    MakePicture
End Function

[贝隆]

类模块第二部分：

Private Function IsValidSignature(Signature() As Byte) As Boolean
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 ergabe As Long
Dim i As Long
For i = 0 To 3
CopyMemory ByVal VarPtr(ergabe) + i, ByVal VarPtr(ByteValue) + (3 - i), 1
Next i
ByteValue = ergabe
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
m_compression = Header.Compression
m_filter = Header.Filter
m_interlacing = Header.Interlacing
End Sub
Public Property Get Width() As Long
Width = m_width
End Property
Public Property Get Height() As Long
Height = m_height
End Property
Public Property Get Bitdepht() As Long
Bitdepht = m_bitdepht
End Property
Public Property Get ColorType() As Long
ColorType = m_colortype
End Property
Public Property Get Compression() As Long
Compression = m_compression
End Property
Public Property Get Filter() As Long
Filter = m_filter
End Property
Public Property Get Interlacing() As Long
Interlacing = m_interlacing
End Property
Private Sub MakePicture()
Dim DataSize As Long
Dim Buffer() As Byte
Dim BitCount As Integer
Dim Bitdepht As Long
Dim Drehen As Integer
m_hAlpha = False
Drehen = 1
Select Case Me.Interlacing
Case 0
 DataSize = DataPerRow * Me.Height
Case 1
 DataSize = (DataPerRow * Me.Height) + Me.Height
End Select
 ReDim Buffer(UBound(IDATData) - 2)
 CopyMemory Buffer(0), IDATData(2), UBound(IDATData) - 1
Select Case Me.Compression
Case 0
 Decompress Buffer, DataSize
End Select
Select Case Me.Interlacing
Case 0
 Buffer = DeFilter(Buffer)
 Drehen = 1
Case 1
 Buffer = DeFilterInterlaced(Buffer)
 Drehen = 0
End Select
 BitCount = Me.Bitdepht
Select Case Me.ColorType
Case 0 'Grayscale
Select Case Me.Bitdepht
Case 16
 Conv16To8 Buffer
 InitColorTable_Grey 8
 BitCount = 8
 BPPprivat = 8
Case 8, 4, 1
Select Case Interlacing
Case 0
 BitCount = Me.Bitdepht
 InitColorTable_Grey Me.Bitdepht, False
 Align32 BitCount, Buffer
Case Else
 BitCount = 8
 InitColorTable_Grey Me.Bitdepht, True
End Select
Case 2
 InitColorTable_Grey 2
If Me.Interlacing = 0 Then
 Pal2To8 Me.Width, Me.Height, Buffer, DataPerRow
End If
 BitCount = 8
 BPPprivat = 8
End Select
If m_hTrans And m_sTrans Then
If Me.Bitdepht <> 2 Then
 Align32 BitCount, Buffer
End If
 PalToRGBA Me.Width, Me.Height, BitCount, Buffer
 BitCount = 32
 BPPprivat = 32
 MakeAlpha m_BGPic, Buffer, m_Bgx, m_Bgy
 BitCount = 24
 BPPprivat = 24
End If
Case 2 'RGB
If Me.Bitdepht = 16 Then Conv16To8 Buffer
 BitCount = 24
 BPPprivat = 24
 ReverseRGB Buffer
 Drehen = 1
 BPPprivat = 8
 Align32 BitCount, Buffer
 BPPprivat = 24
If m_hTrans And m_sTrans Then
 MakeRGBTransparent Buffer
 MirrorData Buffer, Me.Width * 4
 Drehen = 0
 BitCount = 32
 BPPprivat = 32
 MakeAlpha m_BGPic, Buffer, m_Bgx, m_Bgy
 BitCount = 24
 BPPprivat = 24
End If
Case 3 'Palette
Select Case Me.Bitdepht
Case 8, 4, 1
If Me.Interlacing = 1 Then
 BitCount = 8
 BPPprivat = 8
 Align32 BitCount, Buffer
Else
 BitCount = Me.Bitdepht
If BitCount >= 8 Then
 Align32 BitCount, Buffer
End If
End If
Case 2
If Me.Interlacing = 0 Then
 Pal2To8 Me.Width, Me.Height, Buffer, DataPerRow
 BitCount = 8
 BPPprivat = 8
Else
 BitCount = 8
 BPPprivat = 8
 Align32 BitCount, Buffer
End If
End Select
If m_hTrans And m_sTrans Then
If Me.Bitdepht <> 2 Then
 Align32 BitCount, Buffer
End If
 PalToRGBA Me.Width, Me.Height, BitCount, Buffer
 BitCount = 32
 BPPprivat = 32
 MakeAlpha m_BGPic, Buffer, m_Bgx, m_Bgy
 BitCount = 24
 BPPprivat = 24
End If
Case 4 'Grayscale + Alpha
 m_hAlpha = True
If Me.Bitdepht = 16 Then Conv16To8 Buffer
 GrayAToRGBA Buffer
 BPPprivat = 32
 BitCount = 32
 MirrorData Buffer, LineBytes(Me.Width, BitCount)
 Drehen = 0
If m_sAlpha = True Then
 MakeAlpha m_BGPic, Buffer, m_Bgx, m_Bgy
 BPPprivat = 24
 BitCount = 24
End If
Case 6 'RGB + Alpha
 m_hAlpha = True
If Me.Bitdepht = 16 Then Conv16To8 Buffer
 BitCount = 32
 BPPprivat = 32
 ReverseRGBA Buffer
 MirrorData Buffer, LineBytes(Me.Width, BitCount)
 Drehen = 0
If m_sAlpha = True Then
 MakeAlpha m_BGPic, Buffer, m_Bgx, m_Bgy
 BPPprivat = 24
 BitCount = 24
End If
End Select
If Not (((Me.ColorType = 3) And (BitCount = 32)) Or _
 (Me.Bitdepht = 2)) Then
Select Case Me.Bitdepht
Case 16
 Bitdepht = 8
 Bitdepht = 16
End Select
End If
Select Case BitCount
Case 1, 2, 4
 Align32 BitCount, Buffer
End Select
Select Case BitCount
Case 1
Select Case Me.ColorType
Case 3
 InitColorTable_1Palette Palettenbyte
Case Else
 InitColorTable_1
End Select
 CreateBitmap_1 Buffer, Me.Width, Me.Height, True, Colorused
 DrawBitmap Me.Width, Me.Height, m_PicBox, True, m_Bgx, m_Bgy, m_settoBG
Case 4
Select Case Me.ColorType
Case 0
Case Else
 InitColorTable_4 Palettenbyte
End Select
 CreateBitmap_4 Buffer, Me.Width, Me.Height, True, Colorused
 DrawBitmap Me.Width, Me.Height, m_PicBox, True, m_Bgx, m_Bgy, m_settoBG
Case 8
Select Case Me.ColorType
Case 0, 4
Case Else
 InitColorTable_8 Palettenbyte
End Select
 Drehen = 1
 CreateBitmap_8 Buffer, Me.Width, Me.Height, Drehen, Colorused
 DrawBitmap Me.Width, Me.Height, m_PicBox, True, m_Bgx, m_Bgy, m_settoBG
Case 24
 CreateBitmap_24 Buffer, Me.Width, Me.Height, Drehen, 1
 DrawBitmap Me.Width, Me.Height, m_PicBox, True, m_Bgx, m_Bgy, m_settoBG
Case 32
 CreateBitmap_24 Buffer, Me.Width, Me.Height, Drehen
 DrawBitmap Me.Width, Me.Height, m_PicBox, True, m_Bgx, m_Bgy, m_settoBG
End Select
End Sub
Private Function Decompress(ByteArray() As Byte, UncompressedSize As Long, Optional ZIP64 As Boolean = False) As Long
Dim IsLastBlock As Boolean
Dim CompType As Long
Dim Char As Long
Dim Nubits As Long
Dim L1 As Long
Dim L2 As Long
Dim x As Long
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
End If
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
End If
If OutPos + L1 - 1 > UBound(OutStream) Then
 Decompress = -1
 Exit Do
End If
 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
Erase BitMask
Erase Pow2
Erase LC.code
Erase LC.Lenght
Erase dc.code
Erase dc.Lenght
Erase LitLen.code
Erase LitLen.Lenght
Erase Dist.code
Erase Dist.Lenght
Erase LenOrder
ByteArray = OutStream
End Function