Bitmapの表示色を変更するには

解決


ぽち  2007-03-06 10:45:28  No: 25160  IP: 192.*.*.*

ビットマップで表示している画像の白を黒、黒を白と
反転させて表示したいのですが、ピクセルを調べていって
反転させて行くしかないのでしょうか?
パレットを変更するとうまく行くのかなと思いましたが、
考え方が間違っているのかさっぱりうまく行きません。

よろしくお願いします。

編集 削除
junki  2007-03-06 13:26:49  No: 25161  IP: 192.*.*.*

> 考え方が間違っているのかさっぱりうまく行きません。

どのように書いて、どううまくいかないのですか?

PixelFormat は、pf8bit pf1bit ?

編集 削除
ofZ  2007-03-06 13:50:12  No: 25162  IP: 192.*.*.*

Bitmap.PixelFormat = pf1bit であれば...

procedure paletteChange(aBitmap: TBitmap);
var
  hpt: HPalette;
  lpl: PLogPalette;
  i: Integer;
begin
  //秘密の魔法(意味わからんて)
  aBitmap.PixelFormat := pfDevice;
  {メモリ取得}
  GetMem(lpl, SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * 2);
  {$R-}//範囲チェックエラー回避用
  i := 0;
  //palpalentry[0], palpalentry[1], と書くと、
  //「範囲外の〜」とコンパイルエラーになります
  TColor(lpl^.palpalentry[i]) := clWhite;
  i := 1;
  TColor(lpl^.palpalentry[i]) := clBlack;
  {$R+}
  lpl^.palVersion := $300;  //おまじない
  lpl^.palNumEntries := 2;  //色数
  hpt := CreatePalette(lpl^);
  aBitmap.Palette := hpt;
  //メモリ開放
  FreeMem(lpl);
  //パレット割り当て・・・と解釈すればよいのか?
  SelectPalette(aBitmap.Canvas.Handle, aBitmap.Palette, False);
  //(意味わからんが)論理パレットをシステムパレットにマップする
  RealizePalette(aBitmap.Canvas.Handle);
  //魔法解除(わからんてば)
  aBitmap.PixelFormat := pf1bit;
end;

編集 削除
deldel  2007-03-06 14:22:34  No: 25163  IP: 192.*.*.*

べたなやり方ですが・・・

var
  y, x: Word;
  P1, P2 :PByteArray;
begin
  Image1.Picture.Bitmap.LoadFromFile('C:\aaa.bmp');

  Image2.Picture.Bitmap.Width  := Image1.Picture.Bitmap.Width;
  Image2.Picture.Bitmap.Height := Image1.Picture.Bitmap.Height;
  Image1.Picture.Bitmap.PixelFormat := pf24bit;
  Image2.Picture.Bitmap.PixelFormat := pf24bit;

  for y := 0 to Pred(Image1.Picture.Bitmap.Height) do begin
    P1 := Image1.Picture.Bitmap.ScanLine[y];
    P2 := Image2.Picture.Bitmap.ScanLine[y];
    for x := 0 to Pred(Image1.Picture.Bitmap.Width) do begin
      if (P1[X*3+0] = 0) and (P1[X*3+1] = 0) and (P1[X*3+2] = 0) then begin
        P2[X*3+0] := $FF;
        P2[X*3+1] := $FF;
        P2[X*3+2] := $FF;
      end else

      if (P1[X*3+0] = $FF) and (P1[X*3+1] = $FF) and (P1[X*3+2] = $FF) then begin
        P2[X*3+0] := 0;
        P2[X*3+1] := 0;
        P2[X*3+2] := 0;
      end else

      begin
        P2[X*3+0] := P1[X*3+0];
        P2[X*3+1] := P1[X*3+1];
        P2[X*3+2] := P1[X*3+2];
      end;
    end;
  end;
end;

編集 削除
ぽち  2007-03-06 14:37:49  No: 25164  IP: 192.*.*.*

junkiさん、ofZさん

早速のレス、ありがとうございます。
PixelFormat は pf8bitです。

おかしな事をしてるのだとは思うのですが、以下の通りです。
ご指摘をお願い致します。そもそもパレットの仕組みが、、、

------------------------------------------------------------------------------------
function BW_ColorRevPalette(CoCount: Byte): HPALETTE;
var
  Palette: ^TLogPalette;
  i: Integer;
begin
   GetMem(Palette, SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * CoCount);
   Palette^.palNumEntries := CoCount + 1;
   Palette^.palVersion := $0300;

   for i := 0 to CoCount do begin
     if TColor(Palette^.palPalEntry[i]) = clWhite then
     begin
        TColor(Palette^.palPalEntry[i]) := clBlack;
     end
     else if TColor(Palette^.palPalEntry[i]) = clBlack then
     begin
        TColor(Palette^.palPalEntry[i]) := clWhite;
     end;
   end;

   Result := CreatePalette(Palette^);
   FreeMem(Palette);
end;


procedure TForm1.Button2Click(Sender: TObject);
var
  pal: TMaxLogPalette;
  PalSize: WORD;
  BitMap : TBitMap; //ビットマップオブジェクトの宣言
begin
  BitMap := TBitMap.Create; //ビットマップの生成
  BitMap.LoadFromFile('d:\123.bmp');//pf8bit

  BitMap.Palette := BW_ColorRevPalette(255);

  Form1.Image1.Picture.Bitmap := BitMap;

  Bitmap.Free;
end;

編集 削除
junki  2007-03-06 14:48:00  No: 25165  IP: 192.*.*.*

> PixelFormat は pf8bitです。

あ、それなら簡単です。

http://blog.livedoor.jp/junki560/archives/19148659.html
http://blog.livedoor.jp/junki560/archives/18288210.html

などを見ていただけると分かりますように、グレイスケールのパレットを
エントリを反対にするだけです。

var
  bmp8:TBitmap;
  ct: array[0..255] of TRGBQuad;
  c:TRGBQuad;
  ps:PRGBQuad;
  i,ix,iy:integer;
  cbw:Word;
  pd:PByte;
begin
  bmp.PixelFormat := pf32bit;

  bmp8 := TBitmap.Create;
  bmp8.PixelFormat := pf8bit;
  bmp8.Width := bmp.Width;
  bmp8.Height := bmp.Height;
  for i := 0 to 255 do
  begin
    ct[i].rgbBlue := i;
    ct[i].rgbGreen := i;
    ct[i].rgbRed := i;
    ct[i].rgbReserved := 0;
  end;
  SetDIBColorTable(bmp8.Canvas.Handle,0,255,ct);
  DeleteObject(bmp8.ReleasePalette);

ここでは、エントリの順番にグレイスケールのパレットを設定してますが、これを

ct[i].rgbBlue := 255 - i;

などとするだけです。TBitmap の扱い方は私のブログやHPで詳しく説明しています。

http://blog.livedoor.jp/junki560/archives/30287059.html
http://junki.main.jp/

編集 削除
ぽち  2007-03-06 16:10:40  No: 25166  IP: 192.*.*.*

deldelさん
  ありがとうございます。ぱっちり行けました。
  画像サイズが相当大きくなければ、これで大丈夫そうです。

junkiさん
  追加情報ありがとうございます。
  グレイスケール化はお教え頂いたページのサンプルで簡単に出来たの
  ですが、白を黒・黒を白、その他そのままというのが、いまだに私の
  頭では理解出来ないでいます。もう少し頑張ってみます。

編集 削除
junki  2007-03-06 17:21:42  No: 25167  IP: 192.*.*.*

> 白を黒・黒を白、その他そのままというのが、いまだに私の
>  頭では理解出来ないでいます。もう少し頑張ってみます。

「その他はそのまま」なんですか? ネガティブにするんじゃないのですね。

白は、エントリのRGBが全部255、黒は全部ゼロなんですから、それをパレットの
エントリから探して変更するだけなのでは?

編集 削除
もにゃ  2007-03-06 17:35:03  No: 25168  IP: 192.*.*.*

junkiさんのパレット変更法だと
procedure TForm1.Button1Click(Sender: TObject);
var
  bmp8:TBitmap;
  ct: array[0..255] of TRGBQuad;
  c:TRGBQuad;
  ps:PRGBQuad;
  i,ix,iy:integer;
  cbw:Word;
  pd:PByte;
begin
  bmp8 := TBitmap.Create;
  bmp8.PixelFormat := pf8bit;
  bmp8.LoadFromFile('test.bmp');

  GetDIBColorTable(bmp8.Canvas.Handle,0,255,ct);
  for i := 0 to 255 do
  begin
    ct[i].rgbBlue  := 255 - ct[i].rgbBlue;
    ct[i].rgbGreen := 255 - ct[i].rgbGreen;
    ct[i].rgbRed   := 255 - ct[i].rgbRed;
    ct[i].rgbReserved := 0;
  end;
  SetDIBColorTable(bmp8.Canvas.Handle,0,255,ct);
  DeleteObject(bmp8.ReleasePalette);

  BitBlt(Canvas.Handle,0,0,bmp8.Width,bmp8.Height,bmp8.Canvas.Handle,0,0,SRCCOPY);
  bmp8.Free;
end;
こんな感じですよね。

しかし初めて知ったのですが、BitbltのSRCINVERTじゃだめなんですね。

編集 削除
junki  2007-03-06 17:44:48  No: 25169  IP: 192.*.*.*

手打ちでコンパイルしてないので、タイポがあれば勘弁

function BtoW(bmp8: TBitmap): boolean;
var
  num, i, x, y: integer;
  pe: array[0..255] of TPaletteEntry;
  ct: array[0..255] of TRGBQuad;
begin
  result := false;
  if bmp8.PixelFormat <> pf8bit then exit;
  try
    num := GetPaletteEntries(bmp8.Palette,0,256,pe);
  except
    exit;
  end;

  for i := 0 to num-1 do
  begin
    if (pe[i].peRed = 0) and (pe[i].peGreen = 0) and (pe[i].peBlue = 0) then
    begin
      ct[i].rgbBlue := 255;
      ct[i].rgbGreen := 255;
      ct[i].rgbRed := 255;
    end
    else
    if (pe[i].peRed = 255) and (pe[i].peGreen = 255) and (pe[i].peBlue = 255) then
    begin
      ct[i].rgbBlue := 0;
      ct[i].rgbGreen := 0;
      ct[i].rgbRed := 0;
    end
    else
    begin
      ct[i].rgbBlue := pe[i].peBlue;
      ct[i].rgbGreen := pe[i].peGreen;
      ct[i].rgbRed := pe[i].peRed;
    end
  end;

  SetDIBColorTable(bmp8.Canvas.Handle,0,num-1,ct)
  DeleteObject(bmp8.ReleasePalette);
  
  result := true;
end;

編集 削除
junki  2007-03-06 17:49:12  No: 25170  IP: 192.*.*.*

あー

> SetDIBColorTable(bmp8.Canvas.Handle,0,num-1,ct)

これは

SetDIBColorTable(bmp8.Canvas.Handle,0,num,ct)

かもしれません。

編集 削除
もにゃ  2007-03-06 17:50:32  No: 25171  IP: 192.*.*.*

ネガポジじゃ無いのか!
ごみレスすまそ!

編集 削除
ぽち  2007-03-06 18:22:29  No: 25172  IP: 192.*.*.*

junkiさん、もにゃさん

  junkiさんのソースにて無事動きました〜。ありがとうございます。
  結局自分のソースでは動いて悲しいですが、junkiさんのソースも
  完全に理解しているわけではないので、まずはしっかりと読み解いて
  1つ1つ理解していこうと思います。

  SetDIBColorTable(bmp8.Canvas.Handle,0,num,ct)、
  SetDIBColorTable(bmp8.Canvas.Handle,0,num-1,ct)のどちらでも
  動きました。何が違うのかも理解しなければです。

  大変お手数をお掛けいたしました。助かりました。

編集 削除