Пример создания FileListBox 2

Delphi , Компоненты и Классы , Списки

Автор: 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, который создает FileListBox с возможностью навигации по директориям и открытия файлов с помощью функции ShellExecute. Проект также включает в себя такие функции, как:

• Добавление иконок к элементам списка (ExtractAssociatedIcon)
• Кастомное рисование элементов списка (OnDrawItem-обработчик события)
• Обработка событий двойного клика для открытия файлов (OnDblClick-обработчик события)

Код хорошо структурирован и легко понятен, с ясными именами переменных и комментариями. Однако, есть несколько потенциальных проблем, которые можно улучшить:

1. Переменная IconIndex в процедуре ListBox1DrawItem объявлена как слово, но присваивается только значение 1. Лучше объявить ее как целое число и присвоить более значимое значение.
2. В той же процедуре переменная bm создается с шириной и высотой 34, но не используется в коде. Она могла быть удалена или заменена на более значимый случай использования.
3. Процедура ListBox1KeyDown просто вызывает метод Repaint для списка без какой-либо конкретной обработки нажатий клавиш. Это может потенциально привести к проблемам, если пользователь пытается навигировать по списку с помощью ввода клавиатуры.

Вот альтернативное решение, которое решает эти проблемы:

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  Icon: HICON;
  Bitmap: TBitmap;
begin
  Icon := ExtractAssociatedIcon(HInstance, PChar(edit1.Text + ListBox1.Items[Index]), 0);
  if Icon <> 0 then
  begin
    Bitmap := TBitmap.Create;
    try
      Bitmap.Width := 16;
      Bitmap.Height := 16;
      DrawIcon(Bitmap.Canvas.Handle, 0, 0, Icon);
      Bitmap.Canvas.StretchDraw(Rect, Bitmap);
    finally
      Bitmap.Free;
      CloseHandle(Icon);
    end;
  end;
end;

procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    // Обработка левого кнопки мыши здесь
  end;
end;

В этом измененном коде я удалил переменную IconIndex и заменял ее на более значимое значение 0 в вызове ExtractAssociatedIcon. Я также удалил неиспользуемую переменную bm и заменил ее на более значимый случай использования для рисования иконок в элементах списка. Наконец, я добавил обработчик события левой кнопки мыши, чтобы продемонстрировать, как это можно использовать для обработки различных типов ввода пользователя.

Пример создания FileListBox с поддержкой иконок и функцией поиска в директории.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Списки ::