タイトル：TBitmap.PixelFormat変換で生じる色化けを回避する

　TBitmap.PixelFormat を pf24bit に設定してフルカラーに変換
したり pf15bit に設定してハイカラーに変換するのは正常に行わ
れるが、pf16bit に設定するととんでもない色になってしまいます。
　それから pf4bit から pf8bit に変換する際も、パレットの数
に余裕があるのだから正しく変換できなければいけないのにシステ
ムパレットの影響を受けて色化けしてしまうことがあります。

　これらを回避する例として２つの関数を出します。

    pf24bit_to_pf16bit // pf24bit から pf16bit に変換する
    pf4bit_to_pf8bit   // pf4bit から pf8bit に変換する

　下記のサンプルコードではエラー処理（例外の発生など）を
抜いています。実際に使う場合には適宜手を入れてください。


function pf24bit_to_pf16bit(Dst, Src: TBitmap): Boolean;
var
  bmp: HBITMAP;
  pbi: PBitmapInfo;
  pBits: Pointer;
  x, y: Integer;
  pSrc: PRGBQUAD;
  pDst: PWORD;
begin
  Result := FALSE;
  if not Assigned(Src)
    or Src.Empty
    or (Src.PixelFormat <> pf24bit)then
    Exit;
  // Src.PixelFormat := pf24bit; // とするのもありかも？
  
  pbi := AllocMem(sizeof(BITMAPINFO) + sizeof(DWORD) * 3);
  try
    with pbi^.bmiHeader do
    begin
      biSize := sizeof(BITMAPINFOHEADER);
      biPlanes := 1;
      biBitCount := 16;
      biWidth := Src.Width;
      biHeight := Src.Height;
      biCompression := BI_BITFIELDS;
    end;
    
    // BITFIELDS の設定
    PWORDARRAY(@(pbi^.bmiColors[0]))^[0] := $f800; // 5 bits
    PWORDARRAY(@(pbi^.bmiColors[0]))^[2] := $07e0; // 6 bits
    PWORDARRAY(@(pbi^.bmiColors[0]))^[4] := $001f; // 5 bits
    
    // ビットマップの作成
    bmp := CreateDIBSection(0, pbi^, DIB_RGB_COLORS, pBits, 0, 0);
    if bmp <> HBITMAP(0) then
    try
      // なぜか GetDIBits ＡＰＩでは良い結果が出ない（バグ？）
      // のでライン毎に変換しています。
      for y := 0 to Src.Height - 1 do
      begin
        pSrc := PRGBQUAD(Src.ScanLine[y]);
        pDst := PWORD(Integer(pBits) +
          ((Src.Width * 2 + 3)and -4) // １ラインのバイト数
          * (Src.Height - 1 - y));
        // ライン毎に変換する
        for x := 0 to Src.Width - 1 do
        begin
          pDst^ :=
            (pSrc^.rgbBlue shr 3)                 // 5 bits
            or((pSrc^.rgbGreen shr 2) shl 5)      // 6 bits
            or(DWORD(pSrc^.rgbRed shr 3) shl 11); // 5 bits
          Inc(Integer(pSrc), 3);
          Inc(pDst);
        end;
      end;
      Result := TRUE;
    finally
      // ビットマップを出力先に設定する
      Dst.Handle := bmp;
    end;
  finally
    FreeMem(pbi);
  end;
end;

function pf4bit_to_pf8bit(Dst, Src: TBitmap): Boolean;
var
  bmp: HBITMAP;
  pbi: PBitmapInfo;
  pBits: Pointer;
  x, y: Integer;
  pSrc: PBYTE;
  pDst: PBYTE;
begin
  Result := FALSE;
  if not Assigned(Src)
    or Src.Empty
    or (Src.PixelFormat <> pf4bit)then
    Exit;
  
  pbi := AllocMem(sizeof(BITMAPINFO) + sizeof(RGBQUAD) * 16);
  try
    with pbi^.bmiHeader do
    begin
      biSize := sizeof(BITMAPINFOHEADER);
      biPlanes := 1;
      biBitCount := 8;
      biWidth := Src.Width;
      biHeight := Src.Height;
      biClrUsed :=
        // パレットの色を取得する
        GetDIBColorTable(Src.Canvas.Handle, 0, 16, pbi^.bmiColors[0]);
    end;
    
    // ビットマップの作成
    bmp := CreateDIBSection(0, pbi^, DIB_RGB_COLORS, pBits, 0, 0);
    if bmp <> HBITMAP(0) then
    try
      // なぜか GetDIBits ＡＰＩでは良い結果が出ない（バグ？）
      // のでライン毎に変換しています。
      for y := 0 to Src.Height - 1 do
      begin
        pSrc := PBYTE(Src.ScanLine[y]);
        pDst := PBYTE(Integer(pBits) +
          ((Src.Width + 3)and -4) // １ラインのバイト数
          * (Src.Height - 1 - y));
        // ライン毎に変換する
        for x := 0 to Src.Width - 1 do
        begin
          pDst^ := pSrc^ shr (not x and 1 * 4) and $f;
          Inc(pSrc, x and 1);
          Inc(pDst);
        end;
      end;
      Result := TRUE;
    finally
      // ビットマップを出力先に設定する
      Dst.Handle := bmp;
    end;
  finally
    FreeMem(pbi);
  end;
end;

1999/10/13、河邦 正（GCC02240@nifty.ne.jp）
（http://member.nifty.ne.jp/kht0000/ 自作ComponentのNifty外へ公開用）

Original document by 河邦 正         氏 ID:(GCC02240)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。