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

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.