Witam,
Mam problem a mianowicie chciałym wyciągnąć ikony wszystkich plików znajdujących się w danym folderze (przykładowo folderze pulpitu) i po kolei je wyświetlić. Problem jest w tym, że program pobiera złe ikony tzn. z innych plików niż powinien.
Powiedzmy ze mam 4 pliki o różnych ikonach to program zamiast wyciągnąc ikonę z każdego pliku, wyciąga z jednego a reszta ma taką samą. Nie jest tak zawsze,na przykład gdy plików jest więcej, niektóre ikony są dobre, a niektóre się powtarzają.
Oto kod to przetestowania:
const
SHIL_LARGE = $00; //The image size is normally 32x32 pixels. However, if the Use large icons option is selected from the Effects section of the Appearance tab in Display Properties, the image is 48x48 pixels.
SHIL_SMALL = $01; //These images are the Shell standard small icon size of 16x16, but the size can be customized by the user.
SHIL_EXTRALARGE= $02; //These images are the Shell standard extra-large icon size. This is typically 48x48, but the size can be customized by the user.
SHIL_SYSSMALL = $03; //These images are the size specified by GetSystemMetrics called with SM_CXSMICON and GetSystemMetrics called with SM_CYSMICON.
SHIL_JUMBO = $04; //Windows Vista and later. The image is normally 256x256 pixels.
IID_IImageList: TGUID= '{46EB5926-582E-4017-9FDF-E8998DAA0950}';
function GetImageListSH(SHIL_FLAG:Cardinal): HIMAGELIST;
type
_SHGetImageList = function (iImageList: integer; const riid: TGUID; var ppv: Pointer): hResult; stdcall;
var
Handle : THandle;
SHGetImageList: _SHGetImageList;
begin
Result:= 0;
Handle:= LoadLibrary('Shell32.dll');
if Handle<> S_OK then
try
SHGetImageList:= GetProcAddress(Handle, PChar(727));
if Assigned(SHGetImageList) and (Win32Platform = VER_PLATFORM_WIN32_NT) then
SHGetImageList(SHIL_FLAG, IID_IImageList, Pointer(Result));
finally
FreeLibrary(Handle);
end;
end;
Procedure GetIconFromFile(aFile:String; var aIcon : TIcon;SHIL_FLAG:Cardinal);
var
aImgList : HIMAGELIST;
SFI : TSHFileInfo;
Begin
//Get the index of the imagelist
SHGetFileInfo(PChar(aFile), FILE_ATTRIBUTE_NORMAL, SFI,
SizeOf( TSHFileInfo ), SHGFI_ICON or SHGFI_LARGEICON or SHGFI_SHELLICONSIZE or
SHGFI_SYSICONINDEX or SHGFI_TYPENAME or SHGFI_DISPLAYNAME );
if not Assigned(aIcon) then
aIcon:= TIcon.Create;
//get the imagelist
aImgList:= GetImageListSH(SHIL_FLAG);
//extract the icon handle
aIcon.Handle:= ImageList_GetIcon(aImgList, Pred(ImageList_GetImageCount(aImgList)), ILD_NORMAL);
End;
procedure TForm1.Button1Click(Sender: TObject);
var
x,y: integer;
s: tsearchrec;
hicon : array[0..100] of TIcon;
image: array[0..100] of Timage;
labels: array[0..100] of Tlabel;
begin
x := 0;
y:= 0;
if FindFirst('C:\Documents and Settings\user\Pulpit\*.*', faAnyFile, s) = 0 then
repeat
hicon[x]:= TIcon.Create;
memo1.lines.add('C:\Documents and Settings\user\Pulpit\' + s.name);
GetIconFromFile('C:\Documents and Settings\user\Pulpit\' + s.name,hicon[x],SHIL_EXTRALARGE);
image[x] := timage.create(self);
with image[x] do
begin
parent := form1;
canvas.Create;
width:=100;
height:=100;
left:=120 * x;
top:=100 * y;
visible := true;
Picture.Icon.Assign(hIcon[x]); //assign to timage
end;
labels[x] := Tlabel.Create(self);
with labels[x] do
begin
parent := form1;
left := (120 * x);
top := 100 * y;
visible := true;
caption := s.name;
end;
hIcon[x].Free;
inc(x);
if x = 8 then
begin
inc(y);
x := 0;
end;
until FindNext(s) <> 0;
memo1.lines.add(inttostr(x));
end;
Program tworzy komponenty TImage oraz Tlabel w odpowiednim miejscu z nazwą pliku.
Funkcje pobierania ikon wziąłem stąd:
http://stackoverflow.com/questions/1703186/can-48x48-or-64x64-icons-be-obtained-from-the-vista-shell
Co ciekawe, gdy pobieram którąś z ikon osobno to wszystko jest w porządku.