Fórum Trocar imagem ao passar o mouse #350995

unit AASNImage;

interface

uses
  WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TCMMouseEnter = record
    Msg    : Cardinal;
    Unused : Integer;
    Sender : TControl;
    Result : LongInt;
  end;
  TCMMouseLeave = TCMMouseEnter;
  TAASNImage = class(TImage)
  private
    { Private declarations }
    FOnMouseEnter : TNotifyEvent;
    FOnMouseLeave : TNotifyEvent;
    procedure CMMouseEnter(var Msg : TCMMouseEnter); message CM_MouseEnter;
    procedure CMMouseLeave(var Msg : TCMMouseLeave); message CM_MouseLeave;
  protected
    { Protected declarations }
  public
    { Public declarations }
    Constructor Create(AOwner : TComponent); 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(´Geral´, [TAASNImage]);
end;

Constructor TAASNImage.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
end;

procedure TAASNImage.CMMouseEnter(var Msg : TCMMouseEnter);
begin
  inherited;
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;

procedure TAASNImage.CMMouseLeave(var Msg : TCMMouseLeave);
begin
  inherited;
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
end;

end.

type
  TForm1 = class(TForm)
    ...
  private
    SavedImgWindowProc :TWndMethod;
    procedure WndMouseMessage(var Message: TMessage);
  end;

...

// procedimento utilizado apenas pelo TImage
procedure TFrmSplash.WndMouseMessage(var Message: TMessage);
begin
  case Message.Msg of
    CM_MouseEnter :
        Label1.Caption := ´Entrou´;
    CM_MouseLeave :
        Label1.Caption := ´Saiu´;
  end;

 // passamos as mensagens para o processador
 // default de mensagens da janela do TImage
  SavedImgWindowProc(Message);
end;

// inicializamos o processador de mensagens de janela 
// do TImage, no OnCreate do form que o contém
procedure TFrm.FormCreate(Sender: TObject);
begin
 // salvamos o endereço do procedimento default
  SavedImgWindowProc := Image1.WindowProc;
 // atribuimos o novo processador de eventos
  Image1.WindowProc := WndMouseMessage;
end;