unit Popup2;

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

type
 TCapturedButton = (cbtNone, cbtClose, cbtMinimize);

 TfPopup2 = class(TForm)
   ClientPanel: TPanel;
   CloseButton: TButton;
   procedure FormPaint(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure CloseButtonClick(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormActivate(Sender: TObject);
   procedure FormDeactivate(Sender: TObject);
   procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);
 private
   FCaptionRect : TRect;
   FCapturedButton : TCapturedButton;
   FMouseInCloseButton : Boolean;
   FMouseInMinimizeButton : Boolean;
   FCloseButtonRect : TRect;
   FMinimizeButtonRect : TRect;
   FWindowActive : Boolean;
   FWindowMinimized : Boolean;
   FSavedHeight : Integer;
   procedure WMHCHitTest (var Message : TWMNCHitTest); message WM_NCHITTEST;
   procedure MinimizeButtonClick;
 end;

var
 fPopup2: TfPopup2;

implementation

{$R *.dfm}

procedure TfPopup2.FormPaint(Sender: TObject);
var
 ARect : TRect;
 CaptionFlags : UINT;
 MinButtonKind : UINT;
begin
 CaptionFlags := DC_GRADIENT OR DC_SMALLCAP OR DC_TEXT;
 if FWindowActive then
   CaptionFlags := CaptionFlags OR DC_ACTIVE;
 ARect := ClientRect;
{ DrawEdge рисует линию толщиной в 2 пикселя (Tnx, [MBo]) }
 DrawEdge(Canvas.Handle, ARect, BDR_RAISED, BF_RECT);
 DrawCaption(Handle, Canvas.Handle, FCaptionRect, CaptionFlags);
 if FWindowMinimized then
   MinButtonKind := DFCS_CAPTIONMAX
 else
   MinButtonKind := DFCS_CAPTIONMIN;
 if (FCapturedButton = cbtClose) AND (FMouseInCloseButton) then
   DrawFrameControl(Canvas.Handle, FCloseButtonRect, DFC_CAPTION, DFCS_CAPTIONCLOSE OR DFCS_PUSHED)
 else
   DrawFrameControl(Canvas.Handle, FCloseButtonRect, DFC_CAPTION, DFCS_CAPTIONCLOSE);
 if (FCapturedButton = cbtMinimize) AND (FMouseInMinimizeButton) then
   DrawFrameControl(Canvas.Handle, FMinimizeButtonRect, DFC_CAPTION, MinButtonKind OR DFCS_PUSHED)
 else
   DrawFrameControl(Canvas.Handle, FMinimizeButtonRect, DFC_CAPTION, MinButtonKind);
end;

procedure TfPopup2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Action := caFree;
end;

procedure TfPopup2.CloseButtonClick(Sender: TObject);
begin
 Close();
end;

procedure TfPopup2.FormCreate(Sender: TObject);
begin
 SetRect(FCaptionRect, GetSystemMetrics(SM_CXSIZEFRAME), GetSystemMetrics(SM_CYSIZEFRAME),
         Width - GetSystemMetrics(SM_CXSIZEFRAME),
         GetSystemMetrics(SM_CYSMCAPTION)+GetSystemMetrics(SM_CYSIZEFRAME)-1);
 FCloseButtonRect := FCaptionRect;
 InflateRect(FCloseButtonRect, -1, -1);
 FCloseButtonRect.Left := FCloseButtonRect.Right -
                            (FCloseButtonRect.Bottom - FCloseButtonRect.Top);
 FMinimizeButtonRect := FCloseButtonRect;
 OffsetRect(FMinimizeButtonRect, - (FCloseButtonRect.Right - FCloseButtonRect.Left) - 2, 0);
end;

procedure TfPopup2.FormActivate(Sender: TObject);
begin
 FWindowActive := true;
 InvalidateRect(Handle, @FCaptionRect, false);
end;

procedure TfPopup2.FormDeactivate(Sender: TObject);
begin
 FWindowActive := false;
 InvalidateRect(Handle, @FCaptionRect, false);
end;

procedure TfPopup2.WMHCHitTest (var Message : TWMNCHitTest);
begin
 if PtInRect (FCaptionRect,
        ScreenToClient(SmallPointToPoint(Message.Pos))) and NOT
    PtInRect (FCloseButtonRect,
        ScreenToClient(SmallPointToPoint(Message.Pos))) and not
    PtInRect (FMinimizeButtonRect,
        ScreenToClient(SmallPointToPoint(Message.Pos))) then
   Message.Result := HTCAPTION
 else
   inherited;
end;

procedure TfPopup2.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 if Button <> mbLeft then
   Exit;
 if NOT PtInRect(FCaptionRect, Point(X,Y)) then
   Exit;
 if PtInRect(FCloseButtonRect, Point(X,Y)) then begin
   FCapturedButton := cbtClose;
   SetCapture(Handle);
   FMouseInCloseButton := true;
 end else if PtInRect(FMinimizeButtonRect, Point(X,Y)) then begin
   FCapturedButton := cbtMinimize;
   FMouseInMinimizeButton := true;
   SetCapture(Handle);
 end;
 if FCapturedButton <> cbtNone then
   InvalidateRect(Handle, @FCaptionRect, false);
end;

procedure TfPopup2.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
var
 OldButton : TCapturedButton;
begin
 if Button <> mbLeft then
   Exit;
 if FCapturedButton = cbtNone then
   Exit;
 OldButton := cbtNone;
 if PtInRect(FCloseButtonRect, Point(X,Y)) then
   OldButton := cbtClose
 else if PtInRect(FMinimizeButtonRect, Point(X,Y)) then
   OldButton := cbtMinimize;
 ReleaseCapture();
 FCapturedButton := cbtNone;
 if OldButton <> cbtNone then begin
   InvalidateRect(Handle, @FCaptionRect, false);
   case OldButton of
   cbtClose:
     Close();
   cbtMinimize:
     MinimizeButtonClick;
   end;
 end;
end;

procedure TfPopup2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
begin
 if FCapturedButton = cbtNone then
   Exit;
 FMouseInCloseButton := PtInRect(FCloseButtonRect, Point(X,Y));
 FMouseInMinimizeButton := PtInRect(FMinimizeButtonRect, Point(X,Y));
 InvalidateRect(Handle, @FCloseButtonRect, false);
 InvalidateRect(Handle, @FMinimizeButtonRect, false);
end;

procedure TfPopup2.MinimizeButtonClick;
begin
 if NOT FWindowMinimized then begin
   FSavedHeight := Height;
   Height := GetSystemMetrics(SM_CYSIZEFRAME)*2 +
         FCaptionRect.Bottom - FCaptionRect.Top;
 end else
   Height := FSavedHeight;
 FWindowMinimized := NOT FWindowMinimized;
 Invalidate;
end;

end.