一个在Panel上显示图标的控件

rel=File-List href="./怎么格式全不对了.files/filelist.xml">

//原来要HTML格式呀！

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ExtCtrls,Printers, Buttons,Contnrs,

  ElementClass,TypInfo,IniFiles,ImgList;

 

Type

  TLedPanelEx = class(TPanel)

  private

    FBitMap:TBitmap;

    FImageChangeLink: TChangeLink;

    FImages: TCustomImageList;

    FLedIndex: Integer;

    procedure SetImages(const Value: TCustomImageList);

    procedure ImageListChange(Sender: TObject);

    procedure SetLedIndex(const Value: Integer);

  protected

    procedure Paint; override;

    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;

  public

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

  published

    property Images: TCustomImageList read FImages write SetImages;

    property LedIndex:Integer Read FLedIndex Write SetLedIndex;

  end;

 

procedure Register;

 

implementation

 

procedure Register;

begin

  RegisterComponents('Standard', [TLedPanelEx]);

end;

{ TLedPanelEx }

 

function TLedPanelEx.CanAutoSize(var NewWidth,

  NewHeight: Integer): Boolean;

begin

//如果设置了自动大小后则大小只能是当前显示的图标大小

  if AutoSize and Assigned(FImages) then

  begin

    NewWidth:=FImages .Width ;

    NewHeight:=FImages .Height;

  end;

end;

 

constructor TLedPanelEx.Create(AOwner: TComponent);

begin

  inherited;

  FImageChangeLink := TChangeLink.Create;

  FImageChangeLink.OnChange := ImageListChange;

  FBitMap:=TBitmap .Create;

end;

 

destructor TLedPanelEx.Destroy;

begin

  FBitMap.Free;

  FImageChangeLink.Free;

  inherited;

end;

 

procedure TLedPanelEx.ImageListChange(Sender: TObject);

begin

  if Sender = Images then Refresh ;

end;

 

procedure TLedPanelEx.Paint;

begin

  inherited;

  if Assigned (Images) then

  begin

    Canvas .CopyMode:=cmWhiteness;

    if Images.GetBitmap(FLedIndex,FBitMap) then

      Canvas .BrushCopy(Rect(0,0,Images .Width,Images .Height),FBitMap ,Rect(0,0,Images .Width,Images

.Height),clWhite);

  end;

end;

 

procedure TLedPanelEx.SetImages(const Value: TCustomImageList);

begin

//指定一个图标列表

  if Images <> nil then Images.UnRegisterChanges(FImageChangeLink);

  FImages := Value;

  if Images <> nil then

  begin

    Images.RegisterChanges(FImageChangeLink);

    Images.FreeNotification(Self);

  end;

  Refresh ;

end;

 

procedure TLedPanelEx.SetLedIndex(const Value: Integer);

begin

//设置显示的图标索引

  FLedIndex := Value;

  Refresh ;

end;

end.

{

Canvas .BrushCopy(Rect(0,0,Images .Width,Images .Height),FBitMap ,Rect(0,0,Images .Width,Images

.Height),clWhite);

 

用来透明显示图片，可是如果遇到图中间有白色的地方也会透明，有没有更好的办法？？

}