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

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

____________________________________________________________________

procedure TreeView1Change(Sender: TObject;

Node: TTreeNode); procedure TreeView1Expanding(Sender: TObject;

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

procedure

{$IFDEF WINDOWS}

function Find_Logical_Disks(): boolean; procedure SetAllDirectories;

{$ENDIF} private

{private declarations } public

{public declarations } end;

var

Form1: TForm1; path: string;

implementation

{ TForm1 }

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

686

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

____________________________________________________________________

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 while pDrive^ <> #0 do

begin

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

if GetDriveType(pDrive) = Hard_Disk then

begin

s:= pDrive;

687

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

____________________________________________________________________

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}

procedure TForm1.FormCreate(Sender: TObject); var

Node: TTreeNode;

srNode, srChild: TSearchRec; searchMask: string;

688

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

____________________________________________________________________

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 then

begin repeat

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

689

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

____________________________________________________________________

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;

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

SysUtils.FindClose(srNode);

end;

end;

TreeView1.EndUpdate;

690