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

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 := (C shr 8) and $FF;
  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为完全遮罩）

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

procedure SoftBmp(bmp: TBitmap;var DarkRect: TRect;const SoftColor: TColor;const SoftPercent: Integer=50);
var
  i,j : integer;
  pB : PByteArray;
  BmpFormatXs: Integer;
  w,h:Integer;
  R,G,B: Integer;
begin
  if bmp.PixelFormat <> pf32bit then 
    bmp.PixelFormat := pf32bit;
  BmpFormatXs := 4;

  w:= DarkRect.Right - DarkRect.Left;
  h:= DarkRect.Bottom - DarkRect.Top;
 
  if DarkRect.Right > bmp.Width then
  begin
    DarkRect.Left:=bmp.Width - w;
    DarkRect.Right:=bmp.Width;
  end;
  if (DarkRect.Bottom > bmp.Height) then
  begin
    DarkRect.Top:= bmp.Height - h;
    DarkRect.Bottom:=bmp.Height;
  end;
  if DarkRect.Left <0 then
  begin
    DarkRect.Left:=0;
    DarkRect.Right:=w;
  end;
  if DarkRect.Top <0 then
  begin
    DarkRect.Top:=0;
    DarkRect.Bottom:=h;
  end;
  TColorToRGB(SoftColor,R,G,B);
  for i := 0 to DarkRect.Top - 1 do
  begin
    pb:=bmp.ScanLine[i];
    j := 0;
    while j < BmpFormatXs*bmp.Width - 1 do
    begin
      pb[j] := B + (100-SoftPercent) * (pb[j] - B) div 100;
      pb[j+1] := G + (100-SoftPercent) * (pb[j+1] - G) div 100;
      pb[j+2] := R + (100-SoftPercent) * (pb[j+2]-R) div 100;
      inc(j,BmpFormatXs);
    end;
  end;

  for i := DarkRect.Top to bmp.Height - 1 do
  begin
    pb:=bmp.ScanLine[i];
    j := 0;
    while j < BmpFormatXs*DarkRect.Left - 1 do
    begin
      pb[j] := B + (100-SoftPercent) * (pb[j] - B) div 100;
      pb[j+1] := G + (100-SoftPercent) * (pb[j+1] - G) div 100;
      pb[j+2] := R + (100-SoftPercent) * (pb[j+2]-R) div 100;
      inc(j,BmpFormatXs);
    end;
  end;
  for i := DarkRect.Bottom to bmp.Height - 1 do
  begin
    pb:=bmp.ScanLine[i];
    j := BmpFormatXs*DarkRect.Left;
    while j < BmpFormatXs*bmp.Width - 1 do
    begin
      pb[j] := B + (100-SoftPercent) * (pb[j] - B) div 100;
      pb[j+1] := G + (100-SoftPercent) * (pb[j+1] - G) div 100;
      pb[j+2] := R + (100-SoftPercent) * (pb[j+2]-R) div 100;
      inc(j,BmpFormatXs);
    end;
  end;

  for i := DarkRect.Top to DarkRect.Bottom - 1 do
  begin
    pb:=bmp.ScanLine[i];
    j := BmpFormatXs*DarkRect.Right;
    while j < BmpFormatXs*bmp.Width - 1 do
    begin
      pb[j] := B + (100-SoftPercent) * (pb[j] - B) div 100;
      pb[j+1] := G + (100-SoftPercent) * (pb[j+1] - G) div 100;
      pb[j+2] := R + (100-SoftPercent) * (pb[j+2]-R) div 100;
      inc(j,BmpFormatXs);
    end;
  end;
end;

• ·Delphi从普通对象方法转换到回调函数
• ·Delphi操作Word的几个知识点
• ·Delphi写StringGrid导出到Excel转换函数
• ·Variant的相关函数
• ·关于跨进程使用回调函数的研究,以跨进程获取Richedit中RTF流为例
• ·一个将HTML代码转换成IHTMLDocument2接口的函数
• ·BCB/Delphi中常用的VCL函数说明
• ·Delphi中使用汇编(关于POS函数的问题)
• ·Delphi与汇编学习4(两个转16进制的函数)
• ·Delphi检测对象有方法时是否为纯虚函数
• ·Delphi中的静态虚拟及动态方法函数的区别
• ·Delphi无限位四则运算的几个函数
• ·Delphi分割字符串的函数ExtractStrings
• ·Delphi过程函数传递参数的几种方式
• ·Pos函数(比FastPos还要快)
• ·Delphi中Stream到Variant的转化函数
• ·Delphi计算汉字笔划的函数
• ·Delphi函数Shl与Shr介绍说明
• ·Delphi写的验证身份证号有效性函数
• ·Delphi中GetTickCount函数原型及其用途