unit MyImage;
interface
uses
SysUtils, Classes, Controls, ExtCtrls, Graphics, Messages;
type TMyImage =class(TImage)
private
FOnMouseEnter: TNotifyEvent;
FOnMouseLeave: TNotifyEvent;
FMLPic: TPicture;
FMEPic: TPicture;
procedure CMMouseEnter(
var Message: TMessage);
message CM_MOUSEENTER;
procedure CMMouseLeave(
var Message: TMessage);
message CM_MOUSELEAVE;
procedure SetMEPic(
const Value: TPicture);
procedure SetMLPic(
const Value: TPicture);
protected
public
constructor Create(AOwner : TComponent);
override;
destructor Destroy;
override;
published
property OnMouseEnter : TNotifyEvent
read FOnMouseEnter
Write FOnMouseEnter;
property OnMouseLeave : TNotifyEvent
read FOnMouseLeave
Write FOnMouseLeave;
property MouseEnterPicture : TPicture
read FMEPic
write SetMEPic;
property MouseLeavePicture : TPicture
read FMLPic
write SetMLPic;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
Beispiele', [TMyImage]);
end;
{ TMyImage }
procedure TMyImage.CMMouseEnter(
var Message: TMessage);
begin
if Message.Msg=CM_MOUSEENTER
then begin
if csDesigning
in ComponentState
then begin
if FMLPic <>
NIL then picture.Assign(FMLPic);
end
else begin
if FMEPic <>
NIL then picture.Assign(FMEPic);
end;
if ( Assigned(FOnMouseEnter) )
then FOnMouseEnter(self);
repaint;
end;
end;
procedure TMyImage.CMMouseLeave(
var Message: TMessage);
begin
if Message.Msg=CM_MOUSELEAVE
then begin
if FMLPic <>
NIL then picture.Assign(FMLPic);
if ( Assigned(FOnMouseLeave) )
then FOnMouseLeave(self);
repaint;
end;
end;
constructor TMyImage.Create(AOwner: TComponent);
begin
inherited;
FMLPic := TPicture.Create;
FMEPic := TPicture.Create;
end;
destructor TMyImage.Destroy;
begin
FreeAndNil(FMLPic);
FreeAndNil(FMEPic);
inherited;
end;
procedure TMyImage.SetMEPic(
const Value: TPicture);
begin
FMEPic.Assign(Value);
end;
procedure TMyImage.SetMLPic(
const Value: TPicture);
begin
FMLPic.Assign(Value);
end;
end.