procedure BmpBlend(bmpIn1,bmpIn2:tbitmap; x1,y1: integer);
type PRGBarray = ^TRGBarray;
    TRGBarray = array[0..30000] of TRGBQuad;
var  x,y,w,h: integer;
    colorLine1,colorLine2 : pRGBarray;
    trfact:real;

function byteSum(op1,op2:byte):byte;
begin
if (op1+op2)>255 then
byteSum:=255 else
byteSum:=op1+op2;
end;

Begin

bmpin2.PixelFormat:=pf32bit;
bmpin1.PixelFormat:=pf32bit;
h:=bmpin2.Height; w:=bmpin2.Width;

for x:=1 to w-1 do begin

  colorline1:=bmpin1.ScanLine[x+x1];
  colorline2:=bmpin2.ScanLine[x];

  for y := 1 to h-1 do  begin

     trfact:=colorline2[y].rgbReserved/255;

     colorline1[y+y1].rgbBlue:=byteSum(trunc(colorline1[y+y1].rgbBlue*trfact),
     trunc(colorline2[y].rgbBlue*(1-trfact)));

     colorline1[y+y1].rgbGreen:=byteSum(trunc(colorline1[y+y1].rgbGreen*trfact),
     trunc(colorline2[y].rgbGreen*(1-trfact)));

     colorline1[y+y1].rgbRed:=byteSum(trunc(colorline1[y+y1].rgbRed*trfact),
     trunc(colorline2[y].rgbRed*(1-trfact)));
  end;
end;
End;