unit Unit4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TfrmMovingControlsEx = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    ListBox1: TListBox;
    chkSetMovable: TCheckBox;
    procedure chkSetMovableClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMovingControlsEx: TfrmMovingControlsEx;

implementation

{$R *.dfm}

procedure MakeMovable(Handle: HWND);
var
  style, exstyle: LongInt;
  flags: UINT;
  rc: TRect;
begin
  //Разрешаем перемещение элемента управления
  style := GetWindowLong(Handle, GWL_STYLE);
  style := style or WS_OVERLAPPED or WS_THICKFRAME or WS_CAPTION;
  SetWindowLong(Handle, GWL_STYLE, style);

  exstyle := GetWindowLong(Handle, GWL_EXSTYLE);
  exstyle := exstyle or WS_EX_TOOLWINDOW;
  SetWindowLong(Handle, GWL_EXSTYLE, exstyle);

  //Сделаем так, чтобы положение клиентской области получившегося окна
  //совпадало с первоначальным положением  элемента управления
  //..расчет размера окна
  GetWindowRect(Handle, rc);
  ScreenToClient(GetParent(Handle), rc.TopLeft);
  ScreenToClient(GetParent(Handle), rc.BottomRight);
  AdjustWindowRectEx(rc, style, FALSE, exstyle);
  //..перемещение окна
  flags := SWP_DRAWFRAME or SWP_NOZORDER;
  SetWindowPos(Handle,0, rc.Left, rc.Top,
               rc.Right - rc.Left, rc.Bottom - rc.Top, flags);
end;

procedure MakeUnmovable(Handle: HWND);
var
  style: LongInt;
  flags: UINT;
  rc: TRect;
  isHScroll, isVScroll: Boolean;
begin
  //Убираем поломы прокрутки (если они есть)
  style := GetWindowLong(Handle, GWL_STYLE);
  if (style and WS_HSCROLL <> 0) then
  begin
    //Есть горизонтальная полоска прокруки
    isHScroll := True;
    style := style and not WS_HSCROLL;
  end
  else
    isHScroll := False;

  if (style and WS_VSCROLL <> 0) then
  begin
    //Есть вертикальная полоска прокруки
    isVScroll := True;
    style := style and not WS_VSCROLL;
  end
  else
    isVScroll := False;
  SetWindowLong(Handle, GWL_STYLE, style);
  UpdateWindow(Handle);

  //Устанавливаем элемент управления в то же место,
  //где находилась клиентская область окна с рамкой
  GetClientRect(Handle, rc);
  ClientToScreen(Handle, rc.TopLeft);
  ClientToScreen(Handle, rc.BottomRight);
  ScreenToClient(GetParent(Handle), rc.TopLeft);
  ScreenToClient(GetParent(Handle), rc.BottomRight);

  //Возвращаем полосы прокрутки на место
  if isHScroll then style := style or WS_HSCROLL;
  if isVScroll then style := style or WS_VSCROLL;
  SetWindowLong(Handle, GWL_STYLE, style);

  //Запрещаем перемещение элемента управления
  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_DRAWFRAME or SWP_NOZORDER;
  SetWindowPos(Handle, 0, rc.Left, rc.Top, rc.Right - rc.Left,
               rc.Bottom - rc.Top, flags);
end;


procedure TfrmMovingControlsEx.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;

end.
