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.
回答:
使用
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.