Как запретить перемещение окна мышкой?
Помогите понять что происходит.
Встала задача запретить перемещение окна. Первое что пришло в голову подменить оконную функцию, и фильтровать сообщения.
Собственно код:
Код:
implementation
{$R *.dfm}
function NewWndProc(Handle: CARDINAL; Msg: CARDINAL; WParam, LParam: INTEGER): INTEGER; stdcall;
begin
if Msg = WM_MOVE then
begin
Msg := WM_KILLFOCUS; // Просто выбрано самое нейтральное
//MessageBox(0, 'Окно двигается', 'Message', 0);
end;
result := CallWindowProc(POINTER(WndProc), Handle, Msg, WParam, LParam);
end;
И при создании формы я тут же делаю подмену
procedure TForm1.FormCreate(Sender: TObject);
begin
WndProc := SetWindowLong(Form1.Handle, GWL_WNDPROC, INTEGER(@NewWndProc));
end;
{$R *.dfm}
function NewWndProc(Handle: CARDINAL; Msg: CARDINAL; WParam, LParam: INTEGER): INTEGER; stdcall;
begin
if Msg = WM_MOVE then
begin
Msg := WM_KILLFOCUS; // Просто выбрано самое нейтральное
//MessageBox(0, 'Окно двигается', 'Message', 0);
end;
result := CallWindowProc(POINTER(WndProc), Handle, Msg, WParam, LParam);
end;
И при создании формы я тут же делаю подмену
procedure TForm1.FormCreate(Sender: TObject);
begin
WndProc := SetWindowLong(Form1.Handle, GWL_WNDPROC, INTEGER(@NewWndProc));
end;
И когда вывод сообщения закоментен то окно двигается как ни в чём ни бывало.
Так как заставить окно не реагировать на попытки перемещения? При этом в окне должен работать правый клик мыши.
И вообще желательно сохранить весь функционал окна за исключением движения
Нужно ловить WM_SYSCOMMAND с wParam == $F012, и не пропускать.
Код:
if Msg = WM_LButtonDown then
begin
Msg := WM_KillFocus;
//MessageBox(0, 'Окно двигается', 'Msg', 0);
//Result := 0;
Exit;
end;
begin
Msg := WM_KillFocus;
//MessageBox(0, 'Окно двигается', 'Msg', 0);
//Result := 0;
Exit;
end;
Пишу програмку где формы выстроены определённым образом. Не хотелось бы чтоб одну из форм случайно можно было сдвинуть
Код:
FormBorderStyle = System.Windows.Forms.FormBorderStyle.None;
Цитата: cronya
Код:
FormBorderStyle = System.Windows.Forms.FormBorderStyle.None;
Гениально! А систем-меню с бордюрами нарисовать вручную на канве! ;-)
Код:
int WM_NCLBUTTONDOWN = 0x00A1;
const int WM_NCHITTEST = 0x0084;
const int HTCAPTION = 2;
[DllImport("User32.dll")]
static extern int SendMessage(IntPtr hWnd,
int Msg, IntPtr wParam, IntPtr lParam);
protected override void WndProc(ref Message m)
{
if (m.Msg == WM_NCLBUTTONDOWN)
{
//Проверяем где именно нажали кнопку мыши
int result = SendMessage(m.HWnd, WM_NCHITTEST,
IntPtr.Zero, m.LParam);
if (result == HTCAPTION)
//Не позволяем этому сообщению быть обработанным
return;
}
base.WndProc(ref m);
}
private void Form1_Load(object sender, EventArgs e)
{
this.StartPosition = FormStartPosition.CenterScreen;
this.MaximizeBox = false;
this.MinimizeBox = false;
}
const int WM_NCHITTEST = 0x0084;
const int HTCAPTION = 2;
[DllImport("User32.dll")]
static extern int SendMessage(IntPtr hWnd,
int Msg, IntPtr wParam, IntPtr lParam);
protected override void WndProc(ref Message m)
{
if (m.Msg == WM_NCLBUTTONDOWN)
{
//Проверяем где именно нажали кнопку мыши
int result = SendMessage(m.HWnd, WM_NCHITTEST,
IntPtr.Zero, m.LParam);
if (result == HTCAPTION)
//Не позволяем этому сообщению быть обработанным
return;
}
base.WndProc(ref m);
}
private void Form1_Load(object sender, EventArgs e)
{
this.StartPosition = FormStartPosition.CenterScreen;
this.MaximizeBox = false;
this.MinimizeBox = false;
}
Код:
void __fastcall TForm1::WinProc(TMessage &Message)//переопределенная оконная функция
{
LPRECT lpRect;
switch (Message.Msg)
{
case WM_MOVING: {
lpRect = (LPRECT) Message.LParam;
GetWindowRect(Handle, lpRect);
} break;
}
Dispatch(&Message);
}
{
LPRECT lpRect;
switch (Message.Msg)
{
case WM_MOVING: {
lpRect = (LPRECT) Message.LParam;
GetWindowRect(Handle, lpRect);
} break;
}
Dispatch(&Message);
}
Код:
function NewWndProc(Handle: CARDINAL; Msg: CARDINAL; WParam: INTEGER; LParam: INTEGER): INTEGER; stdcall;
begin
if Msg = WM_NCLBUTTONDOWN then
begin
//Msg := wm_KillFocus;
//MessageBox(0, 'Прогу сука двигают', 'Msg', 0);
//Result := 0;
Exit;
end;
result := CallWindowProc(Pointer(WndProc), Handle, Msg, WParam, LParam);
end;
begin
if Msg = WM_NCLBUTTONDOWN then
begin
//Msg := wm_KillFocus;
//MessageBox(0, 'Прогу сука двигают', 'Msg', 0);
//Result := 0;
Exit;
end;
result := CallWindowProc(Pointer(WndProc), Handle, Msg, WParam, LParam);
end;
Вот так окно не двигается. Но есть одна маленькая проблемка, Не срабатывает кнопка закрытия окна.
Как лечить ? Можно ли както проверить что кликнули по крестику и самому вызвать DestroyWindow?
ну вот на C# еще раз там нажимается кнопка
Код:
DllImport("User32.dll")]
static extern bool GetWindowRect(IntPtr hWnd, Int32 lpRect);
public const int WM_MOVING = 0x0216;
protected override void WndProc(ref Message m)
{
switch (m.Msg)
{
case WM_MOVING:
GetWindowRect(m.HWnd, (Int32)m.LParam);
break;
}
base.WndProc(ref m);
}
static extern bool GetWindowRect(IntPtr hWnd, Int32 lpRect);
public const int WM_MOVING = 0x0216;
protected override void WndProc(ref Message m)
{
switch (m.Msg)
{
case WM_MOVING:
GetWindowRect(m.HWnd, (Int32)m.LParam);
break;
}
base.WndProc(ref m);
}
Код:
function NewWndProc(Handle: CARDINAL; Msg: CARDINAL; WParam: INTEGER; LParam: INTEGER): INTEGER; stdcall;
begin
lpRect: PRect;
if Msg := WM_MOVING then
begin
lpRect := Msg.lprect;
GetWindowRect(Handle,lpRect );
Exit;
end;
result := CallWindowProc(Pointer(WndProc), Handle, Msg, WParam, LParam);
end;
begin
lpRect: PRect;
if Msg := WM_MOVING then
begin
lpRect := Msg.lprect;
GetWindowRect(Handle,lpRect );
Exit;
end;
result := CallWindowProc(Pointer(WndProc), Handle, Msg, WParam, LParam);
end;
Цитата: Meander
попробуй примерно так:
Код:
function NewWndProc(Handle: CARDINAL; Msg: CARDINAL; WParam: INTEGER; LParam: INTEGER): INTEGER; stdcall;
var
lpRect: PRect;
begin
//lpRect: PRect; // Так в паскале не делается, нужно всек переменные записывать в секцию объявления переменных
if Msg := WM_MOVING then // Вот тут тоже весело. Вы делаете присвоение
begin
lpRect := Msg.lprect; // Вот тут можно поподробней? Что мы тут делаем? Ибо в делфи не проканывает.
GetWindowRect(Handle,lpRect );
Exit;
end;
result := CallWindowProc(Pointer(WndProc), Handle, Msg, WParam, LParam);
end;
var
lpRect: PRect;
begin
//lpRect: PRect; // Так в паскале не делается, нужно всек переменные записывать в секцию объявления переменных
if Msg := WM_MOVING then // Вот тут тоже весело. Вы делаете присвоение
begin
lpRect := Msg.lprect; // Вот тут можно поподробней? Что мы тут делаем? Ибо в делфи не проканывает.
GetWindowRect(Handle,lpRect );
Exit;
end;
result := CallWindowProc(Pointer(WndProc), Handle, Msg, WParam, LParam);
end;
:= замени на =
Exit; - вообще убери
Там вон выше писали что мол всё вам написали, но сконвертить в паскаль не выходит(ибо есть непонимание некоторых действий)
lpRect := Msg.lprect; Вот тут координаты какието нужно получить? Здесь Msg Типа CARDINAL(UINT), то есть это просто номер сообщения. Не знаю как там в си, но в паскале у типа CARDINAL нет таких методов.
Видимо координаты нужно извлекать из WParam или LParam.
GetWindowRect(Handle,lpRect ); Вот тут заполняем структуру но нигде её не используем.
Блин, паскальщики вообще перевелись? Помогите кто нибудь.
Код:
Есть свойство WindowProc: TWndMethod;
TWndMethod объявлен как:
Туре TWndMethod=Procedure(Var Message: TMessage) Of Object;
тебе надо создать процедуру такого вида:
procedure NewWndProc(var Message: TMessage);
var PRect : ^TRect;
begin
PRect := Pointer (Message.LParam);
if Message.Msg = WM_MOVING then
begin
GetWindowRect(Message.hWnd,PRect);
end;
else WndProc(Message);
end;
а при создании формы надо сделать присваивание:
WindowProc := NewWndProc;
NewWndProc - должна быть членом класса твоей формы
TWndMethod объявлен как:
Туре TWndMethod=Procedure(Var Message: TMessage) Of Object;
тебе надо создать процедуру такого вида:
procedure NewWndProc(var Message: TMessage);
var PRect : ^TRect;
begin
PRect := Pointer (Message.LParam);
if Message.Msg = WM_MOVING then
begin
GetWindowRect(Message.hWnd,PRect);
end;
else WndProc(Message);
end;
а при создании формы надо сделать присваивание:
WindowProc := NewWndProc;
NewWndProc - должна быть членом класса твоей формы
Гугл отключен, что ли. Свойство формы Align := alCustom;
Там принимает участие не только моя программа. Там ещё есть прога с внедрённой дллкой.
Вот я и хотел создать код который потом не в ущерб работоспособности можно будет записать в эту длл.
В идеале должен быть код который ничего не должен требовать кроме хендла окна
Код:
if Msg = WM_MOVING then
begin
MoveWindow(Form1.Handle, Form1.Left, Form1.Top, Form1.Width, Form1.Height, TRUE);
end;
begin
MoveWindow(Form1.Handle, Form1.Left, Form1.Top, Form1.Width, Form1.Height, TRUE);
end;
Но когда я выводил сообщение то при WM_MOVING окно смещалось после появления сообщения, а при WM_MOVE до.
Ща попробую сохранять все координаты при первом поступившем сообщении, и потом всегда их подставлять
Тот код, который я написал на C++ у меня работает. Последний вариант на паскале я не могу проверить, но я его составил по аналогии с найденными в сети. Структура Message содержит дескриптор окна hWnd а также область, где оно расположено Pointer (Message.LParam). Функция GetWindowRect(Message.hWnd,PRect); принимает дескриптор окна и структуру содержащую прямоугольную область. Просто поподробнее посмотри механизм переопределения WindowProc и работу с полем Message.LParam.
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin, ComCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
OldWndProcEdit:TWndMethod;
procedure NewWndMethod(var Message: TMessage);//Замещающая оконная процедура
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
OldWndProcEdit:=WindowProc;
WindowProc:=NewWndMethod;
end;
procedure TForm1.NewWndMethod(var Message: TMessage);
var
r:PRect;
begin
if Message.Msg = WM_MOVING then
begin
r:=PRect(Message.LParam);
GetWindowRect(Message.hWnd,r);
end;
else //попробовать с else и без него
OldWndProcEdit(Message);//Вызываем оригинальный обработчик
end;
end.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin, ComCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
OldWndProcEdit:TWndMethod;
procedure NewWndMethod(var Message: TMessage);//Замещающая оконная процедура
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
OldWndProcEdit:=WindowProc;
WindowProc:=NewWndMethod;
end;
procedure TForm1.NewWndMethod(var Message: TMessage);
var
r:PRect;
begin
if Message.Msg = WM_MOVING then
begin
r:=PRect(Message.LParam);
GetWindowRect(Message.hWnd,r);
end;
else //попробовать с else и без него
OldWndProcEdit(Message);//Вызываем оригинальный обработчик
end;
end.
Начал искать проблему начиная с создания формы. И код при создании формы не срабатывал, перешол в инспектор объектов, кликнул по методу OnCreate у формы. Переместился в тот же код(который уже был написан), но теперь заработало.
Разумеется я попадал на этот код из поиска. Но он не компилился, а когда я добился чтоб он компилился он просто не работал. Может и тогда был баг о котором я написал выше.
Ща буду кубаторить как всё это привести в нормальный вид
Код:
if Message.Msg = WM_MOVING then
begin
r:=PRect(Message.LParam);
GetWindowRect(Form1.Handle,r^); // Вот тут например не проканывает Message.hWnd, не имеется на выбор никаких хендлов.
//И r там какой то криворучка подставляет, его компилятор ни смутило несоответствие типов? :-)
//ShowMessage('ЗАЕ***');
end
begin
r:=PRect(Message.LParam);
GetWindowRect(Form1.Handle,r^); // Вот тут например не проканывает Message.hWnd, не имеется на выбор никаких хендлов.
//И r там какой то криворучка подставляет, его компилятор ни смутило несоответствие типов? :-)
//ShowMessage('ЗАЕ***');
end
Прототип функции должен быть такой:
Код:
function NewWindowProc(HWnd: CARDINAL; Msg: CARDINAL; WParam: INTEGER; LParam: INTEGER): INTEGER; Stdcall;
В итоге пришлось ставить хук WH_CBT:
Код:
...
var
Form1: TForm1;
Hook: HHOOK;
implementation
{$R *.DFM}
function CBTProc(Code: INTEGER; WParam: INTEGER; LParam: INTEGER): INTEGER; stdcall;
begin
if Code < 0 then
begin
Result := CallNextHookEx(Hook, Code, WParam, LParam);
Exit;
end;
case Code of
HCBT_MOVESIZE:
Begin
//ShowMessage('Отъе*** от окна');
Exit;
end;
end;
Result := CallNextHookEx(Hook, Code, WParam, LParam);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Hook := SetWindowsHookEx(WH_CBT, @CBTProc, hInstance, GetWindowThreadProcessId(Form1.Handle, NIL));
end;
var
Form1: TForm1;
Hook: HHOOK;
implementation
{$R *.DFM}
function CBTProc(Code: INTEGER; WParam: INTEGER; LParam: INTEGER): INTEGER; stdcall;
begin
if Code < 0 then
begin
Result := CallNextHookEx(Hook, Code, WParam, LParam);
Exit;
end;
case Code of
HCBT_MOVESIZE:
Begin
//ShowMessage('Отъе*** от окна');
Exit;
end;
end;
Result := CallNextHookEx(Hook, Code, WParam, LParam);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Hook := SetWindowsHookEx(WH_CBT, @CBTProc, hInstance, GetWindowThreadProcessId(Form1.Handle, NIL));
end;
Формально задача решена, но хочется лучшего. Если у кого есть какие идеи выкладывайте, не стесняйтесь.
Цитата: Meander
Код:
...
...
а при создании формы надо сделать присваивание:
WindowProc := NewWndProc;
NewWndProc - должна быть членом класса твоей формы
...
а при создании формы надо сделать присваивание:
WindowProc := NewWndProc;
NewWndProc - должна быть членом класса твоей формы
И вот это ещё забыл прокоментировать. Нету такого события. Форма уже созданна, то есть предполагалась подмена когда программа уже работает
И нельзя ли чтобы NewWndProc не была членом класса моей формы, не все окна там класса моей формы.
Логически всё было просто. Сохраняем указатель на оконную функцию, подставляем указатель на свою функцию. В своей функции вызываем оригинальную функцию, за исключением сообщений о перемещениях.
Но на практике ...
Я думал, что необходимо просто субклассировать контрол, а так как нет, то не важно чьи это свойства - WindowProc := NewWndProc; Главное отловить хендл, по нему получить область где находится форма, отлавливать сообщение WM_MOVING любого окна и отправлять ему сообщение GetWindowRect(Handle,r^); где Handle - и есть целевое окно.
Цитата: 0nni
Нужно ловить WM_SYSCOMMAND с wParam == $F012, и не пропускать.
Спасибо огромное. Вот это действительно помогли. Задача решена на все сто.
Точ в точ ожидаемое поведение, и код не сложен:
Код:
function NewWndProc(Handle: CARDINAL; Msg: CARDINAL; WParam: INTEGER; LParam: INTEGER): INTEGER; stdcall;
begin
if (Msg = WM_SYSCOMMAND) and ((WParam = SC_MOVING) or (WParam = SC_MOVE)) then Exit;
result := CallWindowProc(POINTER(CurWndProc), Handle, Msg, WParam, LParam);
end;
begin
if (Msg = WM_SYSCOMMAND) and ((WParam = SC_MOVING) or (WParam = SC_MOVE)) then Exit;
result := CallWindowProc(POINTER(CurWndProc), Handle, Msg, WParam, LParam);
end;
Вот так не двигается ни мышкой ни когда выбираешь переместить и пытаешся двигать с клавы
Только вот решение получилось слишком уж замудренным.
Ведь существуют стандартные приемы субклассирования как средствами VCL,
так и средствами Windows API.
Желающие могут прочитать более подробную информацию об этом здесь.
А теперь код работающего примера на Delphi:
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const
SC_MOVING =61458;
type
TForm1 = class(TForm)
Label1: TLabel;
procedure WndProc(var Msg: TMessage); override;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WndProc(var Msg: TMessage);
begin
if (Msg.WParam = SC_MOVING) {or (Msg.WParam = SC_MOVE)} then Exit;
inherited WndProc(msg);
end;
end.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
const
SC_MOVING =61458;
type
TForm1 = class(TForm)
Label1: TLabel;
procedure WndProc(var Msg: TMessage); override;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WndProc(var Msg: TMessage);
begin
if (Msg.WParam = SC_MOVING) {or (Msg.WParam = SC_MOVE)} then Exit;
inherited WndProc(msg);
end;
end.
не имеет смысла: если запрещено перемещение, сообщение об окончании
перемещения не возникает.
Этот вопрос долго изучался, и в итоге самое простое решение вы видели в последних постах
Код:
function NewWndProc(Handle: CARDINAL; Msg: CARDINAL; WParam: INTEGER; LParam: INTEGER): INTEGER; stdcall;
begin
if (Msg = WM_SYSCOMMAND) and ((WParam = SC_MOVING) or (WParam = SC_MOVE)) then Exit;
result := CallWindowProc(POINTER(CurWndProc), Handle, Msg, WParam, LParam);
end;
begin
if (Msg = WM_SYSCOMMAND) and ((WParam = SC_MOVING) or (WParam = SC_MOVE)) then Exit;
result := CallWindowProc(POINTER(CurWndProc), Handle, Msg, WParam, LParam);
end;
Всегда вызывается оригинальная оконная процедура, кроме случаев которые нас интересуют. Т.е. окна программы ведут себя как обычно за исключением перемещений(любых, будь то перемещение мышкой или выбор меню и попытка двигать с помощью клавиатуры)
За ссылку конечно спасибо, но код уже давно работает и у меня счейчас нет времени читатьт информацию в этой ссылке.
Уверен что там достойная информация.