Указатель мыши над контролом...

← →
TrainerOfDolphins © (2006-10-02 14:27) [0]

День добрый!
Хотел написать функцию, которая будет проверять находится ли курсор мыши над данным контролом или нет.

function CursorIsUnderControl(ParentControl,ChildControl:TWidgetControl):boolean;
var
c: TControl;
p: TPoint;
BEGIN
p := Mouse.CursorPos;
p := ParentControl.ScreenToClient(p);
c := ParentControl.ControlAtPos(p, true, true);
if c=ChildControl
then Result:=true;
END;
Но она почему-то всегда возвращает False;
ParentControl.ControlAtPos(p, true, true) возвращает nil, хотя не должен...
Где у меня ошибка?
Спасибо

← →
Elen © (2006-10-02 14:45) [1]

> TrainerOfDolphins

А где и когда она вызывается? Вообще лучше пропиши OnMouseMove...

← →
TrainerOfDolphins © (2006-10-02 14:55) [2]

>А где и когда она вызывается?
Над DBGrid-ом нужно выполнить некоторые действия. Но нужно их делать только тогда, когда мышь над ним, и сразу прекратить, как только мышь будет не над ним. Но, собственно, не важно, где я вызываю эту функцию. Чую, что где-то недопонял принцип. Дело в самой ф-ции.
>Вообще лучше пропиши OnMouseMove...
От куда я знаю, где окажется курсор, после того, как покинет DBGrid?
Назначать его всем контролам на форме как-то некошерно... :)

← →
Elen © (2006-10-02 15:02) [3]

А так :
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, DBGrids; type TForm1 = class(TForm) DBGrid1: TDBGrid; procedure FormCreate(Sender: TObject); procedure FC(var Msg: TMsg; var Handled: Boolean); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FC; begin if DBGrid1.Handle = msg.hwnd then caption:="ok" else caption:="no"; end; procedure TForm1.FormCreate(Sender: TObject); begin Application.OnMessage:=fc; end; end.
Так кошерно?

← →
TrainerOfDolphins © (2006-10-02 15:29) [4]

Прикольно... Работает. Только я не понял как... :)
Но дело в том, что yes возникат только тогда, когда двигаешь мышкой над гридом, в состоянии покоя ничего не происходит. Мне надо иметь возможность в любой момент узнать лежит ли указатель над гридом...
А что ты скажешь по поводу кода в [1]. Он мне больше подходит, но там где-то недочёт...

← →
Elen © (2006-10-02 15:56) [5]

> TrainerOfDolphins

Симпатично, но я не знаю как ты его вызываеш с какими параметрами и где. Это важно!

← →
Elen © (2006-10-02 16:03) [6]

> в любой момент узнать лежит ли указатель над гридом.

Вот тебе еще каша :
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormCr(Sender: TObject; var Done: Boolean); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} //********* PROCEDURE********** procedure tform1.FormCr; //const //Var begin caption:=TimeToStr(time); end; //********* END PROCEDURE******* procedure TForm1.FormCreate(Sender: TObject); begin Application.OnIdle:=FormCr; end; end.
заходи расхлебывать... :-)

← →
TrainerOfDolphins © (2006-10-02 16:08) [7]

Значится так: :)
Есть у меня TabSheet. На нём лежит DBGrid. Стало быть первый - Parent, второй - Child.
Создал я пока в ActionList действие с определённым ShortCut и поместил в обработчик этого действия вызов моей ф-ции:

begin
if CursorIsUnderControl(TWidgetControl(TabSheet),TWidgetControl(DBGrid)
then Label.Caption:="Yes"
else Label.Caption:="No"
end;

Потом я навожу курсор на DBGrid и с клавиатуры вызываю проверку. И... получаю шишь... :)

← →
Юрий Зотов © (2006-10-02 16:10) [8]

Mouse.CursorPos + FindVCLWindow + ControlAtPos

← →
Elen © (2006-10-02 16:11) [9]

Чем тебе [2] не подходит ? :-(

← →
TrainerOfDolphins © (2006-10-02 16:14) [10]

2 Elen
в смысле [3]?

← →
Elen © (2006-10-02 16:19) [11]

Да и [6]?

← →
TrainerOfDolphins © (2006-10-02 16:22) [12]

2 Elen
я вообще не понял, при чём тут [6]...
Особенно
caption:=TimeToStr(time); :)

← →
Elen © (2006-10-02 16:23) [13]

Вот это должно ответить на твой вопрос :
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids; type TForm1 = class(TForm) DBGrid1: TDBGrid; procedure FormCreate(Sender: TObject); procedure FormCr(Sender: TObject; var Done: Boolean); procedure FormCr2(var Msg: TMsg; var Handled: Boolean); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} //********* PROCEDURE********** procedure tform1.FormCr; //const var tp:Tpoint; begin GetCursorPos(tp); if WindowFromPoint(tp)=dbgrid1.Handle then caption:="да" else caption:="нет"; end; //********* END PROCEDURE******* //********* PROCEDURE********** procedure tform1.FormCr2; //const //Var begin if DBGrid1.Handle = msg.hwnd then caption:="ok" else caption:="no"; end; //********* END PROCEDURE******* procedure TForm1.FormCreate(Sender: TObject); begin Application.OnIdle:=FormCr; Application.OnMessage:=FormCr2; end; end.
FormCr будет выполняться когда ты ничего не делаеш и проверять где курсор.
formcr2 будет выполняться всегда когда прога будет получать месагу и тут тоже проверочка. Чем плохо :-(

← →
Elen © (2006-10-02 16:25) [14]

P.S. Я ж тебе на-водку даю...

← →
TrainerOfDolphins © (2006-10-02 16:25) [15]

2 Юрий Зотов
Прошу прощения, а не могли бы Вы чуточку конкретнее. Я не совсем понял, куда притулить FindVCLWindow... :)

← →
Юрий Зотов © (2006-10-02 16:28) [16]

function ControlUnderMouse: TControl; var P: TPoint; W: TWinControl; begin P := Mouse.CursorPos; W := FindVCLWindow(P); if W <> nil then begin Result := W.ControlAtPos(W.ScreenToClient(P), True); if Result = nil then Result := W end else Result := nil end; function IsControlUnderMouse(Control: TControl): boolean; begin Result := (Control <> nil) and (ControlUnderMouse = Control) end;

← →
TrainerOfDolphins © (2006-10-02 16:40) [17]

2 Elen
>Я ж тебе на-водку даю...
Водку я не пью. А если и пью, то на свои :)
>Чем тебе не подходит?
Во-первых, пока ничего не понимаю в сообщениях... :)
Во-вторых, сложновато немного. В одном обработчике назначается другой и всё это в главном юните. Все служебные ф-ции я стараюсь спрятать куда-нть подальше, в отдельный модуль.
А код [0] и [16] можно обернуть в одну маленькую ф-цию и забыть на время о её реализации...
А вообще, большое спасибо! Методы у тебя хакерские. Полезно поразмыслить на досуге. :)

← →
TrainerOfDolphins © (2006-10-02 16:43) [18]

2 Юрий Зотов
Спасибо.
Попью чаю и попробую...

← →
Elen © (2006-10-02 16:44) [19]

> TrainerOfDolphins

НИЧЕГО ХАКЕРСКОГО!!!!!!!! Глупости... Ты где собрался свою функцию вызывать?

← →
TrainerOfDolphins © (2006-10-02 17:02) [20]

>Ты где собрался свою функцию вызывать?
Ой, долго рассказывать. Но хорошая ф-ция должна работать, где-бы её не вызвали...

← →
Ketmar © (2006-10-02 17:09) [21]

>[20] TrainerOfDolphins(c) 2-Oct-2006, 17:02
>Ой, долго рассказывать. Но хорошая ф-ция должна
>работать, где-бы её не вызвали...
например, в драйвере режима ядра...

← →
TrainerOfDolphins © (2006-10-02 17:19) [22]

2 Юрий Зотов
Однако и FindVCLWindow(P) всё время nil возвращает... :(

p := Mouse.CursorPos; w:=FindVCLWindow(P); {w=nil}

← →
TrainerOfDolphins © (2006-10-02 17:20) [23]

2 Ketmar
Это Вы о чём? :)

← →
Ketmar © (2006-10-02 17:30) [24]

>[23] TrainerOfDolphins(c) 2-Oct-2006, 17:20
>Это Вы о чём? :)
о том, что "работать, где бы не вызвали" -- это утопия.

← →
TrainerOfDolphins © (2006-10-02 17:37) [25]

2 Ketmar
>о том, что "работать, где бы не вызвали" -- это утопия.
Любое утверждение относительно, и моё тоже...
А Вы к словам придираетесь. :)
А по сабжу есть соображения?

← →
Ketmar © (2006-10-02 17:44) [26]

есть. баг в коде. только что проверил: FindVCLWindow() работает отлично.

← →
Gydvin © (2006-10-02 17:46) [27]

А чем
CM_MOUSEENTER, CM_MOUSELEAVE отлавливать негодится?

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Grids, DBGrids; type TForm1 = class(TForm) DBGrid1: TDBGrid; procedure FormCreate(Sender: TObject); private { Private declarations } Sender_1: TObject; public { Public declarations } procedure WndProc(var Message: TMessage); override; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.WndProc(var Message: TMessage); begin inherited; case Message.Msg of CM_MOUSEENTER: begin if Message.LParam = integer(Sender_1) then Caption := "Hello, mouse"; end; CM_MOUSELEAVE: begin if Message.LParam = integer(Sender_1) then Caption := "By-by, mouse"; end; end; end; procedure TForm1.FormCreate(Sender: TObject); begin Sender_1:=DBGrid1; end; end.

← →
Ketmar © (2006-10-02 17:50) [28]

>[27] Gydvin(c) 2-Oct-2006, 17:46
>А чем
>CM_MOUSEENTER, CM_MOUSELEAVE отлавливать
>негодится?
попробуй резко "выдернуть" мышь из окошка. бедный контрол этого не заметит. есть и другие случаи, когда эти сообщения "теряются". оно не смертельно, но неприятно.

2 Ketmar
Скажи плиз, где ты вызывал FindVCLWindow() и что он тебе вернул?

на. я ленив. %-)
{$APPTYPE CONSOLE} uses Windows, Controls, StdCtrls, Forms; var f: TForm; b: TButton; w: Pointer; begin Application.Initialize(); f := TForm.Create(nil); f.Left := 10; f.Top := 10; f.Width := 320; f.Height := 200; b := TButton.Create(f); b.Parent := f; b.Left := 0; b.Top := 0; f.Show; Sleep(3000); w := FindVCLWindow(Mouse.CursorPos); if w = nil then WriteLn("shit!") else WriteLn(TObject(w).ClassName); end.

и какой объект он вернул?

когда мышь была над формой -- TForm. когда над кнопкой -- TButton. как и ожидалось.

Спасибо всем за помощь. Вариант описанный в [0] заработал, когда я вместо TwidgetControl передавать TWinControl. Только интересно почему он не работал с TwidgetControl ...

> TrainerOfDolphins

Наверное потому что TwidgetControl используется в CLX, а у тебя по всей видимости простая аппликация

Привет, Elen!
А чем отличается простая аппликация от CLX?

> TrainerOfDolphins

CLX - позволяет разрабатывать кросс-платформенные приложения, идущие и под Линуксом и для Виндой. Только этот CLX помоему не фонтан...

Недоработанный?

> TrainerOfDolphins

Не. просто я его на Пингвинчике пробую, а он не идет :-). Ну я вообще-то пользуюсь Linux Live On cd - knoppix 6 RE, может это не совсем то... В общем это чисто субъективное мнение... К тому же сейчас популярние .NET

Ясно, спасиба :)
Что бы я делал без мастеров...

Удалено модератором
Примечание: Флудить завязываем

Указатель мыши над контролом... Найти похожие ветки