procedure TForm1.BuildCopy24to32(_B_in,_B_mask:TBitmap; var _B_out: TBitmap);
const
 MaxPixelCountA = MaxInt div SizeOf(TRGBQuad);
 MaxPixelCount = MaxInt div SizeOf(TRGBTriple);
type
 PRGBArray = ^TRGBArray;
 TRGBArray = array[0..MaxPixelCount-1] of TRGBTriple;
 PRGBAArray = ^TRGBAArray;
 TRGBAArray = array[0..MaxPixelCountA-1] of TRGBQuad;
var x, y: Integer; RowOut: PRGBAArray; RowIn,RowInMask:PRGBArray;
begin
 _B_out.Width:=_B_in.Width;
 _B_out.Height:=_B_in.Height;
 for y:=0 to _B_in.Height-1 do begin
    RowOut:= _B_out.ScanLine[y];
    RowIn:= _B_in.ScanLine[y];
    RowInMask:= _B_mask.ScanLine[y];
   for x:=0 to _B_in.Width-1 do begin
         RowOut[x].rgbReserved:=trunc((RowInMask[x].rgbtBlue+RowInMask[x].rgbtGreen+RowInMask[x].rgbtRed)/3);
         RowOut[x].rgbBlue:=byte(trunc(RowIn[x].rgbtBlue*RowOut[x].rgbReserved/255));
         RowOut[x].rgbGreen:=byte(trunc(RowIn[x].rgbtGreen*RowOut[x].rgbReserved/255));
         RowOut[x].rgbRed:=byte(trunc(RowIn[x].rgbtRed*RowOut[x].rgbReserved/255));
   end;
 end
end;


procedure TForm1.RenderForm;
var zsize:TSize; zpoint:TPoint; zbf:TBlendFunction;
   TopLeft: TPoint; DC:HDC;
begin
 SetWindowLong(Form1.Handle,GWL_EXSTYLE, GetWindowLong(Form1.Handle,GWL_EXSTYLE) or WS_EX_LAYERED);

 width:=BT.Width;
 height:=BT.Height;

 zsize.cx := BT.Width;
 zsize.cy := BT.Height;
 zpoint := Point(0,0);

 with zbf do begin
   BlendOp := AC_SRC_OVER;
   BlendFlags := 0;
   AlphaFormat := AC_SRC_ALPHA;
   SourceConstantAlpha := 255;
 end;
 DC:= GetDC(0);
 TopLeft:=BoundsRect.TopLeft;
 UpdateLayeredWindow(Form1.Handle,DC,@TopLeft,@zsize,BT.Canvas.Handle,@zpoint,0,@zbf, ULW_ALPHA);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Picture.Bitmap.PixelFormat:=pf24bit;
Image2.Picture.Bitmap.PixelFormat:=pf24bit;
BT:=Tbitmap.Create;
BT.PixelFormat:=pf32bit;
BuildCopy24to32( Image1.Picture.Bitmap,Image2.Picture.Bitmap, Form1.bt );
RenderForm;
end;

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

  ...
  private
     FRegion: THandle;
     function CreateRegion(Bmp: TBitmap): THandle;
  ...

function TForm1.CreateRegion(Bmp: TBitmap): THandle;
var
   X, Y, StartX: Integer;
   Excl: THandle;
   Row: PRGBArray;
   TransparentColor: TRGBTriple;
   Color: Longint;
   r, g, b: Byte;
begin

   Bmp.PixelFormat := pf24Bit;

   Result := CreateRectRGN(0, 0, Bmp.Width, Bmp.Height);

   for Y := 0 to Bmp.Height - 1 do
   begin
     Row := Bmp.Scanline[Y];

     StartX := -1;

     if Y = 0 then  begin
  Color := ColorToRGB(clWhite);
  r     := Color;
  g     := Color shr 8;
  b     := Color shr 16;
TransparentColor.rgbtRed:=r;
TransparentColor.rgbtGreen:=g;
TransparentColor.rgbtBlue:=b;
end;

     for X := 0 to Bmp.Width - 1 do
     begin
       if (Row[X].rgbtRed = TransparentColor.rgbtRed) and
         (Row[X].rgbtGreen = TransparentColor.rgbtGreen) and
         (Row[X].rgbtBlue = TransparentColor.rgbtBlue) then
       begin
         if StartX = -1 then StartX := X;
       end
       else
       begin
         if StartX > -1 then
         begin
           Excl := CreateRectRGN(StartX, Y, X + 1, Y + 1);
           try
             CombineRGN(Result, Result, Excl, RGN_DIFF);
             StartX := -1;
           finally
             DeleteObject(Excl);
           end;
         end;
       end;
     end;

     if StartX > -1 then
     begin
       Excl := CreateRectRGN(StartX, Y, Bmp.Width, Y + 1);
       try
         CombineRGN(Result, Result, Excl, RGN_DIFF);
       finally
         DeleteObject(Excl);
       end;
     end;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Bmp: TBitmap;
begin
if openDialog1.Execute=false then exit;
   Bmp := TBitmap.Create;
   try
     Bmp.LoadFromFile(openDialog1.FileName);
     FRegion := CreateRegion(Bmp);
     SetWindowRGN(BitBtn1.Handle, FRegion, True);
   finally
     Bmp.Free;
   end;
Form1.Width:= Bmp.Width;
Form1.Height:= Bmp.Height;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteObject(FRegion);
end;