Keen LZW Compressor in VB.NET

Function CompressLZW(Data As IO.Stream, MaxBits As Byte) As IO.MemoryStream
        Dim out As New IO.MemoryStream
        Dim bits As New List(Of Byte)
        Dim dict As New List(Of Byte())
        For x = 0 To 255
            dict.Add({x})
        Next
        dict.Add({})
        dict.Add({})
        Dim usebits As Byte = 9
        Dim PutCode = Sub(Code As UInteger)
                          For x = usebits To 1 Step -1
                              If Code - (2 ^ (x - 1)) >= 0 Then
                                  Code -= 2 ^ (x - 1)
                                  bits.Add(1)
                              Else
                                  bits.Add(0)
                              End If
                          Next
                      End Sub
        Dim AddToDict = Function(Entry As Byte()) As Boolean
                            If dict.Count < 2 ^ MaxBits Then
                                dict.Add(Entry)
                                If dict.Count = 2 ^ (usebits - 1) Then usebits = Math.Min(usebits + 1, MaxBits)
                                Return True
                            Else
                                Return False
                            End If
                        End Function
        Dim FindCode = Function(Bytes As Byte()) As UInteger
                           For x = 1 To dict.Count
                               If dict(x - 1).SequenceEqual(Bytes) Then Return x - 1
                           Next
                           Throw New NotFiniteNumberException
                       End Function
        Dim DictContains = Function(Bytes As Byte()) As Boolean
                               For x = 1 To dict.Count
                                   If dict(x - 1).Length = Bytes.Length Then
                                       If dict(x - 1).SequenceEqual(Bytes) Then Return True
                                   End If
                               Next
                               Return False
                           End Function
        Dim match As Byte() = {Data.ReadByte}
        Do Until Data.Position = Data.Length
            Dim nbyte As Byte = Data.ReadByte
            Dim nmatch As Byte() = match.Concat({nbyte}).ToArray
            If DictContains(nmatch) Then
                match = nmatch
            Else
                If AddToDict(nmatch) Then
                    PutCode(dict.Count - 1)
                Else
                    PutCode(FindCode(match))
                End If
                match = {nbyte}
            End If
        Loop
        PutCode(FindCode(match))
        PutCode(257)
        Do Until bits.LongCount Mod 8L = 0L
            bits.Add(0)
        Loop
        For x = 1 To CInt(bits.LongCount / 8L)
            Dim b As Byte = 0
            For y = 0 To 7
                b += bits((x - 1) * 8 + y) * (2 ^ (7 - y))
            Next
            out.WriteByte(b)
        Next
        out.Position = 0
        Return out
    End Function