如何从文件中提取出图标呢? (0分)

V

vfphome

Unregistered / Unconfirmed
GUEST, unregistred user!
如何从文件中提取出图标呢?

回答:
使用
IconExtractor 构件.
该构件代码如下:
unit IconExtractor;

interface

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

type
TIconExtractor = class(TCustomControl)
private
FIcon: TIcon;
FFileName: String;
FIconIndex, FIconCount, FIconWidth, FIconHeight : Integer;

procedure SetIcon(Value: TIcon);
procedure SetFileName(Value: String);
procedure SetIconIndex(Value: Integer);
procedure SetIconCount(Value: Integer);
procedure SetIconWidth(Value: Integer);
procedure SetIconHeight(Value: Integer);
{ Private declarations }
protected
{ Protected declarations }
public
constructor Create(Owner: TComponent);
override;
destructor Destroy;
override;
procedure Paint;
override;

function Extract(FileName: String;
IconIndex: Integer): integer;
{ Public declarations }
published
property Icon: TIcon read FIcon write SetIcon;
property FileName: String read FFileName write SetFileName ;
property IconIndex: Integer read FIconIndex write SetIconIndex;
property IconCount: Integer read FIconCount write SetIconCount;
property IconWidth: Integer read FIconWidth write SetIconWidth;
property IconHeight: Integer read FIconHeight write SetIconHeight;
property Align;
property Color;
property Visible;
{ Published declarations }
end;


procedure Register;

implementation

constructor TIconExtractor.Create(Owner: TComponent);
begin

inherited Create(Owner);
Color:=clTeal;
FIcon := TIcon.Create;
Width := 32;
Height := 32;
end;


destructor TIconExtractor.Destroy;
begin

FIcon.Destroy;
inherited Destroy;
end;


procedure TIconExtractor.Paint;
begin

inherited Paint;
with Canvas do
Draw(0, 0, FIcon);
end;


procedure TIconExtractor.SetIcon(Value: TIcon);
begin

FIcon.Assign(Value);
Invalidate;
end;


procedure TIconExtractor.SetFileName(Value: String);
begin

FFileName := Value;
Extract(FFileName, FIconIndex);
end;


procedure TIconExtractor.SetIconIndex(Value: Integer);
begin

FIconIndex := Value;
Extract(FFileName, FIconIndex);
end;


procedure TIconExtractor.SetIconCount(Value: Integer);
begin

FIconCount := Value;
Extract(FFileName, FIconIndex);
end;


procedure TIconExtractor.SetIconWidth(Value: Integer);
begin

FIconWidth := Value;
Extract(FFileName, FIconIndex);
end;


procedure TIconExtractor.SetIconHeight(Value: Integer);
begin

FIconHeight := Value;
Extract(FFileName, FIconIndex);
end;


function TIconExtractor.Extract(FileName: String;
IconIndex: integer): integer;
var CharArr : array[0..255] of Char;
lh, sh : HIcon;
begin

FFileName := FileName;
FIconIndex := IconIndex;
StrPCopy(CharArr, FileName);
Result:=ExtractIconEx(Pchar(FFileName),-1,lh,sh,0);
FIcon.Handle := ExtractIcon(0, CharArr, IconIndex);
FIconCount:=Result;
FIconWidth:=FIcon.Width;
FIconHeight:=FIcon.Height;
Refresh;
Invalidate;
end;


procedure Register;
begin

RegisterComponents('K2', [TIconExtractor]);
end;


end.


 

Similar threads

顶部