Обработка WndProc(var Message: TMessage);

← →
Ptr (2003-10-13 11:32) [0]

Уважаемые мастера! Помогите pls разобраться в 10 строчках...
Компонент должен (при выполнении условиия) посылать TWMMouse сообщение родителю (т.е. бать прозрачен для мыши)

Написал код:
//::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
procedure XXXGraphic.WndProc(var Message: TMessage);
begin
case Message.Msg of
WM_LBUTTONDOWN, WM_RBUTTONDOWN:
if not (csDesigning in ComponentState) then
begin
if (TWMMouse(Message).XPos in [10 .. Width-20]) and
(TWMMouse(Message).YPos in [10 .. Height-20]) then
begin
// Message.LParamLo := Message.LParamLo + Word(Left);
// Message.LParamHi := Message.LParamHi + Word(Top);
Parent.Perform(Message.Msg, Message.WParam,
Message.LParam);
exit;
end;
end;
end;
inherited WndProc(Message);
end;
//::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Проблема в том, что при закоментированных строчках обработчик события Parent.MouseDown(...) срабатывает, но, естественно, родитель получает искаженные параметры курсора;
Если я разкоментирую строки с изменением координат, то происходит переполнение буфера (т.е. бесконечный цикл).
Может Есть ЗНАТОКИ??? В ЧЕМ ТУТ ДЕЛО ???
Заранее спасибо...

← →
Skier (2003-10-13 11:38) [1]

>Ptr (13.10.03 11:32)
А конечная цель всего этого какая ?

← →
Ptr (2003-10-13 11:44) [2]

Цель - построить компонент, отображающий геометрическую фигуру (несколько фигур или линий), а обработчик должен работать только при попадании на границу фигуры например линию, в случае попадания вне зоны фигуры (но в пределах компонента) действовать так как еслибы он был прозрачен т.е. должен срабатывать обработчик родителя.. Вот

← →
Skier (2003-10-13 11:47) [3]

> в случае попадания вне зоны фигуры (но в пределах компонента)
> действовать так как еслибы он был прозрачен т.е. должен
> срабатывать обработчик родителя..

Тогда видимо ты inherited зыбыл для этого случая...

← →
NAlexey (2003-10-13 11:48) [4]

Делай MapWindowFromPoints преобразуя координаты клика на Child в координаты Parent.

← →
KSergey (2003-10-13 11:51) [5]

Возможно, проблема в Perform: это SendMessage. Возможно, родитель видит, что курсор над дочерним элементом и вызывает его WndProc. А тут мы опять его, а он нас - ну и т.д. ;)
Может воспользоваться PostMessage?

Все это просто предположения.

← →
KSergey (2003-10-13 11:53) [6]

> [3] Skier © (13.10.03 11:47)
> Тогда видимо ты inherited зыбыл для этого случая...

Разве??
Он ведь хочет, чтобы родителю ушло, а не компонент обрабатывал.

← →
Skier (2003-10-13 11:54) [7]

>KSergey © (13.10.03 11:51) [5]

> Может воспользоваться PostMessage?

Perform это и есть PostMessage

← →
Ptr (2003-10-13 11:56) [8]

Спасибо за ответы но:
Skier Прошу прощения, но мне кажется inherited вызывает метод базового класса а не родителя.
NAlexey MapWindowPoints только преобразует координаты, но у меня с этим проблеи и так нет после выполнения
Message.LParamLo := Message.LParamLo + Word(Left);
Message.LParamHi := Message.LParamHi + Word(Top);
в LParam находтся координаты в системк родителя (я проверял)
Не могу понять только почему при этом програма не переходит на Exit? а без изменеия выходит...

← →
Skier (2003-10-13 11:58) [9]

>KSergey © (13.10.03 11:53) [6]
Угу. Согласен.

← →
Ptr (2003-10-13 11:59) [10]

KSergey Ваш ответ наиболее логичен - надо проверить

← →
KSergey (2003-10-13 12:01) [11]

> [7] Skier © (13.10.03 11:54)
> Perform это и есть PostMessage

Неправда ваша ;)

Из VCL:

function TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
var
Message: TMessage;
begin
Message.Msg := Msg;
Message.WParam := WParam;
Message.LParam := LParam;
Message.Result := 0;
if Self <> nil then WindowProc(Message);
Result := Message.Result;
end;

Это, как понимаете, по сути SendMessage, только реализованный ручками борланда ;)

← →
Skier (2003-10-13 12:03) [12]

if (TWMMouse(Message).XPos in [10 .. Width-20]) and
(TWMMouse(Message).YPos in [10 .. Height-20]) then
Использование здесь множеств некорретно.
т.к. "диапазон" мн-ва [0..255]

← →
Ptr (2003-10-13 12:10) [13]

Skier - согласен но это только тест и координаты заведомо меньше 255. Тут то как раз условие выполняется (просто было лень писать полное условие)

KSergey я почти уверен что это поможет надо попытаться...

Skier, KSergey!

ОГРОМНОЕ ВСЕМ СПАСИБО ЗА УЧАСТИЕ !!!!!!!!!!!!

← →
han_malign (2003-10-13 12:13) [14]

>Perform это и есть PostMessage
- Perform это прямой вызов WndProc объекта, минуя очередь сообщений...

>Тогда видимо ты inherited зыбыл для этого случая...
- не прокатывает, компонент не прозрачен для сообщений, даже, если в ConrolStyle проставить все свойства которые за это отвечают (+[csNoStdEvents]-[csClickEvents,csDoubleClicks]). Мне помог только прямой вызов метода Parenta(FormOn...) отработывающего событие...

>Message.LParamLo := Message.LParamLo + Word(Left);
- всетаки правильне так:
var pt : TPoint; begin pt:=Parent.ScreenToClient(ClientToScreen(Point(X,Y)));
хотя в данном случае это не поможет...

З.Ы. Единственное, что 100% прокатит на уровне системы - это регионы...

← →
Ptr (2003-10-13 12:17) [15]

han_malign не хотелось бы связываться с "прямой вызов метода Parenta(FormOn...) отработывающего событие..." стройность теряется, вот с регионами можно попробывать повозиться, спасибо

← →
KSergey (2003-10-13 12:35) [16]

[14] han_malign © (13.10.03 12:13)
З.Ы. Единственное, что 100% прокатит на уровне системы - это регионы...

регионы - безусловный гуд, однако автор (правда, это лишь мое предположение) делает компонент от TGraphicControl, а к нему регионы не применшь - не окно это.

- не прокатывает, компонент не прозрачен для сообщений, даже, если в ConrolStyle проставить все свойства которые за это отвечают (+[csNoStdEvents]-[csClickEvents,csDoubleClicks]). Мне помог только прямой вызов метода Parenta(FormOn...) отработывающего событие...

Чета я тут поразмыслил над этой фразой - а ведь и правда может не проканать вовсе, хоть и с PostMessage. И, думаю, проблема будет вот в чем: сообщения Windows вообще-то для окон только передаются. Уж тем более при выборе из очереди.
Т.е. фактически получается, что сообщения и так валятся реально паренту, и уже лишь в недрах VCL передаются лажещим на нем не оконным компонентам. Т.е. цепочка опять замкнулась - хоть как передавай - а VCL все равно от парента вернет лежащему на нем компоненту... Хотя, конечно, пробывать надо. Неплохо бы найти соотв. место в VCL - посмотреть, можно ли его как-то обойти.

pt:=Parent.ScreenToClient(ClientToScreen(Point(X,Y)));
хотя в данном случае это не поможет...

Не понятно, правда, что имелось в виду под "не поможет"
Однако, и я хотел предложить тот же вариант, вообще-то он наиболее надежен и корректен, однако мне не удалось найти этих ф-ций не у виндовых компонент.
А, как я писал выше, я предполагал (по названию), что компонент автора наследуются не от TWinControl.

← →
icWasya (2003-10-13 12:57) [17]

попробуй перехватывать WM_NCHITTEST

type TMyComponent=class .... function OnLine(X,Y:Intger):Boolean; procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; .... end; Procedure TMyComponent.WMNCHitTest(var Message: TWMNCHitTest); Begin If OnLine(Message.XPos,Message.YPos) Then Message.Result:=HTCLIENT Else Message.Result:=HTERROR End; function TMyComponent.OnLine(X,Y:Intger):Boolean; begin ... end;

← →
han_malign (2003-10-13 13:27) [18]

> однако мне не удалось найти этих ф-ций не у виндовых компонент.
TControl = class(TComponent) .............. piblic .............. function ClientToScreen(const Point: TPoint): TPoint; function ClientToParent(const Point: TPoint; AParent: TWinControl = nil): TPoint; .............. TGraphicControl = class( TControl)
- если уж есть WndProc, то и все остальное есть...

> и уже лишь в недрах VCL передаются лажещим на нем не оконным компонентам
- есть такая фича...
function TWinControl.IsControlMouseMsg(var Message: TWMMouse): Boolean; var Control: TControl; P: TPoint; begin if GetCapture = Handle then begin if (CaptureControl <> nil) and (CaptureControl.Parent = Self) then Control := CaptureControl else Control := nil; end else Control := ControlAtPos(SmallPointToPoint(Message.Pos), False); Result := False; if Control <> nil then begin P.X := Message.XPos - Control.Left; P.Y := Message.YPos - Control.Top; Message.Result := Control.Perform(Message.Msg, Message.Keys, Longint(PointToSmallPoint(P))); Result := True; end; end; procedure TWinControl.WndProc(var Message: TMessage); var Form: TCustomForm; begin case Message.Msg of .......................... WM_MOUSEFIRST..WM_MOUSELAST: if IsControlMouseMsg(TWMMouse(Message)) then begin { Check HandleAllocated because IsControlMouseMsg might have freed the window if user code executed something like Parent := nil. } if ( Message.Result = 0) and HandleAllocated then DefWindowProc(Handle, Message.Msg, Message.wParam, Message.lParam); Exit; end; ............................................................ end; inherited WndProc(Message); end;
- из чего вывод - для обеспечения прозрачности события мыши, вместо
// Message.LParamLo := Message.LParamLo + Word(Left); // Message.LParamHi := Message.LParamHi + Word(Top); Parent.Perform(Message.Msg, Message.WParam, Message.LParam);
нужно
Message.Result:=0; exit;

← →
KSergey (2003-10-13 13:40) [19]

> [18] han_malign © (13.10.03 13:27)
> function ClientToScreen(const Point: TPoint): TPoint;
> function ClientToParent(const Point: TPoint; AParent:

Признаю, плохо искал ;)
Ну а дальше - вообще на 5+!! Спасибо.

← →
Ptr (2003-10-13 15:51) [20]

han_malign:
- из чего вывод - для обеспечения прозрачности события мыши, вместо
// Message.LParamLo := Message.LParamLo + Word(Left);
// Message.LParamHi := Message.LParamHi + Word(Top);
Parent.Perform(Message.Msg, Message.WParam,
Message.LParam);
нужно
Message.Result:=0;
exit;
------------------------------
Вывод действительно логичен, но Parent не реагирует ;-) (т.е. не обрабатывает, например MouseDown).
Зато благодаря Вашему пояснению теперь понятно почему происходит бесконечный цикл, если в Parent.Perform передавать измененные параметры координат мыши, которые находятся внутри области копонента. И все же, пока проблему решить не удалось

← →
icWasya (2003-10-13 16:05) [21]

см (13.10.03 12:57) [17]

← →
Романов Р.В. (2003-10-13 16:49) [22]

procedure TGraphicControl.CMHitTest(var Message: TCMHitTest);
begin
Message.Result := 0;
end;

procedure TWindowControl.WMNCHitTest(var Message: TWMNCHitTest);
begin
Message.Result := HTTRANSPARENT;
end;

← →
Ptr (2003-10-13 17:13) [23]

icWasya: К сожалению - неработает
(У меня такое подозрение, что процедура WMNCHitTest только для TWinControl а я рисую на базе TGraphicControl)
Попробывал использовать CMHitTest при этом не входит в обработчик компонента, а работает обработчик Parent, независимо от результата OnLine.
Честно говоря я даже в Delphi 7 не нашел описание WMNCHitTest (ни в Help не в Source...) но спасибо !

← →
Ptr (2003-10-13 17:14) [24]

Романов Р.В. прав !!!

← →
Ptr (2003-10-15 10:38) [25]

Хочу еще раз поблагодарить всех за участие. И кому интересно, все заработало с обработкой CMHitTest
//::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Procedure TIDEFArrow.CMHitTest(var Message: TCMHitTest);
Begin
If MouseInArrow(Point(Message.XPos,Message.YPos)) Then
Message.Result := 1
Else
Message.Result := 0;
end;
//::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

← →
Романов Р.В. (2003-10-15 11:35) [26]

Незначительная поправочка
If MouseInArrow(Point(Message.XPos,Message.YPos)) Then
Message.Result := HTCLIENT
// inherited // Второй вариант. Может кто скажет какой более правильный
Else
Message.Result := HTNOWHERE;

Обработка WndProc(var Message: TMessage); Найти похожие ветки