首页  编辑  

现在窗体的移动必须在屏幕以内

Tags: /超级猛料/VCL/Form,窗体/FAQ/   Date Created:

拦截WM_MOVING消息即可

  private

    { Private declarations }

    procedure WMMove ( var Msg : TMessage ); message WM_MOVING ;

procedure TForm1 . WMMove ;

var

  PR : PRect ;

begin

  inherited ;

  PR := Pointer ( Msg . lParam );

  if PR . Left < 0 then

    PR . Left := 0

  else if PR . Left > Screen . Width - Width then

    PR . Left := Screen . Width - Width ;

  if PR . Top < 0 then

    PR . Top := 0

  else if PR . Top > Screen . Height - Height then

    PR . Top := Screen . Height - Height ;

  PR . Right := PR . Left + Width ;

  PR . Bottom := PR . Top + Height ;

  Msg . Result := 1 ;

end ;

---------------------------------------

// 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;