تحصل على icon البرامج التنفيدية

مشكور اخ Madi على هالكود

وجعله الله في موازين حسناتك

بس جرب هذا الكود وشوف

Uses

Shellapi;

procedure TForm1.Button1Click(Sender: TObject);

var

IconIndex: word;

Buffer: array[0..2048] of char;

IconHandle: HIcon;

begin

StrCopy(@Buffer, 'C:WindowsHelpWindows.hlp');

IconIndex := 0;

IconHandle := ExtractAssociatedIcon(HInstance, Buffer, IconIndex);

if IconHandle <> 0 then

Image1.Picture.Icon.Handle := IconHandle;

end;

طبعاً هذا الكود يعطيك ايقونة اي ملف تريده بس طبعاً لازم تحدد مسار الملف :)

طبعاً يوجد كود آخر وهو افضل من هذا بس انه طويل شوي وهو يعطيك الملفات حسب نوعيتها يعني مهو لازم تحدد الملف اكتب نوعية الملف ويعطيك ايقونته

واليك الكود

uses

Registry, ShellAPI;

type

PHICON = ^HICON;

procedure GetAssociatedIcon(FileName: TFilename; PLargeIcon, PSmallIcon: PHICON);

var

IconIndex: word;

FileExt, FileType: string;

Reg: TRegistry;

p: integer;

p1, p2: pchar;

Buffer: Array [0..MAX_PATH] of char;

label

noassoc;

begin

GetSystemDirectory(Buffer, MAX_PATH);

IconIndex := 0;

// Get the extension of the file

FileExt := UpperCase(ExtractFileExt(FileName));

if ((FileExt <> '.EXE') and (FileExt <> '.ICO')) or

not FileExists(FileName) then begin

// If the file is an EXE or ICO and it exists, then

// we will extract the icon from this file. Otherwise

// here we will try to find the associated icon in the

// Windows Registry...

Reg := nil;

try

Reg := TRegistry.Create(KEY_QUERY_VALUE);

Reg.RootKey := HKEY_CLASSES_ROOT;

if FileExt = '.EXE' then FileExt := '.COM';

if Reg.OpenKeyReadOnly(FileExt) then

try

FileType := Reg.ReadString('');

finally

Reg.CloseKey;

end;

if (FileType <> '') and Reg.OpenKeyReadOnly(

FileType + 'DefaultIcon') then

try

FileName := Reg.ReadString('');

finally

Reg.CloseKey;

end;

finally

Reg.Free;

end;

// If we couldn't find the association, we will

// try to get the default icons

if FileName = '' then goto noassoc;

// Get the filename and icon index from the

// association (of form '"filaname",index')

p1 := PChar(FileName);

p2 := StrRScan(p1, ',');

if p2 <> nil then begin

p := p2 - p1 + 1; // Position of the comma

IconIndex := StrToInt(Copy(FileName, p + 1,

Length(FileName) - p));

SetLength(FileName, p - 1);

end;

end;

// Attempt to get the icon

if ExtractIconEx(pchar(FileName), IconIndex,

PLargeIcon^, PSmallIcon^, 1) <> 1 then

begin

noassoc:

// The operation failed or the file had no associated

// icon. Try to get the default icons from SHELL32.DLL

try // to get the location of SHELL32.DLL

FileName := StrPas(Buffer)+'SHELL32.DLL'

except

FileName := 'C:WINDOWSSYSTEMSHELL32.DLL';

end;

// Determine the default icon for the file extension

if (FileExt = '.DOC') then IconIndex := 1

else if (FileExt = '.EXE')

or (FileExt = '.COM') then IconIndex := 2

else if (FileExt = '.HLP') then IconIndex := 23

else if (FileExt = '.INI')

or (FileExt = '.INF') then IconIndex := 63

else if (FileExt = '.TXT') then IconIndex := 64

else if (FileExt = '.BAT') then IconIndex := 65

else if (FileExt = '.DLL')

or (FileExt = '.SYS')

or (FileExt = '.VBX')

or (FileExt = '.OCX')

or (FileExt = '.VXD') then IconIndex := 66

else if (FileExt = '.FON') then IconIndex := 67

else if (FileExt = '.TTF') then IconIndex := 68

else if (FileExt = '.FOT') then IconIndex := 69

else IconIndex := 0;

// Attempt to get the icon.

if ExtractIconEx(pchar(FileName), IconIndex,

PLargeIcon^, PSmallIcon^, 1) <> 1 then

begin

// Failed to get the icon. Just "return" zeroes.

if PLargeIcon <> nil then PLargeIcon^ := 0;

if PSmallIcon <> nil then PSmallIcon^ := 0;

end;

end;

end;

-----------------

طريقة الأستدعاء

-----------------

procedure TForm1.Button1Click(Sender: TObject);

var

SmallIcon: HICON;

begin

GetAssociatedIcon('file.doc', nil, @SmallIcon);

if SmallIcon <> 0 then

Image1.Picture.Icon.Handle := SmallIcon;

end;

وفي الختام تقبل اطيب تحياتي اخوك SUM

و الله لك وحشة اخي سم , دائما لمساتك الحلوة بتزين هالمنتدى ..

وشكرا لكل من يساهم في تنشيط المنتدى .

والى الامام

وشكرا(*)