关于图像合成所引申的几个函数

于是，随手写的一个函数，具体代码如下：

{作者：不得闲

 2009-02-11}

function HeCheng(A,b:TBitmap;const TransPercent: integer=50):TBitmap;
var
  i,j: integer;
  p1,p2: PByteArray;
  count,MinBegin: Integer;
  MinHeight: integer;
  MinWidth,MaxWidth: Integer;
  r: TRect;
begin
  A.PixelFormat := pf32bit;
  b.PixelFormat := pf32bit;

  MinHeight := Min(A.Height,B.Height);
  MinWidth := Min(A.Width,B.Width);
  MaxWidth := Max(A.Width,B.Width);

  MinBegin := 4 * ((MaxWidth - MinWidth) Div 2);
  count := 4 * (MaxWidth-(MaxWidth - MinWidth) Div 2 - 1);

  for i := 0 to MinHeight - 1 do
  begin
    if MinHeight = B.Height then
    begin
      p1 := A.ScanLine[i];
      p2 := B.ScanLine[i];
    end
    else
    begin
      p1 := B.ScanLine[i];
      p2 := A.ScanLine[i];
    end;
    j := MinBegin;
    while j < count do
    begin
      if (p2[j - MinBegin] = 255) and (p2[j-MinBegin+1] = 255) and (p2[j-MinBegin+2]=255) then
        inc(j,4)
      else
      begin
        p1[j] := p1[j] + TransPercent * (p2[j-MinBegin] - p1[j]) div 100;
        inc(j);
      end;
    end;
  end;
  if MinHeight = B.Height then
  begin
    r.Top := A.Height - A.Canvas.TextHeight('你好')-5;
    r.Bottom := A.Height;
    r.Left := 0;
    r.Right := A.Width;
    A.Canvas.Brush.Style := bsclear;
    windows.DrawText(A.Canvas.Handle,'你好',-1,r,DT_Center or DT_VCenter or DT_SIngleLine);
    Result := A;
  end
  else
  begin
    r.Top := B.Height - B.Canvas.TextHeight('你好')-5;
    r.Bottom := B.Height;
    r.Left := 0;
    r.Right := B.Width;
    B.Canvas.Brush.Style := bscleae r;
    windows.DrawText(B.Canvas.Handle,'你好',-1,r,DT_Center or DT_VCenter or DT_SIngleLine);
    Result := B;
  end;
end;

这里，我先将位图A和B都转化成了pf32bit，此时每个位图的每个像素点由4个字节存储

存储的方式为 BGRL，所以，总的字节数应该是 4*宽度

过滤掉白色，也就是RGB分别为255的时候，不处理合成则可。

由上面我们又可以引申一个函数，可以用来过滤任何颜色的，也就是说，指定一个颜色，只要图片中含有该颜色的区域就过滤掉，比如，图片B中含有红蓝两色，此时设置一个红色过滤色，哪么合成之后B图中的红色被过滤掉

代码如下：

{-------------------------------------------------------------------------------
  过程名:    TColorToRGB
  作者:      不得闲
  日期:      2009.02.11
  参数:      const Color: TColor; var R, G, B: Byte
  返回值:    无
  用途：     获得颜色的RGB值
-------------------------------------------------------------------------------}
procedure TColorToRGB(const Color: TColor; var R, G, B: Byte);
var
  C: Integer;
begin
  C := ColorToRGB(Color);
  R := C and FF;G:=(Cshr8)andFF;G:=(Cshr8)andFF;
  B := (C shr 16) and $FF;
end;
{-------------------------------------------------------------------------------
  过程名:    HeCheng
  作者:      不得闲
  日期:      2009.02.11
  参数:      A,b: 指定合成位图
            TransPercent: 设置透明度
            ignoreColor:  设置合成时忽略的颜色
            ColorOffset:  透明色的边缘色差(在该色差内的颜色都将忽略掉)

  返回值:    TBitmap
  用途：     合成两张位图
-------------------------------------------------------------------------------}
function HeCheng(A,b:TBitmap;const TransPercent: integer=50;const ignoreColor: TColor = clwhite;Const ColorOffset: byte=0):TBitmap;
var
  i,j: integer;
  p1,p2: PByteArray;
  count,MinBegin: Integer;
  MinHeight: integer;
  MinWidth,MaxWidth: Integer;
  r: TRect;
  RColor,GColor,BColor: Byte;
begin
  A.PixelFormat := pf32bit;
  b.PixelFormat := pf32bit;
  TColorToRGB(ignoreColor,RColor,GColor,BColor);
  
  MinHeight := Min(A.Height,B.Height);
  MinWidth := Min(A.Width,B.Width);
  MaxWidth := Max(A.Width,B.Width);

  MinBegin := 4 * ((MaxWidth - MinWidth) Div 2);
  count := 4 * (MaxWidth-(MaxWidth - MinWidth) Div 2 - 1);

  for i := 0 to MinHeight - 1 do
  begin
    if MinHeight = B.Height then
    begin
      p1 := A.ScanLine[i];
      p2 := B.ScanLine[i];
    end
    else
    begin
      p1 := B.ScanLine[i];
      p2 := A.ScanLine[i];
    end;
    j := MinBegin;
    while j < count do
    begin

      //比较字节的值，位图该点像素的RGB值是否为需要过滤的颜色值，如果是，则过滤掉
      if (abs(p2[j - MinBegin] - BColor)<=ColorOffset) and

         (abs(p2[j-MinBegin+1] - GColor)<=ColorOffset) and

         (abs(p2[j-MinBegin+2]-RColor)<=ColorOffset)  then
        inc(j,4)
      else
      begin
        p1[j] := p1[j] + TransPercent * (p2[j-MinBegin] - p1[j]) div 100;
        inc(j);
      end;
    end;
  end;
  if MinHeight = B.Height then
  begin
    r.Top := A.Height - A.Canvas.TextHeight('你好')-5;
    r.Bottom := A.Height;
    r.Left := 0;
    r.Right := A.Width;
    A.Canvas.Brush.Style := bsclear;
    windows.DrawText(A.Canvas.Handle,'你好',-1,r,DT_Center or DT_VCenter or DT_SIngleLine);
    Result := A;
  end
  else
  begin
    r.Top := B.Height - B.Canvas.TextHeight('你好')-5;
    r.Bottom := B.Height;
    r.Left := 0;
    r.Right := B.Width;
    B.Canvas.Brush.Style := bsclear;
    windows.DrawText(B.Canvas.Handle,'你好',-1,r,DT_Center or DT_VCenter or DT_SIngleLine);
    Result := B;
  end;
end;

比如，现在要透明一个图片合成上去

HeCheng(Image1.Picture.Bitmap,Image4.Picture.Bitmap,100,Image4.Canvas.Pixels[0,0]，20);

在加一个透明图画法的函数，效果不大好

{-------------------------------------------------------------------------------
  过程名:    TransparentDraw
  作者:      不得闲
  日期:      2009.02.12
  参数:      DestCanvas: 目标画布
             DestRect: 目标区域
             Graphic: 位图
             ColorOffset 背景色附近的颜色差值，在该差值之内的颜色，都会被透明掉
  返回值:    无
-------------------------------------------------------------------------------}

procedure TransparentDraw(DestCanvas: TCanvas;DestRect: TRect;Graphic: TBitmap;const ColorOffset: Byte=0);
var
  i,j,Count: integer;
  RectH,RectW: integer;
  p: PByteArray;
  RColor,GColor,BColor: Byte;
begin
  //区域高度
  Graphic.PixelFormat := pf32bit;
  RectH := DestRect.Bottom - DestRect.Top;
  if RectH > Graphic.Height then
    RectH := Graphic.Height;
  RectH := DestRect.Top + RectH;
  RectW := DestRect.Right - DestRect.Left;
  TColorToRGB(Graphic.Canvas.Pixels[0,0],RColor,GColor,BColor);
  if RectW > Graphic.Width then
    RectW := Graphic.Width;
  Count := 4*RectW - 1;
  for i := DestRect.Top to RectH - 1 do
  begin
    p := Graphic.ScanLine[i - DestRect.Top];
    j := 0;
    while j < Count do
    begin
      if (abs(p[j] - BColor)<=ColorOffset) and (abs(p[j+1] - GColor) <= ColorOffset) and (abs(p[j+2] - RColor)<=ColorOffset) then
        inc(j,4)
      else
      begin
        BColor := p[j];
        GColor := p[j + 1];
        RColor := p[j+2];
        DestCanvas.Pixels[j div 4,i] := RGB(RColor,GColor,BColor);
        inc(j,4);
      end;
    end;
  end;
end;

同时，也写下了一个更换图片背景色的函数，代码如下：

{-------------------------------------------------------------------------------
  过程名:    ChangeBmpBackGround
  作者:      不得闲
  日期:      2009.02.12
  参数:      bmp: TBitmap;
             ChangeToBack: 要修改为的背景色
             ColorOffset 背景色附近的颜色差值，在该差值之内的颜色，也会被修改
  返回值:    无
-------------------------------------------------------------------------------}

procedure ChangeBmpBackGround(bmp: TBitmap;ChangeToBack: TColor;const ColorOffset: Byte = 0);
var
  i,j,Count: integer;
  RColor,GColor,BColor: Byte;
  TRColor,TGColor,TBColor: Byte;
  p: PByteArray;
begin
  bmp.PixelFormat := pf32bit;
  TColorToRGB(bmp.Canvas.Pixels[0,0],RColor,GColor,BColor);
  TColorToRGB(ChangeToBack,TRColor,TGColor,TBColor);
  count := 4 * bmp.Width - 1;
  for i := 0 to bmp.Height - 1 do
  begin
    j := 0;
    p := bmp.ScanLine[i];
    while j < count do
    begin
      if (abs(p[j] - BColor)<=ColorOffset) and (abs(p[j+1] - GColor) <= ColorOffset) and (abs(p[j+2] - RColor)<=ColorOffset) then
      begin
         p[j] := TBColor;
         P[j+1] := TGColor;
         p[j+2] := TRColor;
      end;
      inc(j,4);
    end;
  end;
end;

今天在公司由于要用到一个图片遮罩的效果，于是按照同样的思路写了一个图像遮罩函数：

代码如下：

{-------------------------------------------------------------------------------
  过程名:    SoftBmp
  作者:      不得闲
  日期:      2009.02.13
  参数:      bmp: TBitmap;
            DarkRect: 不遮罩的区域
            SoftColor:指定遮罩色

            SoftPercent指定遮罩度（取1-100，100为完全遮罩）

  返回值:    无
-------------------------------------------------------------------------------}

end;

本文转自 不得闲 博客园博客，原文链接： http://www.cnblogs.com/DxSoft/archive/2010/01/01/1637662.html  ，如需转载请自行联系原作者