Delphi 自定义 TImage 组件 - 组件中的 MouseEnter、MouseLeave

Question

我正在尝试基于 FMX.Objects.TImage 构建一个组件。我希望 MultiResBitmap.Items 永久分配的图像无需在应用程序中使用 OnMouseEnter 和 OnMouseLeave 即可更改。当然我会用构造函数和析构函数

我是初学者，可能有些地方不懂。我已经尝试了一个星期了，但我无法检测到组件上的鼠标并正确地为其分配事件。我临时用了ShowMessage()来测试

理论上，这段代码应该可以工作，也可以不工作。告诉我哪里做错了。

unit ImageCustoms;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, FMX.Types, vcl.Controls, FMX.Objects, FMX.ImgList, vcl.Dialogs, vcl.Graphics, FMX.ExtCtrls;

type
    TImageCostoms = class(TImage)
private
  { Private declarations }
    FOnMouseLeave: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
    procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
protected
  { Protected declarations }
    procedure DoMouseEnter; virtual;
    procedure DoMouseLeave; virtual;
public
  { Public declarations }
    //constructor Create(AOwner: TComponent); override;
    //destructor Destroy; override;
published
  { Published declarations }
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;

procedure Register;

implementation

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

procedure TImageCostoms.CMMouseEnter(var msg: TMessage);
begin
  ShowMessage('Enter');
  DoMouseEnter;
end;

procedure TImageCostoms.CMMouseLeave(var msg: TMessage);
begin
  ShowMessage('Leave');
  DoMouseLeave;
end;

procedure TImageCostoms.DoMouseEnter;
begin
  if Assigned(FOnMouseEnter) then
  ShowMessage('Enter');
  FOnMouseEnter(Self);
end;

procedure TImageCostoms.DoMouseLeave;
begin
  if Assigned(FOnMouseLeave) then
  ShowMessage('Leave');
  FOnMouseLeave(Self);
end;

{constructor TImageCostoms.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  MultiResBitmap.Items[0].Bitmap.LoadFromFile('focus0.png');    // .\img\i.png
end;

destructor TImageCostoms.Destroy;
begin
   inherited Destroy;
end; }

end.

Answer 1

首先，不要在您自己的单元中混合使用 VCL 和 FMX 单元。 VCL 和 FMX 不能一起使用。因为 FMX 是跨平台的，所以不要在你的代码中使用 Winapi 单位，除非你正在编写 Windows-specific 代码（你不是，在这种情况）。

您不需要直接处理 CM_MOUSE(ENTER|LEAVE) 消息，框架已经在内部为您处理了。而且您不需要重新声明 OnMouse(Enter|Leave) 事件，它们已经存在并且在 TImage.

中 published

您真正需要做的就是 override（不是重新声明）来自 Timage 的现有虚拟 DoMouse(Enter|Leave) 方法，例如：

unit ImageCustoms;

interface

uses
  System.SysUtils, System.Classes, FMX.Types, FMX.Objects, FMX.ImgList, FMX.ExtCtrls;

type
  TImageCostoms = class(TImage)
  private
    { Private declarations }
  protected
    { Protected declarations }
    procedure DoMouseEnter; override;
    procedure DoMouseLeave; override;
  public
    { Public declarations }
    //constructor Create(AOwner: TComponent); override;
    //destructor Destroy; override;
  published
    { Published declarations }
  end;

procedure Register;

implementation

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

procedure TImageCostoms.DoMouseEnter;
begin
  ... 
  inherited;
end;

procedure TImageCostoms.DoMouseLeave;
begin
  ...
  inherited;
end;

{constructor TImageCostoms.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  MultiResBitmap.Items[0].Bitmap.LoadFromFile('focus0.png');    // .\img\i.png
end;

destructor TImageCostoms.Destroy;
begin
   inherited Destroy;
end; }

end.

不要使用 ShowMessage() 调试组件代码，尤其是在响应 keyboard/mouse 焦点更改的事件中。如果您想查看调试消息，请改用 OutputDebugString() 或等效项，然后在 IDE 的输出 window 中查找消息。或者，只需在 UI 中更改显示，例如颜色更改等

Answer 2

谢谢，它帮助了我，我正在努力上坡。事实上，在 FMX 中它很简单并且一切正常。非常感谢你。我写的程序支持虚拟键盘，整体只是一个透明的按钮，稍微改变一下焦点。再次感谢。为了后代，现在看起来像这样，我将尝试添加来自全局 ImageList 的支持。


interface
uses
 System.SysUtils, System.Classes, FMX.Types, FMX.Objects, FMX.ImgList, vcl.Dialogs, System.UITypes;
type
    TImageCostoms = class(TImage)

private
  { Private declarations }
    procedure DoMouseEnter; override;
    procedure DoMouseLeave; override;

protected
  { Protected declarations }

public
  { Public declarations }
    constructor Create(AOwner: TComponent); override;

published
  { Published declarations }

end;

procedure Register;

implementation


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

procedure TImageCostoms.DoMouseEnter;
begin
  inherited ;
  MultiResBitmap.Items[1].Bitmap.LoadFromFile('focus1.png');
end;

procedure TImageCostoms.DoMouseLeave;
begin
  inherited;
  MultiResBitmap.Items[0].Bitmap.LoadFromFile('focus0.png');
end;

constructor TImageCostoms.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  width:=45;
  height:=45;
  MultiResBitmap.Items[0].Bitmap.LoadFromFile('focus0.png');
end;


end.```

Delphi 自定义 TImage 组件 - 组件中的 MouseEnter、MouseLeave

Delphi Custom TImage Component - MouseEnter, MouseLeave in component

delphi

controls

components

timage

mouseevent