本控件实现翻转图效果,共有三个图像:默认图像,活动图像,移开图像。
代码源于大富翁论坛,由于在设计器图像活动,会将默认图像与活动图像设为一样,所以我增加了一个属性isActiveNow ,设计期将此属性设为False ,在Form.create 中将该属性设为True 就OK了。
//========================================================
unit IMageMouse;
interface
uses
SysUtils, Classes, Controls, ExtCtrls,Graphics,Windows,Messages;
type
TIMageMouse = class(TImage)
private
{ Private declarations }
FInPicture:TPicture;
FOutPicture:TPicture;
FisActiveNow:Boolean;
procedure SetInPicture(const value:TPicture);
procedure SetOutPicture(const value:TPicture);
procedure SetisActiveNow(Value: Boolean);
procedure MouseEnter(var mess:TMessage);message CM_MOUSEENTER;
procedure MouseLeave(var mess:TMessage);message CM_MOUSELEAVE;
protected
{ Protected declarations }
procedure DOPaint(var Mess:TWMPaint);message WM_PAINT;
public
{ Public declarations }
isMouseHere:Boolean;
constructor Create(AOwner:TComponent);override;
destructor Destroy();override;
published
{ Published declarations }
property InPicture:TPicture read FInPicture write SetInPicture;
property OutPicture:TPicture read FOutPicture write SetOutPicture;
property isActiveNow:boolean read FisActiveNow write FisActiveNow;
end;
procedure Register;
implementation
{ TIMageMouse }
constructor TIMageMouse.Create(AOwner: TComponent);
begin
inherited;
FInPicture :=TPicture.Create;
FOutPicture :=TPicture.Create;
FisActiveNow :=false;
end;
destructor TIMageMouse.Destroy;
begin
FInPicture.Free;
FOutPicture.Free;
FInPicture :=nil;
FOutPicture :=nil;
inherited;
end;
procedure TIMageMouse.DOPaint(var Mess: TWMPaint);
begin
inherited;
end;
procedure TIMageMouse.MouseEnter(var mess: TMessage);
begin
isMouseHere :=True;
if (finpicture<>nil) and FisActiveNow then
begin
picture.Assign(finpicture);
Repaint();
end;
end;
procedure TIMageMouse.MouseLeave(var mess: TMessage);
begin
isMouseHere :=False;
if (foutpicture<>nil) and FisActiveNow then
begin
picture.Assign(foutpicture);
Repaint();
end;
end;
procedure TIMageMouse.SetisActiveNow(value: Boolean);
begin
FisActiveNow:=Value;
end;
procedure TIMageMouse.SetInPicture(const value: TPicture);
begin
FInPicture.Assign(value);
end;
procedure TIMageMouse.SetOutPicture(const value: TPicture);
begin
FOutPicture.Assign(value);
end;
procedure Register;
begin
RegisterComponents('Samples', [TIMageMouse]);
end;
end.