Anonymous

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, GIFImg, ExtDlgs, jpeg, pngimage;
type
  TRGBArray = ARRAY[0..32767] OF TRGBTriple; // pf24bit
  pRGBArray = ^TRGBArray;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

                                                    //250 = 100% transparent
function Alpha_Blend(Src, Watermark: TBitmap; X, Y, Alpha: Integer): Boolean;
var
  p1, p2,
  pe1, pe2: PByte;
  Inc1, Inc2 : integer;
  Line1, Line2 : pRGBArray;
  AColor : TColor;
  Rct, srcR, wmR : TRect;
  xx, yy, z : integer;
  r, g, b : byte;
  trans : boolean;
  Table: array[-255..255] of Smallint;
begin
  if (Src.PixelFormat <> pf24bit) or (Watermark.PixelFormat <> pf24bit) then
    raise Exception.Create('Bitmaps must be 24 bit');
 
  for xx := -255 to 255 do
    Table[xx] := (Alpha * xx) shr 8;
 
  wmR := Rect(X, Y, X +Watermark.Width -1, Y +Watermark.Height -1);
  srcR := Rect(0, 0, Src.Width -1, Src.Height -1);
  result := IntersectRect(Rct, srcR, wmR);
 
  if not result then
    exit;

 
  p1 := Src.Scanline[0];
  Inc1 := integer(Src.Scanline[1]) - integer(p1);
  pe1 := p1;
  Inc(pe1, Inc1 *Src.Height);
 
  p2 := Watermark.Scanline[0];
  Inc2 := integer(Watermark.Scanline[1]) - integer(p2);
  pe2 := p2;
  Inc(pe2, Inc2 *Watermark.Height);
 
  trans := Watermark.Transparent;
  if trans then begin
    AColor := ColorToRGB(Watermark.TransparentColor);

    r := GetRValue(AColor);
    g := GetGValue(AColor);
    b := GetBValue(AColor);
  end;
 
  yy := 0;
  repeat
    Line1 := pRGBArray(p1);
 
    if (yy >= Rct.Top) and (yy <= Rct.Bottom) then begin
      Line2 := pRGBArray(p2);
 
      for xx := Rct.Left to Rct.Right do begin
        z := xx -Rct.Left;
 
        if trans and (Line2[z].rgbtBlue = b) and
          (Line2[z].rgbtGreen = g) and (Line2[z].rgbtRed = r) then
            continue;
 
        Line1[xx].rgbtBlue := Table[Line1[xx].rgbtBlue - Line2[z].rgbtBlue] + Line2[z].rgbtBlue;
        Line1[xx].rgbtGreen := Table[Line1[xx].rgbtGreen - Line2[z].rgbtGreen] + Line2[z].rgbtGreen;
        Line1[xx].rgbtRed := Table[Line1[xx].rgbtRed - Line2[z].rgbtRed] + Line2[z].rgbtRed;
      end;
 
      Inc(p2, Inc2);
    end;
    Inc(yy);

    Inc(p1, Inc1);
  until (yy > Rct.Bottom) or (p1 = pe1) or (p2 = pe2);

  result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Src, Wm : TBitmap;
  A: TImage;
begin
  Src := TBitmap.Create;
  Wm := TBitmap.Create;
  try if Opendialog1.Execute then
    Image1.Picture.LoadFromFile(Opendialog1.FileName);
    Image2.Picture.LoadFromFile('brazukas.png');
    A.Picture.
    Src.PixelFormat := pf24bit;
    Wm.PixelFormat := pf24bit;
    Src.Width := Image1.Picture.Width;
    Src.Height := Image1.Picture.Height;
    Src.Canvas.Draw(0, 0, Image1.Picture.Graphic);

    Wm.Width := Image2.Picture.Width;
    Wm.Height := Image2.Picture.Height;
    Wm.Canvas.Draw(0, 0, Image2.Picture.Graphic);
    Wm.Transparent := true;

      if Alpha_Blend(Src, Wm, Image1.Picture.Width - Image2.Picture.Width, Image1.Picture.Height - Image2.Picture.Height, 0) then  //250 = 100% transparent
     begin
      Image3.Picture.Assign(Src);
     end
    else
      Image3.Picture.Assign(nil);
  finally
    Wm.Free;
    Src.Free;
  end;
end;

end.