Пример написания FileListBox

Материал из DRKB


1) WinAPI

{uses ShellApi}

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  s: string;
begin
  s := ListBox1.Items[SendMessage(ListBox1.Handle, lb_GetCurSel, 0, 0)];
  if Edit1.Text[Length(Edit1.Text)] <> '\' then
    Edit1.Text := Concat(Edit1.Text + '\');
  if (not FileExists(Edit1.Text + s)) and (s[1] = '[') and (s[Length(s)] = ']') then
    DlgDirList(Handle,
      PChar(Edit1.Text + Copy(s, 2, Length(s)-2)),
      ListBox1.Handle,
      Edit1.Handle,
      faAnyFile
    );
  if Edit1.Text[Length(Edit1.Text)] <> '\' then
    Edit1.Text := Concat(Edit1.text + '\');
  if FileExists(Edit1.Text + s) then
  begin
    Caption := Edit1.Text + s;
    ShellExecute(Handle, 'open', PChar(Edit1.Text + s), '', 'c:\', sw_show);
  end
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Width := 1024 * 8 - 1;
  Edit1.Visible := False;
  DlgDirList(Handle, PChar('c:\'), ListBox1.Handle, Edit1.Handle, faAnyFile);
  ListBox1.Sorted := False;
  ListBox1.Sorted := True;
end;



2)

{uses ShellAPI}

type PListBox = ^TListBox;

procedure FillList(AList: PListBox; APath, AMask: string; AAttr: Cardinal);
var
  Path: string;
  Ser: TSearchRec;
begin
  Path := APath;
  if Path[Length(Path)] <> '\' then Path := Path + '\';
  AList^.Items.Clear;
  if FindFirst(Path + AMask, AAttr, Ser) <> 0 then exit;
  AList^.Items.Add(Ser.Name);
  while FindNext(Ser) = 0 do
  begin
    if (Ser.Attr and faDirectory) = faDirectory then
      AList^.Items.Add(' [' + Ser.Name + ']')
    else
      AList^.Items.Add(Ser.Name);
  end;
  AList^.Sorted := False;
  Alist^.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(AList: PListBox; APath, AMask: string; AAttr: Cardinal);
var
  Path: string;
  Ser: TSearchRec;
begin
  Path := APath;
  if Path[Length(Path)] <> '\' then Path := Path + '\';
  AList^.Items.Clear;
  if FindFirst(Path + AMask, AAttr, Ser) <> 0 then exit;
  AList^.Items.Add(Ser.Name);
  while FindNext(Ser) = 0 do
  begin
    if (Ser.Attr and faDirectory) = faDirectory then
      AList^.Items.Add(' [' + Ser.Name + ']')
    else
      AList^.Items.Add(Ser.Name);
  end;
  AList^.Sorted := False;
  Alist^.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;



Author: Mikel
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 03182