Delphi 实现无窗口移动(详细使用WM_NCHITTEST和PtInRect API进行测试)

procedure imgListMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
private

 procedure WMNCHITTEST(var Msg: TWMNCHITTEST); message WM_NCHITTEST;


procedure TfrmStartHit.WMNCHITTEST(var Msg: TWMNCHITTEST);
const
  cOffset = 10;
var
  vPoint: TPoint;
begin
  inherited;
  vPoint := ScreenToClient(Point(Msg.XPos, Msg.YPos));
  if PtInRect(Rect(0, 0, cOffset, cOffset), vPoint) then
    Msg.Result := HTTOPLEFT
  else if PtInRect(Rect(Width - cOffset, Height - cOffset, Width, Height), vPoint) then
    Msg.Result := HTBOTTOMRIGHT
  else if PtInRect(Rect(Width - cOffset, 0, Width, cOffset), vPoint) then
    Msg.Result := HTTOPRIGHT
  else if PtInRect(Rect(0, Height - cOffset, cOffset, Height), vPoint) then
    Msg.Result := HTBOTTOMLEFT
  else if PtInRect(Rect(cOffset, 0, Width - cOffset, cOffset), vPoint) then
    Msg.Result := HTTOP
  else if PtInRect(Rect(0, cOffset, cOffset, Height - cOffset), vPoint) then
    Msg.Result := HTLEFT
  else if PtInRect(Rect(Width - cOffset, cOffset, Width, Height - cOffset), vPoint) then
    Msg.Result := HTRIGHT
  else if PtInRect(Rect(cOffset, Height - cOffset, Width - cOffset, Height), vPoint) then
    Msg.Result := HTBOTTOM;
end;


procedure TfrmStartHit.imgListMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const
  SC_DRAGMOVE = $F012;
begin
  if (Button = mbLeft) then
  begin
    ReleaseCapture;
    (Self as TControl).Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
  end;
end;

http://blog.csdn.net/yanjiaye520/article/details/6736069

procedure MoveSelf;
begin
  if form1.Active then
  begin
  ReleaseCapture;
  SendMessage(form1.Handle,WM_SYSCOMMAND,SC_MOVE or HTCAPTION,0);
  end;
end;

在做登录窗口时一般都是无标题栏,窗口不能被鼠标拖动, 上面的过程可以拖动窗体,结合application.onmessage可时间点任何地方移动窗体

http://blog.csdn.net/y281252548/article/details/18813719

原文地址:https://www.cnblogs.com/findumars/p/5272650.html