Мансуров. Основы программирования в среде Lazarus. 2010
.pdfГлава 6 Программирование приложений с графическим интерфейсом
____________________________________________________________________
OnColumnClick;
GridLines: boolean – разрешает или запрещает показ линий в режиме
ViewStyle = vsReport;
HideSelection: boolean – запрещает или разрешает сохранять выбор элементов при потере компонентом фокуса;
Items: TListItems – содержит список всех элементов;
LargeImages: TImageList – указывает источник крупных пиктограмм;
MultiSelect: boolean – разрешает/запрещает множественный выбор;
ReadOnly: boolean - запрещает/разрешает редактирование надписей;
ShowColumnHeaders: boolean - разрешает/запрещает показ заголовков колонок в режиме ViewStyle = vsReport;
SmallImages – указывает источник мелких пиктограмм;
SortType – указывает способ сортировки элементов, возможные значения stNone, stData, stText, stBoth;
StateImages – указывает источник пиктограмм для выбранных элемен-
тов;
Свойства и методы класса TListItems:
Item[Index: integer]: TListItem – открывает индексный доступ к элементам списка;
Count – содержит количество элементов в Item;
function Add: TListItem – добавляет очередной элемент к списку;
procedure Clear – очищает список;
procedure BeginUpdate – блокирует обновление экрана до тех пор,
пока не будет выполнен метод EndUpdate. Используется при одновременной вставке нескольких элементов списка для предотвращения мерцания экрана;
procedure Delete(Index: Integers) – удаляет элемент списка с
681
6.3 Визуальное программирование в среде Lazarus
____________________________________________________________________
индексом Index;
procedure EndUpdate - отменяет блокировку обновления экрана мето-
дом BeginUpdate;
function IndexOf(Value: TListItem) – возвращает индекс эле-
мента Value;
function Insert(Index: integer): TListItem – вставляет но-
вый элемент после элемента, заданного Index;
Очень важное свойство SubItems: TStrings.
При помощи этого свойства с каждым элементом списка может быть свя-
зан целый набор строк и объектов. Сначала следует создать необходимое коли-
чество колонок. При этом следует учесть, что первая из них будет отведена под сам элемент списка. Последующие же колонки будут отображать тексты строк из свойства Items.SubItems.
Заполним программно TListView данными из рис. 6.78. В новом проекте поместите компонент TListView и в обработчике OnShow формы введите следующий код:
procedure TForm1.FormShow(Sender: TObject);
var
ListItem: TListItem;
begin
with ListView1 do
begin
ViewStyle:= vsReport;
// создаем колонку
Columns.Add;
// заголовок колонки
Columns.Items[0].Caption:='Должность';
682
Глава 6 Программирование приложений с графическим интерфейсом
____________________________________________________________________
// ширина колонки
Columns.Items[0].Width:= 100;
// создаем колонку
Columns.Add;
// заголовок колонки
Columns.Items[1].Caption:='Ф.И.О.';
// ширина колонки
Columns.Items[1].Width:= 100;
// создаем колонку
Columns.Add;
// заголовок колонки
Columns.Items[2].Caption:='Уч. степень';
// ширина колонки
Columns.Items[2].Width:= 100;
// создаем колонку
Columns.Add;
// заголовок колонки
Columns.Items[3].Caption:='Телефон';
// ширина колонки
Columns.Items[3].Width:= 100;
// добавляем первый элемент
ListItem:= Items.Add;
ListItem.Caption:= 'Ректор';
// добавляем подэлементы первого элемента
ListItem.SubItems.Add('Иванов И.И.');
ListItem.SubItems.Add('д.ф.-м.н., проф.');
ListItem.SubItems.Add('234-45-45');
// добавляем второй элемент
683
6.3 Визуальное программирование в среде Lazarus
____________________________________________________________________
ListItem:= Items.Add; ListItem.Caption:= 'Проректор 1'; // добавляем подэлементы второго элемента
ListItem.SubItems.Add('Петров П.П.');
ListItem.SubItems.Add('д.т.н., проф.');
ListItem.SubItems.Add('122-12-12');
// добавляем третий элемент
ListItem:= Items.Add;
ListItem.Caption:= 'Проректор 2'; // добавляем подэлементы третьего элемента
ListItem.SubItems.Add('Сидоров С.С.');
ListItem.SubItems.Add('к.т.н., доц.');
ListItem.SubItems.Add('111-11-11');
end;
end;
Продолжим наши опыты с Проводником. Давайте, теперь реализуем пра-
вое окно Проводника. Для этой цели компонент TListView подходит как нельзя лучше. Создайте новый проект. Поместите на форму TTreeView, затем компонент TListView. Не забудьте поместить на форму также TMemo и TImageList.
Если мы посмотрим, как работает Проводник, то мы увидим, что при нажа-
тии кнопки раскрытия узла-каталога в левом окне, узел просто раскрывается, а
в правом окне ничего не появляется. Если же мы нажмем на сам узел-каталог,
то он также раскрывается и, в то же время, содержимое этого каталога (подка-
талоги и файлы) появляются в ListView1.
Для отображения содержимого узла-каталога можно использовать ту же самую процедуру Show_Only_Dir(), только найденные подкаталоги теперь
684
Глава 6 Программирование приложений с графическим интерфейсом
____________________________________________________________________
будут добавляться не только TTreeView, но и в TListView. Но эта процеду-
ра используется для вывода каталогов в левом окне, поэтому создадим проце-
дуру с другим именем. Для вывода файлов, если в данном подкаталоге они имеются, также создадим процедуру. Алгоритм тот же самый, только функции
FindFirst-FindNext будут искать уже не каталоги, а файлы. Причем скрытые файлы мы показывать не будем. Код программы:
unit Unit1;
{$mode objfpc}{$H+} interface
uses
Classes, SysUtils, FileUtil, LResources, Forms,
Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
ExtCtrls, LCLType,
{$IFDEF UNIX}
unix;
{$ELSE}
Windows;
{$ENDIF}
type
{ TForm1 }
TForm1 = class(TForm)
ImageList1: TImageList;
ListView1: TListView;
Memo1: TMemo;
TreeView1: TTreeView;
procedure FormCreate(Sender: TObject);
685
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