// Arbeitsplatz auf TListview abbilden.


// Getestet mit D4 unter XP

uses shlobj, activex, shellapi, commctrl; 
 
procedure Arbeitsplatz(lv: TListview; il: TImagelist); 
var 
  pshl, ShlFlr: IShellFolder; 
  FileInfo: SHFileInfo; 
  PIDL: PITEMIDLIST; 
  EIDL: IEnumIDList; 
  PMalloc: IMalloc; 
  item: TListitem; 
  strr: _STRRET; 
  sl: TStringList; 
  pF: Cardinal; 
  x: integer; 
begin 
  il.clear; 
  il.width := 32; 
  il.height := 32; 
  lv.Items.clear; 
  lv.ViewStyle := vsIcon; 
  lv.LargeImages := il; 
  sl := TStringList.Create;        
  try 
    SHGetDesktopFolder(ShlFlr); 
    SHGetSpecialFolderLocation(0, CSIDL_DRIVES, pidl); 
    SHGetMalloc(PMalloc); 
    ShlFlr.BindToObject(pidl, nil, IID_IShellFolder, Pointer(pshl)); 
    pshl.EnumObjects(0, SHCONTF_FOLDERS, EIDL); 
    while EIDL.Next(1, pidl, pF) = S_OK do 
    begin 
      pF := 0; 
      strr.uType := 0; 
      pshl.GetDisplayNameOf(pidl, SHGDN_FORPARSING, strr); 
      sl.Add(strr.pOleStr); 
    end; 
    for x := 0 to sl.count - 1 do begin 
      SHGetFileInfo(PChar(sl[x]), 0, 
        FileInfo, sizeof(SHFileInfo), SHGFI_ICON or SHGFI_DISPLAYNAME); 
      ImageList_AddIcon(il.handle, FileInfo.hIcon); 
      item := lv.items.add; 
      item.Imageindex := x; 
      item.caption := FileInfo.szDisplayName; 
    end; 
  finally 
    sl.Free; 
    pMalloc._Release; 
    pMalloc := nil; 
  end; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Arbeitsplatz(Listview1, Imagelist1); 
end;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke