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

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
Category:Файловая система
Category:ListBox