扩展Image使其能在鼠标移进，移出时改变显示图片，有点问题，请指教。 ( 积分: 50 )

  • 主题发起人 主题发起人 hyh5795
  • 开始时间 开始时间
H

hyh5795

Unregistered / Unconfirmed
GUEST, unregistred user!
我第一次写一个实现当鼠标移进，移出Image控件时实现两张图片转换，
但有点问题，实现不了效果代码如下，请各位高手帮我更正一下，谢谢！

unit IMageMouse;

interface

uses
SysUtils, Classes, Controls, ExtCtrls,Graphics,Windows,QControls,Messages;

type
TIMageMouse = class(TImage)
private
{ Private declarations }

FInPicture:TPicture;
FOutPicture:TPicture;

procedure SetInPicture(const value:TPicture);
procedure SetOutPicture(const value:TPicture);
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;
end;

procedure Register;

implementation



{ TIMageMouse }

constructor TIMageMouse.Create(AOwner: TComponent);
begin
inherited;
FInPicture :=TPicture.Create;
FOutPicture :=TPicture.Create;
end;

destructor TIMageMouse.Destroy;
begin
FInPicture.Free;
FOutPicture.Free;
FInPicture :=nil;
FOutPicture :=nil;
inherited;
end;

procedure TIMageMouse.DOPaint(var Mess: TWMPaint);
var
rect :TRect;
begin
inherited;
if isMouseHere then
begin
Canvas.StretchDraw(ClientRect,FInPicture.Bitmap)
end
else
Canvas.StretchDraw(ClientRect,FOutPicture.Bitmap);
end;

procedure TIMageMouse.MouseEnter(var mess: TMessage);
begin
isMouseHere :=True;
Repaint();
end;

procedure TIMageMouse.MouseLeave(var mess: TMessage);
begin
isMouseHere :=False;
Repaint();
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.
 
我第一次写一个实现当鼠标移进，移出Image控件时实现两张图片转换，
但有点问题，实现不了效果代码如下，请各位高手帮我更正一下，谢谢！

unit IMageMouse;

interface

uses
SysUtils, Classes, Controls, ExtCtrls,Graphics,Windows,QControls,Messages;

type
TIMageMouse = class(TImage)
private
{ Private declarations }

FInPicture:TPicture;
FOutPicture:TPicture;

procedure SetInPicture(const value:TPicture);
procedure SetOutPicture(const value:TPicture);
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;
end;

procedure Register;

implementation



{ TIMageMouse }

constructor TIMageMouse.Create(AOwner: TComponent);
begin
inherited;
FInPicture :=TPicture.Create;
FOutPicture :=TPicture.Create;
end;

destructor TIMageMouse.Destroy;
begin
FInPicture.Free;
FOutPicture.Free;
FInPicture :=nil;
FOutPicture :=nil;
inherited;
end;

procedure TIMageMouse.DOPaint(var Mess: TWMPaint);
var
rect :TRect;
begin
inherited;
if isMouseHere then
begin
Canvas.StretchDraw(ClientRect,FInPicture.Bitmap)
end
else
Canvas.StretchDraw(ClientRect,FOutPicture.Bitmap);
end;

procedure TIMageMouse.MouseEnter(var mess: TMessage);
begin
isMouseHere :=True;
Repaint();
end;

procedure TIMageMouse.MouseLeave(var mess: TMessage);
begin
isMouseHere :=False;
Repaint();
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.
 
我改了一点代码？你看看可以吗？
unit IMageMouse;

interface

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

type
TIMageMouse = class(TImage)
private
{ Private declarations }
FInPicture:TPicture;
FOutPicture:TPicture;
procedure SetInPicture(const value:TPicture);
procedure SetOutPicture(const value:TPicture);
protected
{ Protected declarations }
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
public
{ Public declarations }
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;
end;

procedure Register;

implementation



{ TIMageMouse }

constructor TIMageMouse.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FInPicture := TPicture.Create;
FOutPicture := TPicture.Create;
end;

destructor TIMageMouse.Destroy;
begin
FInPicture.Free;
FOutPicture.Free;
FInPicture := nil;
FOutPicture := nil;
inherited Destroy;
end;

procedure TIMageMouse.CMMouseEnter(var Message: TMessage);
begin
inherited;
//Application.MainForm.Caption := 'Enter Mouse';
if not(csDesigning in ComponentState) then
Picture.Assign(FInPicture);
end;

procedure TIMageMouse.CMMouseLeave(var Message: TMessage);
begin
inherited;
//Application.MainForm.Caption := 'Leave Mouse';
if not(csDesigning in ComponentState) then
Picture.Assign(FOutPicture);
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.
 
不能在设计时出现图片交换，在运行期可以。delphi6.0下通过。
unit IMageMouse;

interface

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

type
TIMageMouse = class(TImage)
private
{ Private declarations }

FInPicture:TPicture;
FOutPicture:TPicture;

procedure SetInPicture(const value:TPicture);
procedure SetOutPicture(const value:TPicture);
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;
end;

procedure Register;

implementation



{ TIMageMouse }

constructor TIMageMouse.Create(AOwner: TComponent);
begin
inherited;
FInPicture :=TPicture.Create;
FOutPicture :=TPicture.Create;
end;

destructor TIMageMouse.Destroy;
begin
FInPicture.Free;
FOutPicture.Free;
FInPicture :=nil;
FOutPicture :=nil;
inherited;
end;

procedure TIMageMouse.DOPaint(var Mess: TWMPaint);
var
rect :TRect;
begin
inherited;
end;

procedure TIMageMouse.MouseEnter(var mess: TMessage);
begin
isMouseHere :=True;
if finpicture<>nil then
begin
picture.Assign(finpicture);
Repaint();
end;
end;

procedure TIMageMouse.MouseLeave(var mess: TMessage);
begin
isMouseHere :=False;
if foutpicture<>nil then
begin
picture.Assign(foutpicture);
Repaint();
end;
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.
 
谢谢两位
gekin
的方法的用了基本可以实现，
但有一点小问题，就是移进和移出的图片反了，
默认情况应该和移出的一样。
需要修改一下谢谢
 
多人接受答案了。
 
{***************************************************************}
{ }
{ Hui Ynag SoftWare System }
{ Copyright(c) 2004-2005 Hy Software Corporation }
{ SoftWareName: XControl Components }
{ Version: V1.0 }
{ DevIDE: Delphi6.0 }
{ Create date: 2005-08-26 }
{ Author: jfyes }
{ Function: }
{ Description: }
{ Noteice: }
{***************************************************************}

//加了两个事件,
//OnMouseEnter OnMouseLeave
//完整的给你
unit XControl;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Mask, DB, DBCtrls,
VDBConsts, Forms, Dialogs, Buttons, ComCtrls, Graphics, ExtCtrls;

type
TXImage = class(TImage)
private
{ Private declarations }
FInPicture: TPicture;
FOutPicture: TPicture;
FActive: Boolean;
FMouseEnter: TXMouseEvent;
FMouseLeave: TXMouseEvent;
procedure SetInPicture(const value:TPicture);
procedure SetOutPicture(const value:TPicture);
procedure SetActive(const Value: Boolean);
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
{ Protected declarations }

public
{ Public declarations }
constructor Create(AOwner:TComponent);override;
destructor Destroy; override;
published
{ Published declarations }
property XActive: Boolean read FActive write SetActive;
property XEnterPicture:TPicture read FInPicture write SetInPicture;
property XLeavePicture:TPicture read FOutPicture write SetOutPicture;
property OnMouseEnter: TXMouseEvent read FMouseEnter write FMouseEnter;
property OnMouseLeave: TXMouseEvent read FMouseLeave write FMouseLeave;
end;


procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Jfyes Express', [TXImage]);
end;

{ TIMageMouse }

constructor TXImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FActive := False;
FInPicture := TPicture.Create;
FOutPicture := TPicture.Create;
end;

destructor TXImage.Destroy;
begin
FInPicture.Free;
FOutPicture.Free;
FInPicture := nil;
FOutPicture := nil;
inherited Destroy;
end;

procedure TXImage.SetActive(const Value: Boolean);
begin
if FActive <> Value then
FActive := Value;
end;

procedure TXImage.CMMouseEnter(var Message: TMessage);
begin
inherited;
if Assigned(FMouseEnter) then
FMouseEnter(Self);
if FActive then
if not(csDesigning in ComponentState) then
Picture.Assign(FInPicture);
end;

procedure TXImage.CMMouseLeave(var Message: TMessage);
begin
inherited;
if Assigned(FMouseLeave) then
FMouseLeave(Self);
if FActive then
if not(csDesigning in ComponentState) then
Picture.Assign(FOutPicture);
end;

procedure TXImage.SetInPicture(const value: TPicture);
begin
FInPicture.Assign(value);
end;

procedure TXImage.SetOutPicture(const value: TPicture);
begin
FOutPicture.Assign(value);
end;
 
您必须登录或注册才可回复。

Similar threads

Y
我写的一个构件，继承于tLabel,想实现在鼠标在文字上方时鼠标为crHandPoint,链接为红色.....(100分)
回复
4
查看
196
ynfly
Y
J
怎么让有从TPersistent继承来的属性的控件随着该属性值的改变而改变？（请教高手）(30分)
回复
0
查看
166
jackyxinli
J
L
发布一个显示点阵字的控件，UP得分 (100分)
回复
14
查看
326
LeonSu
L
W
怪了，ｅｄｉｔ的ｏｎｅｘｉｔ (100分)
回复
4
查看
199
wjqdelphi
W
A
很急的问题，关于TCollection，不惜分数请教 (200分)
回复
6
查看
211
awing
A
后退
顶部