(*
   Пример создания окна "произвольной" формы в Delphi 3.x, 4.x, 5.x
   ----------------------------------------------------------------
   Автор: Апраксин Дмитрий (adw@nm.ru)

   В некоторых случаях требуется придать
   созданному приложению красивый внешний вид.
   Многие полагают, что это довольно сложно
   сделать в ОС Windows из-за того, что нельзя
   преодолеть "прямоугольность" создаваемой данной ОС
   окон. Но это далеко не так.

   Для создания окон, имеющих произвольную форму
   в ОС предусмотрен ряд функций, работающих с так
   называемыми РЕГИОНАМИ или ОБЛАСТЯМИ.
   Можно создавать эллиптические, прямоугольные и
   многоугольные ОБЛАСТИ, затем их комбинировать
   между собой (применяют такие операции булевой
   алгебры как AND, OR, XOR и др.), добиваясь
   создания требуемой области.

   Применив полученную ОБЛАСТЬ к окну, для которого
   она была создана (функция SetWindowRgn) Вы получите
   окно требуемой формы, которое будет АБСОЛЮТНО корректно
   обрабатываться WINDOWS.

   См. Win32SDK Region Functions
*)

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;  { рисунок заднего фона окна приложения }
    Panel1: TPanel;  { на панельке размещаем крестик, чтобы TImage получал сообщения }
    Image2: TImage;  { это кнопочка в виде крестика (не нажатого) }
    Image3: TImage;  { это кнопочка в виде крестика (нажатого) }
    procedure FormCreate(Sender: TObject);
    procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
    { создаваемые области, указатели на них }
    r1, r2, region: THANDLE;
    { обрабатываем сообщение wm_NCHitTest для того, чтобы }
    { перемещать окно приложения не только за CaptionBar, }
    { но и за любую другую его часть }
    procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
  inherited;
  { просто делаем так, что Windows думает, что мы }
  { потащили окно за CaptionBar }
  if M.Result = htClient then M.Result := htCaption;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  { r1 - нижний прямоугольничек }
  r1 := CreateRectRgn(0, 22, 250, 250);
  { r2 - верхний прямоугольничек }
  r2 := CreateRectRgn(0, 0, 108, 25);
  { region - вся область окна, включающая и r1 и r2 }
  {region := CreateRectRgn(0,0,250,250);}
  Region:=CreateEllipticRgn(0,0,108,25);

  { создаём область, которая будет включать все три предыдущие }
  CombineRgn(region, r1, r2, RGN_OR);
  { придаём вид окну, на всякий случаем сообщаем о том, что мы
    хотим перерисовать окно (TRUE) }
  SetWindowRgn(Handle, region, TRUE);
end;

procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Image2.Hide;
  Image3.Show;
end;

procedure TForm1.Image2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Image3.Hide;
  Image2.Show;
  close; { во время "отпускания" кнопки, закрываем окно }
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := MessageDlg('Exit. Are you shore?', mtConfirmation, [mbYes, mbNo], 0) = mrYes;
end;

(*
   ПРИМЕЧАНИЕ:
      Обратите внимание на то, что крестик, закрывающий окно,
      расположен на отдельном компоненте - TPanel.
      Это сделано намеренно, т.к. перехват wm_NCHitTest
      приводит к тому, что сообщения о нажатии кнопки мыши на
      форме (и TImage тоже, т.к. оно не имеет своего окна),
      интерпритируются как сообщения о перетаскивании окна за
      CaptionBar.
*)

end.
