C# と VB.NET の質問掲示板

24bit画像をインデックス画像に変換したいのですが、
https://teratail.com/questions/67361
ここに書かれてあるように

using (var srcFs = new FileStream(@"src.bmp", FileMode.Open))
{
    using (var srcBmp = new Bitmap(srcFs))
    {
        using (var dstFs = new FileStream(@"dst.bmp", FileMode.Create, FileAccess.Write))
        {
            var dstBmp = srcBmp.Clone(new Rectangle(0, 0, srcBmp.Width, srcBmp.Height), PixelFormat.Format8bppIndexed);
            dstBmp.Save(dstFs, ImageFormat.Bmp);
        }
    }
}

これで確かに変換することができるのですが、
色合いが変わってしまいます。
例えば、
RGB=10, 59, 118
の色が
RGB=0, 50, 102
に変わったりします。

大体は再現できているのですが、少し変化してしまいます。

IrfanviewやPhotoshopを使えば、綺麗に変換することができるのですが、
VBやC#ではどのようにすれば良いですか？

ありがとうございます。

デフォルトではそのような機能はないのですね。

検索すると高速な変換コードが見つかりました。

http://www.wischik.com/lu/programmer/1bpp.html

これをVBに書き換えてみたのですが
エラーなくインデックス画像は出力されるのですが、
元画像と比べてかなり暗い色になってしまいます。

どこに変換ミスがあるか見ていただけないでしょうか？





    Private Function CopyToBpp(ByVal b As System.Drawing.Bitmap, ByVal bpp As Integer) As System.Drawing.Bitmap
        If ((bpp <> 1) _
                     AndAlso (bpp <> 8)) Then
            Throw New System.ArgumentException("1 or 8", "bpp")
        End If

        Dim h As Integer = b.Height
        Dim w As Integer = b.Width
        Dim hbm As IntPtr = b.GetHbitmap
        ' this is step (1)
        '
        ' Step (2): create the monochrome bitmap.
        ' "BITMAPINFO" is an interop-struct which we define below.
        ' In GDI terms, it's a BITMAPHEADERINFO followed by an array of two RGBQUADs
        Dim bmi As BITMAPINFO = New BITMAPINFO
        bmi.biSize = 40
        ' the size of the BITMAPHEADERINFO struct
        bmi.biWidth = w
        bmi.biHeight = h
        bmi.biPlanes = 1
        ' "planes" are confusing. We always use just 1. Read MSDN for more info.
        bmi.biBitCount = CType(bpp, Short)
        ' ie. 1bpp or 8bpp
        bmi.biCompression = BI_RGB
        ' ie. the pixels in our RGBQUAD table are stored as RGBs, not palette indexes
        bmi.biSizeImage = CType((((w + 7) And 4294967288) * (h / 8)), UInteger)
        bmi.biXPelsPerMeter = 1000000
        ' not really important
        bmi.biYPelsPerMeter = 1000000
        ' not really important
        ' Now for the colour table.
        Dim ncols As UInteger = CUInt(1 + bpp)
        ' 2 colours for 1bpp; 256 colours for 8bpp
        bmi.biClrUsed = ncols
        bmi.biClrImportant = ncols
        bmi.cols = New UInteger((256) - 1) {}
        ' The structure always has fixed size 256, even if we end up using fewer colours
        If (bpp = 1) Then
            bmi.cols(0) = MAKERGB(0, 0, 0)
            bmi.cols(1) = MAKERGB(255, 255, 255)
        Else
            Dim i As Integer = 0
            Do While (i < ncols)
                bmi.cols(i) = MAKERGB(i, i, i)
                i = (i + 1)
            Loop

        End If

        ' For 8bpp we've created an palette with just greyscale colours.
        ' You can set up any palette you want here. Here are some possibilities:
        ' greyscale: for (int i=0; i<256; i++) bmi.cols[i]=MAKERGB(i,i,i);
        ' rainbow: bmi.biClrUsed=216; bmi.biClrImportant=216; int[] colv=new int[6]{0,51,102,153,204,255};
        '          for (int i=0; i<216; i++) bmi.cols[i]=MAKERGB(colv[i/36],colv[(i/6)%6],colv[i%6]);
        ' optimal: a difficult topic: http://en.wikipedia.org/wiki/Color_quantization
        ' 
        ' Now create the indexed bitmap "hbm0"
        Dim bits0 As IntPtr
        ' not used for our purposes. It returns a pointer to the raw bits that make up the bitmap.
        Dim hbm0 As IntPtr = CreateDIBSection(IntPtr.Zero, bmi, DIB_RGB_COLORS, bits0, IntPtr.Zero, 0)
        '
        ' Step (3): use GDI's BitBlt function to copy from original hbitmap into monocrhome bitmap
        ' GDI programming is kind of confusing... nb. The GDI equivalent of "Graphics" is called a "DC".
        Dim sdc As IntPtr = GetDC(IntPtr.Zero)
        ' First we obtain the DC for the screen
        ' Next, create a DC for the original hbitmap
        Dim hdc As IntPtr = CreateCompatibleDC(sdc)
        SelectObject(hdc, hbm)
        ' and create a DC for the monochrome hbitmap
        Dim hdc0 As IntPtr = CreateCompatibleDC(sdc)
        SelectObject(hdc0, hbm0)
        ' Now we can do the BitBlt:
        BitBlt(hdc0, 0, 0, w, h, hdc, 0, 0, SRCCOPY)
        ' Step (4): convert this monochrome hbitmap back into a Bitmap:
        Dim b0 As System.Drawing.Bitmap = System.Drawing.Bitmap.FromHbitmap(hbm0)
        '
        ' Finally some cleanup.
        DeleteDC(hdc)
        DeleteDC(hdc0)
        ReleaseDC(IntPtr.Zero, sdc)
        DeleteObject(hbm)
        DeleteObject(hbm0)
        '
        Return b0
    End Function

    <System.Runtime.InteropServices.StructLayout(System.Runtime.InteropServices.LayoutKind.Sequential)>
    Public Structure BITMAPINFO

        Public biSize As UInteger
        Public biWidth As Integer
        Public biHeight As Integer
        Public biPlanes As Short
        Public biBitCount As Short
        Public biCompression As UInteger
        Public biSizeImage As UInteger
        Public biXPelsPerMeter As Integer
        Public biYPelsPerMeter As Integer
        Public biClrUsed As UInteger
        Public biClrImportant As UInteger

        <System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValArray, SizeConst:=256)>
        Public cols() As UInteger
    End Structure


    Public Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As IntPtr) As Boolean

    Public Declare Function GetDC Lib "user32.dll" (ByVal hwnd As IntPtr) As IntPtr

    Public Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As IntPtr

    Public Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As IntPtr, ByVal hdc As IntPtr) As Integer

    Public Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As Integer

    Public Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As IntPtr, ByVal hgdiobj As IntPtr) As IntPtr

    Public Declare Function BitBlt Lib "gdi32.dll" (ByVal hdcDst As IntPtr, ByVal xDst As Integer, ByVal yDst As Integer, ByVal w As Integer, ByVal h As Integer, ByVal hdcSrc As IntPtr, ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal rop As Integer) As Integer

    Private SRCCOPY As Integer = 13369376

    Private Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal hdc As IntPtr, ByRef bmi As BITMAPINFO, ByVal Usage As UInteger, ByRef bits As IntPtr, ByVal hSection As IntPtr, ByVal dwOffset As UInteger) As IntPtr

    Private BI_RGB As UInteger = 0

    Private DIB_RGB_COLORS As UInteger = 0

    Private Function MAKERGB(ByVal r As Integer, ByVal g As Integer, ByVal b As Integer) As UInteger
        Return (CType((b And 255), UInteger) _
                     Or (CType(((r And 255) _
                     + 8), UInteger) Or CType(((g And 255) _
                     + 16), UInteger)))
    End Function