Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

unit Unit1;

 interface

 uses
   Windows, Classes, SysUtils, Graphics, Forms;

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

 type
   TForm1 = class(TForm)
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
   private
     { Private declarations }
     FRegion: THandle;
     function CreateRegion(Bmp: TBitmap): THandle;
   end;

 var
   Form1: TForm1;

 implementation

 {$R *.dfm}

 function TForm1.CreateRegion(Bmp: TBitmap): THandle;
 var
   X, Y, StartX: Integer;
   Excl: THandle;
   Row: PRGBArray;
   TransparentColor: TRGBTriple;
 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
       TransparentColor := Row[0];

     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
   Bmp := TBitmap.Create;
   try
     Bmp.LoadFromFile('C:\YourBitmap.bmp');
     FRegion := CreateRegion(Bmp);
     SetWindowRGN(Handle, FRegion, True);
   finally
     Bmp.Free;
   end;
 end;

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

 end.