📄 imgbnt.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 + -