本控件实现翻转图效果,共有三个图像:默认图像,活动图像,移开图像。

代码源于大富翁论坛,由于在设计器图像活动,会将默认图像与活动图像设为一样,所以我增加了一个属性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.


imagemouse.pas

最后修改:2009 年 08 月 16 日
一分也是爱
  • 相关文章

    • 无相关文章