Мансуров. Основы программирования в среде Lazarus. 2010
.pdf
Глава 6 Программирование приложений с графическим интерфейсом
____________________________________________________________________
Type
TSearchRec = record
Time: Longint;
Size: Int64;
Attr: Longint;
Name: TFileName;
end;
Здесь Attr - атрибуты файла (см. выше), Time - время и дата создания или последнего обновления файла в системном формате, Size - длина файла в байтах, Name - имя и расширение файла.
Директива out идентифицирует параметр только для вывода. Это эквива-
лентно var за исключением того, что значение не может быть изменено под-
программой.
Функция FindFirst ищет файлы, соответствующие параметрам Path и Attr, возвращая 0, если первое соответствие найдено. Результат поиска при этом сохраняется в Rslt. Если соответствие не найдено, то функция возвраща-
ет отрицательное число и в Rslt ничего не записывается.
FindNext - функция ищет следующий соответствующий файл, как за-
дано в параметрах поиска функции FindFirst.
Определяется следующим образом:
function FindNext(var Rslt: TSearchRec): Longint;
Возвращает 0, если соответствие найдено, результат поиска сохраняется в
Rslt.
FindClose – освобождает ресурсы, используемые функциями
FindFirst и FindNext при поиске файлов. Определена в модуле
661
6.3 Визуальное программирование в среде Lazarus
____________________________________________________________________
SysUtils следующим образом:
procedure FindClose (var F : TSearchRec);
Эту процедуру нужно вызывать всегда, после окончания поиска.
Напишем программу, которая ищет в текущем каталоге файл с расширени-
ем *.pas и, если находит, то выводит его в TMemo. Кроме того, в TStatusBar
выводит имя файла, дату его создания и размер в байтах. Пусть все это проис-
ходит в момент показа главной формы программы, т.е. в обработчике OnShow.
procedure TForm1.FormShow(Sender: TObject); var
srRec: TSearchRec; tfile: TStringList; str: string;
begin
if FindFirst('*.pas', faAnyFile, srRec) <> 0 then exit; tfile:= TStringList.Create; tfile.LoadFromFile(srRec.Name);
str:= tfile.Text; Memo1.Lines.Add(str); tfile.Free;
StatusBar1.SimpleText:='Файл: ' + srRec.Name + ', создан ' + DateToStr(FileDateToDateTime(srRec.Time)) +
', размер: '+ IntToStr(srRec.Size) + ' байтов';
FindClose(srRec);
end;
Здесь для преобразования системного формата даты и времени в обычный
662
Глава 6 Программирование приложений с графическим интерфейсом
____________________________________________________________________
формат дата-время мы воспользовались функцией FileDateToDateTime(),
а для преобразования в строку функцией DateToStr().
Обратите внимание, при загрузке файла в TMemo мы не стали преобразо-
вывать его в кодировку UTF-8 как это мы делали при загрузке текстового фай-
ла. Дело в том, что файл с исходным кодом модуля с расширением *.pas созда-
ется Lazarus и он уже в кодировке UTF-8!
Также нам понадобится функция
function SetCurrentDir(const NewDir: string ): boolean;
Устанавливает текущую директорию в NewDir, возвращая true в случае ус-
пеха.
Следующие две функции нужны только тем, кто использует Windows. За-
ядлым "линуксоидам", которые "на дух" не переносят Windows, описание этих функций могут пропустить.
Функция GetLogicalDriveStrings возвращает список всех дисков,
зарегистрированных в Windows. Описание:
function GetLogicalDriveStrings(nBufferLength: DWORD;
lpBuffer: LPSTR): DWORD;
Параметр nBufferLength определяет максимальный размер массива
(буфера) символов, указанного в параметре lpBuffer.
Параметр lpBuffer – указатель типа PChar на массив, который содер-
жит строки с нулевым символом (#0) в конце.
В случае успешного завершения работы функции, возвращаемое значение является общей длиной (в символах) всех строк скопированных в буфер.
В массиве lpBuffer содержатся имена всех дисков (включая логические дис-
ки, CD-ROM, съемные носители, такие как флешки, дискеты и т.д.), разделен-
663
6.3 Визуальное программирование в среде Lazarus
____________________________________________________________________
ные друг от друга завершающим нулѐм #0.
Если функция терпит неудачу, возвращаемое значение является нулем.
Функция GetDriveType - определяет и возвращает тип носителя. Описа-
ние:
function GetDriveType(lpRootPathName: LPCSTR):UINT;
GetDriveType использует всего один параметр – указатель на устройст-
во. Функция возвращает одно из следующих значений:
0 – мнемоническое обозначение Drive_Unknown: диск не определен или не существует;
1 – Drive_No_Root_Dir: неверный путь;
2 – Drive_Removable: съемное устройство (дискета, флешка и т.д.);
3 – Drive_Fixed: тип устройства - фиксированный (жесткий диск);
4 – Drive_Remote: удаленный (сетевой) диск;
5 – Drive_CDROM: это устройство CD-ROM;
6 – Drive_RAMDisk: виртуальный диск, созданный в оперативной памяти.
Напишем функцию, которая определяет имена всех разделов жесткого диска (или дисков, если на компьютере их имеются несколько). Для простоты будем рассматривать только жесткие диски.
function Find_Logical_Disks(): boolean; const
Hard_Disk = 3; // рассматриваем только жесткие диски var
size: LongWord;
Drives: array[0..128] of char; pDrive: PChar;
664
Глава 6 Программирование приложений с графическим интерфейсом
____________________________________________________________________
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;
s:= Copy(s, 1, 2); // берем только имя раздела и двоеточие
Memo1.Lines.Add(s); // добавляем имя раздела в Memo1 end;
inc(pDrive, 4); end;
end;
Здесь вопрос может вызвать оператор
inc(pDrive, 4);
Дело в том, что функция GetLogicalDriveStrings() записывает в массив (буфер) Drives имена устройств в виде 'Однобуквенный символ имени устройства:\#0', например 'C:\#0', т.е. каждая строка массива состоит из че-
665
6.3 Визуальное программирование в среде Lazarus
____________________________________________________________________
тырех символов.
Найденные имена логических дисков мы сохраняем в Memo1, причем мы вырезали два последних символа (обратный слеш и #0). Можно, конечно, ис-
пользовать массив строк. Но, поскольку количество установленных на том или ином компьютере жестких дисков и созданных в них разделов нам неизвестно,
пришлось бы использовать динамический массив. И, к тому же, пришлось бы этот массив передавать в другие функции и процедуры. Поэтому проще ис-
пользовать Memo1, ведь по сути это и есть динамический массив строк! Просто в программе мы его не будем показывать, установив свойство Visible в false.
С помощью следующей процедуры мы записываем в TTreeView содер-
жимое Memo1.
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;
666
Глава 6 Программирование приложений с графическим интерфейсом
____________________________________________________________________
Обратите внимание, если вы заносите в TTreeView несколько элементов (уз-
лов), то может возникнуть неприятное мерцание экрана. Поэтому мы использо-
вали TreeView1.BeginUpdate перед началом записи узлов и
TreeView1.EndUpdate после завершения записи.
Далее мы указали, что узел имеет дочерние подузлы оператором
Node.HasChildren:= true;
В этом случае рядом узлом появится значок раскрытия узла. Ну, что же,
теперь мы можем реализовать задачу отображения дерева папок и каталогов в
TTreeView. Создайте новый проект. Поместите на форму компоненты
TTreeView, TMemo и TImageList. Код программы:
unit Unit1;
{$mode objfpc}{$H+} interface
uses
Classes, SysUtils, FileUtil, LResources, Forms,
Controls, Graphics, Dialogs, ComCtrls, StdCtrls
{$IFDEF WINDOWS}
,Windows {$ENDIF};
type
{ TForm1 }
TForm1 = class(TForm)
ImageList1: TImageList;
Memo1: TMemo;
TreeView1: TTreeView;
procedure FormCreate(Sender: TObject);
667
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); {$IFDEF WINDOWS}
function Find_Logical_Disks(): boolean; procedure SetAllDirectories;
{$ENDIF} private
{private declarations } public
{public declarations } end;
var
Form1: TForm1; 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
668
Глава 6 Программирование приложений с графическим интерфейсом
____________________________________________________________________
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;
s:= Copy(s, 1, 2); // берем только имя раздела и двоеточие
Memo1.Lines.Add(s); // добавляем имя раздела в Memo1 end;
inc(pDrive, 4); end;
end;
669
6.3 Визуальное программирование в среде Lazarus
____________________________________________________________________
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; SetDirWin: boolean = false;
begin Memo1.Clear;
Memo1.Visible:= false;
TreeView1.Images:= ImageList1;
TreeView1.ExpandSignType:= tvestPlusMinus;
TreeView1.BeginUpdate;
{$IFDEF WINDOWS}
670