imgbutton.pas

一个图片按钮控件,比较适合用于媒体播放器按钮的样式控制.

unit ImgButton;

interface

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

type
  TImgButton = class(TImage)
  private
    GetLoadFilePicNorman:Tbitmap;
    GetLoadFilePicOver:Tbitmap;
    GetLoadFilePicPress:Tbitmap;
    FTransparentColor: TColor;
    FOnChange: TNotifyEvent;
    { Private declarations }
  protected
    procedure SetLoadFilePicNorman(PicNormanPath:Tbitmap);virtual;
    procedure SetLoadFilePicOver(PicOverPath:Tbitmap);virtual;
    procedure SetLoadFilePicPress(PicPressPath:Tbitmap);virtual;
    procedure BitmapsChanged( Sender: TObject );
    procedure SetTransparentColor(ValueColor: TColor);
    procedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;
    procedure MouseDown( Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); override;
    procedure MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); override;
    { Protected declarations }
  public

    constructor Create(AOwner: TComponent);override;
    { Public declarations }
  published
    property LoadPicNorman:Tbitmap read GetLoadFilePicNorman write SetLoadFilePicNorman;// Default '\image\Button_Play_Normal.bmp';
    property LoadPicOver:Tbitmap read GetLoadFilePicOver write SetLoadFilePicOver;// Default '\image\Button_Play_Over.bmp';
    property LoadPicPress:Tbitmap read GetLoadFilePicPress write SetLoadFilePicPress;// Default '\image\Button_Play_Press.bmp';
    property TransparentColor: TColor read FTransparentColor write SetTransparentColor;    { Published declarations }
  end;

procedure Register;

implementation

constructor TImgButton.Create(AOwner: TComponent);
begin
    GetLoadFilePicNorman:=Tbitmap.Create;
    GetLoadFilePicOver:=Tbitmap.Create;
    GetLoadFilePicPress:=Tbitmap.Create;
    FTransparentColor:=clFuchsia;
    FOnChange:=BitmapsChanged;
inherited Create(AOwner);
Width:=32;
Height:=32;
end;

procedure TImgButton.CMMouseEnter (var Message: TMessage);
begin
  inherited;
  PicTure.Bitmap.FreeImage;
  PicTure.Bitmap:=GetLoadFilePicOver;
end;

procedure TImgButton.CMMouseLeave (var Message: TMessage);
begin
  inherited;
  PicTure.Bitmap.FreeImage;
  PicTure.Bitmap:=GetLoadFilePicNorman;
end;

procedure TImgButton.MouseDown( Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
  inherited;
  PicTure.Bitmap.FreeImage;
  PicTure.Bitmap:=GetLoadFilePicPress;
end;

procedure TImgButton.MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
  inherited;
  PicTure.Bitmap.FreeImage;
  PicTure.Bitmap:=GetLoadFilePicNorman;
end;

procedure TImgButton.SetLoadFilePicNorman(PicNormanPath:Tbitmap);
begin
  GetLoadFilePicNorman.Assign(PicNormanPath);
  inherited;
  PicTure.Assign(PicNormanPath);
  PicTure.Bitmap:=GetLoadFilePicNorman
end;

procedure TImgButton.SetLoadFilePicOver(PicOverPath:Tbitmap);
begin
GetLoadFilePicOver.Assign(PicOverPath);
end;

procedure TImgButton.SetLoadFilePicPress(PicPressPath:Tbitmap);
begin
GetLoadFilePicPress.Assign(PicPressPath);
end;

procedure TImgButton.BitmapsChanged( Sender: TObject );
begin
  if Assigned( FOnChange ) then
    FOnChange( Self );
end;

procedure TImgButton.SetTransparentColor(ValueColor:TColor);
begin
  if FTransparentColor <> ValueColor then
  begin
    FTransparentColor := ValueColor;
    PicTure.Bitmap.TransparentColor:=FTransparentColor;
    //BitmapsChanged(Self);
  end;
end;

procedure Register;
begin
  RegisterComponents('8Enter_Control', [TImgButton]);
end;

end.