两个BMP图片合成问题

Question

我要实现的功能：
　　创建两个TBitmap对象A和B。
　　Ａ载入一个100×100象素的图片，Ｂ载入一个50×50的图片。Ａ做为背景，把Ｂ合成到Ａ上。合成要求：　　1.Ｂ靠Ａ上边缘居中显示。　
　　2.在Ａ下边缘居中输出文字“你好”。
写成一个函数，例如：Function HeCheng(A,b:TBitmap):TBitmap;返回值为合成的新图。
　　

Answer 1

最好发两个样图过来[email protected]

Answer 2

function Foo(Background, TopPic: TBitmap): TBitmap;
const
  CSText  = '你好';
var
  X, Y  : Integer;
  clrTranBak  : TColor;
  IsTransBak  : Boolean;
begin
  Result  := TBitmap.Create;
  Result.Assign(Background);
  with TopPic do
  begin
    clrTranBak  := TransparentColor;
    IsTransBak  := Transparent;
    TransparentColor  := clWhite;
    Transparent := True;
  end;  with Result, Canvas do
  try
    X := (Width - TopPic.Width)shr 1;
    Y := 0;
    Draw(X, Y, TopPic);    Font.Color  := clWhite;
    Font.Size   := 12;
    Brush.Style := bsClear;
    Y := Height - TextHeight(CSText);
    X := (Width - TextWidth(CSText))shr 1;
    TextOut(X, Y, CSText);
  finally
    with TopPic do
    begin
      TransparentColor  := clrTranBak;
      Transparent := IsTransBak;
    end;
  end;
end;

Answer 3

随手写了一个，看看是否合适：
function HeCheng(A,b:TBitmap):TBitmap;
var
  i,j: integer;
  p1,p2 : pByteArray;
  r: TRect;
begin
  A.PixelFormat := pf32bit;
  b.PixelFormat := pf32bit;
  for i := 0 to B.height-1 do
  begin
    p1 := A.ScanLine[i];
    p2 := B.ScanLine[i];
    for j := 100 to (4 * (A.Width-25)) - 1 do
    begin
      if P2[j-100] <> 255  then
        p1[j] := p1[j] + (p2[j-100] - p1[j]) div 3;
    end;
  end;
  r.Top := A.Height - A.Canvas.TextHeight('你好');
  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;

Answer 4

-_-....感谢楼主看得起
我只会用一个TCanvas.CopyRect方法:
var
  R: TRect;
begin
  R.Left := (B1.Width-B2.Width) div 2;
  R.Top := 0;
  R.Right := R.Left + B2.Width;
  R.Bottom := B2.Height;
  B1.Canvas.CopyRect(R, B2.Canvas, B2.Canvas.ClipRect);
  B1.Canvas.TextOut(B1.Width-60, B1.Height-20, '你好');
  Image1.Picture.Bitmap.Assign(B1);
end;

Answer 5

B1 = Ａ
B2 = Ｂ很专业的方法 + 特效 + .... 我就不会了,向您推荐个图像处理名人: maozefa

Answer 6

要将白色都去掉的话，还是需要修改一下
应该需要判断最每四个字节中的前三个连续字节的值全部位255（分别位G,B,R，全部位255的时候位白色）
所以代码修改如下：
function HeCheng(A,b:TBitmap):TBitmap;
var
  i,j: integer;
  p1,p2 : pByteArray;
  r: TRect;
begin
  A.PixelFormat := pf32bit;
  b.PixelFormat := pf32bit;
  for i := 0 to B.height-1 do
  begin
    p1 := A.ScanLine[i];
    p2 := B.ScanLine[i];
    j := 100;
    while j < 4 * (A.Width-25) do
    begin
      if (p2[j - 100] = 255) and (p2[j-99] = 255) and (p2[j-98]=255) then
        inc(j,4)
      else
      begin
        p1[j] := p1[j] + (p2[j-100] - p1[j]) div 3;
        inc(j);
      end;
    end;
  end;
  r.Top := A.Height - A.Canvas.TextHeight('你好');
  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;

Answer 7

在修改一下，改成支持将B融合到A上时，B的透明度的设置function HeCheng(A,b:TBitmap;const TransPercent: integer=50):TBitmap;
//TransPercent指定为透明度为1-100
var
  i,j: integer;
  p1,p2 : pByteArray;
  r: TRect;
begin
  A.PixelFormat := pf32bit;
  b.PixelFormat := pf32bit;
  for i := 0 to B.height-1 do
  begin
    p1 := A.ScanLine[i];
    p2 := B.ScanLine[i];
    j := 100;
    while j < 4 * (A.Width-25) do
    begin
      if (p2[j - 100] = 255) and (p2[j-99] = 255) and (p2[j-98]=255) then
        inc(j,4)
      else
      begin
        p1[j] := p1[j] + TransPercent*(p2[j-100] - p1[j]) div 100;
        inc(j);
      end;
    end;
  end;
  r.Top := A.Height - A.Canvas.TextHeight('你好');
  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;

Answer 8

var
  bmp100,bmp50: TBitmap;
  str: String;
  sz:TSize;
  rc: TRECT;
begin
  bmp100 := TBitmap.Create;
  try
    bmp100.LoadFromFile('c:\100.bmp');
    bmp50 := TBitmap.Create;
    try
      bmp50.LoadFromFile('c:\50.bmp');
      BitBlt( PaintBox1.Canvas.Handle,0,0,100,100,bmp100.Canvas.Handle,0,0,SRCCOPY);
      TransparentBlt( PaintBox1.Canvas.Handle,25,0,50,50,bmp50.Canvas.Handle,0,0,50,50,clWhite);
      str := '你好';
      GetTextExtentPoint32( PaintBox1.Canvas.Handle,PAnsiChar(str),Length(str),sz);
      rc.Left := (100 - sz.cx) div 2;
      rc.Top := 100 - sz.cy;
      rc.Right := rc.Left + sz.cx;
      rc.Bottom := rc.Top + sz.cy;
      PaintBox1.Canvas.Brush.Style := bsClear;
      DrawText(PaintBox1.Canvas.Handle,PAnsiChar(str),Length(str),rc,DT_VCENTER + DT_CENTER)
    finally
      bmp50.free;
    end;
  finally
    bmp100.Free;
  end;end;

Answer 9

windows gdi对DIB（设备无关位图）有许多内建的支持功能，用不着那么麻烦非得自己算，效率还不一定比gdi更高

Answer 10

var
  bmp100,bmp50: TBitmap;
  str: String;
  sz:TSize;
  rc: TRECT;
begin
  bmp100 := TBitmap.Create;
  try
    bmp100.LoadFromFile('c:\100.bmp');
    bmp50 := TBitmap.Create;
    try
      bmp50.LoadFromFile('c:\50.bmp');      PaintBox1.Width := bmp100.Width;
      PaintBox1.Height := bmp100.Height;
      //复制原图
      BitBlt(   PaintBox1.Canvas.Handle
              , 0
              , 0
              , bmp100.Width
              , bmp100.Height
              , bmp100.Canvas.Handle
              , 0
              , 0
              , SRCCOPY
              );
      //透明方式复制(白色为透明色)
      TransparentBlt(   PaintBox1.Canvas.Handle
                      , (bmp100.Width - bmp50.Width) div 2
                      , 0
                      , bmp50.Width
                      , bmp50.Height
                      , bmp50.Canvas.Handle
                      , 0
                      , 0
                      , bmp50.Width
                      , bmp50.Height
                      , clWhite
                      );      str := '你好';
      //取得文字占位高度和宽度（象素数）
      GetTextExtentPoint32(   PaintBox1.Canvas.Handle
                            , PAnsiChar(str)
                            , Length(str)
                            , sz
                            );      //计算文字位置
      rc.Left := (100 - sz.cx) div 2;
      rc.Top := 100 - sz.cy;
      rc.Right := rc.Left + sz.cx;
      rc.Bottom := rc.Top + sz.cy;
      //透明画笔
      PaintBox1.Canvas.Brush.Style := bsClear;
      //写字
      DrawText(PaintBox1.Canvas.Handle,PAnsiChar(str),Length(str),rc,DT_VCENTER + DT_CENTER)
    finally
      bmp50.free;
    end;
  finally
    bmp100.Free;
  end;end;

Answer 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] = 255) and (p2[j-MinBegin]=255) then
        inc(j,4)
      else
      begin
        p1[j] := p1[j] + TransPercent * (p2[j-MinBegin] - p1[j]) div 100;
        inc(j);
      end;
    end;
  end;
  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;