unit Unit8;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;

type
 TForm8 = class(TForm)
   Button1: TButton;
   procedure FormCreate(Sender: TObject);
   procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure Button1Click(Sender: TObject);
   procedure FormPaint(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
   procedure BuildCopy24to32(_B_in,_B_mask:TBitmap; var _B_out: TBitmap);
 protected
   procedure WMWINDOWPOSCHANGING(var Msg: TWMWINDOWPOSCHANGING); message WM_WINDOWPOSCHANGING;
 end;

var
 Form8: TForm8;

implementation

{$R *.dfm}

procedure TForm8.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 TForm8.Button1Click(Sender: TObject);
begin
 ShowMessage('1');
 SendMessage(Handle,WM_PAINT,0,0);
end;

procedure TForm8.FormCreate(Sender: TObject);
var
 FWorkBMP, BGBmp, MaskBmp: TBitmap;
 zsize:TSize;
 zpoint:TPoint;
 zbf:TBlendFunction;
 TopLeft: TPoint;
 DC:HDC;
 Rgn: HRGN;
begin
 DoubleBuffered:=true;

 BGBmp:=TBitmap.Create;
 BGBmp.PixelFormat := pf32Bit;
 BGBmp.LoadFromFile('bg.bmp');

 MaskBmp:=TBitmap.Create;
 MaskBmp.PixelFormat := pf32Bit;
 MaskBmp.LoadFromFile('mask.bmp');

 FWorkBMP := TBitmap.Create;
 FWorkBMP.PixelFormat := pf32Bit;
 FWorkBMP.Width := BGBmp.Width;
 FWorkBMP.Height := BGBmp.Height;

 BuildCopy24to32(BGBmp,MaskBmp,FWorkBMP);

 SetWindowLong(Handle,GWL_EXSTYLE, GetWindowLong(Handle,GWL_EXSTYLE) or WS_EX_LAYERED);

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

 zsize.cx := FWorkBMP.Width;
 zsize.cy := FWorkBMP.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(Handle,DC,@TopLeft,@zsize,FWorkBMP.Canvas.Handle,@zpoint,0,@ zbf, ULW_ALPHA);
 ReleaseDC(0, DC);

 Rgn := CreateRoundRectRgn(0, 0, FWorkBMP.Width, FWorkBMP.Height, 20, 20);
 SetWindowRgn(Handle, rgn, True);

 BGBmp.Free;
 MaskBmp.Free;
 FWorkBMP.Free;

end;

procedure TForm8.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
if Button <> mbRight then begin
  ReleaseCapture;
  SendMessage(Handle, WM_SYSCOMMAND, 61458, 0);
  end;
end;

procedure TForm8.FormPaint(Sender: TObject);
begin
 UpdateWindow(Handle);
 ShowMessage('1');
end;

procedure TForm8.WMWINDOWPOSCHANGING(var Msg: TWMWINDOWPOSCHANGING);
begin
SetWindowPos(Handle,HWND_TOPmost,Left,Top,Width,Height, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE );
end;

end.

function BitmapToRgn(Image: TBitmap): HRGN;
var
 TmpRgn: HRGN;
 x, y: integer;
 ConsecutivePixels: integer;
 CurrentPixel: TColor;
 CurrentColor: TColor;
begin
 Result := CreateRectRgn(0, 0, Image.Width, Image.Height);
 if (Image.Width = 0) or (Image.Height = 0) then
   exit;
 for y := 0 to Image.Height - 1 do
 begin
   CurrentColor := Image.Canvas.Pixels[0,y];
   ConsecutivePixels := 1;
   for x := 0 to Image.Width - 1 do
   begin
     CurrentPixel := Image.Canvas.Pixels[x, y];
     if CurrentColor = CurrentPixel then
       inc(ConsecutivePixels)
     else
     begin
        if CurrentColor = clWhite then
       begin
         TmpRgn := CreateRectRgn(x - ConsecutivePixels, y, x, y + 1);
         CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
          DeleteObject(TmpRgn);
       end;
       CurrentColor := CurrentPixel;
       ConsecutivePixels := 1;
     end;
   end;
   if (CurrentColor = clWhite) and (ConsecutivePixels > 0) then
   begin
     TmpRgn := CreateRectRgn(x-ConsecutivePixels, y, x, y+1);
     CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
     DeleteObject(TmpRgn);
   end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 MaskBmp: TBitmap;
begin
 MaskBmp := TBitmap.Create;
 try
   MaskBmp.LoadFromFile('Mask.bmp');
   Height := MaskBmp.Height;
   Width := MaskBmp.Width;
   SetWindowRgn(Self.Handle, BitmapToRgn(MaskBmp), True);
 finally
   MaskBmp.Free;
 end;
end;