Delphi World - Пример создания FileListBox 2
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Пример создания FileListBox 2

Автор: Mikel
WEB-сайт: http://forum.vingrad.ru

{uses ShellAPI}
type
  PListBox = ^TListBox;

procedure FillList(List: PListBox; pathh, mask: string; attr: Cardinal);
var
  path: string;
  ser: TSearchRec;
begin
  path := pathh;
  if path[length(path)] <> '\' then
    path := path + '\';
  List^.Items.Clear;
  if FindFirst(path + mask, attr, ser) <> 0 then
    exit;
  List^.Items.Add(ser.Name);
  while FindNext(ser) = 0 do
  begin
    if ser.Attr and faDirectory = faDirectory then
      List^.Items.Add(' [' + Ser.Name + ']')
    else
      List^.Items.Add(Ser.Name);
  end;
  List^.Sorted := false;
  list^.Sorted := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FillList(@ListBox1, edit1.text, '*.*', faAnyFile);
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  s: string;
begin
  s := ListBox1.Items[SendMessage(ListBox1.Handle, lb_GetCurSel, 0, 0)];
  if (not FileExists(edit1.text + s)) and (s[1] + s[2] = ' [') and (s[length(s)]
    = ']') then
  begin
    FillList(@ListBox1, edit1.text + copy(s, 3, length(s) - 3), '*.*',
      faAnyFile);
    edit1.text := edit1.text + copy(s, 3, length(s) - 3) + '\';
  end;
  if FileExists(edit1.text + s) then
    ShellExecute(handle, 'open', PChar(edit1.text + s), '', 'c:\', sw_show);
end;

Добавим иконки:

{uses ShellAPI}
type
  PListBox = ^TListBox;

procedure FillList(List: PListBox; pathh, mask: string; attr: Cardinal);
var
  path: string;
  ser: TSearchRec;
begin
  path := pathh;
  if path[length(path)] <> '\' then
    path := path + '\';
  List^.Items.Clear;
  if FindFirst(path + mask, attr, ser) <> 0 then
    exit;
  List^.Items.Add(ser.Name);
  while FindNext(ser) = 0 do
  begin
    if ser.Attr and faDirectory = faDirectory then
      List^.Items.Add(' [' + Ser.Name + ']')
    else
      List^.Items.Add(Ser.Name);
  end;
  List^.Sorted := false;
  list^.Sorted := true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FillList(@ListBox1, edit1.text, '*.*', faAnyFile);
  listbox1.itemheight := 18;
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  s: string;
  Icon: hIcon;
  IconIndex: word;
begin
  IconIndex := 1;
  s := ListBox1.Items[SendMessage(ListBox1.Handle, lb_GetCurSel, 0, 0)];
  if (not FileExists(edit1.text + s)) and (s[1] + s[2] = ' [') and (s[length(s)]
    = ']') then
  begin
    FillList(@ListBox1, edit1.text + copy(s, 3, length(s) - 3), '*.*',
      faAnyFile);
    edit1.text := edit1.text + copy(s, 3, length(s) - 3) + '\';
  end;
  if FileExists(edit1.text + s) then
    ShellExecute(handle, 'open', PChar(edit1.text + s), '', 'c:\', sw_show);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  a: array of integer;
  i: integer;
begin
  SetLength(a, ListBox1.Items.Count + 1);
  //ZeroMemory(@a,ListBox1.Items.Count*4);
  for i := 0 to ListBox1.Items.Count + 1 do
    a[i] := 10;
  beep;
  beep;
  beep;
  beep;
  beep;
  SendMessage(ListBox1.Handle, lb_SetTabStops, ListBox1.Items.Count,
    Integer(@a));
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  icon: hIcon;
  iconindex: word;
  bm: TBitmap;
begin
  iconindex := 1;
  bm := TBitmap.create;
  bm.Width := 34;
  bm.Height := 34;
  ListBox1.Canvas.TextOut(17 + Rect.Left, Rect.Top, ListBox1.Items[index]);
  if (copy(ListBox1.Items[index], 1, 2) = ' [') and
    (not FileExists(edit1.text + ListBox1.Items[Index])) then
  begin
    Icon := ExtractAssociatedIcon(HInstance,
      PChar(edit1.text + copy(ListBox1.Items[Index], 3,
      length(ListBox1.Items[Index]) - 3)), IconIndex);
    DrawIcon(bm.Canvas.Handle, 0, 0, Icon);
    bm.Canvas.StretchDraw(classes.rect(0, 0, 16, 16), bm);
    ListBox1.Canvas.CopyRect(classes.rect(0, rect.top, 16, rect.top + 16),
      bm.canvas, classes.rect(0, 0, 16, 16));
  end
  else
  begin
    Icon := ExtractAssociatedIcon(HInstance,
      PChar(edit1.text + ListBox1.Items[Index]),
      IconIndex);
    DrawIcon(bm.Canvas.Handle, 0, 0, Icon);
    bm.Canvas.StretchDraw(classes.rect(0, 0, 16, 16), bm);
    ListBox1.Canvas.CopyRect(classes.rect(0, rect.top, 16, rect.top + 16),
      bm.canvas, classes.rect(0, 0, 16, 16));
  end;
  bm.Free;
  CloseHandle(Icon);
end;

procedure TForm1.ListBox1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  ListBox1.Repaint;
end;

procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  k: word;
begin
  k := 0;
  Listbox1.OnKeyDown(sender, k, shift);
end;
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования