Limit the form position to the screen's work area

Mirror

Limit the form position to the screen's work area (Views: 704)

Problem/Question/Abstract:

What's the best windows message to check if the Form's position is beyond the desktop area, when the user is moving it? How can I prevent the form/ mouse from moving when that happens?

Answer:

Solve 1:

You need a message that is send to the form before it moves and allows you to modfify the position it is about to move to before it actually does move. WM_MOVING or WM_WINDOWPOSCHANGING fit that bill. I would use the second, WM_MOVING will not be send if the user has switched off the "drag full window" option.

Limit a form to the screens workarea:

{ Private declarations }

procedure WMWINDOWPOSCHANGING(var msg: TWMWINDOWPOSCHANGING);
  message WM_WINDOWPOSCHANGING;

procedure TForm1.WMWINDOWPOSCHANGING(var msg: TWMWINDOWPOSCHANGING);
var
  r: TRect;
begin
  if ((SWP_NOMOVE or SWP_NOSIZE) and msg.WindowPos^.flags) < > (SWP_NOMOVE
    or SWP_NOSIZE) then
  begin
    {Window is moved or sized, get usable screen area}
    SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);
    {Check if operation would move part of the window out of this area.
                If so correct position and, if required, size, to keep window fully inside
                the workarea. Note that simply adding the SWM_NOMOVE and SWP_NOSIZE flags
                to the flags field does not work as intended if full dragging of windows is
                disabled. In this case the window would snap back to the start position instead
                of stopping at the edge of the workarea, and you could still move the
    drag rectangle outside that area. }
    with msg.WindowPos^ do
    begin
      if x < r.left then
        x := r.left;
      if y < r.top then
        y := r.top;
      if (x + cx) > r.right then
      begin
        x := r.right - cx;
        if x < r.left then
        begin
          cx := cx - (r.left - x);
          x := r.Left;
        end;
      end;
      if (y + cy) > r.bottom then
      begin
        y := r.bottom - cy;
        if y < r.top then
        begin
          cy := cy - (r.top - y);
          y := r.top;
        end;
      end;
    end;
  end;
  inherited;
end;

Delphi 4.03 does not recognize TWMMOVING, because there is no message record type declared for it for some reason. That is easily fixed, however:

type
  TWmMoving = record
    Msg: Cardinal;
    fwSide: Cardinal;
    lpRect: PRect;
    Result: Integer;
  end;

Solve 2:

You can get this behaviour by handing the WM_MOVING message in the form. The message is send to the form before it actually moves, so you can modify the rectangle with the new form position before you pass the message on to the inherited handler.

For some reason messages.pas declares no message record for this message.

type
  TWmMoving = record
    Msg: Cardinal;
    fwSide: Cardinal;
    lpRect: PRect;
    Result: Integer;
  end;

Add a handler to your forms private section:

procedure WMMoving(var msg: TWMMoving); message WM_MOVING;

Implement it as:

procedure TFormX.WMMoving(var msg: TWMMoving);
var
  r: TRect;
begin
  r := Screen.WorkareaRect;
  {Compare the new form bounds in msg.lpRect^ with r and modify it if necessary}
  if msg.lprect^.left < r.left then
    OffsetRect(msg.lprect^, r.left - msg.lprect^.left, 0);
  if msg.lprect^.top < r.top then
    OffsetRect(msg.lprect^, 0, r.top - msg.lprect^.top);
  if msg.lprect^.right > r.right then
    OffsetRect(msg.lprect^, r.right - msg.lprect^.right, 0);
  if msg.lprect^.bottom > r.bottom then
    OffsetRect(msg.lprect^, 0, r.bottom - msg.lprect^.bottom);
  inherited;
end;

<< Back to main page