[<<D>>]

procedure DrawAlpha(bmpBack, bmpFore : TBitmap; TransColor : TColor; OffX, OffY : Integer; Alpha : Integer);

type
TRGBArray = array[0..32767] of TRGBTriple;
PRGBArray = ^TRGBArray;

var
X, Y : Integer;
rowFore,
rowBack : PRGBArray;

begin
// check bitmaps
if not Assigned(bmpBack) or
not Assigned(bmpFore) then
Exit;

// check color depth
if (bmpFore.PixelFormat <> pf24bit) or
(bmpBack.PixelFormat <> pf24bit) then
Exit;

// check dimensions
if (bmpFore.Height + OffY > bmpBack.Height) or
(bmpFore.Width + OffX > bmpBack.Width) then
Exit;

// check alpha value
if (Alpha > 10) or
(Alpha < 1) then
Alpha := 10;

for y := 0 to bmpFore.Height - 1 do
begin
// scan bitmap rows
rowBack := bmpBack.ScanLine[y + OffY];
rowFore := bmpFore.ScanLine[y];
for x := 0 to bmpFore.Width - 1 do
// if not transparent color
if not ((rowFore[x].rgbtRed = GetRValue(TransColor)) and
(rowFore[x].rgbtGreen = GetGValue(TransColor)) and
(rowFore[x].rgbtBlue = GetBValue(TransColor))) then
// calculate new pixel value
begin
rowBack[x + OffX].rgbtRed := ((rowBack[x + OffX].rgbtRed * (10 - Alpha)) + (rowFore[x].rgbtRed * Alpha)) div 10;
rowBack[x + OffX].rgbtGreen := ((rowBack[x + OffX].rgbtGreen) * (10 - Alpha) + (rowFore[x].rgbtGreen * Alpha)) div 10;
rowBack[x + OffX].rgbtBlue := ((rowBack[x + OffX].rgbtBlue) * (10 - Alpha) + (rowFore[x].rgbtBlue * Alpha)) div 10;
end;
end;
end;





В таймере (interval=50) :

image1.Picture.Bitmap.PixelFormat := pf24bit;
image2.Picture.Bitmap.PixelFormat := pf24bit;
DrawAlpha(image1.Picture.Bitmap, image2.Picture.Bitmap, clFuchsia, 0, 0, 2);
image1.Invalidate;