Pisałem już wielokrotnie pod Delphi7 i Lazarusem różne komponenty, które standardowo nie posiadają zdarzeń OnMouseEnter i OnMouseLeave; Dodać obsługę komunikatów CM_MOUSEENTER i CM_MOUSELEAVE nie problem, są one przechwytywane i obsługiwane; Jednak za każdym razem jest taka sama sytuacja - problem pojawia się z komunikatem CM_MOUSELEAVE w momencie, gdy komponent jest duży, ustawimy nad nim kursor, a następnie bardzo szybko przesuwamy kursor poza komponent i formularz - wtedy komponent komunikatu nie dostaje;
Z obecnymi komponentami kombinowałem, ale nie udało mi się rozwiązać problemu; Napisałem więc malutki komponent do testów, dziedziczący z klasy TGraphicControl; Jego kod poniżej:
{$mode objfpc}{$H+}
interface
uses
LMessages, Classes, Controls, Graphics;
type
TMouseTest = class(TGraphicControl)
private
FHover: Boolean;
protected
procedure CMMouseEnter(var AMessage: TLMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var AMessage: TLMessage); message CM_MOUSELEAVE;
protected
procedure Paint(); override;
public
constructor Create(AOwner: TComponent); override;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Misc', [TMouseTest]);
end;
constructor TMouseTest.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Parent := AOwner as TWinControl;
FHover := False;
end;
procedure TMouseTest.CMMouseEnter(var AMessage: TLMessage);
begin
inherited;
FHover := True;
inherited Invalidate();
end;
procedure TMouseTest.CMMouseLeave(var AMessage: TLMessage);
begin
inherited;
FHover := False;
inherited Invalidate();
end;
procedure TMouseTest.Paint();
const
FRAME_COLORS: array [Boolean] of TColor = (clGray, clMenuHighlight);
BACKG_COLORS: array [Boolean] of TColor = (clLtGray, clWhite);
begin
with Self.Canvas do
begin
Pen.Color := FRAME_COLORS[FHover];
Brush.Color := BACKG_COLORS[FHover];
Rectangle(0, 0, Self.Width, Self.Height);
end;
end;
end.
Jak widać nic skomplikowanego - szary prostokąt, po najechaniu kursorem zmienia się na biały z kolorową ramką; Jeśli komponent jest mały i/lub daleko od krawędzi formularza, wszystko działa dobrze; Natomiast jeśli jest duży i znajduje się blisko krawędzi formularza, szybki ruch kursorem wzdłuż komponentu aż poza formularz, nie spowoduje jego deaktywacji (nie zmieni kolorów z powrotem na szare); Komponent dostaje ten komunikat dopiero po ponownym najechaniu kursorem na formularz, czyli nieco za późno;
Standardowe komponenty nie mają takich problemów - bez względu na to jak są duże i jak szybko ruszam kursorem, zawsze aktywują się i deaktywują prawidłowo; Niestety w ich źródłach nie znalazłem nic pomocnego;
Wie ktoś co jest przyczyną gubienia wspomnianego komunikatu i jak temu zaradzić? Będę wdzięczny za wszelką pomoc, bo już nie mam do tego nerwów;
W załączniku dorzucam kod komponentu, paczkę z tym komponentem do instalacji oraz aplikację testową (TestApp\project.exe) - można sprawdzić o co się rozchodzi.