unit test; 
 
interface 
 
uses 
  Windows, Forms, SysUtils, Classes, Controls, Graphics, 
  StdCtrls, ComCtrls; 
 
type 
  TForm1 = class(TForm) 
    ListView1: TListView; 
    Button1: TButton; 
    Button2: TButton; 
    procedure Button1Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure ListView1CustomDrawSubItem(Sender: TCustomListView; 
      Item: TListItem; SubItem: Integer; State: TCustomDrawState; 
      var DefaultDraw: Boolean); 
    procedure ListView1CustomDrawItem(Sender: TCustomListView; 
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); 
    procedure Button2Click(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    procedure HoleDateien; 
    procedure GetFiles; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
uses ShellApi, CommCtrl; 
 
var 
  SpaltenFarbe: array[0..3] of TColor = ($99FFFF, $9999FF, $AAFFAA, $FF6666); 
  FontFarbe: array[0..3] of TColor = (clRed, clBlack, clBlue, clWhite); 
  SelectedFont: TColor = clYellow; 
  SelectedBkg: TColor = clGreen; 
  ImageListHandle: THandle; 
  FileInfo: _SHFILEINFO; 
  Gitter: boolean; 
  pfad: string = ''; 
  gr: Uint; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  gr := SizeOf(FileInfo); 
  with ListView1 do begin 
    Gitter := GridLines; 
    GridLines := false; 
    Canvas.Pen.Color := clBlack; 
    Columns[0].width := 18; 
    ListView_SetBkColor(Handle, SpaltenFarbe[0]); 
    RowSelect := true; 
  end; 
  ImageListHandle := SHGetFileInfo(pchar(pfad), 0, FileInfo, gr, 
    SHGFI_SYSICONINDEX or SHGFI_SMALLICON); 
  SendMessage(ListView1.Handle, LVM_SETIMAGELIST, LVSIL_SMALL, 
    ImageListHandle); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  ImageList_RemoveAll(ImageListHandle); 
  ImageList_Destroy(ImageListHandle); 
end; 
 
// zum Testen: 
procedure TForm1.HoleDateien; 
var 
  sr: TWin32FindData; 
  Itm: TListitem; 
  ft: TfileTime; 
  dt: Cardinal; 
  h: THandle; 
  s: string; 
begin 
  screen.cursor := crHourglass; 
  ListView1.items.clear; 
  if ansilastchar(pfad) <> '\' then pfad := pfad + '\'; 
  h := FindFirstFile(PChar(pfad + '*'), sr); 
  if h <> INVALID_HANDLE_VALUE then repeat 
      if sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin 
        Itm := ListView1.items.add; 
        Itm.Caption := sr.cFilename; 
        Itm.subitems.add(sr.cFilename); 
        Itm.subitems.add(formatfloat('#,##0', 
          sr.nFileSizeHigh * MAXDWORD + sr.nFileSizeLow)); 
        SHGetFileInfo(pchar(pfad + sr.cFilename), 0, 
          FileInfo, gr, SHGFI_TypeName or SHGFI_Icon or SHGFI_SMALLICON); 
        if trim(FileInfo.szTypename) = '' then begin 
          s := ansiuppercase(extractfileext(sr.cFilename)); 
          if s <> '' then s := s + '-'; 
          Itm.subitems.add( 
            uppercase(copy(s, 2, length(s) - 1)) + 'Datei'); 
        end else 
          Itm.subitems.add(FileInfo.szTypename); 
        FileTimeToLocalFiletime(sr.ftLastWriteTime, ft); 
        FileTimeToDosDateTime(ft, LongRec(dt).Hi, LongRec(dt).Lo); 
        Itm.subitems.add(FormatDateTime('dd.mm.yyyy hh:nn', 
          FileDateToDateTime(dt))); 
        Itm.ImageIndex := FileInfo.iIcon; 
      end; 
    until (Findnextfile(h, sr) = false) or application.terminated; 
  windows.FindClose(h); 
  screen.cursor := crDefault; 
end; 
 
procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView; 
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); 
begin 
//  Dummy ; muss sein 
end; 
 
procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView; 
  Item: TListItem; SubItem: Integer; State: TCustomDrawState; 
  var DefaultDraw: Boolean); 
var 
  R: TRect; 
  u: Uint; 
begin 
  DefaultDraw := false; 
  ListView_GetSubItemRect(Sender.Handle, Item.Index, SubItem, LVIR_LABEL, @R); 
  if Subitem = 2 then u := DT_Right else u := DT_Left; 
  with Sender.Canvas do begin 
    if Item.Selected then begin 
      Brush.color := SelectedBkg; 
      Font.Color := SelectedFont; 
    end else begin 
      Brush.color := SpaltenFarbe[pred(SubItem)]; 
      Font.Color := FontFarbe[pred(SubItem)]; 
    end; 
    FillRect(R); 
    if Gitter then begin 
      moveto(0, pred(R.Bottom)); 
      lineto(pred(R.Right), pred(R.Bottom)); 
      lineto(pred(R.Right), pred(R.Top)); 
    end; 
    InflateRect(R, -2, 0); 
    DrawText(Handle, PChar(Item.SubItems[pred(SubItem)]), -1, R, 
      DT_SingleLine or DT_VCenter or u); 
  end; 
end; 
 
procedure TForm1.GetFiles; 
begin 
  ListView1.Items.BeginUpdate; 
  ListView_DeleteAllItems(ListView1.Handle); 
  HoleDateien; 
  ListView1.Items.EndUpdate; 
end; 
 
 
// Beispielaufrufe 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Pfad := 'D:\'; 
  GetFiles; 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  Pfad := 'C:\Bilder'; 
  GetFiles; 
end; 
 
end.