procedure MakeMovable(Handle: HWND);

var

style: LongInt;

flags: UINT;

begin

//Разрешаем перемещение элемента управления

style:= GetWindowLong(Handle, GWL_STYLE);

style:= style or WS_OVERLAPPED or WS_THICKFRAME or WS_CAPTION;

SetWindowLong(Handle, GWL_STYLE, style);

style:= GetWindowLong(Handle, GWL_EXSTYLE);

style:= style or WS_EX_TOOLWINDOW;

SetWindowLong(Handle, GWL_EXSTYLE, style);

//Перерисуем в новом состоянии

flags:= SWP_NOMOVE or SWP_NOSIZE or SWP_DRAWFRAME or SWP_NOZORDER;

SetWindowPos(Handle, 0, 0, 0, 0, 0, flags);

end;

Как можно увидеть, дополнительные флаги задаются в два этапа. Сначала считывается старое значение стиля окна. Потом с помощью двоичной операции ИЛИ стиль (задается целочисленным значением) дополняется новыми флагами. Это делается для того, чтобы не пропали ранее установленные значения стиля окна.

Вообще, процедура MakeMovable изменяет два стиля окна: обычный и расширенный. Расширенный стиль окна изменяется лишь для того, чтобы строка заголовка получившегося окна занимала меньше места (получаем так называемое окно панели инструментов). Полный перечень как обычных, так и расширенных стилей можно просмотреть в приложении 2.

Логично также реализовать процедуру, обратную MakeMovable, запрещающую перемещение окон элементов управления (листинг 1.23).

procedure MakeUnmovable(Handle: HWND);

var

style: LongInt;

flags: UINT;

begin

//Запрещаем перемещение элемента управления

style:= GetWindowLong(Handle, GWL_STYLE);

style:= style and not WS_OVERLAPPED and not WS_THICKFRAME

and not WS_CAPTION;

SetWindowLong(Handle, GWL_STYLE, style);

style:= GetWindowLong(Handle, GWL_EXSTYLE);

style:= style and not WS_EX_TOOLWINDOW;

SetWindowLong(Handle, GWL_EXSTYLE, style);

//Перерисуем в новом состоянии

flags:= SWP_NOMOVE or SWP_NOSIZE or SWP_DRAWFRAME or SWP_NOZORDER;

SetWindowPos(Handle, 0, 0, 0, 0, 0, flags);

end;

Осталось только реализовать вызовы процедур MakeMovable и MakeUnmovable в нужном месте программы. В рассматриваемом примере вызовы заключены внутри обработчика изменения состояния флажка на форме (листинг 1.24).

procedure TfrmMovingControls.chkSetMovableClick(Sender: TObject);

begin

if chkSetMovable.Checked then

begin

//Разрешаем перемещение элементов управления

MakeMovable(Memo1.Handle);

MakeMovable(ListBox1.Handle);

MakeMovable(Button1.Handle);

end

else

begin

//Запрещаем перемещение элементов управления

MakeUnmovable(Memo1.Handle);

MakeUnmovable(ListBox1.Handle);

MakeUnmovable(Button1.Handle);

end;

end;