Мансуров. Основы программирования в среде Lazarus. 2010

Глава 6 Программирование приложений с графическим интерфейсом

____________________________________________________________________

if (srNode.Attr and faDirectory) <> 0 then begin

DirName:= ListView1.Selected.Caption;

Show_ListView_Dir(DirName);

Show_ListView_Files(DirName);

exit;

end;

if (srNode.Attr and faHidden) = 0 then begin

progr:= pchar(s); {$IFDEF UNIX}

shell(progr);

{$ELSE}

WinExec(progr, 1);

{$ENDIF} end;

end;

В Linux при таком способе запуска исполняемого файла запустить кон-

сольное приложение не удастся, поскольку консольное приложение должно за-

пускаться в консоли или терминале. Кроме того, существует более эффектив-

ный способ запуска внешних приложений, подходящий как для Linux, так и для

Windows. Это использование процессов и потоков (нитей). Не вдаваясь в под-

робности, отмечу, что при запуске программы порождается процесс. Если в программе запускается другая программа, то порождается дочерний процесс.

Создать и запустить дочерний процесс можно следующим образом:

var

AProcess: TProcess;

701

6.3 Визуальное программирование в среде Lazarus

____________________________________________________________________

begin

AProcess:= TProcess.Create(nil);

AProcess.CommandLine:= 'Имя исполняемого файла';

AProcess.Execute;

AProcess.Free;

end;

Перепишем обработчик OnDblClick:

procedure TForm1.ListView1DblClick(Sender: TObject); var

s: string; AProcess: TProcess; 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 if (srNode.Attr and faDirectory) <> 0 then begin

DirName:= ListView1.Selected.Caption;

Show_ListView_Dir(DirName);

Show_ListView_Files(DirName);

exit;

702

Глава 6 Программирование приложений с графическим интерфейсом

____________________________________________________________________

end;

if (srNode.Attr and faHidden) = 0 then begin

AProcess:= TProcess.Create(nil);

{$IFDEF UNIX}

if MessageDlg('Открывать в терминале?', mtCustom, [mbYes, mbNO], 0) = mrYes then

s:= 'xterm -T ''Lazarus Run Output''' + ' -e $(TargetCmdLine)' + s;

{$ENDIF} AProcess.CommandLine:= s; AProcess.Execute; AProcess.Free;

end;

end;

Окинем еще раз взглядом код всей нашей программы. Мы видим, что в ней имеются пять похожих процедур. Конечно, они не совсем похожи! Каждая про-

цедура решает свою задачу. Я имею в виду, что в них имеются повторяющиеся участки кода. Хотелось бы написать одну общую процедуру. Ясно, что эта

"универсальная" процедура будет довольно-таки запутанной из-за необходимо-

сти производить многочисленные проверки. В таких случаях перед программи-

стом всегда встает дилемма, что выбрать – простой и ясный код, но с дублиро-

ванием или код "с наворотами".

Все же большинство профессиональных программистов предпочтут более про-

стой и прозрачный код, несмотря на то, что размер исполняемого файла может оказаться больше. Особенно, если планируется программу в дальнейшем моди-

фицировать. Ведь спустя некоторое время разбираться даже в своей собствен-

ной программе бывает достаточно тяжело.

703

6.3 Визуальное программирование в среде Lazarus

____________________________________________________________________

Однако мы все же попробуем объединить эти пять процедур в одну. Назо-

вем эту процедуру ShowExpandNode и введем два дополнительных параметра

ShowMode: integer и IsinTListView: boolean.

Пусть ShowMode = 0, если необходимо вывести каталоги в TTreeView.

ShowMode = 1, если необходимо вывести только каталоги в

TListView, но узел берется из TTreeView.

ShowMode = 2, если необходимо вывести только файлы в TListView

из каталога выбранного в TTreeView.

IsinTListView = false, если мы находимся в TTreeView.

IsinTListView = true, если мы находимся в TListView.

Окончательно код программы будет выглядеть следующим образом:

unit Unit1;

{$mode objfpc}{$H+} interface

uses

Classes, SysUtils, FileUtil, LResources, Forms,

Controls, Graphics, Dialogs, ComCtrls, StdCtrls,

ExtCtrls, LCLType, Process,

{$IFDEF UNIX}

unix;

{$ELSE}

Windows;

{$ENDIF} type

{ TForm1 }

TForm1 = class(TForm)

704

Глава 6 Программирование приложений с графическим интерфейсом

____________________________________________________________________

ImageList1: TImageList;

ListView1: TListView;

Memo1: TMemo;

TreeView1: TTreeView;

procedure FormCreate(Sender: TObject); procedure ListView1DblClick(Sender: TObject); procedure TreeView1Change(Sender: TObject; Node:

TTreeNode); procedure TreeView1Expanding(Sender: TObject;

Node: TTreeNode; var AllowExpansion: Boolean); function Real_Directory(sname: string): boolean; procedure ShowExpandNode(ParentNode: TTreeNode;

DirName: string; ShowMode: integer;

IsinTListView: boolean);

function GetPath(ParentNode: TTreeNode): string; function GetPath_1(DirName: string;

p: string): string;

{$IFDEF WINDOWS}

function Find_Logical_Disks(): boolean; procedure SetAllDirectories;

{$ENDIF} private

{private declarations } public

{public declarations } end;

var

Form1: TForm1;

path, oldpath: string;

705

6.3 Визуальное программирование в среде Lazarus

____________________________________________________________________

implementation

{ TForm1 }

function TForm1.Real_Directory(sname: string): boolean; begin

result:= (sname <> '.') and (sname <> '..'); end;

{$IFDEF WINDOWS}

// Эти функции нужны только для Windows

function TForm1.Find_Logical_Disks(): boolean; const

Hard_Disk = 3; // рассматриваем только жесткие диски var

size: LongWord;

Drives: array[0..128] of char; pDrive: PChar;

s: string; begin

size:= GetLogicalDriveStrings(SizeOf(Drives), Drives); if size = 0 then

begin

Result:= false; exit;

end;

if size > SizeOf(Drives) then

raise Exception.Create(SysErrorMessage(ERROR_OUTOFMEMORY));

pDrive:= Drives; // устанавливаем указатель на Drives

706

Глава 6 Программирование приложений с графическим интерфейсом

____________________________________________________________________

while pDrive^ <> #0 do

begin

// если тип устройства жесткий диск

if GetDriveType(pDrive) = Hard_Disk then begin

s:= pDrive;

s:= Copy(s, 1, 2); // берем только имя раздела и двоеточие

Memo1.Lines.Add(s); // добавляем имя раздела в Memo1 end;

inc(pDrive, 4); end;

end;

procedure TForm1.SetAllDirectories; var

i: integer; Node: TTreeNode;

begin TreeView1.BeginUpdate;

for i:= 0 to Memo1.Lines.Count - 1 do begin

Node:= TreeView1.Items.AddChild(nil, Memo1.Lines[i]);

Node.ImageIndex:= 0;

Node.SelectedIndex:= 0;

Node.HasChildren:= true;

end;

TreeView1.EndUpdate;

end; {$ENDIF}

707

6.3 Визуальное программирование в среде Lazarus

____________________________________________________________________

function TForm1.GetPath(ParentNode: TTreeNode): string; var

Node: TTreeNode; begin

Node:= ParentNode; path:= '';

repeat

{$IFDEF WINDOWS}

path:= UTF8ToSys(Node.Text) + '\' + path; {$ELSE}

path:= '/' + Node.Text + '/' + path; {$ENDIF}

Node:= Node.Parent; until Node = nil; Result:= path;

end;

function TForm1.GetPath_1(DirName: string; p: string): string;

begin

{$IFDEF WINDOWS}

p:= p + UTF8ToSys(DirName) + '\' ; {$ELSE}

p:= '/' + p + DirName + '/'; {$ENDIF}

Result:= p; end;

procedure TForm1.FormCreate(Sender: TObject);

708

Глава 6 Программирование приложений с графическим интерфейсом

____________________________________________________________________

var

Node: TTreeNode;

srNode, srChild: TSearchRec; searchMask: string; SetDirWin: boolean = false;

begin Memo1.Clear;

Memo1.Visible:= false;

TreeView1.Images:= ImageList1;

TreeView1.ExpandSignType:= tvestPlusMinus;

TreeView1.BeginUpdate;

{$IFDEF WINDOWS}

// Определение логических дисков

if Find_Logical_Disks() then

begin

SetAllDirectories;

SetDirWin:= true;

end

else

{Если произошла ошибка в функции Find_Logical_Disks(),

то выбираем корневой каталог текущего диска}

SetCurrentDir('\');

{$ELSE}

SetCurrentDir('/'); // корневой каталог в Linux {$ENDIF}

if not SetDirWin then begin

path:= GetCurrentDir;

if FindFirst(path + '*', faDirectory, srNode) = 0

709

6.3 Визуальное программирование в среде Lazarus

____________________________________________________________________

then begin

repeat

// Показываем только каталоги

if (srNode.Attr and faDirectory <> 0) and (Real_Directory(srNode.Name)) then begin

Node:= TreeView1.Items.AddChild(nil,

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;

// Освобождение занятых ресурсов

710