Пример создания 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;

Статья Пример создания FileListBox 2 раздела Компоненты и Классы Списки может быть полезна для разработчиков на Delphi и FreePascal.

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

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