Пример написания 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