Форма окна по Bitmap

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
.

Другое по теме:

• Bitmap без формы
• Bitmap.Scanline для PixelFormat
• Вращать Bitmap вокруг точки