Izvedi klasu iz TCustomListView i uvedi ovaj metod:
Code:
procedure ChangeDir(const Dir: string);
var
SearchRec: TSearchRec;
TempIcon: TIcon;
begin
if DirectoryExists(Dir) then
begin
if FindFirst(Maska, Attr, SearchRec) = 0 then
repeat
with Items.Add do
begin
Caption := SearchRec.Name;
TempIcon := TIcon.Create;
try
TempIcon.Handle := GetIconHandle(Dir + '\' + SearchRec.Name, itNormal);
LargeImages.AddIcons(TempIcon);
finally
TempIcon.Free;
end;
ImageIndex := Items.Count - 1
end;
until FindNext(SearchRec);
FindClose(SearchRec);
end;
end;
Primetices Masku i Attr kao ulaz procedure FindFirst. Njih moras definisati (smor mi je da i to sad kucam), a kao vodilja nek ti posluzi kod koji je napisan u TFileListView. Ovde pozivas i funkciju GetIconHandle (zahteva ShellAPI). Kao ulazni parametar ide IconModifier (pogledaj definiciju i skontaces sta znaci):
Code:
TIconModifier = (imNormal, imOverlay, imSelected, imOpen, imShellSize, imSmall);
Ovo je sama f-ja:
Code:
function TisCommander.GetIconHandle(FileName: string; Modifier: TIconModifier): THandle;
const
aModifier:array [TIconModifier] of integer = (0, SHGFI_LINKOVERLAY,
SHGFI_SELECTED,
SHGFI_OPENICON,
SHGFI_SHELLICONSIZE,
SHGFI_SMALLICON);
var
sfi: TSHFileInfo;
begin
SHGetFileInfo(PChar(FileName), 0, sfi, SizeOf(TSHFileInfo),
SHGFI_SYSICONINDEX or SHGFI_ICON or aModifier[Modifier]);
Result := sfi.HICON;
end;
Napomena, ovaj kod je kucan iz glave i ne znam da li tacno radi (ovako kako je napisan nisam siguran, ali kad se malo sredi sigurno radi - provereno). Nadam se da ce ti pomoci. A ako ti je smor da pravis novu komponentu (ili volis Shell) onda jednostavno upotrebi neku od Shell komponenti (recimo Plasmatech ili Ortus Shell komponente - lepo izgledaju, savrseno rade, a besplatne su za nekomercijalne aplikacije, bez nag screenova i slicnih gluposti -->
www.delphipages.com ).
Potpis
http://www.activecollab.com - Alat za upravljanje projektima