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

来源:互联网 发布:apache无法访问子目录 编辑:程序博客网 时间:2024/04/27 23:39
//怎么格式全不对了

//原来要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 FImageswrite SetImages;

    property LedIndex:Integer Read FLedIndex WriteSetLedIndex;

 end;

 

procedure Register;

 

implementation

 

procedure Register;

begin

 RegisterComponents('Standard', [TLedPanelEx]);

end;

{ TLedPanelEx }

 

function TLedPanelEx.CanAutoSize(varNewWidth,

 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;

 

procedureTLedPanelEx.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(constValue: 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(constValue: 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);

 

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

}

原创粉丝点击