Создать окно произвольной формы

unit Axx;
 
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, jpeg;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    SpeedButton1: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
// Dragging – параметр для перетаскивания, OldLeft,OldTop – первоначальные координаты окна
   Dragging  : Boolean; 
    OldLeft,OldTop: Integer;
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
// Функция создания области на картинке
function CreateRgnFromBitmap(rgnBitmap: TBitmap): HRGN;
var
  TransColor: TColor;
  i, j: Integer;
  i_width, i_height: Integer;
  i_left, i_right: Integer;
  rectRgn: HRGN;
begin
 Result := 0;
// запоминание размеров окна
 i_width := rgnBitmap.Width;
 i_height := rgnBitmap.Height;
// определение прозрачного цвета
 transColor := rgnBitmap.Canvas.Pixels[0, 0];
// цикл перебора строк картинки для определения области окна без фона
 for i := 0 to i_height - 1 do
  begin
   i_left := -1;
// цикл перебора столбцов картинки для определения области окна без фона
  for j := 0 to i_width - 1 do
    begin
     if i_left < 0 then
      begin
       if rgnBitmap.Canvas.Pixels[j, i] <> transColor then
        i_left := j;
      end
     else
      if rgnBitmap.Canvas.Pixels[j, i] = transColor then
       begin
        i_right := j;
        rectRgn := CreateRectRgn(i_left, i, i_right, i + 1);
        if Result = 0 then
         Result := rectRgn
        else
         begin
// Напоминаем  режимы: 
RGN_AN – область перекрывания;
RGN_COPY- копия первой области
RGN_DIFF- удаление второй из первой области
RGN_XOR – объединение областей, исключая все пересечения;      
//Функция для комбинирования  (объединения) областей.
CombineRgn(Result, Result, rectRgn, RGN_OR);
          DeleteObject(rectRgn);
         end;
        i_left := -1;
       end;
    end;
   if i_left >= 0 then
    begin
     rectRgn := CreateRectRgn(i_left, i, i_width, i + 1);
     if Result = 0 then
      Result := rectRgn
     else
      begin
       CombineRgn(Result, Result, rectRgn, RGN_OR);
       DeleteObject(rectRgn);
      end;
    end;
  end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
 WindowRgn: HRGN;
begin
 BorderStyle := bsNone;
 ClientWidth := Image1.Picture.Bitmap.Width;
 ClientHeight := Image1.Picture.Bitmap.Height;
 windowRgn := CreateRgnFromBitmap(Image1.Picture.Bitmap);
 SetWindowRgn(Handle, WindowRgn, True);
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
 Canvas.Draw(0, 0, Image1.Picture.Bitmap);
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if button=mbLeft then
  begin
   Dragging := True;
   OldLeft := X;
   OldTop := Y;
  end;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if Dragging then
  begin
   Left := Left+X-OldLeft;
   Top := Top+Y-OldTop;
  end;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 Dragging := False;
end;
 
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
 Close;
end;
 
end.