1.2 Обработка двумерных массивов
Объявление массива
Массив, как и любая переменная программы, перед использованием должен быть объявлен в разделе объявления переменных.
При объявлении массива удобно использовать именованные константы. Именованная константа объявляется в разделе объявления констант, который обычно располагают перед разделом объявления переменных. Начинается раздел объявления констант словом const. В инструкции объявления именованной константы указывают имя константы и ее значение, которое отделяется от имени символом «равно». После объявления именованной константы ее можно использовать в программе как обычную числовую или символьную константу. Ниже в качестве примера приведено объявление массива названий команд-участниц чемпионата по футболу, в котором используются именованные константы.
Для того чтобы в программе использовать элемент массива, надо указать имя массива и номер элемента (индекс), заключив индекс в квадратные скобки. В качестве индекса можно использовать константу или выражение целого типа,
Операции с массивами
Типичными операциями при работе с массивами являются:
– вывод массива;
– ввод массива;
– поиск максимального или минимального элемента массива;
– поиск заданного элемента массива;
– сортировка массива.
Вывод массива
Под выводом массива понимается вывод на экран монитора (в диалоговое окно) значений элементов массива.
Если в программе необходимо вывести значения всех элементов массива, то для этого удобно использовать инструкцию for.
Ввод (вывод) массива
Под вводом массива понимается процесс получения от пользователя (или из файла) во время работы программы значений элементов массива.
Данны в массив можно вводить (выводить) с помощью компонентов StringGrid и Memo (вкладка Additional).
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;//номер элемента, сравниваемого с минимальным
a:array[1..10] of integer;
min:integer;//номер минимального элемента
begin
//Введем массив
for i:=1 to 10 do
//Преобразуем полученные подстроки в числа
a[i]:=StrToInt(GetSubStr(Edit1.text,' ',i));//используем пробел в качестве разделителя
//Найдем минимальный элемент
min:=1; //пусть номер минимального элемента = 1
for i:= 2 to 10 do // начнем искать со следующего
if a[i] < a[min] then min:=i;
Form1.caption:=IntToStr(a[min]); // выводим минимальный элемент
End
Рисунок 1. Код программы в Delphi
Рисунок 2. Пример работы программы
Задача 2. Составить программу для нахождения суммы четных элементов массива.
Код программы
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
LabeledEdit1: TLabeledEdit;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
private { Private declarations }
public { Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var i:byte;
s:integer;
begin
randomize;
s:=0;
for i:=0 to 7 do begin
StringGrid1.Cells[i,0]:=IntToStr(random(10));
if i mod 2<>0 then
s:=s+StrToInt(StringGrid1.cells[i,0]);
LabeledEdit1.text:=IntToStr(S);
end;end;end.
Рисунок 1. Код программы в Delphi
Рисунок 2. Результат работы программы
var
Form1: TForm1;
A: array of array of integer;
m, n: integer;
imax, jmax, imin, jmin: integer;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
Var
i, j: integer;
begin
if (Edit1.Text<>'') and (Edit2.Text<>'') then begin
Randomize;
n:=StrToInt(Edit1.Text);
m:=StrToInt(Edit2.Text);
SetLength(A,n,m);
for j:=0 to m-1 do
for i:=0 to n-1 do
begin
A[i,j]:=Round(Sin(Random(100))*100);
end;
StringGrid1.RowCount:=n+1;
StringGrid1.ColCount:=m+1;
with StringGrid1 do
begin
for i:=1 to RowCount do
begin
Cells[i,0]:=IntToStr(i);
end;
for j:=1 to ColCount do
begin
Cells[0,j]:=IntToStr(j);
end;
end;
with StringGrid1 do
begin
for i:=1 to n do
for j:=1 to m do
Cells[j,i]:=IntToStr(A[i-1,j-1]);
end;
end
else Showmessage('Введите размерность массива.');
end;
procedure TForm1.Button2Click(Sender: TObject);
Var
i, j: integer;
begin
imax:=0;
jmax:=0;
imin:=0;
jmin:=0;
For i:=0 to High(A) do
For j:=0 to High(A) do
if A[i,j] > A[imax,jmax] then begin
imax:=i;
jmax:=j;
end;
For i:=0 to High(A) do
For j:=0 to High(A) do
if A[i,j] < A[imin,jmin] then begin
imin:=i;
jmin:=j;
end;
Edit3.Text:=IntToStr(A[imax,jmax])+' индексы ['+IntToStr(imax+1)+','+IntToStr(jmax+1)+']';
Edit4.Text:=IntToStr(A[imin,jmin])+' индексы ['+IntToStr(imin+1)+','+IntToStr(jmin+1)+']';
end;
procedure TForm1.Button3Click(Sender: TObject);
Var
i, j: integer;
begin
{if (Edit1.Text<>'') and (Edit2.Text<>'') then begin
Randomize;
n:=StrToInt(Edit1.Text);
m:=StrToInt(Edit2.Text);
SetLength(A,n,m);
for j:=0 to m-1 do
for i:=0 to n-1 do
begin
A[i,j]:=Round(Sin(Random(100))*100);
end;
StringGrid2.RowCount:=n+1;
StringGrid2.ColCount:=m+1;
with StringGrid2 do
begin
for i:=1 to RowCount do
begin
Cells[i,0]:=IntToStr(i);
end;
for j:=1 to ColCount do
begin
Cells[0,j]:=IntToStr(j);
end;
end;}
with StringGrid2 do
begin
for i:=1 to n do
for j:=1 to m do
Cells[j,i]:=IntToStr(A[i-1,j-1]);
Edit5.Text:= IntToStr(imax+1);
end;end;
rocedure TForm1.Button4Click(Sender: TObject);
var
i, j: integer;
begin
for I := StringGrid2.Row to StringGrid2.RowCount - 1 do
begin
j:=StrToInt(Edit5.Text);
for j := 1 to StringGrid2.ColCount - 1 do
begin
StringGrid2.Cells[j, i]:=StringGrid2.Cells[j, i+1];
End;end;end;end.
Рисунок 1. Рабочее окно программы
Рисунок 2. Результат выполнения программы
Рисунок 3. Окно программы
var
Form1: TForm1;
A: array of array of integer;
m, n: integer;
imax, jmax, imin, jmin: integer;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
Var
i, j: integer;
begin
if (Edit1.Text<>'') and (Edit2.Text<>'') then begin
Randomize;
n:=StrToInt(Edit1.Text);
m:=StrToInt(Edit2.Text);
SetLength(A,n,m);
for j:=0 to m-1 do
for i:=0 to n-1 do
begin
A[i,j]:=Round(Sin(Random(100))*100);
end;
StringGrid.RowCount:=n+1;
StringGrid.ColCount:=m+1;
with StringGrid do
begin
for i:=1 to RowCount do
begin
Cells[i,0]:=IntToStr(i);
end;
for j:=1 to ColCount do
begin
Cells[0,j]:=IntToStr(j);
end;
end;
with StringGrid do
begin
for i:=1 to n do
for j:=1 to m do
Cells[j,i]:=IntToStr(A[i-1,j-1]);
end;
end
else Showmessage('Введите размерность массива.');
end;
procedure TForm1.Button2Click(Sender: TObject);
Var
i, j: integer;
begin
imax:=0;
jmax:=0;
imin:=0;
jmin:=0;
For i:=0 to High(A) do
For j:=0 to High(A) do
if A[i,j] > A[imax,jmax] then begin
imax:=i;
jmax:=j;
end;
For i:=0 to High(A) do
For j:=0 to High(A) do
if A[i,j] < A[imin,jmin] then begin
imin:=i;
jmin:=j;
end;
Edit3.Text:=IntToStr(A[imax,jmax])+' индексы ['+IntToStr(imax+1)+','+IntToStr(jmax+1)+']';
Edit4.Text:=IntToStr(A[imin,jmin])+' индексы ['+IntToStr(imin+1)+','+IntToStr(jmin+1)+']';
end;
procedure TForm1.Button3Click(Sender: TObject);
Var
i, j, p: integer;
begin
p:=A[imax,jmax];
A[imax,jmax]:=A[imin,jmin];
A[imin,jmin]:=p;
with StringGrid do
begin
for i:=1 to n do
for j:=1 to m do
Cells[j,i]:=IntToStr(A[i-1,j-1]);
end;
end;
end.
Рисунок 3. Результат выполнения программы
1.3 Работа с текстовыми файлами
Для чтения в первую очередь нужно открыть поток класса StreamReader, привязав его к файлу. Делается это при помощи метода File.OpenText(‘имя файла’);
StreamReader sr = File.OpenText("test.txt");
Если нам нужно считать только первую строку из файла, то все просто. Для этого воспользуемся следующей конструкцией sr.ReadLine().
Обработка типизированных файлов
Прежде чем выполнять какие либо операции с файлом, необходимо инициализировать файл, т.е. установить связь файловой переменной f с внешним файлом на диске при помощи процедуры.
После выполнения процедуры чтения или записи в файл указатель текущей позиции в файле смещается на число позиций, равное длине прочитанного или записанного выражения. У типизированных файлов длина любого компонента строго постоянна и определяется при описании его типа. Это дает возможность организовать прямой доступ к каждой компоненте. Доступ к строкам текстового файла возможен лишь последовательно.
Чтобы избежать этой ошибки, достаточно вставить при записи в файл после каждой переменной пробел. Тогда программа при каждом чтении берет символы от пробела до пробела и правильно преобразует текстовое представление в число.
Можно использовать одну и ту же переменную для работы с несколькими файлами, если они обрабатываются последовательно.
Задача 1.
Составить программу, открывающую текстовый файл.
Код программы:
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
private { Private declarations }
Public { Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
opendialog1.Execute;
opendialog1.filter:='|*.txt,*.doc|';
if opendialog1.execute then
memo1.Lines.Loadfromfile(opendialog1.filename);
end; end.
Рисунокунок1. Код программы в Delphi
Рисунок 2. Результат работы программы
Задача 2. Составить программу позволяющую найти документ, Рисунокунок, и любые другие файлы на компьютере.
Код программы
Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,FileCtrl, ComCtrls, Menus,ShellAPI, ImgList,StrUtils,
ExtCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Label1: TLabel;
Button1: TButton;
Memo1: TMemo;
Edit2: TEdit;
Label2: TLabel;
Button2: TButton;
Label3: TLabel;
Label4: TLabel;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
BalloonHint1: TBalloonHint;
ImageList1: TImageList;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
Memo2: TMemo;
Label5: TLabel;
Label6: TLabel;
PopupMenu2: TPopupMenu;
N6: TMenuItem;
Button3: TButton;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
Image1: TImage;
Label7: TLabel;
N7: TMenuItem;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Edit2KeyPress(Sender: TObject; var Key: Char);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure Edit1Click(Sender: TObject);
procedure Memo2KeyPress(Sender: TObject; var Key: Char);
procedure Memo1KeyPress(Sender: TObject; var Key: Char);
procedure Button3Click(Sender: TObject);
procedure CheckBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure CheckBox2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure CheckBox3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure CheckBox4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Memo1Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N7Click(Sender: TObject);
private
{ Private declarations }
procedure ScanFolder(Folder: string);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
NomFile,NomDir,kl: integer;
st: TSearchRec;
str : string;
function GetFileDateTime(FileName: string): TDateTime;
var
intFileAge: LongInt;
begin
intFileAge := FileAge(FileName);
if intFileAge = -1 then
Result := 0
else
Result := FileDateToDateTime(intFileAge)
end;
function myremovedir(sdir : string) : boolean;
var
iindex : integer;
searchrec : tsearchrec;
sfilename : string;
begin
result := false;
sdir := sdir + '\*.*';
iindex := findfirst(sdir, faanyfile, searchrec);
while iindex = 0 do begin
sfilename := extractfiledir(sdir)+'\'+searchrec.name;
if searchrec.attr = fadirectory then begin
if (searchrec.name <> '' ) and
(searchrec.name <> '.') and
(searchrec.name <> '..') then
myremovedir(sfilename);
end else begin
if searchrec.attr <> faarchive then
filesetattr(sfilename, faarchive);
if not deletefile(sfilename) then
showmessage('не могу удалить ' + sfilename);
end;
iindex := findnext(searchrec);
end;
findclose(searchrec);
removedir(extractfiledir(sdir));
result := true;
end;
function SlashSep(Path, FName: string): string;
begin
if Path[Length(Path)] <> '\' then
Result:= Path +'\'+ FName
else Result := Path + FName;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
NomFile:=0;
NomDir:= 0;
kl:= 0;
if Length(Edit1.Text) = 0 then
begin
if MessageBox(Handle,PChar('А название?!'),PChar('Внимание ошибка!'),
MB_ICONERROR+MB_ok)= IDOK then Exit;
end;
if Length(Edit2.Text) <> 0 then
begin
Memo1.Clear;
Memo2.Clear;
Button1.Caption:= 'Ищу...';
Button1.Enabled:= False;
Button2.Enabled:= False;
ScanFolder(Edit2.Text);
end
else
if MessageBox(Handle,PChar('Нужно выбрать директорию!!!'),PChar('Внимание'),
MB_ICONERROR+MB_ok)= IDOK then Exit;
if Memo1.Lines.Count = 0 then
begin
Memo1.Font.Color:= cLRed;
Memo1.Font.Size:= 10;
Memo1.Lines.Add('Файлов с таким именем не найдено');
end;
Button1.Caption:= 'Найти';
Button1.Enabled:= True;
Button2.Enabled:= True;
Label5.Font.Size:= 10;
Label5.Font.Style:= [fsBold];
Label6.Font.Size:= 10;
Label6.Font.Style:= [fsBold];
Label6.Caption:= 'Найдено файлов : '+IntToStr(NomFile);
Label5.Caption:= 'Найдено папок : '+IntToStr(NomDir);
Label7.Caption:= '';
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Path: string;
begin
// Выбираем директорию ( подключить FileCtrl)
if SelectDirectory('Выберите папку','',Path) then
begin
Edit2.Visible:= True;
Label2.Visible:= True;
Edit2.Text:= Path;
end;
end;
// выход из цикла
procedure TForm1.Button3Click(Sender: TObject);
begin
kl:= 1;
end;
procedure TForm1.CheckBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
CheckBox2.Checked:= False;
CheckBox3.Checked:= False;
CheckBox4.Checked:= False;
CheckBox1.Checked;
end;
procedure TForm1.CheckBox2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
CheckBox1.Checked:= False;
CheckBox3.Checked:= False;
CheckBox2.Checked;
end;
procedure TForm1.CheckBox3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
CheckBox1.Checked:= False;
CheckBox2.Checked:= False;
CheckBox3.Checked;
end;
procedure TForm1.CheckBox4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
CheckBox1.Checked:= False;
CheckBox4.Checked;
end;
procedure TForm1.Edit1Click(Sender: TObject);
begin
Memo1.Clear;
Memo2.Clear;
Form1.Label5.Caption:='';
Form1.Label6.Caption:='';
end;
procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
Key:= Chr(0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Edit2.Visible:= False;
Label2.Visible:= False;
end;
procedure TForm1.Memo1Click(Sender: TObject);
var
ic: TIcon;
w: integer;
begin
ic := TIcon.Create;
ic.Handle := ExtractIcon(Application.Handle,
PChar(Memo1.Lines.Strings[Memo1.CaretPos.Y]), 0);
Image1.Canvas.Brush.Color:= clAqua;
Image1.Canvas.Rectangle(0,0,35,35);
Image1.Canvas.Draw(32 * (0 mod w), 32 * (0 div w), ic);
ic.Destroy;
end;
procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
Key:= Chr(0);
end;
procedure TForm1.Memo2KeyPress(Sender: TObject; var Key: Char);
begin
Key:= Chr(0);
end;
function DeleteFileWithUndo(sFileName:string):boolean;
var
fos:TSHFileOpStruct;
begin
sFileName:=sFileName+#0;
FillChar(fos, SizeOf(fos), 0);
with fos do
begin
wFunc:=FO_DELETE;
pFrom:=PChar(sFileName);
fFlags:=FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
end;
Result:=(0=ShFileOperation(fos));
end;
procedure TForm1.N1Click(Sender: TObject);
begin
if Length(Memo1.Lines.Strings[Memo1.CaretPos.Y]) = 0 then
begin
if MessageBox(Handle,PChar('Выберите файл!'),PChar('Внимание ошибка!'),
MB_ICONERROR+MB_ok)= IDOK then Exit;
end;
if Memo1.SelLength <> 0 then
if MessageBox(Handle,PChar('Вы действительно хотите удалить файл:'+#13+
Memo1.Lines.Strings[Memo1.CaretPos.Y]+' в корзину?'),PChar('Предупреждение!!!'),
MB_ICONQUESTION+MB_YESNO)= IDNO then Exit;
if DeleteFileWithUndo(Memo1.Lines.Strings[Memo1.CaretPos.Y]) then
begin
if MessageBox(Handle,PChar('Файл '+Memo1.Lines.Strings[Memo1.CaretPos.Y]+#13+
'успешно удалён в корзину'),PChar('Файл удален'),
MB_ICONINFORMATION+MB_ok)= IDOK then
begin
Memo1.Lines.Delete(Memo1.CaretPos.Y);
Exit;
end
else
begin
if MessageBox(Handle,PChar('Номер ошибки : '+IntToStr(GetLastError)),PChar('Ошибка удаления!'),
MB_ICONERROR+MB_ok)= IDOK then Exit
end;
end;
end;
procedure TForm1.N2Click(Sender: TObject);
var
Path,Name: string;
begin
if Length(Memo1.Lines.Strings[Memo1.CaretPos.Y]) = 0 then
begin
if MessageBox(Handle,PChar('Выберите файл!'),PChar('Внимание ошибка!'),
MB_ICONERROR+MB_ok)= IDOK then Exit;
end;
// Выбираем директорию ( подключить FileCtrl)
if SelectDirectory('Выберите папку','',Path) then
begin
Name:= Copy(Memo1.Lines.Strings[Memo1.CaretPos.Y],
Length(Memo1.Lines.Strings[Memo1.CaretPos.Y])-Pos('\',
ReverseString(Memo1.Lines.Strings[Memo1.CaretPos.Y]))+2,
Length(Memo1.Lines.Strings[Memo1.CaretPos.Y])-Pos('\',
ReverseString(Memo1.Lines.Strings[Memo1.CaretPos.Y]))+1);
if CopyFile(PChar(Memo1.Lines.Strings[Memo1.CaretPos.Y]),
PChar(Path+'\'+Name) ,true) then
begin
if MessageBox(Handle,PChar('Файл '+Memo1.Lines.Strings[Memo1.CaretPos.Y]+#13+
'успешно скопирован в '+Path+'\'),PChar('Файл скопирован'),
MB_ICONINFORMATION+MB_ok)= IDOK then Exit;
end
else
begin
if MessageBox(Handle,PChar('Номер ошибки : '+IntToStr(GetLastError)),
PChar('Ошибка копирования!'),
MB_ICONERROR+MB_ok)= IDOK then Exit;
end;end;end;
procedure TForm1.N3Click(Sender: TObject);
begin
if Length(Memo1.Lines.Strings[Memo1.CaretPos.Y])= 0 then
begin
if MessageBox(Handle,PChar('Выберите файл!'),PChar('Внимание ошибка!'),
MB_ICONERROR+MB_ok)= IDOK then Exit;
end;
ShellExecute(Application.MainForm.Handle, nil,
PChar(Memo1.Lines.Strings[Memo1.CaretPos.Y]),'',
PChar(Memo1.Lines.Strings[Memo1.CaretPos.Y]), SW_SHOW);
end;
procedure TForm1.N4Click(Sender: TObject);
var
l:string;
begin
l:=ExtractFileDir(Memo1.Lines.Strings[Memo1.CaretPos.Y]);
if l<>'' then ShellExecute(Application.Handle,'open',PChar(l),nil,nil,SW_SHOW);
end;
procedure TForm1.N5Click(Sender: TObject);
var
u: string;
t: TDateTime;
begin
if Length(Memo1.Lines.Strings[Memo1.CaretPos.Y])= 0 then
begin
if MessageBox(Handle,PChar('Выберите файл!'),PChar('Внимание ошибка!'),
MB_ICONERROR+MB_ok)= IDOK then Exit;
end;
u:=Memo1.Lines.Strings[Memo1.CaretPos.Y];
T:= GetFileDateTime(u);
ShowMessage('Дата и время создания '+#13+''+#13+DateTimeToStr(t));
end;
procedure TForm1.N6Click(Sender: TObject);
begin
if Length(Memo2.Lines.Strings[Memo2.CaretPos.Y])= 0 then
begin
if MessageBox(Handle,PChar('Выберите папку!'),PChar('Внимание ошибка!'),
MB_ICONERROR+MB_ok)= IDOK then Exit;
end;
if MessageBox(Handle,PChar('Вы действительно хотите удалить папку: '+Memo2.Lines.Strings[Memo2.CaretPos.Y]+' ?'),
PChar('Внимание'),
MB_ICONQuestion+MB_YESNO)= IDNO then Exit;
if myremovedir(Memo2.Lines.Strings[Memo2.CaretPos.Y])
then
begin
MessageBox(Handle,PChar('Папка '+Memo2.Lines.Strings[Memo2.CaretPos.Y]+#13+
'успешно удалёна '),PChar('Папка удалена'),
MB_ICONINFORMATION+MB_ok);
Memo2.Lines.Delete(Memo2.CaretPos.Y);
end
else
if MessageBox(Handle,PChar('Номер ошибки: '+IntToStr(GetLastError)),PChar('Внимание ошибка!'),
MB_ICONERROR+MB_ok)= IDOK then Exit;
end;
procedure TForm1.N7Click(Sender: TObject);
var
l:string;
begin
l:=Memo2.Lines.Strings[Memo2.CaretPos.Y];
if l<>'' then ShellExecute(Application.Handle,'open',PChar(l),nil,nil,SW_SHOW);
end;
procedure TForm1.ScanFolder(Folder: string);
var
st: TSearchRec;
FileName: string;
begin
if FindFirst(Folder+'\*.*',faAnyFile ,st)= 0 then // ищем файлы и папки
begin
repeat
if (st.Name='.') or (st.Name='..') then
continue;
FileName:= SlashSep(Folder, st.Name);
Label7.Font.Size:= 7;
Label7.Font.Style:= [];
Label7.Caption:= FileName;
Application.ProcessMessages; // дадим поработать другим
if kl = 1 then Break;// остановка цикла
// Это папка или нет
if (st.Attr and faDirectory)= faDirectory then
begin
if AnsiUpperCase(Edit1.Text)=AnsiUpperCase(Copy(st.Name,1,Length(Edit1.Text)))
then
begin
Memo2.Lines.Add(FileName);
NomDir:=NomDir+1;
end;
ScanFolder(FileName);
continue;
end;
if CheckBox1.Checked= True then
begin
st.Name:= Copy(st.Name,Pos('.',st.Name),Length(st.Name));
Memo1.Visible:= True;
Memo2.Visible:= False;
Label6.Visible:= True;
Label5.Visible:= False;
end;
if (CheckBox2.Checked= True) and (CheckBox4.Checked= True) then
begin
st.Name:= Copy(st.Name,1,Pos('.',st.Name)-1);
Memo2.Visible:= True;
Memo1.Visible:= False;
Label5.Visible:= True;
Label6.Visible:= False;
end;
if (CheckBox2.Checked= True) and (CheckBox4.Checked= False) then
begin
st.Name:= Copy(st.Name,1,Pos('.',st.Name)-1);
Memo1.Visible:= True;
Memo2.Visible:= False;
Label6.Visible:= True;
Label5.Visible:= False;
end;
if (CheckBox3.Checked= True) and (CheckBox4.Checked= False) then
begin
Memo1.Visible:= True;
Memo2.Visible:= False;
Label6.Visible:= True;
Label5.Visible:= False;
end;
if (CheckBox3.Checked= True) and (CheckBox4.Checked= True) then
begin
Memo1.Visible:= False;
Memo2.Visible:= True;
Label6.Visible:= False;
Label5.Visible:= True;
end;
if (CheckBox4.Checked= True) and (CheckBox3.Checked= False) and (CheckBox2.Checked= False)
then
begin
Showmessage('Укажите по какому признаку искать');
Exit;
end;
if AnsiUpperCase(Edit1.Text)=AnsiUpperCase(Copy(st.Name,1,Length(Edit1.Text)))
then
begin
Memo1.Font.Color:= cLBlack;
Memo1.Font.Size:= 8;
Memo1.Lines.Add(FileName);
NomFile:= NomFile+1;
end;
until FindNext(st) <> 0;
end;
FindClose(st);
end;
end.
Рисунок 1. Код программы в Delphi
Рисунок 2. Пример работы программы