如何增加控件的OnMouseDown和OnMouseUp事件 ( 积分: 100 )

  • 主题发起人 主题发起人 zyyjc
  • 开始时间 开始时间
Z

zyyjc

Unregistered / Unconfirmed
GUEST, unregistred user!
我想要在控件TChartfx上派生一个新的控件,实现OnMouseDown和OnMouseUp事件,
OnMouselease和OnMouseEnter可以响应,可是OnMouseDown和OnMouseUp却不行,
请高手帮忙看看什么问题,代码如下:
unit chartfx1;

interface

uses
SysUtils, Classes, Controls, OleCtrls, Chartfx3, messages, forms;

type
tchartfx1 = class(TChartfx)
private
FOnMouseEnter: TNotifyEvent;
FOnMouseLeave: TNotifyEvent;
FControlState: TControlState;
FOnMouseDown: TMouseEvent;
FOnMouseMove: TMouseMoveEvent;
FOnMouseUp: TMouseEvent;

procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); dynamic;
procedure CMMouseLeave(var Message: TWMMouse); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TWMMouse); message CM_MOUSEENTER;
{ Private declarations }
procedure MouseEnter; virtual;
procedure MouseLeave; virtual;
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
procedure WMMButtonDown(var Message: TWMMButtonDown); message WM_MBUTTONDOWN;
procedure DoMouseDown(var Message: TWMMouse; Button: TMouseButton;
Shift: TShiftState);
protected
{ Protected declarations }
public
{ Public declarations }
published
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;

{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Samples', [tchartfx1]);
end;

{ tchartfx1 }

procedure tchartfx1.CMMouseEnter(var Message: TWMMouse);
begin
inherited;
MouseEnter;

end;

procedure tchartfx1.CMMouseLeave(var Message: TWMMouse);
begin
inherited;
MouseLeave;
end;

procedure tchartfx1.DoMouseDown(var Message: TWMMouse;
Button: TMouseButton; Shift: TShiftState);
begin
if not (csNoStdEvents in ControlStyle) then
with Message do
if (Width > 32768) or (Height > 32768) then
with CalcCursorPos do
MouseDown(Button, KeysToShiftState(Keys) + Shift, X, Y)
else
MouseDown(Button, KeysToShiftState(Keys) + Shift, Message.XPos, Message.YPos);

end;

procedure tchartfx1.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y);
end;

procedure tchartfx1.MouseEnter;
begin
if Assigned(FOnMouseEnter) then FOnMouseEnter(self);
end;

procedure tchartfx1.MouseLeave;
begin
if Assigned(FOnMouseLeave) then FOnMouseLeave(self);
end;

procedure tchartfx1.WMLButtonDown(var Message: TWMLButtonDown);
begin
SendCancelMode(Self);
inherited;
if csCaptureMouse in ControlStyle then MouseCapture := True;
if csClickEvents in ControlStyle then Include(FControlState, csClicked);
DoMouseDown(Message, mbLeft, []);

end;

procedure tchartfx1.WMMButtonDown(var Message: TWMMButtonDown);
begin
inherited;
DoMouseDown(Message, mbMiddle, []);
end;

procedure tchartfx1.WMNCLButtonDown(var Message: TWMNCLButtonDown);
begin
SendCancelMode(Self);
inherited;
end;

procedure tchartfx1.WMRButtonDown(var Message: TWMRButtonDown);
begin
inherited;
DoMouseDown(Message, mbRight, []);

end;

end.
 
没看到截MouseUp消息的地方啊

---------------------------
www.waibaoinfo.com
 
啊,我以为是WM_LBUTTONDOWN..那些消息,
如果不是,那应该怎么写?
 
不用这样的吧,如果控件继承自TControl直接发布就好了
tchartfx1 = class(TChartfx)
published
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
如果父控件设置了不响应鼠标事件,那么要重新设置ControlStyle;
constructor TChartFx1.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csClickEvents];
ControlStyle := ControlStyle - [csNoStdEvents];
end;
 
按照ANiDelphi大侠的方法试了一下,还是不能响应鼠标的事件
这个TChartfx是Delphi自带的,有哪位DFW能帮帮忙试试
 

Similar threads

后退
顶部