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.