需要一个有热点的Image(30分)

  • 主题发起人 主题发起人 悲情城市
  • 开始时间 开始时间

悲情城市

Unregistered / Unconfirmed
GUEST, unregistred user!
有热点功能,就是鼠标移动到图像上时,可以换一张图片,移开时再还原,
在设计时和运行时都要能改变图像
上次找了一个HImage,不好用,不能在运行时读取图像和改变图像,要不然倒也能用了
 
留下Email,这个不难编

另外:分可不可以多一点[:)]
 
对onmousemove事件进行编程就可以了吗[:D]
 
unit HotImage;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;

type
THotImage = class(TImage)
private
{ Private declarations }
FMouseInRect: Boolean;
FPictureFileName1: TFileName;
FPictureFileName2: TFileName;

procedure DrawBackground(const FileName: TFileName);
procedure SetPictureFileName1(const Value: TFileName);
procedure SetPictureFileName2(const Value: TFileName);
protected
{ Protected declarations }
procedure CMMouseEnter(var Msg: TMessage); message CM_MouseEnter;
procedure CMMouseLeave(var Msg: TMessage); message CM_MouseLeave;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
property PictureFileName1: TFileName read FPictureFileName1 write SetPictureFileName1;
property PictureFileName2: TFileName read FPictureFileName2 write SetPictureFileName2;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Additional', [THotImage]);
end;

{ THotImage }

procedure THotImage.CMMouseEnter(var Msg: TMessage);
begin
if not FMouseInRect then
begin
FMouseInRect:=True;
DrawBackground(FPictureFileName1)
end;

inherited
end;

procedure THotImage.CMMouseLeave(var Msg: TMessage);
begin
if FMouseInRect then
begin
FMouseInRect:=False;
DrawBackground(FPictureFileName2)
end;

inherited
end;

constructor THotImage.Create(AOwner: TComponent);
var
Point: TPoint;
begin
inherited;

GetCursorPos(Point);
FMouseInRect:=PtInRect(ClientRect, Point);

FPictureFileName1:='';
FPictureFileName2:=''
end;

procedure THotImage.DrawBackground(const FileName: TFileName);
begin
try
Picture.LoadFromFile(FileName)
except
end
end;

procedure THotImage.SetPictureFileName1(const Value: TFileName);
begin
if FPictureFileName1<>Value then
begin
FPictureFileName1:=Value;
if FMouseInRect then
DrawBackground(FPictureFileName1)
end
end;

procedure THotImage.SetPictureFileName2(const Value: TFileName);
begin
if FPictureFileName2<>Value then
begin
FPictureFileName2:=Value;
if not FMouseInRect then
DrawBackground(FPictureFileName2)
end
end;

end.

见笑见笑
在设计期图片不会转变,不知道为什么?
 
To LeeChange:
http://www.delphibbs.com/delphibbs/DispQ.asp?LID=682607
问题我已经回答了。
 
多人接受答案了。
 
后退
顶部