Советы по Delphi
         

Перемещение формы не за заголовок V


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

    {Определение в главной форме...}
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;

[001750]



Содержание раздела