Delphi World - Получить иконку из ярлыка
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Получить иконку из ярлыка

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

{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.
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования