BorlandTalk.com

Toni W. · Guest

Hello everybody,

i've got problem with messages in an activeX. i've written a simple
component to test two messages in an activeX: CM_MOUSEENTER and
CM_MOUSELEAVE.
well, in a normal application, the component works fine. But in a
activex/ocx it won't get these messages.

Have you some ideas?

thanks toni

code of the component:

unit OCXTestControl;

interface

uses
windows,Messages,Classes,Controls;

type
TOCXTestControlG = class(TGraphicControl)
private
m_MouseInControl: Boolean;
protected
procedure CMMouseEnter(var Message: TMessage); message
CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message
CM_MOUSELEAVE;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
{ Published-Deklarationen }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Test', [TOCXTestControlG]);
end;

{ TOCXTestControlG }

procedure TOCXTestControlG.CMMouseEnter(var Message: TMessage);
begin
inherited;
if not m_MouseInControl and enabled {and (GetCapture = 0)} then
begin
m_MouseInControl := True;
Repaint;
end;
end;

procedure TOCXTestControlG.CMMouseLeave(var Message: TMessage);
begin
inherited;
if m_MouseInControl and enabled then
begin
m_MouseInControl := False;
Invalidate;
end;
end;

constructor TOCXTestControlG.Create(AOwner: TComponent);
begin
inherited;
height := 30;
width := 125;
end;

procedure TOCXTestControlG.Paint;
begin
inherited;
if m_MouseInControl then
canvas.brush.color := $008000
else
canvas.brush.color := $0000FF;

canvas.fillrect(clientrect);
end;

end.

Toni W. · Guest

i found the solution myself....

here the code for the component:

unit OCXTestControl;

interface

uses
windows,Messages,Classes,Controls,dialogs;

type
TOCXTestControlG = class(TCustomControl)
private
m_MouseInControl: Boolean;
m_MouseIn: Boolean;
m_oldWndProc: TWndMethod;
protected
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;

procedure Paint; override;
Procedure NewWndProc(Var Message: TMessage);
public
constructor Create(AOwner: TComponent); override;
published
{ Published-Deklarationen }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Test', [TOCXTestControlG]);
end;

{ TOCXTestControlG }

procedure TOCXTestControlG.CMMouseEnter(var Message: TMessage);
begin
inherited;
if not m_MouseInControl and enabled then
begin
m_MouseInControl := True;
Repaint;
end;
end;

procedure TOCXTestControlG.CMMouseLeave(var Message: TMessage);
begin
inherited;
if m_MouseInControl and enabled then
begin
m_MouseInControl := False;
Invalidate;
end;
end;

constructor TOCXTestControlG.Create(AOwner: TComponent);
begin
inherited;
height := 30;
width := 125;

m_MouseIn := False;
m_oldWndProc := self.WindowProc;
self.WindowProc := NewWndProc;
end;

procedure TOCXTestControlG.NewWndProc(var Message: TMessage);
const
tme: TTrackMouseEvent = (cbSize: SizeOf(tme); dwHoverTime:HOVER_DEFAULT);
begin
if (Message.Msg = WM_MOUSELEAVE) then
begin
m_oldWndProc(Message);
m_MouseIn := False;
Perform(CM_MOUSELEAVE, 0, 0);
end
else
if (Message.Msg = CM_MOUSELEAVE) then
begin
m_oldWndProc(Message);
end
else
if (Message.Msg = CM_MOUSEENTER) then
begin
m_oldWndProc(Message);
tme.dwFlags := tme_Leave;
tme.hwndTrack := handle;
TrackMouseEvent(tme);
end
else
if (Message.Msg = WM_MouseMove) then
begin
m_oldWndProc(Message);
if not m_MouseIn then
Perform(CM_MOUSEENTER, 0, 0);
m_MouseIn := True;
end
else
m_oldWndProc(Message);

end;

procedure TOCXTestControlG.Paint;
begin
inherited;

if m_MouseInControl then
canvas.brush.color := $008000
else
canvas.brush.color := $0000FF;

canvas.fillrect(clientrect);
end;

end.