Липкие окошки

В статье рассматривается приём создания обработчиков сообщений, которые позволяют форме при перетаскивании «прилипать» к краям экранной области.

Конечно же в WinAPI такой возможности не предусмотрено, поэтому мы воспользуемся сообщениями Windows. Как нам известно, Delphi обрабатывает сообщения через события, генерируя их в тот момент, когда Windows посылает сообщение приложению. Однако некоторые сообщения не доходят до нас. Например, при изменении размеров формы генерируется событие OnResize, соответствующее сообщению WM_SIZE, но при перетаскивании формы никакой реакции не происходит. Конечно же форма может получить это сообщение, но изначально никаких действий для данного сообщения не предусмотрено.

Итак, при перемещении окну посылается сообщение WM_MOVING. Обрабатывая данное сообщение, приложение может отслеживать размер и расположение перетаскиваемого квадрата и при необходимости изменять их.

Также существует сообщение WM_WINDOWPOSCHANGING, которое посылается окну в случае, если его размер, расположение или место в Z-порядке собираются измениться, как результат вызова функции SetWindowPos либо другой функции управления окном.

Чаще всего с сообщением передаются дополнительные параметры, которые сообщают нам необходимую информацию. Например, сообщение WM_MOVE, указывающее на то, что форма изменила своё местоположение, также передаёт в параметре LPARAM новые координаты X и Y.

Сообщение WM_WINDOWPOSCHANGING передаёт нам только один параметр — указатель на структуру WindowPos, которая содержит информацию о новом размере и местоположении окна. Вот как выглядит структура WindowPos:

{codecitation class=»brush: pascal; gutter: false;» width=»500px»}

TWindowPos = packed record
hwnd: HWND; {Identifies the window.}
hwndInsertAfter: HWND; {Window above this one}
x: Integer; {Left edge of the window}
y: Integer; {Right edge of the window}
cx: Integer; {Window width}
cy: Integer; {Window height}
flags: UINT; {Window-positioning options.}
end;

{/codecitation}

Наша задача проста: нам необходимj, чтобы форма прилипла к краю экрана, если она находится на определённом расстоянии от него (допустим, 20 пикселей).

Пример

К новой форме добавьте Label, один Edit и четыре Checkbox. Измените имя Edit на edStickAt. Измените имена чекбоксов на chkLeft, chkTop, и т.д. Для установки количества пикселей используем edStickAt, который будет использоваться для определения необходимого расстояния до края экрана, достаточного для приклеивания формы.

Нас интересует только одно сообщение — WM_WINDOWPOSCHANGING. Обработчик для данного сообщения будет объявлен в секции private. Ниже приведён полный код этого процедуры «прилипания» вместе с комментариями. Обратите внимание, что Вы можете предотвратить «прилипание» формы к определённому краю путём снятия нужной галочки.

Для получения рабочей области декстопа (минус панель задач, панель Microsoft и т.д.), используем SystemParametersInfo, первый параметр которой SPI_GETWORKAREA.

{codecitation class=»brush: pascal; gutter: false;» width=»500px»}

private
procedure WMWINDOWPOSCHANGING
(var Msg: TWMWINDOWPOSCHANGING);
message WM_WINDOWPOSCHANGING;

procedure TfrMain.WMWINDOWPOSCHANGING
(var Msg: TWMWINDOWPOSCHANGING);
const
Docked: Boolean = FALSE;
var
rWorkArea: TRect;
StickAt : Word;
begin
StickAt := StrToInt(edStickAt.Text);

SystemParametersInfo
(SPI_GETWORKAREA, 0, @rWorkArea, 0);

with Msg.WindowPos^ do begin
if chkLeft.Checked then
if x <= rWorkArea.Left + StickAt then begin
x := rWorkArea.Left;
Docked := TRUE;
end;

if chkRight.Checked then
if x + cx >= rWorkArea.Right — StickAt then begin
x := rWorkArea.Right — cx;
Docked := TRUE;
end;

if chkTop.Checked then
if y <= rWorkArea.Top + StickAt then begin
y := rWorkArea.Top;
Docked := TRUE;
end;

if chkBottom.Checked then
if y + cy >= rWorkArea.Bottom — StickAt then begin
y := rWorkArea.Bottom — cy;
Docked := TRUE;
end;

if docked then begin
with rWorkArea do begin
// не должна вылезать за пределы экрана
if x < Left then x := Left;
if x + cx > Right then x := Right — cx;
if y < Top then y := Top;
if y + cy > Bottom then y := Bottom — cy;
end; {ширина rWorkArea}
end; {}
end; {с Msg.WindowPos^}

inherited;
end;
end.

{/codecitation}

Теперь достаточно запустить проект и перетащить форму к любому краю экрана. Вот собственно и всё.

А вот другой более короткий (и может быть, даже лучший) способ:

{codecitation class=»brush: pascal; gutter: false;» width=»500px»}

procedure TCustomGlueForm.WMWindowPosChanging1(var Msg: TWMWindowPosChanging);
var
WorkArea: TRect;
StickAt : Word;
begin
StickAt := 10;
SystemParametersInfo(SPI_GETWORKAREA, 0, @WorkArea, 0);
with WorkArea, Msg.WindowPos^ do
begin
// Сдвигаем границы для сравнения с левой и верхней сторонами
Right:=Right-cx;
Bottom:=Bottom-cy;
if abs(Left — x) <= StickAt then x := Left;
if abs(Right — x) <= StickAt then x := Right;
if abs(Top — y) <= StickAt then y := Top;
if abs(Bottom — y) <= StickAt then y := Bottom;
end;
inherited;
end;

{/codecitation}

Добавить комментарий