How to get icon from a shortcut file ? I have found that if you use a ListView component, to show a list of files in any folder that contains shortcuts, then the shortcut icons do not appear correctly - they do not show the true icon of the application to which they relate. However, there is a a very useful feature of SHGetFileInfo, which is SHGFI_LINKOVERLAY. This adds the shortcut "arrow", which is shown in the bottom left corner of any shortcut icon. The demo code below shows the basic use of the SHGFI_LINKOVERLAY feature. I have added code to this demo, to distingiush between shortcut and non-shortcut files - without this code, it will overlay the shortcut "arrow" irrespective of the file type. To show the icon of a shortcut, the following code can be used as a demo: 1. Add the following components to a new project, and adjust their properties according to the code below: } | Код |
// Code for DFM file:
object Form1: TForm1
Left = 379
Top = 355
Width = 479
Height = 382
Caption = 'Get Icon from Shortcut File'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object ListView: TListView
Left = 0
Top = 73
Width = 471
Height = 275
Align = alClient
Columns = <
item
Width = 100
end
item
Width = 100
end>
SmallImages = imgList
TabOrder = 0
ViewStyle = vsReport
end
object Panel: TPanel
Left = 0
Top = 0
Width = 471
Height = 73
Align = alTop
TabOrder = 1
object btnGetFile: TButton
Left = 16
Top = 8
Width = 75
Height = 25
Caption = 'Get file'
TabOrder = 0
OnClick = btnGetFileClick
end
object btnGetIcon: TButton
Left = 104
Top = 8
Width = 75
Height = 25
Caption = 'Get icon'
TabOrder = 1
OnClick = btnGetIconClick
end
object edFileName: TEdit
Left = 16
Top = 40
Width = 441
Height = 21
TabOrder = 2
end
end
object dlgOpen: TOpenDialog
Filter = 'Shortcut files|*.lnk|All files|*.*'
Options = [ofHideReadOnly, ofNoDereferenceLinks,
ofEnableSizing] // - this is important !
Left = 248
Top = 8
end
object imgList: TImageList
BlendColor = clWhite
BkColor = clWhite
Masked = False
ShareImages = True
Left = 216
Top = 8
end
end
|
| Код |
// 2. Add the code to the PAS file below:
unit cdShortCutIcon;
interface
uses
Windows, Messages, SysUtils, Variants, Graphics, Controls, Forms,
Dialogs, Buttons, ExtCtrls, StdCtrls, StrUtils, ShellAPI,
CommCtrl, ImgList, ComCtrls, Classes;
type
TForm1 = class(TForm)
dlgOpen: TOpenDialog;
ListView: TListView;
imgList: TImageList;
Panel: TPanel;
btnGetFile: TButton;
btnGetIcon: TButton;
edFileName: TEdit;
procedure btnGetFileClick(Sender: TObject);
procedure btnGetIconClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btnGetFileClick(Sender: TObject);
begin
{ choose file to get icon from }
if dlgOpen.Execute then edFileName.Text := dlgOpen.FileName;
end;
procedure TForm1.btnGetIconClick(Sender: TObject);
var
Icon : TIcon;
ListItem : TListItem;
shInfo : TSHFileInfo;
sFileType : string;
begin
{ initialise ListView and Icon }
ListView.SmallImages := imgList;
Icon := TIcon.Create;
try
ListView.Items.BeginUpdate;
ListItem := listview.items.add;{ Initialise ListView.Item.Add }
{ get details about file type from SHGetFileInfo }
SHGetFileInfo(PChar(edFileName.Text), 0, shInfo,
SizeOf(shInfo), SHGFI_TYPENAME);
sFileType := shInfo.szTypeName;
{ is this a shortcut file ? }
if shInfo.szTypeName = 'Shortcut' then
SHGetFileInfo(PChar(edFileName.Text), 0, shInfo, SizeOf(shInfo),
SHGFI_LINKOVERLAY or SHGFI_ICON or
SHGFI_SMALLICON or SHGFI_SYSICONINDEX)
else
{ ...otherwise treat it as a normal file}
SHGetFileInfo(PChar(edFileName.Text), 0, shInfo, SizeOf(shInfo),
SHGFI_ICON or SHGFI_SMALLICON or
SHGFI_SYSICONINDEX);
{ assign icon }
Icon.Handle := shInfo.hIcon;
{ List File name, Icon and FileType in ListView}
ListItem.Caption := ExtractFileName(edFileName.Text); //...add filename
ListItem.SubItems.Add(sFileType); //...and filetype..
ListItem.ImageIndex := imgList.AddIcon(Icon); //...and icon.
finally
ListView.Items.EndUpdate; //..free memory on icon and clean up.
sFileType := '';
Icon.Free;
end;
end;
end.
|
--------------------
Если хочешь, что бы что-то работало - используй написанное,
если хочешь что-то понять - пиши сам... |
Как извлечь иконку из файла ярлыка? 
Загрузка ...
