PHP DM Gate v0.9 » Мышиный Перехват в дизайн-тайм

DevilDevil © (26.07.06 10:17) [0]

Мой TCustomControl компонент должен перехватывать мышиные движения и клики. Реализую перекрытием MouseDown и MouseMove. В ран тайм всё работает нормально. Как сделать, чтобы и в дизайн-тайм всё работало?

<Цитата>
DimaBr (26.07.06 12:28) [1]

Приблизительно так

procedure WMNCHITTEST(var M: TWMNCHITTEST); message WM_NCHITTEST;
......
procedure TMyCustomControl.WMNCHITTEST(var M: TWMNCHITTEST);
var R: TRect;
P: TPoint;
begin
R:=GetClientRect;
P:=ScreenToClient(Point(M.XPos, M.YPos));
if (P.x<R.Left)and(P.y<R.Left) then M.Result:=HTTOPLEFT else
if (P.x<R.Left)and(P.y>R.Bottom) then M.Result:=HTBOTTOMLEFT else
if (P.x>R.Right)and(P.y<R.Left) then M.Result:=HTTOPRIGHT else
if (P.x>R.Right)and(P.y>R.Bottom) then M.Result:=HTBOTTOMRIGHT else
if P.x<R.Left then M.Result:=HTLEFT else
if P.x>R.Right then M.Result:=HTRIGHT else
if P.y<R.Left then M.Result:=HTTOP else
if P.y>R.Bottom then M.Result:=HTBOTTOM else
if P.y<R.Top then M.Result:=HTCAPTION else M.Result:=HTCLIENT;
if (csDesigning in ComponentState) and (M.Result=HTCAPTION) then inherited
end;
end;

<Цитата>
DevilDevil © (26.07.06 12:43) [2]

> DimaBr (26.07.06 12:28) [1]
Cool, а что за сообщение такое
WMNCHITTEST

? За что оно отвечает, только за мышиные или за все сообщения в DesignTime?
csDesigning

стало быть автоматически выставляется в DesignTime?

<Цитата>
Сергей М. © (26.07.06 13:14) [3]

> что за сообщение такое WMNCHITTEST?

The WM_NCHITTEST message is sent to a window when the cursor moves, or when a mouse button is pressed or released. If the mouse is not captured, the message is sent to the window beneath the cursor. Otherwise, the message is posted to the window that has captured the mouse.

<Цитата>
DimaBr (26.07.06 13:31) [4]

> csDesigning стало быть автоматически выставляется в DesignTime?

Да, и это то прекрасно, если нужно отличить от Run Time.

<Цитата>
DevilDevil © (26.07.06 14:45) [5]

А кто-нить знает, как в C++ вызвать типа inherited. Делаю:
TCustomControl::WMNCHitTest(M)

, говорит, недоступен

<Цитата>
DevilDevil © (26.07.06 16:05) [6]

А вообще последняя строка критична?
Если нет, то без неё у меня всё по прежнему; как быть?

<Цитата>
DimaBr (27.07.06 10:19) [7]

Прошу прощения, код просто вырезал из компонента, а в нём переопределён
GetClientRect, поэтому замените строчку

R:=GetClientRect;

на:
with ClientRect do R := Rect(Left+1,Top+1,Right-2,Bottom-2);

<Цитата>
DevilDevil © (27.07.06 14:09) [8]

Один Фиг реакции нет.

DimaBr, пожалуйста, если есть такая возможность, протестите свой компонент без последней строчки. Если у Вас не будет работать, значит всё дело в ней

<Цитата>
DimaBr (27.07.06 14:24) [9]

Вот, работает даже без фокусировки на компоненте.
unit Test;

interface

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

type
TForm1 = class(TForm)
Panel1: TPanel;
MyPanel1: TMyPanel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

TMyPanel = class(TPanel)
private
procedure WMNCHITTEST(var M: TWMNCHITTEST);message WM_NCHITTEST;
end;

var
Form1: TForm1;
APanel: TMyPanel;
procedure Register;
implementation

{$R *.dfm}

procedure Register;
begin
RegisterComponents('Standard',[TMyPanel]);
end;

procedure TMyPanel.WMNCHITTEST(var M: TWMNCHITTEST);
var R: TRect;
P: TPoint;
begin
with ClientRect do R := Rect(Left+1,Top+1,Right-2,Bottom-2);
P:=ScreenToClient(Point(M.XPos, M.YPos));
if (P.x<R.Left)and(P.y<R.Left) then M.Result:=HTTOPLEFT else
if (P.x<R.Left)and(P.y>R.Bottom) then M.Result:=HTBOTTOMLEFT else
if (P.x>R.Right)and(P.y<R.Left) then M.Result:=HTTOPRIGHT else
if (P.x>R.Right)and(P.y>R.Bottom) then M.Result:=HTBOTTOMRIGHT else
if P.x<R.Left then M.Result:=HTLEFT else
if P.x>R.Right then M.Result:=HTRIGHT else
if P.y<R.Left then M.Result:=HTTOP else
if P.y>R.Bottom then M.Result:=HTBOTTOM else
if P.y<R.Top then M.Result:=HTCAPTION else M.Result:=HTCLIENT;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
APanel:= TMyPanel.Create(self);
APanel.Parent := form1;
end;

end.

<Цитата>
DevilDevil © (27.07.06 15:14) [10]

Если я всё правильно понял, то мне нужно отследить, находится ли курсор в клиентской области (HTCLIENT). Вообщем я делаю табличку, сверху названия столбцов, высота которых равна TitleHeight [17 пикселей]. И всё равно блин чё та не хочет. А HTCAPTION - это что такое? Делаю так:

void __fastcall TInfoTable::WMNCHitTest(Messages::TWMNCHitTest &Message)
{
//TRect R = GetClientRect();

TRect R, CL = ClientRect;
R = Rect(CL.Left+1,CL.Top+1+TitleHeight,CL.Right-2,CL.Bottom-2);
TPoint P = ScreenToClient(Point(Message.XPos, Message.YPos));

Message.Result = 0;
if (ComponentState.Contains(csDesigning))
{
if (P.x<R.Left && P.y<R.Left) Message.Result=HTTOPLEFT; else
if (P.x<R.Left && P.y>R.Bottom) Message.Result=HTBOTTOMLEFT; else
if (P.x>R.Right && P.y<R.Left) Message.Result=HTTOPRIGHT; else
if (P.x>R.Right && P.y>R.Bottom) Message.Result=HTBOTTOMRIGHT; else
if (P.x<R.Left) Message.Result=HTLEFT; else
if (P.x>R.Right) Message.Result=HTRIGHT; else
if (P.y<R.Left) Message.Result=HTTOP; else
if (P.y>R.Bottom) Message.Result=HTBOTTOM; else
if (P.y<R.Top) Message.Result=HTCLIENT;
// if (P.y<R.Top) Message.Result=HTCAPTION; //else Message.

Result=HTCLIENT;
}
if (!Message.Result) Message.Result=HTCLIENT;
// if (ComponentState.Contains(csDesigning) && Message.Result==HTCAPTION) TCustomControl::WMNCHitTest();//(Message);

}

<Цитата>
DimaBr (27.07.06 15:51) [11]

К сожалению, я не силён в Си, но идея этого события такова чтобы вернуть результат системе, где находится курсор мыши, как системе отобразить курсор и как реагировать. Для этого и передаётся параметр var M: TWMNCHITTEST. который мы и заполняем. Данный код отслеживает положение курсора и если это положение у самого края компонента - то возвращается значение у какого собственно говоря края. В зависимости от вернувшегося значения система реагирует на поведение курсора. То есть, если мы находимся у правого края, отрабатывается условие
if P.x>R.Right then M.Result:=HTRIGHT

и возвращается значение HTRIGHT. Система отображает курсор в виде <-> и при нажатии на левую кнопку мыши и её перемещение происходит изменение ширины компонента по правому краю.

<Цитата>
DevilDevil © (27.07.06 16:31) [12]

Ну это более менее понятно. А
HTCAPTION

?

<Цитата>
DimaBr (27.07.06 16:34) [13]

Курсор находится в районе заголовка окна.

<Цитата>
DevilDevil © (27.07.06 16:41) [14]

Не катит! Вообще одну строчку оставил:
Message.Result=HTCLIENT;

Естественно, перекомпилировал и даже переустановил.
По идее в ДизайнТайм вообще не должен реагировать... А он реагирует :( [всмысле компонент можно перемещать, изменять размеры]

<Цитата>
DimaBr (27.07.06 16:58) [15]

Я не понимаю чего вы хотите добиться.

> По идее в ДизайнТайм вообще не должен реагировать

Всё с точностью до наоборот. Вы сообщаете системе что курсор находится на территории окна. Почему же он не должен реагировать ?

<Цитата>
DevilDevil © (27.07.06 17:17) [16]

> DimaBr (27.07.06 16:58) [15]
Я не понимаю чего вы хотите добиться.

Пока надо в дизайн тайм изменять ширину столбцов таблицы. В рантайм работает, в дизайнтайм - не воспринимает

<Цитата>
DimaBr (27.07.06 17:24) [17]

Начнём сначала. Что из себя представляет таблица ?

<Цитата>
DevilDevil © (27.07.06 17:33) [18]

таблица - двумерная матрица M x N :)

Предаставляй TStringGrid, у которого есть шапка, слева ничё нету. Можно задавать количество строк и столбцов. Получается M x N ячеек. Ширину каждого столбца можно менять [мышкой, если между 2-мя столбцами в шапке]. Так вот в рантайм всё работает, в дизайн - нет

<Цитата>
Степан (27.07.06 21:27) [19]

Такой компонент уже изобрели :) TListView называется с параметром Style = vsReport!!! Ну а если серьезно, то нафига тебе настраивать ширину столбцов в Дезигн-Тайм... Делай програмно, ненадо самому себе придумывать мозго***тва... Чем проще, тем лучше...

<Цитата>