⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 imgbnt.pas

📁 一个图片按钮控件,比较适合用于媒体播放器按钮的样式控制.
💻 PAS
字号:
unit ImgBnt;

interface

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

type
  TImgButton = class(TImage)
  private
    GetLoadFilePlayPicNorman:Tbitmap;
    GetLoadFilePlayPicOver:Tbitmap;
    GetLoadFilePlayPicPress:Tbitmap;
    GetLoadFilePausePicNorman:Tbitmap;
    GetLoadFilePausePicOver:Tbitmap;
    GetLoadFilePausePicPress:Tbitmap;
    FTransparentColor: TColor;
    FOnChange: TNotifyEvent;
    GetStuts1OrStuts2:Boolean;
    { Private declarations }
  protected
    procedure SetStuts1OrStuts2(Value:Boolean);virtual;
    procedure SetLoadFilePlayPicNorman(PlayPicNormanPath:Tbitmap);virtual;
    procedure SetLoadFilePlayPicOver(PlayPicOverPath:Tbitmap);virtual;
    procedure SetLoadFilePlayPicPress(PlayPicPressPath:Tbitmap);virtual;
    procedure SetLoadFilePausePicNorman(PausePicNormanPath:Tbitmap);virtual;
    procedure SetLoadFilePausePicOver(PausePicOverPath:Tbitmap);virtual;
    procedure SetLoadFilePausePicPress(PausePicPressPath:Tbitmap);virtual;
    procedure BitmapsChanged( Sender: TObject );
    procedure SetTransparentColor(Value: 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 Stuts1MouseNorman:Tbitmap read GetLoadFilePlayPicNorman write SetLoadFilePlayPicNorman;// Default '\image\Button_Play_Normal.bmp';
    property Stuts1MouseMove:Tbitmap read GetLoadFilePlayPicOver write SetLoadFilePlayPicOver;// Default '\image\Button_Play_Over.bmp';
    property Stuts1MouseDown:Tbitmap read GetLoadFilePlayPicPress write SetLoadFilePlayPicPress;// Default '\image\Button_Play_Press.bmp';
    property Stuts2MouseNorman:Tbitmap read GetLoadFilePausePicNorman write SetLoadFilePausePicNorman;// Default '\image\Button_Pause_Normal.bmp';
    property Stuts2MouseMove:Tbitmap read GetLoadFilePausePicOver write SetLoadFilePausePicOver;// Default '\image\Button_Pause_Over.bmp';
    property Stuts2MouseDown:Tbitmap read GetLoadFilePausePicPress write SetLoadFilePausePicPress;// Default '\image\Button_Pause_Press.bmp';
    property TransparentColor: TColor read FTransparentColor write SetTransparentColor;    { Published declarations }
    property Stuts1_Or_Stuts2:Boolean read GetStuts1OrStuts2 write SetStuts1OrStuts2 default False;
  end;

procedure Register;

implementation

constructor TImgButton.Create(AOwner: TComponent);
begin
    GetLoadFilePlayPicNorman:=Tbitmap.Create;
    GetLoadFilePlayPicOver:=Tbitmap.Create;
    GetLoadFilePlayPicPress:=Tbitmap.Create;
    GetLoadFilePausePicNorman:=Tbitmap.Create;
    GetLoadFilePausePicOver:=Tbitmap.Create;
    GetLoadFilePausePicPress:=Tbitmap.Create;
    FTransparentColor:=clOlive;
    FOnChange:=BitmapsChanged;

inherited Create(AOwner);
    Width:=36;
    Height:=36;
//Parent.DoubleBuffered:=True;
end;

procedure TImgButton.CMMouseEnter (var Message: TMessage);
begin
  inherited;
  PicTure.Bitmap.FreeImage;
  if Stuts1_Or_Stuts2 then
  begin
    PicTure.Bitmap:=GetLoadFilePausePicOver;
  end
  else
  begin
    PicTure.Bitmap:=GetLoadFilePlayPicOver;
  end;
end;

procedure TImgButton.CMMouseLeave (var Message: TMessage);
begin
  inherited;
  PicTure.Bitmap.FreeImage;
  if Stuts1_Or_Stuts2 then
  begin
    PicTure.Bitmap:=GetLoadFilePausePicNorman;
  end
  else
  begin
    PicTure.Bitmap:=GetLoadFilePlayPicNorman;
  end;
end;

procedure TImgButton.MouseDown( Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
  inherited;
  PicTure.Bitmap.FreeImage;
  if Stuts1_Or_Stuts2 then
  begin
    PicTure.Bitmap:=GetLoadFilePausePicPress;
    //PlayPauseStuts:=False;
  end
  else
  begin
    PicTure.Bitmap:=GetLoadFilePlayPicPress;
    //PlayPauseStuts:=True;
  end;
end;

procedure TImgButton.MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
  inherited;
  PicTure.Bitmap.FreeImage;
  if Stuts1_Or_Stuts2 then
  begin
    PicTure.Bitmap:=GetLoadFilePausePicNorman;
  end
  else
  begin
    PicTure.Bitmap:=GetLoadFilePlayPicNorman;
  end;
end;

procedure TImgButton.SetStuts1OrStuts2(Value:Boolean);
begin
  GetStuts1OrStuts2:=Value;
  if GetStuts1OrStuts2 then
  PicTure.Bitmap:=GetLoadFilePausePicNorman
  else
  PicTure.Bitmap:=GetLoadFilePlayPicNorman;
end;

procedure TImgButton.SetLoadFilePlayPicNorman(PlayPicNormanPath:Tbitmap);
begin
  GetLoadFilePlayPicNorman.Assign(PlayPicNormanPath);
  inherited;
  PicTure.Assign(PlayPicNormanPath);
  PicTure.Bitmap:=GetLoadFilePlayPicNorman
end;

procedure TImgButton.SetLoadFilePlayPicOver(PlayPicOverPath:Tbitmap);
begin
GetLoadFilePlayPicOver.Assign(PlayPicOverPath);
end;

procedure TImgButton.SetLoadFilePlayPicPress(PlayPicPressPath:Tbitmap);
begin
GetLoadFilePlayPicPress.Assign(PlayPicPressPath);
end;

procedure TImgButton.SetLoadFilePausePicNorman(PausePicNormanPath:Tbitmap);
begin
GetLoadFilePausePicNorman.Assign(PausePicNormanPath);
end;

procedure TImgButton.SetLoadFilePausePicOver(PausePicOverPath:Tbitmap);
begin
GetLoadFilePausePicOver.Assign(PausePicOverPath);
end;

procedure TImgButton.SetLoadFilePausePicPress(PausePicPressPath:Tbitmap);
begin
GetLoadFilePausePicPress.Assign(PausePicPressPath);
end;

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


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

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

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -