VB.NETでCCITT Group4圧縮のTIFFファイルを作る

表題の通り。苦戦した。
以下のコードは、テキストボックスにランダムに表示した5000文字の文字データをキャプチャして、G4圧縮TIFFを作成する処理を指定回数繰り返すというツールの一部抜粋。コメントとかはまたいつか整備します。

Private Sub CreateButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CreateButton.Click

    Dim builder As StringBuilder
    Dim rndNumber As Integer
    Dim rndChar As Char

    For count As Integer = 1 To CInt(ImageCount.Text)
        Dim memoryImage As Bitmap
        builder = New StringBuilder
        For i As Integer = 1 To 5000
            'ランダムな文字を追加
            rndNumber = CInt(Int( (122 - 32 + 1) * Rnd() + 32) )
            rndChar = Chr(rndNumber)
            builder.Append(rndChar)
        Next
        ResultText.Clear()
        ResultText.Text = builder.ToString
        Me.Refresh()

        Dim g As Graphics = Me.CreateGraphics()
        Dim img As Bitmap = New Bitmap(Me.Size.Width, Me.Size.Height, g)

        Dim memoryGraphics As Graphics = Graphics.FromImage(img)
        Dim dc1 As IntPtr = g.GetHdc()
        Dim dc2 As IntPtr = memoryGraphics.GetHdc()
        BitBlt(dc2, 0, 0, _
            Me.ClientRectangle.Width, Me.ClientRectangle.Height, _
            dc1, 0, 0, 13369376)
        g.ReleaseHdc(dc1)
        memoryGraphics.ReleaseHdc(dc2)

        System.Windows.Forms.Application.DoEvents()

        'lock the bits of the original bitmap
        Dim bmdo As BitmapData = img.LockBits(New Rectangle(0, 0, img.Width,　img.Height), ImageLockMode.ReadOnly, img.PixelFormat)

        'and the new 1bpp bitmap
        bm = New Bitmap(img.Width, img.Height, PixelFormat.Format1bppIndexed)
        Dim bmdn As BitmapData = bm.LockBits(New Rectangle(0, 0, bm.Width,　bm.Height), ImageLockMode.ReadWrite, PixelFormat.Format1bppIndexed)

        'scan through the pixels Y by X
        Dim y As Integer
        For y = 0 To img.Height - 1
            Dim x As Integer
            For x = 0 To img.Width - 1
                'generate the address of the colour pixel
                Dim index As Integer = y * bmdo.Stride + x * 4
                'check its brightness
                If Color.FromArgb(Marshal.ReadByte(bmdo.Scan0, index + 2), Marshal.ReadByte(bmdo.Scan0, index + 1), Marshal.ReadByte(bmdo.Scan0, index)).GetBrightness() > 0.5F Then
                    Me.SetIndexedPixel(x, y, bmdn, True) 'set it if its bright.
                End If
            Next x
        Next y

        'tidy up
        bm.UnlockBits(bmdn)
        img.UnlockBits(bmdo)

        'ファイル名確定と書き出し
        Dim fileName As String
        fileName = "c:\Temp2\" & CStr(count) & ".tif"

        Dim enc As New System.Drawing.Imaging.EncoderParameters(2)
        Dim codec As System.Drawing.Imaging.ImageCodecInfo = GetEncoderInfo("image/tiff")

        enc.Param(0) = New Imaging.EncoderParameter(Imaging.Encoder.ColorDepth, 1L)
        enc.Param(1) = New Imaging.EncoderParameter(Imaging.Encoder.Compression, EncoderValue.CompressionCCITT4)

        bm.Save(fileName, codec, enc)

    Next

End Sub 'pictureBox1_Click

Private Shared Function GetEncoderInfo(ByVal mineType As String) _
    As System.Drawing.Imaging.ImageCodecInfo
    'GDI+ に組み込まれたイメージ エンコーダに関する情報をすべて取得
    Dim myEncoders() As System.Drawing.Imaging.ImageCodecInfo = _
        System.Drawing.Imaging.ImageCodecInfo.GetImageEncoders()
    '指定されたMimeTypeを探して見つかれば返す
    Dim myEncoder As System.Drawing.Imaging.ImageCodecInfo
    For Each myEncoder In myEncoders
        If myEncoder.MimeType = mineType Then
            Return myEncoder
        End If
    Next
    Return Nothing
End Function

参考文献：