Перемещение формы не за заголовок. Вариант 5

Written on . Posted in [Delphi] Пользовательский интерфейс. Окна и формы

Вот как это можно сделать...

{Определение в главной форме...}

TForm1 = class(TForm)
private
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
end;

{... и реализация обработчика события}
procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin
inherited;                    { вызвали унаследованный обработчик сообщения, }
if  M.Result = htClient then  { щелкнув в клиентской области окна? }
M.Result := htCaption;      { если так, то мы заставили Windows думать, }
{ что щелчок был произведен по заголовку окна. }
end;

Это заставляет Windows думать, что курсор мыши находится в области заголовка окна. Но это может повлечь за собой другую проблему, поскольку предполагается, что мышь будет считаться расположенной в области заголовка при любом ее нахождении в области клиента, тем не менее, это решение элегантно, поскольку при перетаскивании формы ее границы изменяются на "резиновые". Если это совсем у вас не работает, можно попробовать работать с другим сообщением, который может дать тот же результат.

 

  1. Выключите все BorderIcons формы.
  2. Убедитесь в том, что заголовок является пустой строкой.
  3. BorderStyle = bsNone
  4. Перекройте процедуру формы CreateParams как показано ниже:

    type

    TForm1 = class(TForm)
    {       ...
другие объявления
...}
protected
procedure CreateParams(var Params : TCreateParams); override;
public
end;

{... другой код ...}

implementation

{...}

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
Style := Style or ws_Border or ws_ThickFrame;
end;

{...}

end.

 

Var
Moving  : Boolean;
OldX, OldY : Integer;
...............
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
If Button = mbLeft Then    {нас интересует только левая кнопка}
Begin
OldLeft := X;           {Сохраняем текущую позицию}
OldTop := Y;
Moving := True;
End;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
{Если необходимо переместить окно относительно своей оригинальной позиции}
If Moving Then Self.SetBounds
(Self.Left + X - OldLeft, Self.Top + Y - OldTop, Self.Width,
Self.Height);

end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
If Button = mbLeft Then
Moving := False;              {Останавливаем перемещение}
end;

Не забудьте назначить эти методы каждому элементу управления вашей формы, например так:

Self.Panel1.OnMouseDown := Self.OnMouseDown;

avr форум