主要的功能:
1.可以移动。
2.鼠标移入移出和按下时能显示对应的图片。
3.按下时可以有位置改变的效果。
4.可以设置是否响应双击事件。
5.可设置组按下抬起 GroupIndex
修改日志:
2005-10-04
解决鼠标点击过快时图片位置错误
添加鼠标双击时是否触发双击事件(如果不触发则触发2次单击事件)
2005-11-28
增加组功能,使某组内只有一个图片为被按下的状态 Down=True
2005-12-14
修改在设计环境中也响应鼠标按下消息的错误
//********************************
//最后修改日期 2005-12-14 *
//********************************
unit MyEXImage;
interface
uses
Messages, SysUtils, Classes, Graphics, Controls,
ExtCtrls;
type
TMyEXImage = class(TImage)
private
FOnMove:TNotifyEvent;
FGroupIndex:integer;
MouseIn,
FCanDBClick,
FCanMove,
FButtonEffect,
MDown,FDown:boolean;
OldTop,OldLeft,OldMouseX,OldMouseY:integer;
FDisableImage,FEnterImage,FLeaveImage,FClickImage:TPicture;
FOnMouseEnter:TNotifyEvent;
FOnMouselevel:TNotifyEvent;
procedure WndProc(var Message: TMessage); override;
procedure CMMouseEnter(var msg:TMessage);message CM_MOUSEENTER;
procedure CMMouseLeave(var msg:TMessage);message CM_MOUSELEAVE;
procedure SetDisableImage(const Value: TPicture);
procedure SetEnterImage(const Value: TPicture);
procedure SetLeaveImage(const Value: TPicture);
procedure SetClickImage(const Value: TPicture);
procedure SetCanMove(value:boolean);
procedure SetCanDBClick(value:boolean);
procedure SetButtonEffect(value:boolean);
procedure SetDown(VALUE:boolean);
protected
{ Protected declarations }
procedure SetEnabled(Value: Boolean); override;
public
Data:TObject;
Constructor Create(AOwner:TComponent);override;
Destructor Destroy;override;
published
property Down:boolean read FDown write SetDown;
property GroupIndex:integer read FGroupIndex write FGroupIndex;
property ButtonEffect:boolean read FButtonEffect write SetButtonEffect;
property CanDBClick:boolean read FCanDBClick write SetCanDBClick;
property CanMove:boolean read FCanMove write SetCanMove;
property OnMove:TNotifyEvent read FOnMove write FOnMove;
property DisableImage:TPicture read FDisableImage write SetDisableImage;
property EnterImage:TPicture read FEnterImage write SetEnterImage;
property LeaveImage:TPicture read FLeaveImage write SetLeaveImage;
property ClickImage:TPicture read FClickImage write SetClickImage;
property OnMouseEnter:TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouselevel:TNotifyEvent read FOnMouselevel write FOnMouselevel;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Additional', [TMyEXImage]);
end;
{ MyEXImage }
procedure TMyEXImage.SetDown(VALUE:boolean);
var
i:integer;
Control:Tcontrol;
begin
if FGroupIndex>0 then
begin
FDown:=value;
if value then
begin
if (parent<>nil) then
for i:=0 to parent.ControlCount-1 do
begin
Control:=parent.Controls[i];
if (Control is TMyEXImage) and (Control<>self) then
if TMyEXImage(Control).GroupIndex=FGroupIndex then
TMyEXImage(Control).Down:=false;
end;
end
else
if FLeaveImage.Graphic<>nil then Picture.Assign(FLeaveImage);
end;
end;
procedure TMyEXImage.SetCanDBClick(value:boolean);
begin
FCanDBClick:=value;
end;
procedure TMyEXImage.SetCanMove(value:boolean);
begin
if FButtonEffect then
FCanMove:=false
else
FCanMove:=value;
end;
procedure TMyEXImage.SetButtonEffect(value:boolean);
begin
if value then
FCanMove:=false;
FButtonEffect:=value;
end;
procedure TMyEXImage.CMMouseEnter(var msg: TMessage);
begin
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
if Enabled and (not FDown) and (FEnterImage.Graphic<>nil) then Picture.Assign(FEnterImage);
MouseIn:=true;
end;
procedure TMyEXImage.CMMouseLeave(var msg: TMessage);
begin
if Assigned(FOnMouselevel) then FOnMouselevel(Self);
if Enabled and (not FDown) and (FLeaveImage.Graphic<>nil) then Picture.Assign(FLeaveImage);
MouseIn:=false;
end;
constructor TMyEXImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if parent<>nil then parent.DoubleBuffered:=true;
MDown:=false;
FDown:=false;
FButtonEffect:=false;
FCanMove:=false;
FEnterImage:=TPicture.Create;
FLeaveImage:=TPicture.Create;
FClickImage:=TPicture.Create;
FDisableImage:=Tpicture.Create;
end;
destructor TMyEXImage.Destroy;
begin
FDisableImage.Free;
FEnterImage.Free;
FLeaveImage.Free;
FClickImage.Free;
inherited Destroy ;
end;
procedure TMyEXImage.SetEnabled(Value: Boolean);
var
k:boolean;
begin
k:=GetEnabled<>value;
inherited SetEnabled(Value);
if k then
if not Value then
begin
if FDisableImage.Graphic<>nil then Picture.Assign(FDisableImage);
end
else
if FLeaveImage.Graphic<>nil then Picture.Assign(FLeaveImage);
end;
procedure TMyEXImage.WndProc(var Message: TMessage);
begin
case Message.Msg of
WM_MOVE:
if Assigned(FOnMove) then FOnMove(self);
WM_LBUTTONDOWN:
begin
if FButtonEffect then
if not MDown then
SetBounds(left+1,top+1,width,height);
MDown:=true;
if FCanMove then
begin
OldMouseX:=mouse.CursorPos.X;
OldMouseY:=mouse.CursorPos.Y;
OldLeft:=left;
OldTop:=top;
end;
inherited;
if MouseIn and (FClickImage.Graphic<>nil) then Picture.Assign(FClickImage);
end;
WM_LBUTTONUP:
begin
SetDown(not FDown);
if FButtonEffect then
if MDown and (not FDown) then
SetBounds(left-1,top-1,width,height);
MDown:=false;
inherited;
if not FDown then
if MouseIn then
begin
if FEnterImage.Graphic<>nil then Picture.Assign(FEnterImage);
end
else
begin
if FLeaveImage.Graphic<>nil then Picture.Assign(FLeaveImage);
end;
end;
WM_MOUSEMOVE:
begin
inherited;
if FCanMove and FDown then
SetBounds(OldLeft-OldMouseX+mouse.CursorPos.X,
OldTop-OldMouseY+mouse.CursorPos.Y,
width,height);
end;
WM_LBUTTONDBLCLK:
begin
if not FCanDBClick then
Perform(WM_LBUTTONDOWN,Message.WParam,Message.LParam)
else
inherited;
end;
else
inherited WndProc(Message);
end;
end;
procedure TMyEXImage.SetDisableImage(const Value: TPicture);
begin
FDisableImage.Assign(Value);
if not Enabled and (FDisableImage.Graphic<>nil) then Picture.Assign(FDisableImage);
end;
procedure TMyEXImage.SetEnterImage(const Value: TPicture);
begin
FEnterImage.Assign(Value);
end;
procedure TMyEXImage.SetLeaveImage(const Value: TPicture);
begin
FLeaveImage.Assign(Value);
if Enabled and (FLeaveImage.Graphic<>nil) then Picture.Assign(FLeaveImage);
end;
procedure TMyEXImage.SetClickImage(const Value: TPicture);
begin
FClickImage.Assign(Value);
end;
end.
一个对image的扩展控件
最新推荐文章于 2021-07-11 10:21:12 发布