winicon_lib.pas

一套非常好用的delphi控件,方便程序员工作

{******************************************************************}
{*                    winicon_lib.PAS - TWinIcon                  *}
{*                           从文件中读取肖像                     *}
{*                             来源  互联网                       *}
{*                  属性  Total:Integer                           *}
{*                        FileName:String                         *}
{*                        IconIndex:Integer                       *}
{*                        IconHandle: HICON                       *}
{******************************************************************}
unit winicon_lib;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
   Controls,extctrls,ShellAPI,Forms;

type
  TWinIcon = class(TWinControl)
private
    FImage:TImage;
    FFileName:String;
    FTotal:Integer;
    FIconIndex:Integer;
    procedure SetFileName(file_name:string);
    procedure ChangeIconIndex(I:Integer);
    function FGetHandle: HICON;
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
    //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;
    property IconHandle: HICON read FGetHandle;
  end;

procedure Register;

implementation

procedure Register;
begin
//注册控件
  RegisterComponents('Samples', [TWinIcon]);
end;

constructor TWinIcon.Create(AOwner: TComponent);
Begin
Inherited;
//限制控件的大小
  Constraints.MaxHeight :=34;
  Constraints.MaxWidth  :=34;
  Constraints.MinHeight :=34;
  Constraints.MinWidth  :=34;

  FImage:=TImage.Create(Self);
  FImage.Parent:=Self;
  FImage.Left:=0;FImage.Top:=0;
  FImage.Width:=34;FImage.Height:=34;
End;

function TWinIcon.FGetHandle: HICON;
begin
  if FTotal > 0 then
    Result := FImage.Picture.Icon.Handle
  else
    Result := 0;
end;

procedure TWinIcon.SetFileName(file_name:string);
begin
  FImage.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;
  FImage.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.
    FImage.Picture.SaveToFile(Name);
End;

end.