一个对image的扩展控件

主要的功能：
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.