Einzelnen Beitrag anzeigen

Popov
(Gast)

n/a Beiträge
 
#16

AW: Open- und SaveDialoge sollen nur Dateien (keine Ordner) anzeigen

  Alt 11. Feb 2012, 00:51
Ich habe auf die Schnelle etwas zusammengestellt. Du brauchst nur eine Listbox. Mit GetFiles werden die Dateien mit Pfad eingelesen. In DrawListBox wird es auf Dateinamen gekürzt und das passende Icon davorgezeichnet. Und siehe da, eine DateiListBox.
Delphi-Quellcode:
uses
  ShellApi;

//Liefert Datei-Liste ohne Unterordner
procedure GetFiles(Path, ExtMask: String; List: TStrings);
var
  Attrib, k: Integer;
  Search: TSearchRec;
begin
  if Path[Length(Path)] <> '\then Path := Path + '\';

  Attrib := faArchive + faReadOnly + faHidden;

  while Copy(ExtMask, 1, 1) = '.do
    Delete(ExtMask, 1, 1);

  if FindFirst(Path + '*.' + ExtMask, Attrib, Search) = 0 then
  repeat
    List.Add(Path + Search.Name);
  until FindNext(Search) <> 0;

  FindClose(Search);
end;

function GetIconFromFile(const szFilename: string;
  fSmall: boolean = false): TIcon; {uses ShellApi}
const
  dwIconFlags : array[boolean]of dword =
    (SHGFI_LARGEICON,SHGFI_SMALLICON);
var
  fi : TSHFileInfo;
begin
  Result := nil;

  // Symbol der Datei aus dem System ermitteln
  // Typ (= groß/klein) richtet sich nach dem
  // Funktionsparameter "fSmall" (default = false)
  ZeroMemory(@fi,sizeof(fi));
  SHGetFileInfo(pchar(szFilename),0,fi,sizeof(fi),
    SHGFI_ICON or dwIconFlags[fSmall]);

  // Symbol ermittelt
  if(fi.hIcon <> 0) then
  begin
    Result := TIcon.Create;
    if(Result <> nil) then
      Result.Handle := fi.hIcon;
  end;
end; {by MathiasSimmack}

procedure DrawListBox(Control: TWinControl; Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
const
  Col1: array [Boolean] of TColor = (clWindow, clWindow); //Zebra-Wunschfarben
  Col2: array [Boolean] of TColor = (clInactiveCaptionText, clWindowText);
var
  TopDifTxt, TopDifIco: Integer; // Gleicht die Höhendifferenz aus
  Icon: TIcon;
begin
  with (Control as TListbox) do
  begin
    if odSelected in State then Canvas.Font.Color := clCaptionText else begin
      Canvas.Brush.Color := Col1[Odd(Index)];
      Canvas.Font.Color := Col2[(Control as TListbox).Enabled];
    end;
    TopDifTxt := (ItemHeight div 2) - (Canvas.TextHeight(Items[Index]) div 2);
    TopDifIco := (ItemHeight div 2) - (16 div 2);

    Canvas.TextRect(Rect, Rect.Left + 20, Rect.Top + TopDifTxt,
      ExtractFileName(Items[Index]));

    Canvas.Draw(Rect.Left + 2, Rect.Top + TopDifIco,
      GetIconFromFile(Items[Index], True));
  end;
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  DrawListBox(Control, Index, Rect, State);
end;
Aufruf:

Delphi-Quellcode:
procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Style := lbOwnerDrawFixed; //kann bereits in Create eingestellt werden
  ListBox1.ItemHeight := 20; //kann bereits in Create eingestellt werden

  GetFiles('c:\windows', '*', ListBox1.Items);
end;
  Mit Zitat antworten Zitat