Мансуров. Основы программирования в среде Lazarus. 2010
.pdfГлава 6 Программирование приложений с графическим интерфейсом
____________________________________________________________________
// установка свойств ListView1 with ListView1 do
begin
Align:= alClient;
ViewStyle:= vsReport;
Columns.Add;
Columns.Items[0].Width:= 425;
ScrollBars:= ssAutoBoth;
SmallImages:= ImageList1;
end;
end;
procedure TForm1.Show_Only_Dir(ParentNode: TTreeNode); var
srNode, srChild: TSearchRec; Node: TTreeNode; searchMask: string;
begin
Node:= ParentNode; path:= '';
repeat
{$IFDEF WINDOWS}
path:= UTF8ToSys(Node.Text) + '\' + path; {$ELSE}
path:= '/' + Node.Text + '/' + path; {$ENDIF}
Node:= Node.Parent; until Node = nil;
if FindFirst(path + '*', faDirectory, srNode) = 0 then
691
6.3 Визуальное программирование в среде Lazarus
____________________________________________________________________
repeat
if (srNode.Attr and faDirectory <> 0) and Real_Directory(srNode.Name) then
begin
Node:= TreeView1.Items.AddChild(ParentNode,
SysToUTF8(srNode.Name));
Node.ImageIndex:= 0;
Node.SelectedIndex:= 0;
{$IFDEF WINDOWS}
searchMask:= path + srNode.Name + '\*'; {$ELSE}
searchMask:= path + srNode.Name + '/*'; {$ENDIF}
if FindFirst(searchMask, faDirectory, srChild) = 0 then
repeat
if (srChild.Attr and faDirectory <> 0) and Real_Directory(srChild.Name)
then Node.HasChildren:= true;
until (FindNext(srChild) <> 0) or Node.HasChildren; SysUtils.FindClose(srChild);
end;
until FindNext(srNode) <> 0; SysUtils.FindClose(srNode);
end;
procedure TForm1.Show_in_ListView_Dir(ParentNode: TTreeNode);
var
692
Глава 6 Программирование приложений с графическим интерфейсом
____________________________________________________________________
srNode, srChild: TSearchRec; Node: TTreeNode;
ListItem: TListItem; searchMask: string;
begin
Node:= ParentNode; path:= '';
repeat
{$IFDEF WINDOWS}
path:= UTF8ToSys(Node.Text) + '\' + path; {$ELSE}
path:= '/' + Node.Text + '/' + path; {$ENDIF}
Node:= Node.Parent; until Node = nil;
if FindFirst(path + '*', faDirectory, srNode) = 0 then repeat
if (srNode.Attr and faDirectory <> 0) and Real_Directory(srNode.Name) then
begin
Node:= TreeView1.Items.AddChild(ParentNode,
SysToUTF8(srNode.Name));
if srNode.Attr and faHidden = 0 then begin
ListItem:= ListView1.Items.Add;
ListItem.Caption:= Node.Text;
ListItem.ImageIndex:= 0;
end;
{$IFDEF WINDOWS}
693
6.3 Визуальное программирование в среде Lazarus
____________________________________________________________________
searchMask:= path + srNode.Name + '\*'; {$ELSE}
searchMask:= path + srNode.Name + '/*'; {$ENDIF}
if FindFirst(searchMask, faDirectory, srChild) = 0 then
repeat
if (srChild.Attr and faDirectory <> 0) and Real_Directory(srChild.Name)
then Node.HasChildren:= true;
until (FindNext(srChild) <> 0) or Node.HasChildren; SysUtils.FindClose(srChild);
end;
until FindNext(srNode) <> 0; SysUtils.FindClose(srNode);
end;
procedure TForm1.Show_in_ListView_Files(ParentNode: TTreeNode);
var
srNode: TSearchRec; Node: TTreeNode; ListItem: TListItem;
begin
Node:= ParentNode; path:= '';
repeat
{$IFDEF WINDOWS}
path:= UTF8ToSys(Node.Text) + '\' + path;
694
Глава 6 Программирование приложений с графическим интерфейсом
____________________________________________________________________
{$ELSE}
path:= '/' + Node.Text + '/' + path; {$ENDIF}
Node:= Node.Parent; until Node = nil;
if FindFirst(path + '*', faAnyFile, srNode) = 0 then repeat
if srNode.Attr and faDirectory = 0 then begin
if srNode.Attr and faHidden = 0 then begin
ListItem:= ListView1.Items.Add;
ListItem.Caption:= SysToUTF8(srNode.Name);
ListItem.ImageIndex:= 1;
end;
end;
until FindNext(srNode) <> 0; SysUtils.FindClose(srNode);
end;
procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
if Node = nil then exit; TreeView1.BeginUpdate; ListView1.BeginUpdate; ListView1.Clear; Node.DeleteChildren; Show_in_ListView_Dir(Node);
695
6.3 Визуальное программирование в среде Lazarus
____________________________________________________________________
Show_in_ListView_Files(Node);
Node.Expanded:= true;
ListView1.EndUpdate;
TreeView1.EndUpdate;
end;
procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean);
begin
TreeView1.BeginUpdate;
Node.DeleteChildren;
Show_Only_Dir(Node);
TreeView1.EndUpdate;
end;
initialization
{$I unit1.lrs}
end.
Почему мы разделили вывод в TListView каталогов и файлов на две процедуры? Если их выводить в одной процедуре, то они будут отображаться вперемешку. А ведь принято, чтобы сначала отображались каталоги, и лишь за-
тем файлы. Здесь сортировка не поможет.
Обратите внимание, для файлов мы выбрали другую пиктограмму.
Теперь нам нужно реализовать раскрытие папки в TListView по двойно-
му щелчку по его имени. Для этого напишем две процедуры, одна из которых показывает только каталоги, а другая только файлы. Вызываться они будут в обработчике события OnDblClick для TListView.
procedure TForm1.Show_ListView_Dir(DirName: string);
var
696
Глава 6 Программирование приложений с графическим интерфейсом
____________________________________________________________________
srNode: TSearchRec; ListItem: TListItem;
begin
oldpath:= path; {$IFDEF WINDOWS}
path:= path + UTF8ToSys(DirName) + '\' ; {$ELSE}
path:= '/' + path + DirName + '/'; {$ENDIF}
ListView1.Clear;
if FindFirst(path + '*', faDirectory, srNode) = 0 then repeat
if (srNode.Attr and faDirectory <> 0) and Real_Directory(srNode.Name) then
begin
ListItem:= ListView1.Items.Add;
ListItem.Caption:= SysToUtf8(srNode.Name);
ListItem.ImageIndex:= 0;
end;
until FindNext(srNode) <> 0; SysUtils.FindClose(srNode);
end;
procedure TForm1.Show_ListView_Files(DirName: string); var
srNode: TSearchRec; ListItem: TListItem;
begin path:= '';
697
6.3 Визуальное программирование в среде Lazarus
____________________________________________________________________
{$IFDEF WINDOWS}
path:= oldpath + UTF8ToSys(DirName) + '\' ; {$ELSE}
path:= '/' + oldpath + DirName + '/'; {$ENDIF}
if FindFirst(path + '*', faAnyFile, srNode) = 0 then repeat
if srNode.Attr and faDirectory = 0 then begin
if srNode.Attr and faHidden = 0 then begin
ListItem:= ListView1.Items.Add;
ListItem.Caption:= SysToUTF8(srNode.Name);;
ListItem.ImageIndex:= 1;
end;
end;
until FindNext(srNode) <> 0; SysUtils.FindClose(srNode);
end;
procedure TForm1.ListView1DblClick(Sender: TObject); var
s: string; DirName: string; srNode: TSearchRec;
begin
if ListView1.Selected = nil then exit; {$IFDEF WINDOWS}
s:= path + UTF8ToSys(ListView1.Selected.Caption);
698
Глава 6 Программирование приложений с графическим интерфейсом
____________________________________________________________________
{$ELSE}
s:= path + ListView1.Selected.Caption; {$ENDIF}
if FindFirst(s, faAnyFile, srNode) = 0 then if (srNode.Attr and faDirectory) <> 0 then begin
DirName:= ListView1.Selected.Caption;
Show_ListView_Dir(DirName);
Show_ListView_Files(DirName);
SysUtils.FindClose(srNode);
end;
end;
Добавим в наш Проводник еще одну функциональность, а именно по двой-
ному щелчку на имя исполняемого файла будем его запускать. Запуск испол-
няемого файла (внешнего приложения) в Windows проще всего организовать с помощью функции WinExec. Эта функция определена следующим образом:
function WinExec(lpCmdLine:LPCSTR; uCmdShow:UINT):UINT;
Параметр lpCmdLine является указателем на строку с нулевым символом в конце, содержащую имя выполняемого файла. Можно включить полный путь к файлу и, если необходимо, параметры командной строки. Если имя файла указано без пути, то Windows будет искать в каталогах выполняемый файл в следующей последовательности:
Каталог, из которого загружено приложение;
Текущий каталог;
Системный каталог Windows, возвращаемый функцией
GetSystemDirectory;
Каталог Windows, возвращаемый функцией GetWindowsDirectory;
699
6.3 Визуальное программирование в среде Lazarus
____________________________________________________________________
Список каталогов из переменной окружения PATH.
Параметр uCmdShow определяет форму представления окна запускаемого приложения Windows. Чаще всего используется значение 1, при котором окно запускаемого приложения активизируется и отображается на экране. Если это окно в данный момент свернуто или развернуто, то оно восстанавливается до своих первоначальных размеров и отображается в первоначальной позиции.
В Linux исполняемый файл можно запустить с помощью функции Shell.
Определена в модуле unix:
function Shell(const Command: String): cint;
Параметр Command задает имя файла с путем или без.
Обработчик события OnDblClick перепишите следующим образом:
procedure TForm1.ListView1DblClick(Sender: TObject); var
s: string; progr: pchar;
srNode: TSearchRec; DirName: string;
begin
if ListView1.Selected = nil then exit; {$IFDEF WINDOWS}
s:= path + UTF8ToSys(ListView1.Selected.Caption); {$ELSE}
s:= path + ListView1.Selected.Caption; {$ENDIF}
if FindFirst(s, faAnyFile, srNode) = 0 then
700