盒子论坛 v2.1

unit JyImageButton;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls,jpeg, gifimage,Graphics, windows,pngimage,Messages,Forms;

type
  TJyImageButton = class(TImage)
  private
    ftimer : TTimer;
    f_loadimage:Boolean;
    FNormalGlyph: TPicture;
    FHotGlyph: TPicture;
    FDisabledGlyph: TPicture;
    FOnMouseLeave: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
    fstate,fstate0:Integer;
    ffilename:string;
    FChangeImage:Boolean;
    procedure MyCMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure MyCMMouseEnter(var Message: TMessage); message CM_MOUSEeNTER;
    procedure SetNormalGlyph(Value: TPicture);
    procedure SetHotGlyph(Value: TPicture);
    procedure SetDisabledGlyph(Value: TPicture);
    procedure myGetPicture(pic:TPicture;pt:string);
    procedure mydispaly(Sender: TObject);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property Picture_Normal: TPicture read FNormalGlyph write SetNormalGlyph;
    property Picture_Hot: TPicture read FHotGlyph write SetHotGlyph;
    property Picture_Disabled: TPicture read FDisabledGlyph write SetDisabledGlyph;
    property FileName:string read Ffilename write ffilename;
    property ChangeImage:boolean read FChangeImage write fChangeImage;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('jysoft', [TJyImageButton]);
end;
function GetCurrentPath: string;
var current_path: string;
begin
  current_path := ExtractFilePath(application.ExeName);
  if current_path[length(current_path)] <> '\' then
    current_path := current_path + '\';
  result := current_path;
end;
constructor TJyImageButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FNormalGlyph := TPicture.Create;
  FHotGlyph := TPicture.Create;
  FDisabledGlyph:= TPicture.Create;
  tag:=99;
  AutoSize:=True;
  fstate:=0;
  fstate0:=-1;
  f_loadimage:=False;
  ffilename:='';
  Cursor:=crHandPoint;
  ftimer := TTimer.Create(Self);
  ftimer.Enabled := False;
  ftimer.Interval := 1;
  ftimer.OnTimer := mydispaly;
  FChangeImage:=false;
  if (csDesigning in ComponentState)  then
  ftimer.Enabled := True;
end;

destructor TJyImageButton.Destroy;
begin
  FNormalGlyph.Free;
  FHotGlyph.Free;
  FDisabledGlyph.Free;
  ftimer.free;
  inherited Destroy;
end;
procedure TJyImageButton.mydispaly(Sender: TObject);
begin
  ftimer.Enabled := False;
  refresh;
end;
procedure TJyImageButton.myGetPicture(pic:TPicture;pt:string);
var fn,tmpfn,imgfn,path: string;
  i: integer;
begin
  fn := Trim(ffilename);
  if fn='' then fn:=Name;
  i := Pos('_', fn);
  if i > 0 then fn := Copy(fn, i + 1, length(fn));
  imgfn:='';
  path:=GetCurrentpath+pt;
  tmpfn:=path + fn + '.jpg';
  if FileExists(tmpfn) then
  begin
    imgfn:=tmpfn;
  end;
  tmpfn:=path + fn + '.gif';
  if imgfn='' then
  if FileExists(tmpfn) then
  begin
    imgfn:=tmpfn;
  end;
  tmpfn:=path + fn + '.bmp';
  if imgfn='' then
  if FileExists(tmpfn) then
  begin
    imgfn:=tmpfn;
  end;
  tmpfn:=path + fn + '.png';
  if imgfn='' then
  if FileExists(tmpfn) then
  begin
    imgfn:=tmpfn;
  end;
  if imgfn<>'' then
  begin
    pic.LoadFromFile(imgfn);
  end;
end;
procedure TJyImageButton.Paint;
begin
   if Enabled=false then FState:=2
   else
   begin
     if FState<>1 then FState:=0;
   end;
   if (csDesigning in ComponentState) = false then
   if f_loadimage=false then
   begin
    myGetPicture(FNormalGlyph,'images\button\normal\');
    myGetPicture(FHotGlyph,'images\button\hot\');
    myGetPicture(FDisabledGlyph,'images\button\Disabled\');
    f_loadimage:=True;
    end;
   if (csDesigning in ComponentState)  then
   begin
     fstate:=0;
   end;
   if fstate0<>fstate then
   begin
     fstate0:=fstate;
     if fstate=0 then
     begin
       if FNormalGlyph.Graphic<>nil then
       Picture.Assign(FNormalGlyph);
     end;
     if fstate=1 then
     begin
       if FHotGlyph.Graphic<>nil then
       Picture.Assign(FHotGlyph);
     end;
     if fstate=2 then
     begin
       if FDisabledGlyph.Graphic<>nil then
       Picture.Assign(FDisabledGlyph)
       else
       if FNormalGlyph.Graphic<>nil then
       Picture.Assign(FNormalGlyph);
     end;
   end;
   inherited;
end;
procedure TJyImageButton.MyCMMouseLeave(var Message: TMessage);
begin
  inherited;
  if (csDesigning in ComponentState)  then Exit;
  if Enabled=False then Exit;
  if FNormalGlyph.Graphic<>nil then
  if FChangeImage then
  self.Picture.Assign(FNormalGlyph);
  fstate:=0;
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
end;

procedure TJyImageButton.MyCMMouseEnter(var Message: TMessage);
begin
  inherited;
  if (csDesigning in ComponentState)  then Exit;
  if Enabled=False then Exit;
  if FhotGlyph.Graphic<>nil then
  if FChangeImage then
  self.Picture.Assign(FhotGlyph);
  fstate:=1;
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;
procedure TJyImageButton.SetNormalGlyph(Value: TPicture);
begin
FNormalGlyph.Assign(Value);
fstate0:=-1;
Invalidate;
end;

procedure TJyImageButton.SetHotGlyph(Value: TPicture);
begin
  FHotGlyph.Assign(Value);
  fstate0:=-1;
  Invalidate;
end;
procedure TJyImageButton.SetDisabledGlyph(Value: TPicture);
begin
  FDisabledGlyph.Assign(Value);
  fstate0:=-1;
  Invalidate;
end;
end.
----------------------------------------------
qq:171833017,靖源软件http://www.dxmylove.com

作者：

hsj (hsj)	★☆☆☆☆	-
	盒子活跃会员

2016/8/25 9:22:19

6楼：

自己写的
----------------------------------------------
qq:171833017,靖源软件http://www.dxmylove.com

作者：

devil10086 (testabc)	▲▲▲▲△	-
	普通会员

2016/8/25 10:33:31

7楼：

找了下。我这有个三态的。

此帖子包含附件:devil10086_2016825103331.rar 大小:48.5K

----------------------------------------------
-

作者：

hs_kill (lzl_17948876)	★☆☆☆☆	-
	普通会员

2016/8/26 13:57:30

8楼：

http://www.cnblogs.com/hs-kill/p/5810028.html

可以试试这个, 通过imagelist挂接图片序号, 多态切换, 节省界面资源, 使用上基本结合了TButton和TSpeedbutton
单元独立, 没有第三方依赖
----------------------------------------------
http://www.cnblogs.com/lzl_17948876/

作者：

kisin (小马)	★☆☆☆☆	-
	普通会员

2016/8/27 0:47:24

9楼：

谢谢！我需要在d7里的.....
----------------------------------------------
-

作者：

kingofsun (小矮人酋长)	★☆☆☆☆	-
	普通会员

2016/8/28 15:05:06

10楼：

TPngButton
你可以上网搜索一下
----------------------------------------------
-

作者：

mlskin (mlskin)	▲▲▲▲△	-
	普通会员

2016/8/29 9:42:41

11楼：

TMlSkinImageButton ^_^

http://www.pngui.com
----------------------------------------------
Delphi MlSkin 它能让你的程序拥有像QQ一样多彩炫丽的外观

http://www.pngui.com;

http://www.xeframework.com

作者：

kisin (小马)	★☆☆☆☆	-
	普通会员

2016/8/31 18:00:31

12楼：

有没有免费的啊
----------------------------------------------
-

信息

登陆以后才能回复