动态获取文件的关联扩展名

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, Buttons, ExtCtrls, shellapi;

 

type

  TForm1 = class(TForm)

    Image1: TImage;

    BitBtn1: TBitBtn;

    procedure BitBtn1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

function GetFileIconByExt(const ExtName: string; SmallIcon: boolean): HICON;

 

implementation

 

{$R *.dfm}

 

function GetFileIconByExt(const ExtName: string; SmallIcon: boolean): HICON;

var

  sinfo: SHFILEINFO;

  sFlag: INTEGER;

  tempName: string; 

begin

  tempName := ExtName;

  if Copy(tempName, 1, 1) <> '.' then tempName := '.' + tempName;

  ZeroMemory(@sinfo, sizeof(sinfo));

  if SmallIcon then

    sFlag := (SHGFI_USEFILEATTRIBUTES or SHGFI_SMALLICON or SHGFI_ICON)

  else

    sFlag := (SHGFI_USEFILEATTRIBUTES or SHGFI_LARGEICON or SHGFI_ICON);

  SHGetFileInfo(pchar(tempName), FILE_ATTRIBUTE_NORMAL, sinfo, sizeof(sinfo), sFlag);

  Result := sinfo.HICON; 

end;

 

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

  Image1.picture.icon.handle := GetFileIconByExt('pdf', false);

end;

 

end.