Delphi绘制Alpha图像的函数

最近在整理代码的时候发现了这个函数,但是原作者是谁我已经不知道了,修正了里面的一个bug,然后把alpha修改为0-255个级别!(原来为10)

 

 1 procedure DrawAlpha(bmpBack, bmpFore : TBitmap; TransColor : TColor; OffX, OffY : Integer; Alpha : Integer);
 2 
 3 type
 4   TRGBArray = array[0..32767] of TRGBTriple;
 5   PRGBArray = ^TRGBArray;
 6 
 7 var
 8   X, Y     : Integer;
 9   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 > 255) or
      (Alpha < 0) then
     Alpha := 255;
 
   for y := 0 to bmpFore.Height - 1 do
   begin
     // scan bitmap rows
     if (y > bmpBack.Width) then
           Continue;
     rowBack := bmpBack.ScanLine[y + OffY];
     rowFore := bmpFore.ScanLine[y];
     for x := 0 to bmpFore.Width - 1 do
     begin
     if (x+offx>bmpBack.Width) then
           Continue;
     // 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 * (255 - Alpha))   + (rowFore[x].rgbtRed * abs(Alpha-255)))div 255;
       rowBack[x + OffX].rgbtGreen := ((rowBack[x + OffX].rgbtGreen) * (255 - Alpha) + (rowFore[x].rgbtGreen * Abs(Alpha-255)))div 255;
       rowBack[x + OffX].rgbtBlue  := ((rowBack[x + OffX].rgbtBlue) * (255 - Alpha)  + (rowFore[x].rgbtBlue * Abs(Alpha-255)))div 255;
     end;
   end;
   end;
 end;

下面的是使用的例子

 1 procedure TForm1.Button2Click(Sender: TObject);
 2 begin
 3   // set color depth to 16.7mio colors (24 bit)
 4   // because the loaded bitmaps are 8 bit
 5   img1.Picture.Bitmap.PixelFormat := pf24bit;
 6   img2.Picture.Bitmap.PixelFormat := pf24bit;
 7 
 8   DrawAlpha(img1.Picture.Bitmap, img2.Picture.Bitmap, clFuchsia, 10, 10, 5);
 9 
   // update image1 (result)
   img1.Invalidate;
 end;