好吧，我承认：这是在无聊中写的一个无聊的图形函数

Question

正在无聊地等待测试机执行完庞大的测试任务。为了避免睡着，随手写了一个画图的过程。 没多大用处，不过是指定图片的透明色然后画透明bitmap到DC，呃，可以一次性指定图片中最多8种颜色都作为透明色。速度还可以。和TBitmap.Draw比较了一下，画1280*1024*24bit图片各100次：指定一种透明色，我的过程耗时2375毫秒，TBitmap.Draw耗时4078毫秒。
指定8种透明色，我的过程耗时2279毫秒，TBitmap.Draw(还是一种透明色）耗时4031毫秒代码奉上：
var
  TransMasks: array [0..2, 0..255] of Byte;procedure TransparentPaint(DC: HDC; x, y: Integer; Bmp: TBitmap; Invert: Boolean;
    ClrCnt: Integer; const TransColors: array of Cardinal);
const
  ROP_DstCopy = $00AA0029;var
  MaskBits:                Pointer;
  mskLnW, srcLnW, srcPxW,
  dln, sln, dpx, spx,
  i, j, w, h:              Integer;
  pxMask, m, bk, fr:       Byte;
  hbmp:                    HBITMAP;begin
  // only support 24/32 bits bitmap
  case Bmp.PixelFormat of
    pf24Bit:
    begin
      srcPxW := 3;
      srcLnW := BytesPerScanLine(Bmp.Width, 24, 32);
    end;
    pf32Bit:
    begin
      srcPxW := 4;
      srcLnW := BytesPerScanLine(Bmp.Width, 32, 32);
    end;
  else
    Exit;
  end;  if Invert then
  begin
    bk := $FF;
    fr := 0;
  end
  else begin
    fr := $FF;
    bk := 0;
  end;  w := Bmp.Width;
  h := Bmp.Height;  // setup transparent masks
  if ClrCnt > 8 then ClrCnt := 8;
  m := 1;
  for i := 0 to ClrCnt-1 do
  begin
    dpx := Integer(@TransColors[i]);
    TransMasks[0, PByte(dpx+2)^] := TransMasks[0, PByte(dpx+2)^] or m;
    TransMasks[1, PByte(dpx+1)^] := TransMasks[1, PByte(dpx+1)^] or m;
    TransMasks[2, PByte(dpx)^] := TransMasks[2, PByte(dpx)^] or m;
    m := m shl 1;
  end;  // calc monochrome bitmap's line width
  mskLnW := ((w+7) shr 3 + 1) and $FFFFFFFE;
  // allocate monochrome bitmap's bits data
  MaskBits := AllocMem(mskLnW * h);  // dln, sln point to first scanline
  dln := Integer(MaskBits);
  sln := Integer(Bmp.ScanLine[0]);
  // calculating mask bitmap
  for i := 1 to h do
  begin
    dpx := dln;
    spx := sln;
    pxMask := $7F;
    for j := 1 to w do
    begin
      m := TransMasks[0, PByte(spx)^] and TransMasks[1, PByte(spx+1)^] and TransMasks[2, PByte(spx+2)^];
      if (m = 0) or ( m or (m-1) <> m + (m-1) ) then // not transparent color, set pixel bit as foreground bit
        PByte(dpx)^ := (PByte(dpx)^ and pxMask) or ((not pxMask) and fr)
      else // is transparent color, set pixel bit as transparent bit
        PByte(dpx)^ := (PByte(dpx)^ and pxMask) or ((not pxMask) and bk);      Inc(spx, srcPxW); // next source pixel      // next dest pixel
      asm
        ROR    pxMask, 1
        JC     @@1
        INC    dpx
      @@1:
      end;    end;
    // next scanline
    Inc(dln, mskLnW);
    Dec(sln, srcLnW);  end;
  // clear transparent masks for next time calling
  for i := 0 to ClrCnt-1 do
  begin
    dpx := Integer(@TransColors[i]);
    TransMasks[0, PByte(dpx+2)^] := 0;
    TransMasks[1, PByte(dpx+1)^] := 0;
    TransMasks[2, PByte(dpx)^] := 0;
  end;
  // generate monochrome bitmap
  hbmp := CreateBitmap(w, h, 1, 1, MaskBits);  // paint
  MaskBlt(DC, x, y, w, h, Bmp.Canvas.Handle, 0, 0, hbmp, 0, 0,
              MakeRop4(SRCCOPY, ROP_DstCopy));  // free memory
  DeleteObject(hbmp);
  FreeMem(MaskBits);end;

Answer 1

OK, 让图片来说明功效. 假设有一幅bmp:要透明地画到界面上, 用TBitmap只能指定一种透明色,比如: 红色, 画出来的效果:红色的地方显示的是背景.用我的过程则可以指定最多8种颜色作为透明色,比如: 红色, 蓝色, 黄色都是透明色, 调用:
DC := GetDC(Handle);
TransparentPaint(DC, 128, 176, Image1.Picture.Bitmap, False, 3, [clRed, clBlue, clYellow]);
ReleaseDC(Handle, DC);
之后效果:所有图片中红色,蓝色,黄色的地方都成为了背景

Answer 2

另外, 如果把定义:
var
  TransMasks: array [0..2, 0..255] of Byte;改成
var
  TransMasks: array [0..2, 0..255] of Cardinal;那么最多就支持32种透明色了, 不过占用内存也增加到了3k

Answer 3

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
   var
  TransMasks: array [0..2, 0..255] of Byte;implementation{$R *.dfm}
 procedure TransparentPaint(DC: HDC; x, y: Integer; Bmp: TBitmap; Invert: Boolean;
    ClrCnt: Integer; const TransColors: array of Cardinal);
const
  ROP_DstCopy = $00AA0029;var
  MaskBits:                Pointer;
  mskLnW, srcLnW, srcPxW,
  dln, sln, dpx, spx,
  i, j, w, h:              Integer;
  pxMask, m, bk, fr:       Byte;
  hbmp:                    HBITMAP;begin
  // only support 24/32 bits bitmap
  case Bmp.PixelFormat of
    pf24Bit:
    begin
      srcPxW := 3;
      srcLnW := BytesPerScanLine(Bmp.Width, 24, 32);
    end;
    pf32Bit:
    begin
      srcPxW := 4;
      srcLnW := BytesPerScanLine(Bmp.Width, 32, 32);
    end;
  else
    Exit;
  end;  if Invert then
  begin
    bk := $FF;
    fr := 0;
  end
  else begin
    fr := $FF;
    bk := 0;
  end;  w := Bmp.Width;
  h := Bmp.Height;  // setup transparent masks
  if ClrCnt > 8 then ClrCnt := 8;
  m := 1;
  for i := 0 to ClrCnt-1 do
  begin
    dpx := Integer(@TransColors[i]);
    TransMasks[0, PByte(dpx+2)^] := TransMasks[0, PByte(dpx+2)^] or m;
    TransMasks[1, PByte(dpx+1)^] := TransMasks[1, PByte(dpx+1)^] or m;
    TransMasks[2, PByte(dpx)^] := TransMasks[2, PByte(dpx)^] or m;
    m := m shl 1;
  end;  // calc monochrome bitmap's line width
  mskLnW := ((w+7) shr 3 + 1) and $FFFFFFFE;
  // allocate monochrome bitmap's bits data
  MaskBits := AllocMem(mskLnW * h);  // dln, sln point to first scanline
  dln := Integer(MaskBits);
  sln := Integer(Bmp.ScanLine[0]);
  // calculating mask bitmap
  for i := 1 to h do
  begin
    dpx := dln;
    spx := sln;
    pxMask := $7F;
    for j := 1 to w do
    begin
      m := TransMasks[0, PByte(spx)^] and TransMasks[1, PByte(spx+1)^] and TransMasks[2, PByte(spx+2)^];
      if (m = 0) or ( m or (m-1) <> m + (m-1) ) then // not transparent color, set pixel bit as foreground bit
        PByte(dpx)^ := (PByte(dpx)^ and pxMask) or ((not pxMask) and fr)
      else // is transparent color, set pixel bit as transparent bit
        PByte(dpx)^ := (PByte(dpx)^ and pxMask) or ((not pxMask) and bk);      Inc(spx, srcPxW); // next source pixel      // next dest pixel
      asm
        ROR    pxMask, 1
        JC     @@1
        INC    dpx
      @@1:
      end;    end;
    // next scanline
    Inc(dln, mskLnW);
    Dec(sln, srcLnW);  end;
  // clear transparent masks for next time calling
  for i := 0 to ClrCnt-1 do
  begin
    dpx := Integer(@TransColors[i]);
    TransMasks[0, PByte(dpx+2)^] := 0;
    TransMasks[1, PByte(dpx+1)^] := 0;
    TransMasks[2, PByte(dpx)^] := 0;
  end;
  // generate monochrome bitmap
  hbmp := CreateBitmap(w, h, 1, 1, MaskBits);  // paint
  MaskBlt(DC, x, y, w, h, Bmp.Canvas.Handle, 0, 0, hbmp, 0, 0,
              MakeRop4(SRCCOPY, ROP_DstCopy));  // free memory
  DeleteObject(hbmp);
  FreeMem(MaskBits);end;procedure TForm1.Button1Click(Sender: TObject);
var
dc:hdc;
begin
  DC := GetDC(Handle);
TransparentPaint(DC, 128, 176, Image1.Picture.Bitmap, False, 3, [clRed, clBlue, clYellow]);
ReleaseDC(Handle, DC);end;end.
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
   var
  TransMasks: array [0..2, 0..255] of Byte;implementation{$R *.dfm}
 procedure TransparentPaint(DC: HDC; x, y: Integer; Bmp: TBitmap; Invert: Boolean;
    ClrCnt: Integer; const TransColors: array of Cardinal);
const
  ROP_DstCopy = $00AA0029;var
  MaskBits:                Pointer;
  mskLnW, srcLnW, srcPxW,
  dln, sln, dpx, spx,
  i, j, w, h:              Integer;
  pxMask, m, bk, fr:       Byte;
  hbmp:                    HBITMAP;begin
  // only support 24/32 bits bitmap
  case Bmp.PixelFormat of
    pf24Bit:
    begin
      srcPxW := 3;
      srcLnW := BytesPerScanLine(Bmp.Width, 24, 32);
    end;
    pf32Bit:
    begin
      srcPxW := 4;
      srcLnW := BytesPerScanLine(Bmp.Width, 32, 32);
    end;
  else
    Exit;
  end;  if Invert then
  begin
    bk := $FF;
    fr := 0;
  end
  else begin
    fr := $FF;
    bk := 0;
  end;  w := Bmp.Width;
  h := Bmp.Height;  // setup transparent masks
  if ClrCnt > 8 then ClrCnt := 8;
  m := 1;
  for i := 0 to ClrCnt-1 do
  begin
    dpx := Integer(@TransColors[i]);
    TransMasks[0, PByte(dpx+2)^] := TransMasks[0, PByte(dpx+2)^] or m;
    TransMasks[1, PByte(dpx+1)^] := TransMasks[1, PByte(dpx+1)^] or m;
    TransMasks[2, PByte(dpx)^] := TransMasks[2, PByte(dpx)^] or m;
    m := m shl 1;
  end;  // calc monochrome bitmap's line width
  mskLnW := ((w+7) shr 3 + 1) and $FFFFFFFE;
  // allocate monochrome bitmap's bits data
  MaskBits := AllocMem(mskLnW * h);  // dln, sln point to first scanline
  dln := Integer(MaskBits);
  sln := Integer(Bmp.ScanLine[0]);
  // calculating mask bitmap
  for i := 1 to h do
  begin
    dpx := dln;
    spx := sln;
    pxMask := $7F;
    for j := 1 to w do
    begin
      m := TransMasks[0, PByte(spx)^] and TransMasks[1, PByte(spx+1)^] and TransMasks[2, PByte(spx+2)^];
      if (m = 0) or ( m or (m-1) <> m + (m-1) ) then // not transparent color, set pixel bit as foreground bit
        PByte(dpx)^ := (PByte(dpx)^ and pxMask) or ((not pxMask) and fr)
      else // is transparent color, set pixel bit as transparent bit
        PByte(dpx)^ := (PByte(dpx)^ and pxMask) or ((not pxMask) and bk);      Inc(spx, srcPxW); // next source pixel      // next dest pixel
      asm
        ROR    pxMask, 1
        JC     @@1
        INC    dpx
      @@1:
      end;    end;
    // next scanline
    Inc(dln, mskLnW);
    Dec(sln, srcLnW);  end;
  // clear transparent masks for next time calling
  for i := 0 to ClrCnt-1 do
  begin
    dpx := Integer(@TransColors[i]);
    TransMasks[0, PByte(dpx+2)^] := 0;
    TransMasks[1, PByte(dpx+1)^] := 0;
    TransMasks[2, PByte(dpx)^] := 0;
  end;
  // generate monochrome bitmap
  hbmp := CreateBitmap(w, h, 1, 1, MaskBits);  // paint
  MaskBlt(DC, x, y, w, h, Bmp.Canvas.Handle, 0, 0, hbmp, 0, 0,
              MakeRop4(SRCCOPY, ROP_DstCopy));  // free memory
  DeleteObject(hbmp);
  FreeMem(MaskBits);end;procedure TForm1.Button1Click(Sender: TObject);
var
dc:hdc;
begin
  DC := GetDC(Handle);
TransparentPaint(DC, 128, 176, Image1.Picture.Bitmap, False, 3, [clRed, clBlue, clYellow]);
ReleaseDC(Handle, DC);end;end.怎么没有透明呢，和楼主测试的不一样？

Answer 4

procedure TForm1.Button2Click(Sender: TObject);
var
dc:hdc;
begin
 DC := GetDC(Handle);
TransparentPaint(DC, 128, 176, Image1.Picture.Bitmap, false, 1, [clRed]);
ReleaseDC(Handle, DC);end;这么测试一下 ，结果显示的是原图，一点没变，红色还在？

Answer 5

我水平有限，写不出楼主这么长而复杂的代码。我一般用gdi+操作，再建一个画布，遍历源图所有像素，将自己需要的颜色在新画布上画上去，也就最终实现了楼主所实现的效果。代码应该很短，但效率有没有楼主的高，这个未经考核。

Answer 6

抠相？没那么容易的，照的相片，背景色不可能是纯色！用楼主的代码应该不行的
抠相常用的做法都是采集左上或右上几个像素的RGB平均分量值，找出关键色，然后再根据分量偏差设定一个阈值来判断源像素点是否需要透明

Answer 7

不能直接用我提供的图片， 那个是JPG图片，是有损压缩的，真实颜色值并不是你看到的，比如红色可能颜色值是$000000FE而不是clRed($000000FF), 而且并不是一块同色区域中的颜色值都相等（尽管你肉眼看上去是一样的）