Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.10.07;
Скачать: [xml.tar.bz2];

Вниз

Господа! Помогите отловить CM_MOUSELEAVE!   Найти похожие ветки 

 
EternalWonderer   (2002-09-25 20:39) [0]

Приведённый ниже код не работает (при перемещении мыши за пределы Image не вызывается ImageLeave). В чём может быть причина?

type
TMyImage = class(TImage)
Private
FOnMouseEnter: TNotifyEvent;
FOnMouseLeave: TNotifyEvent;
Procedure CMMouseEnter(Var Msg: TMessage); Message CM_MOUSEENTER;
Procedure CMMouseLeave(Var Msg: TMessage); Message CM_MOUSELEAVE;
Published
Property OnMouseEnter: TNotifyEvent read FOnMouseEnter Write FOnMouseEnter;
Property OnMouseLeave: TNotifyEvent read FOnMouseLeave Write FOnMouseLeave;
End;

TDlgAggModels = class(TForm)
...
public
Image1: TMyImage;
Procedure ImageLeave(Sender: TObject);
end;

implementation

procedure TMyImage.CMMouseEnter(var Msg: TMessage);
begin
If Assigned(FOnMouseEnter) Then FOnMouseEnter(Self);
end;

procedure TMyImage.CMMouseLeave(var Msg: TMessage);
begin
If Assigned(FOnMouseLeave) Then FOnMouseLeave(Self);
end;

Procedure TDlgAggModels.ImageLeave(Sender: TObject);
Begin
// какие-то действия;
End;

procedure TDlgAggModels.FormCreate(Sender: TObject);
begin
Image1:= TMyImage.Create(TabSheet2);
With Image1 Do Begin
Parent := TabSheet2;
Left := 168;
Top := 176;
Width := 64;
Height := 64;
OnMouseLeave := ImageLeave;
End;
End;


 
Юрий Зотов   (2002-09-25 20:56) [1]

1. В обработчиках сообщений нет вызыовов inherited. Подозркваю, что дело может быть в этом (разорвана "родная" цепочка передачи сообшений Parent"ам, что нарушает механизмы VCL).

2. Если делать грамотно, то нужно вводить методы диспетчеризации. Они позволяют наследникам класса безопасно встроить свой код в цепочку обработки события.

TMyImage = class(TImage)
private
FOnMouseEnter: TNotifyEvent;
FOnMouseLeave: TNotifyEvent;
procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
protected
procedure DoMouseEnter; dynamic;
procedure DoMouseLeave; dynamic;
published
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;

procedure TMyImage.CMMouseEnter(var Msg: TMessage);
begin
inheried;
DoMouseEnter
end;

procedure TMyImage.CMMouseLeave(var Msg: TMessage);
begin
inherited;
DoMouseLeave
end;

procedure TMyImage.DoMouseEnter;
begin
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self)
end;

procedure TMyImage.DoMouseLeave;
begin
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self)
end;


 
EternalWonderer   (2002-09-26 09:15) [2]

> Юрий Зотов © (25.09.02 20:56)
Спасибо, действительно так корректней. Однако проблему эти корректировки не решили ...
Видимо, проблема где - то раньше:
procedure TMyImage.CMMouseEnter(var Msg: TMessage);
begin
ShowMessage("OK");
inherited;
DoMouseEnter;
end;

ОК не выдаётся - видимо, именно не доходит сообщение.
Причём "стандартные" сообщения (OnMouseMove) проходят без проблем.

Попробовал использовать пример из "советов программистов" В.Озерова(стр.445),
причём "передрал" его с точностью до буквы - тоже не работает.
Может, что-то я не делаю при создании экземпляра Image1?


 
EternalWonderer   (2002-09-26 09:45) [3]

Если создать новый проект с формой в exe, всё работает, как часы.
Похоже, проблема в том, что форма с Image находится в Dll.
Вот процедура создания формы:
Function ShowDlgAggModels(hWnd: THandle): Integer; export;
Begin
Application.Handle := hWnd;
If DlgAggModels = Nil Then Begin
Application.CreateForm(TDlgAggModels, DlgAggModels);
End;
With DlgAggModels Do Begin
Show;
End;
Result := -1;
End;

Может, где-нибудь здесь собака зарыта?


 
EternalWonderer   (2002-09-26 10:03) [4]

А вот процедура вызова этой функции в exe:

Procedure ShowForm(NameDll, NameProc: PChar; Var LibHandle: THandle);
Var ShowProc: Procedure(hWnd: THandle);
begin
If LibHandle = 0 Then LibHandle := LoadLibrary(NameDll);
If LibHandle <> 0 Then Begin
@ShowProc := GetProcAddress(LibHandle, NameProc);
If @ShowProc <> Nil Then ShowProc(Application.Handle);
End;
end;


 
Юрий Зотов   (2002-09-26 10:18) [5]

Попробуйте переопределить не Handle, а весь объект Application, и заодно Screen. Только это лучше делать ОДИН раз, предварительно запомнив, а перед выгрузкой DLL вернуть эти старые назад.


 
EternalWonderer   (2002-09-26 10:27) [6]

Спасибо, попробую ...


 
EternalWonderer   (2002-09-27 09:12) [7]

Класс!
Решил повторно проверить правильность работы, когда форма находится в exe - файле. Работает, но выявился ещё один "казус" - если перемещать мышь из элемента управления наружу с нажатой кнопкой мыши, сообщение CM_MOUSELEAVE вообще не приходит (хотя в книге "секреты Delphi 2" Рэя Лишнера на стр. 524 сказано, что оно должно прийти асинхронно) и, кроме того, в компонент продолжают поступать сообщения CM_MOUSEMOVE - т.е. в этом случае выход курсора за предела компоненты придётся отслеживать, сравнивая в OnMouseMove координаты X и Y с координатами компоненты. Вот так.

Пробовал передавать в dll и присваивать объект Application из exe - не помогло. Пробовал TScreen - при присвоении в dll выдаёт исключение "не могу присвоить Font". Так что проблему решить так и не удалось.

Как всё - таки быть?.



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.10.07;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.009 c
3-20908
Jaxtor
2002-09-17 09:32
2002.10.07
Создание базы данных в текстовом виде


1-20967
Шурик Ш
2002-09-25 18:00
2002.10.07
Открытие формы


14-21252
cyborg
2002-09-11 14:15
2002.10.07
Вставка картинок в редактор


1-21144
turonix
2002-09-25 23:43
2002.10.07
Как заставить окно с кнопкой


8-21155
Вовчик
2002-06-06 19:55
2002.10.07
ЛЮЮЮДИ





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский