提取图标的Delphi控件

一、TWinIcon 重 要 属 性

---- FileName： 要 从 中 提 取 图 标 的 文 件。

----Total： （ 只 读 属 性）FileName 所 指 定 的 文 件 中 所 包 含 的 图 标 个 数。

----IconIndex：（ 范 围：0 到Total －1） 该 属 性 指 明 当 前 所 显 示 的 图 标。

----About： 显 示 版 本 信 息。

二、TWinIcon 重 要 成 员 函 数（ 方 法）

---- procedure GetIcon(var AnIcon:TIcon;Index:Integer);

----功 能： 获 取Index（ 必 须 在0 到Total －1 之 间） 所 指 定 的 图 标， 图 标 通 过 变 量 参 数AnIcon 返 回。

    procedure SaveIconAs(Name:String);

----功 能： 将 当 前 所 显 示 的 图 标（ 即IconIndex 属 性 所 指 定 的 图 标） 保 存 成 图 标 文 件。

三、TWinIcon 控 件 的 实 现

// 文 件 名：WinIcon.Pas
unit WinIcon;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls,extctrls,ShellAPI,DsgnIntf,Forms;
type
TAboutProperty = class(TPropertyEditor)
public
procedure Edit; override;
function GetAttributes:
TPropertyAttributes; override;
function GetValue: string; override;
end;
TWinIcon = class(TWinControl)
private
fAbout:TAboutProperty;
Image:TImage;
FFileName:String;
FTotal:Integer;
FIconIndex:Integer;
procedure SetFileName(file_name:string);
procedure ChangeIconIndex(I:Integer);
public
//Retrieve an icon denoted by index
procedure GetIcon
(var AnIcon:TIcon;Index:Integer);
//Save the icon denoted by the IconIndex property
procedure SaveIconAs(Name:String);
constructor Create(AOwner: TComponent); override;
published
//(readonly)the number of icons residing 
within the file
property Total:Integer read FTotal;
//The About box
property About:TAboutProperty read fAbout;
//the name of the file from 
which icons are extracted
property FileName:String read 
FFileName write SetFileName;
//ranging from 0 to Total －1, 
this property specifies which icon to display
property IconIndex:Integer read 
FIconIndex write ChangeIconIndex;
end;
procedure Register;
implementation
procedure Register;
begin
// 注 册 控 件
RegisterComponents('Simon', [TWinIcon]);
RegisterPropertyEditor(typeInfo(TAboutProperty), 
TWinIcon,'ABOUT', TAboutProperty);
end;
constructor TWinIcon.Create(AOwner: TComponent);
Begin
Inherited;
// 限 制 控 件 的 大 小
Self.Constraints.MaxHeight :=34;
Self.Constraints.MaxWidth  :=34;
Self.Constraints.MinHeight :=34;
Self.Constraints.MinWidth  :=34;
Image:=TImage.Create(Self);
Image.Parent:=Self;
Image.Left:=0;Image.Top:=0;
Image.Width:=34;Image.Height:=34;
End;
procedure TWinIcon.SetFileName(file_name:string);
begin
Image.Picture:=nil;
FFilename:=file_name;
FTotal:=ExtractIcon(hInstance,
PChar(FFileName),LongWord( －1));
IconIndex:=0;
end;
procedure TWinIcon.GetIcon
(var AnIcon:TIcon;Index:Integer);
begin
if (Index >=Total) or (Index< 0)
then AnIcon.Handle:=0
else AnIcon.handle:=ExtractIcon
(hInstance,PChar(FFileName),Index);
end;
procedure TWinIcon.ChangeIconIndex(I:Integer);
begin
if I >=Total then FIconIndex:=Total －1
else if I< 0 then FIconIndex:=0
else FIconIndex:=I;
//If no icon, FIconIndex will be －1
if Total=0 then exit;
Image.Picture.Icon.Handle :=ExtractIcon
(hInstance,PChar(FFileName),FIconIndex);
end;
Procedure TWinIcon.SaveIconAs(Name:String);
Begin
if FIconIndex< 0 then exit;
//FIconIndex will be －1 if no icons detected.
Image.Picture.SaveToFile(Name);
End;
 以 下 是TAboutProperty 中 的 成 员 函 数
procedure TAboutProperty.Edit;
begin
Application.MessageBox('TWinIcon is written by' ＃13
＋'Simon M LIU' ＃13
＋'Email:simon_liu@263.net',
'About TWinIcon',MB_ICONINFORMATION);
end;
function TAboutProperty.GetAttributes:
TPropertyAttributes;
begin
Result := [paDialog, paReadOnly];
end;
function TAboutProperty.GetValue: string;
begin
Result := '(Simon)';
end;
end.

四、 控 件 的 安 装

---- ＊ 在Delphi 的 集 成 开 发 环 境 中 选 择 "Component | Install Component..."

----＊ 在 对 话 框 的"Unit file name" 填 上WinIcon.Pas 的 路 径 名 和 文 件 名。

---- ＊ 在"Package file name" 处 指 明 将 构 件 安 装 到 哪 一 个 包。

五、 控 件 的 使 用

---- TWinIcon 的 一 个 重 要 特 性 就 是 它 在 Delphi 集 成 开 发 环 境（IDE） 中 就 能 浏 览 文 件 中 的 图 标。 比 如 说， 如 果 你 在IDE 中 将 一 个TWinIcon 控 件 的FileName 属 性 设 置 为 "C:\Windows\Explorer.exe"， 那 么 你 就 会 立 即 看 到 一 个 电 脑 图 标， 通 过 改 变IconIndex 属 性， 你 还 能 看 到 其 它 的 图 标。 每 次 改 变FileName 属 性 时， IconIndex 都 会 自 动 调 整： 如 果FileName 指 定 的 文 件 不 存 在， 则IconIndex 被 置 成 负1， 否 则 被 置 成0。

转载于:https://www.cnblogs.com/myamanda/articles/1528748.html