Форум программистов [Powered by Invision Power Board]

Код

unit WHMain;

interface

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

type
  TFormHole = class(TForm)
    PanelHole: TPanel;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
  private
    FOldPanelWndProc: TWndMethod;
    procedure PanelWndProc(var Msg: TMessage);
    procedure WMSize(var Msg: TWMSize);message WM_SIZE;
  //  procedure SetRegion;
  end;

var
  FormHole: TFormHole;

implementation

{$R *.DFM}

const
  // Минимальное расстояние от края дырки до края окна.
  HoleDistance = 40;
  // Зона чувствительности рамки панели - насколько пикселей
  // может отстоять курсор вглубь от края панели, чтобы его
  // положение расценивалось как попадание в рамку.
  BorderMouseSensivity = 3;
  // Зона чувствительности угла рамки панели - насколько пикселей
  // может отстоять курсор от угла панели, чтобы его
  // положение расценивалось как попадание в угол рамки.
  CornerMouseSensivity = 15;
  // Толщина рамки дырки, использующаяся при вычислении региона
  HoleBorder = 3;
  // Минимальная ширина и высота дырки
  MinHoleSize = 10;
  // Смещение стрелки относительно соответствующего угла

procedure TFormHole.FormCreate(Sender: TObject);
begin
  FOldPanelWndProc := PanelHole.WindowProc;
  PanelHole.WindowProc := PanelWndProc;
  Image1.Picture.Bitmap.Height := Image1.Height;
  Image1.Picture.Bitmap.Width  := Image1.Width;
end;

procedure TFormHole.PanelWndProc(var Msg: TMessage);
var
  Pt: TPoint;
  R: TRect;
begin
 FOldPanelWndProc(Msg);
 if Msg.Msg = WM_NCHITTEST then
 begin
   Pt := PanelHole.ScreenToClient(Point(Msg.LParamLo, Msg.LParamHi));
   if Pt.X < BorderMouseSensivity then
     Msg.Result := 0
   else if Pt.X >= PanelHole.Width - BorderMouseSensivity then
     if Pt.Y < CornerMouseSensivity then
       Msg.Result := 0
     else if Pt.Y >= PanelHole.Height - CornerMouseSensivity then
       Msg.Result := HTBOTTOMRIGHT
     else
      Msg.Result := HTRIGHT
   else if Pt.Y < BorderMouseSensivity then
      Msg.Result := 0
   else if Pt.Y >= PanelHole.Height - BorderMouseSensivity then
     if Pt.X < CornerMouseSensivity then
       Msg.Result := 0
     else if Pt.X >= PanelHole.Width - CornerMouseSensivity then
       Msg.Result := HTBOTTOMRIGHT
    else
       Msg.Result := HTBOTTOM;
 end
 else if Msg.Msg = WM_SIZE then
 begin
   // Устанавливаем новые ограничения для размеров окна,
   // учитывающие новое положение дырки
   Constraints.MinWidth := Width - ClientWidth + PanelHole.Left + MinHoleSize + HoleDistance;
   Constraints.MinHeight := Height - ClientHeight + PanelHole.Top + MinHoleSize + HoleDistance;
   Image1.Picture.Bitmap.Height := Image1.Height - 1;
   Image1.Picture.Bitmap.Width  := Image1.Width - 1;
   Image1.Invalidate;
   Image1.
 end
 else if Msg.Msg = WM_SIZING then
 begin
   // Копируем переданный прямоугольник в переменную R,
   // одновременно пересчитывая координаты из экранных
   // в клиентские
   R.TopLeft := ScreenToClient(PRect(Msg.LParam)^.TopLeft);
   R.BottomRight := ScreenToClient(PRect(Msg.LParam)^.BottomRight);
   // Если ширина слишком мала, проверяем, за какую
   // сторону тянет пользователь. Если за левую -
   // корректируем координаты левой стороны, если за
   // правую - её координаты
   if R.Right - R.Left < MinHoleSize then
     if Msg.WParam in [WMSZ_BOTTOMLEFT, WMSZ_LEFT, WMSZ_TOPLEFT] then
       R.Left := R.Right - MinHoleSize
     else
       R.Right := R.Left + MinHoleSize;
   // Аналогично действуем, если слишком мала высота
   if R.Bottom - R.Top < MinHoleSize then
     if Msg.WParam in [WMSZ_TOP, WMSZ_TOPLEFT, WMSZ_TOPRIGHT] then
       R.Top := R.Bottom - MinHoleSize
     else
       R.Bottom := R.Top + MinHoleSize;
   // Сдвигаем стороны, слишком близко подошедшие
   // к границам окна
   if R.Left < HoleDistance then
     R.Left := HoleDistance;
   if R.Top < HoleDistance then
     R.Top := HoleDistance;
   if R.Right > ClientWidth - HoleDistance then
     R.Right := ClientWidth - HoleDistance;
   if R.Bottom > ClientHeight - HoleDistance then
     R.Bottom := ClientHeight - HoleDistance;
   // Копируем прямоугольник R, переводя его координаты
   // обратно в экранные
   PRect(Msg.LParam)^.TopLeft := ClientToScreen(R.TopLeft);
   PRect(Msg.LParam)^.BottomRight := ClientToScreen(R.BottomRight);
  end;
end;
 
procedure TFormHole.WMSize(var Msg: TWMSize);
begin
  inherited;
  // При уменьшении размеров окна уменьшаем размер дырки,
  // если границы окна подошли слишком близко к ней
  if PanelHole.Left + PanelHole.Width > ClientWidth - HoleDistance then
    PanelHole.Width := ClientWidth - HoleDistance - PanelHole.Left;
  if PanelHole.Top + PanelHole.Height > ClientHeight - HoleDistance then
    PanelHole.Height := ClientHeight - HoleDistance - PanelHole.Top;
end;

end.