unit UxForm;

interface

uses
  Windows, Messages, SysUtils, Types, Classes, Forms, Controls, StdCtrls,
  Graphics, UITypes, UxPanel, Menus, ExtCtrls;

type

  TUxForm = class(TForm)
  strict private type
    TUxPanelCT = class(TUxPanel)
      procedure WMNcHitTest(var Message: TWMNCHittest); message WM_NCHITTEST;
    end;
    TClientWindow = class(TCustomControl)
    end;
  var
    pn: TUxPanelCT;
    cpn: TClientWindow;
    pmWindow: TPopupMenu;
    procedure SysCmd(Sender: TObject);
    function GetParentWindow: TWinControl;
  protected
    procedure WMNCHitTest(var Message: TWMNCHittest); message WM_NCHITTEST;
    procedure WMNCMButtonUp(var Message: TWMNCMButtonUp); message WM_NCMBUTTONUP;
    procedure WMNCRButtonUp(var Message: TWMNCRButtonUp); message WM_NCRBUTTONUP;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure DoShow; override;
  public
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
    function IsShortCut(var Message: TWMKey): Boolean; override;
    property ParentWindow: TWinControl read GetParentWindow;
    procedure SetClientSize(const ASize: TSize);
  end;

implementation

uses
  Math, StrUtils;

function _scale(X: Integer): Integer;
begin
  Result := MulDiv(X, Screen.PixelsPerInch, 96);
end;

{ TUxForm.TUxPanelCT }

procedure TUxForm.TUxPanelCT.WMNcHitTest(var Message: TWMNCHittest);
begin
  Message.Result := HTTRANSPARENT;
end;

{ TUxForm }

procedure TUxForm.CMTextChanged(var Message: TMessage);
begin
  pn.Caption := Caption;
end;

constructor TUxForm.CreateNew(AOwner: TComponent; Dummy: Integer);
var
  mi: TMenuItem;
  OwnerForm: TCustomForm absolute AOwner;
begin

  inherited;

  if not (AOwner is TCustomForm) then
    raise Exception.Create('TUxForm.CreateNew: Owner must be a TCustomForm.');

  Position := poOwnerFormCenter;
  DefaultMonitor := dmDesktop;
  BorderStyle := bsNone;
  Font.Assign(Application.MainForm.Font);
  Color := clWhite;
  Width := _scale(500);
  Height := _scale(400);
  Constraints.MinWidth := _scale(200);
  Constraints.MinHeight := _scale(100);

  pn := TUxPanelCT.Create(Self);
  pn.Parent := Self;
  pn.Align := alClient;
  pn.Caption := Caption;
  pn.BorderWidth := _scale(6);
  pn.Alignment := taCenter;

  pmWindow := TPopupMenu.Create(Self);

  mi := TMenuItem.Create(pmWindow);
  mi.Caption := '&Move';
  mi.Hint := 'Moves this window using the arrow keys.';
  mi.Tag := SC_MOVE;
  mi.OnClick := SysCmd;
  pmWindow.Items.Add(mi);

  mi := TMenuItem.Create(pmWindow);
  mi.Caption := '&Size';
  mi.Hint := 'Resizes this window using the arrow keys.';
  mi.Tag := SC_SIZE;
  mi.OnClick := SysCmd;
  pmWindow.Items.Add(mi);

  mi := TMenuItem.Create(pmWindow);
  mi.Caption := '&Close';
  mi.Hint := 'Closes this window.';
  mi.Tag := SC_CLOSE;
  mi.OnClick := SysCmd;
  pmWindow.Items.Add(mi);
  pmWindow.Items.InsertNewLineBefore(mi);

  cpn := TClientWindow.Create(Self);
  cpn.Parent := pn;
  cpn.Align := alClient;
  cpn.ParentFont := False;
  cpn.Font.Assign(Application.MainForm.Font);

end;

procedure TUxForm.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style := Params.Style or WS_MAXIMIZEBOX;
end;

procedure TUxForm.DoShow;
var
  i: Integer;
begin
  inherited;
  for i := 0 to ControlCount - 1 do
    if not (Controls[i] is TUxPanelCT) then
      Controls[i].Parent := cpn;
end;

function TUxForm.GetParentWindow: TWinControl;
begin
  Result := cpn;
end;

function TUxForm.IsShortCut(var Message: TWMKey): Boolean;
begin
  Result := False;
  if (Message.CharCode = 32) and (HiWord(Message.KeyData) and KF_ALTDOWN <> 0) then
  begin
    with ClientToScreen(Point(pn.Padding.Left, pn.Padding.Top)) do
      pmWindow.Popup(X, Y);
    Result := True;
  end;
end;

procedure TUxForm.SetClientSize(const ASize: TSize);
var
  DX, DY: Integer;
begin
  DX := Width - ParentWindow.ClientWidth;
  DY := Height - ParentWindow.ClientHeight;
  SetBounds(Left, Top, ASize.cx + DX, ASize.cy + DY);
end;

procedure TUxForm.SysCmd(Sender: TObject);
begin
  if Sender is TComponent then
    Perform(WM_SYSCOMMAND, TComponent(Sender).Tag, 0);
end;

procedure TUxForm.WMNCHitTest(var Message: TWMNCHittest);
var
  P: TPoint;
begin
  inherited;
  P := ScreenToClient(Message.Pos);
  if (P.Y < 2*pn.BorderWidth) and (P.X < 2*pn.BorderWidth) then
    Message.Result := HTTOPLEFT
  else if (P.Y < 2*pn.BorderWidth) and (P.X > ClientWidth - 2*pn.BorderWidth) then
    Message.Result := HTTOPRIGHT
  else if (P.Y > ClientHeight - 2*pn.BorderWidth) and (P.X < 2*pn.BorderWidth) then
    Message.Result := HTBOTTOMLEFT
  else if (P.Y > ClientHeight - 2*pn.BorderWidth) and (P.X > ClientWidth - 2*pn.BorderWidth) then
    Message.Result := HTBOTTOMRIGHT
//  else if P.Y < pn.BorderWidth then
//    Message.Result := HTTOP
  else if P.Y < pn.CaptionRect.Height then
    Message.Result := HTCAPTION
  else if P.Y > ClientHeight - pn.BorderWidth then
    Message.Result := HTBOTTOM
  else if P.X < pn.BorderWidth then
    Message.Result := HTLEFT
  else if P.X > ClientWidth - pn.BorderWidth then
    Message.Result := HTRIGHT
  else
    Message.Result := HTCLIENT;
end;

procedure TUxForm.WMNCMButtonUp(var Message: TWMNcMButtonUp);
begin
  inherited;
  if Message.HitTest = HTCAPTION then
  begin
    ModalResult := mrCancel;
    Message.Result := 0;
  end;
end;

procedure TUxForm.WMNCRButtonUp(var Message: TWMNCRButtonUp);
begin
  inherited;
  if Message.HitTest = HTCAPTION then
  begin
    if Assigned(pmWindow) then
    begin
      pmWindow.Popup(Message.XCursor, Message.YCursor);
      Message.Result := 0;
    end;
  end;
end;

end.
