Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, Grids, StdCtrls, Spin;
type
TForm5202 = class(TForm)
LabelText: TLabel;
StringGridIn: TStringGrid;
Button: TButton;
MainMenu5166: TMainMenu;
ActionMenuItem: TMenuItem;
ExecMenuItem: TMenuItem;
SpinEdit: TSpinEdit;
LabelArray: TLabel;
LabelOut: TLabel;
procedure ExecMenuItemClick(Sender: TObject);
procedure ButtonClick(Sender: TObject);
procedure SpinEditChange(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure Lab5202MenuItemClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
M: array of array of Integer;
end;
var
Form5202: TForm5202;
implementation
uses MainUnit;
{$R *.dfm}
procedure TForm5202.Lab5202MenuItemClick(Sender: TObject);
begin
BringWindowToTop(Handle);
// Button.Click;
end;
procedure TForm5202.FormCreate(Sender: TObject);
begin
MainForm.Labs5202MenuItem.Enabled := False;
SpinEditChange(Self);
end;
procedure TForm5202.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
MainForm.Labs5202MenuItem.Enabled := True;
end;
procedure TForm5202.SpinEditChange(Sender: TObject);
var
i, j: Integer;
begin
// зададим новый размер матрицы
SetLength(M, SpinEdit.Value);
for i := 0 to Length(M)-1 do
SetLength(M[i], SpinEdit.Value);
// заполним её случайноми значениями
Randomize;
for i := 0 to SpinEdit.Value-1 do
for j := 0 to SpinEdit.Value-1 do
M[i, j] := -50 + Random(100);
// выведем её в StringGridIn
StringGridIn.RowCount := SpinEdit.Value;
StringGridIn.ColCount := SpinEdit.Value;
for i := 0 to SpinEdit.Value-1 do
for j := 0 to SpinEdit.Value-1 do
StringGridIn.Cells[j, i] := IntToStr(M[i, j]);
end;
procedure TForm5202.ButtonClick(Sender: TObject);
var
i, j, s: Integer;
Cnt: Integer;
begin
Cnt := 0;
for i := 0 to SpinEdit.Value-1 do
begin
s := 0; // посчитаем сумму ряда
for j := 0 to SpinEdit.Value-1 do s := s + M[i, j];
if s < 0 then inc(Cnt);
end;
LabelOut.Caption := Format(
'Найдено %d строк с отрицательной суммой элементов.',
[Cnt]);
end;
procedure TForm5202.ExecMenuItemClick(Sender: TObject);
begin
BringWindowToTop(Handle);
Button.Click;
end;
end.
Задание № 211
Дана вещественная матрица размером 7*4. Найти максимальный
элемент матрицы, расположенный ниже побочной диагонали.
unit Unit5211;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, Grids;
type
TForm5211 = class(TForm)
LabelText: TLabel;
StringGridIn: TStringGrid;
Button: TButton;
LabelOut: TLabel;
MainMenu5166: TMainMenu;
ActionMenuItem: TMenuItem;
ExecMenuItem: TMenuItem;
procedure ButtonClick(Sender: TObject);
procedure StringGridInDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure ExecMenuItemClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form5211: TForm5211;
implementation
uses MainUnit, Math;
{$R *.dfm}
procedure TForm5211.ExecMenuItemClick(Sender: TObject);
begin
BringWindowToTop(Handle);
Button.Click;
end;
procedure TForm5211.FormCreate(Sender: TObject);
var
i, j: Integer;
begin
MainForm.Labs5211MenuItem.Enabled := False;
// Заполним сетку StringGridIn случайными значениями:
Randomize;
for i := 0 to 6 do
for j := 0 to 3 do
StringGridIn.Cells[j, i] := FloatToStr(RoundTo(Random * 100, -2));
Button.Click;
end;
procedure TForm5211.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
MainForm.Labs5211MenuItem.Enabled := True;
end;
procedure TForm5211.StringGridInDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
with (Sender as TStringGrid) do
begin
if ACol+1 + ARow+1 = 5
then Canvas.Brush.Color := clLtGray
else Canvas.Brush.Color := clWindow;
if State <> [] then Canvas.Brush.Color := clBtnFace;
Canvas.Pen.Color := Canvas.Brush.Color;
Canvas.Font.Color := clBlack;
Canvas.Rectangle(Rect);
Canvas.TextOut(Rect.Left+1, Rect.Top+1, Cells[ACol, ARow]);
end;
end;
procedure TForm5211.ButtonClick(Sender: TObject);
var
i, j: Integer;
M: array[1..7, 1..4] of Real;
P: TPoint;
V: Real;
GP: TGridRect;
begin
// заполним матрицу значениями из StringGridIn
for i := 1 to 7 do
for j := 1 to 4 do
M[i, j] := StrToFloat(StringGridIn.Cells[j-1, i-1]);
// найдем максимальный элемент ниже побочной диагонали
// т.е. с суммой координат больше 4 и запомним его позицию
V := -100; // меньше в матрице не будет
for i := 1 to 7 do
for j := 1 to 4 do
if i + j > 5 then
if M[i, j] > V then
begin
V := M[i, j];
P := Point(i, j);
end;
LabelOut.Caption := Format( // выведем ответ
'Максимальный элемент ниже побочной диагонали M[%d, %d] = %f',
[P.X, P.Y, V]);
GP.Top := P.X-1; GP.Left := P.Y-1;
GP.Right := GP.Left; GP.Bottom := GP.Top;
StringGridIn.Selection := GP;
end;
end.
Лабораторная работа № 6
Задание № 166
Дан файл Т, который содержит номера телефонов сотрудников учреждения: указываются фамилия, инициалы и номер телефона. Найти номер телефона сотрудника по его фамилии и инициалам.
unit Unit6166;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ComCtrls;
type
TForm6166 = class(TForm)
LabelText: TLabel;
MainMenu5166: TMainMenu;
ActionMenuItem: TMenuItem;
SelectFileMenuItem: TMenuItem;
ListView: TListView;
ClearListViewMenuItem: TMenuItem;
N2: TMenuItem;
FindMenuItem: TMenuItem;
Button: TButton;
OpenDialog: TOpenDialog;
procedure ButtonClick(Sender: TObject);
procedure FindMenuItemClick(Sender: TObject);
procedure ClearListViewMenuItemClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure SelectFileMenuItemClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
FileName: TFileName;
procedure FillListView;
end;
var
Form6166: TForm6166;
implementation
uses MainUnit, StrUtils;
{$R *.dfm}
procedure TForm6166.SelectFileMenuItemClick(Sender: TObject);
begin
OpenDialog.InitialDir := ExtractFilePath(ParamStr(0)) + 'data';
if OpenDialog.Execute then
begin
FileName := OpenDialog.FileName;
FillListView;
end;
end;
procedure TForm6166.FillListView;
var
i: Integer;
S: String;
begin
ListView.Items.Clear;
with TStringList.Create do
try
LoadFromFile(FileName);
for i := 0 to Count-1 do
if pos(',', Strings[i]) > 0 then
with ListView.Items.Add do
begin
Caption := Trim(LeftStr(Strings[i], pos(',', Strings[i])-1));
SubItems.Add(Trim(RightStr(Strings[i], Length(Strings[i]) - pos(',', Strings[i]))));
end;
finally
Free;
end;
end;
procedure TForm6166.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
MainForm.Labs6166MenuItem.Enabled := True;
end;
procedure TForm6166.FormCreate(Sender: TObject);
begin
MainForm.Labs6166MenuItem.Enabled := False;
end;
procedure TForm6166.ClearListViewMenuItemClick(Sender: TObject);
begin
ListView.Clear;
end;
procedure TForm6166.FindMenuItemClick(Sender: TObject);
begin
Button.Click;
end;
procedure TForm6166.ButtonClick(Sender: TObject);
var
Finded: Boolean;
S, SS: String;
Name, Tel: String;
F: TextFile;
li: TListItem;
begin
if Trim(FileName) = '' then
Raise Exception.Create('Сначала выбетере файл');
if not FileExists(FileName) then
Raise Exception.CreateFmt('Файл "%s" не найден', [FileName]);
// Выводим окно для ввода фамилии для поиска
SS := InputBox('Поиск по фамилии', 'Введите фамилию и инициалы', '');
SS := Trim(SS);
if SS = '' then Exit;
Finded := False; // флажек "найденности"
AssignFile(F, FileName); // Задаем соответствие файлоой переменной с файлом
Reset(F); // открываем файл
while not Eof(F) do // пока не достигнут конец файла...
begin
Readln(F, S); // читаем построчно файл
Name := Trim(LeftStr(S, pos(',', S)-1));
Tel := Trim(RightStr(S, Length(S) - pos(',', S)));
if AnsiUpperCase(Name) = AnsiUpperCase(SS) then
begin // регистронезависимо сравниваем
Finded := True;
Break;
end;
end;
CloseFile(F); // закрываем файл
if Finded then
begin // Найден, выведем результат.
MessageBox(Handle, PChar(Format(
'По Вашему запросу найдено: '#13#10 +
'Фамилия: %s'#13#10 +
'Телефон: %s', [Name, Tel])), 'Результат',
MB_ICONINFORMATION + MB_OK);
// и отметим строку в ListView, если она там есть
li := ListView.FindCaption(0, Name, False, True, False);
if Assigned(li) then li.Selected := True;
ListView.SetFocus;
end;
end;
end.
Задание № 202
Имеется файл, элементами которого являются отдельные слова. Найти (во всех случаях считать, что размер файла неизвестен):
а) слова, порядковый номер которых четный, и составить из них предложение;
б) самое длинное слово;
в) самое короткое слово.
unit Unit6202;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus;
type
TForm6202 = class(TForm)
LabelText: TLabel;
Button: TButton;
MainMenu5166: TMainMenu;
ActionMenuItem: TMenuItem;
SelectFileMenuItem: TMenuItem;
N2: TMenuItem;
FindMenuItem: TMenuItem;
OpenDialog: TOpenDialog;
LabelA: TLabel;
MemoA: TMemo;
LabelB: TLabel;
MemoB: TMemo;
LabelC: TLabel;
MemoC: TMemo;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure ButtonClick(Sender: TObject);
procedure SelectFileMenuItemClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
FileName: TFileName;
end;
var
Form6202: TForm6202;
implementation
uses MainUnit;
{$R *.dfm}
procedure TForm6202.SelectFileMenuItemClick(Sender: TObject);
begin
OpenDialog.InitialDir := ExtractFilePath(ParamStr(0)) + 'data';
if OpenDialog.Execute then
begin
FileName := OpenDialog.FileName;
Button.Click;
end;
end;
procedure TForm6202.ButtonClick(Sender: TObject);
var
Words: array of String;
procedure ParseLine(Line: String); // процедура разбивки строки на слова
const
Separators = [' ', ',', '.', ':', '/', '!', '"', '''', '(', ')']; // набор разделителей слов
var
i: Integer;
S: String;
begin
if Length(Line) = 0 then Exit;
i := 1;
while i <= Length(Line) do
begin
S := '';
while (i <= Length(Line)) and
not (Line[i] in Separators) do
begin
S := S + Line[i];
inc(i);
end;
while (i <= Length(Line)) and // удаляем повторы разделителей
(Line[i] in Separators) do inc(i); // и переходим к следующему слову
if Trim(S) <> '' then
begin // добавляем слово в массив слов
SetLength(Words, Length(Words) + 1);
Words[Length(Words)-1] := S;
end;
end;
end;
var
i: Integer;
f: TextFile;
S: String;
SmallIndex,
BigIndex: Integer;
begin
MemoA.Clear;
MemoB.Clear;
MemoC.Clear;
if Trim(FileName) = '' then
Raise Exception.Create('Сначала выбетере файл');
if not FileExists(FileName) then
Raise Exception.CreateFmt('Файл "%s" не найден', [FileName]);
SetLength(Words, 0);
AssignFile(F, FileName); // Задаем соответствие файлоой переменной с файлом
Reset(F); // открываем файл
while not Eof(F) do // пока не достигнут конец файла...
begin
Readln(F, S); // читаем построчно файл
ParseLine(S); // рабиваем на слова и заносим в массив слов
end;
CloseFile(F); // закрываем файл
if Length(Words) = 0 then Exit;
// составляем предложение из четных слов
S := '';
for i := 0 to Length(Words)-1 do
if (i+1) / 2 = (i+1) div 2 then // только четные
S := S + Words[i] + ' ';
S := Trim(S); // удаляем лишние пробелы в конце
MemoA.Lines.Add(S); // выводим результат.
// ищем самое короткое и самое длинное слово
SmallIndex := 0;
BigIndex := 0;
for i := 0 to Length(Words)-1 do
begin
if Length(Words[i]) < Length(Words[SmallIndex]) then
SmallIndex := i;
if Length(Words[i]) > Length(Words[BigIndex]) then
BigIndex := i;
end;
// выводим результат
MemoB.Lines.Add(Words[BigIndex]);
MemoB.Perform(EM_SCROLL, 0, -1);
MemoC.Lines.Add(Words[SmallIndex]);
MemoC.Perform(EM_SCROLL, 0, -1);
end;
procedure TForm6202.FormCreate(Sender: TObject);
begin
MainForm.Labs6202MenuItem.Enabled := False;
end;
procedure TForm6202.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
MainForm.Labs6202MenuItem.Enabled := True;
end;
end.
Задание № 211
Имеется файл, элементами которого являются отдельные буквы слова «деревяный». Получить новый файл, в котором не будет орфографической ошибки.
unit Unit6211;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls;
type
TForm6211 = class(TForm)
LabelText: TLabel;
LabelIn: TLabel;
LabelOut: TLabel;
Button: TButton;
MemoIn: TMemo;
MemoOut: TMemo;
MainMenu5166: TMainMenu;
ActionMenuItem: TMenuItem;
SelectFileMenuItem: TMenuItem;
N2: TMenuItem;
FindMenuItem: TMenuItem;
OpenDialog: TOpenDialog;
CloseFileMenuItem: TMenuItem;
procedure ButtonClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure SelectFileMenuItemClick(Sender: TObject);
procedure FindMenuItemClick(Sender: TObject);
procedure CloseFileMenuItemClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
FileName: TFileName;
FileNameOut: TFileName;
end;
var
Form6211: TForm6211;
implementation
uses MainUnit, StrUtils;
{$R *.dfm}
procedure TForm6211.CloseFileMenuItemClick(Sender: TObject);
begin
FileName := '';
MemoIn.Clear;
MemoOut.Clear;
end;
procedure TForm6211.FindMenuItemClick(Sender: TObject);
begin
Button.Click;
end;
procedure TForm6211.SelectFileMenuItemClick(Sender: TObject);
begin
OpenDialog.InitialDir := ExtractFilePath(ParamStr(0)) + 'data';
if OpenDialog.Execute then
begin
CloseFileMenuItem.Click;
FileName := OpenDialog.FileName;
MemoIn.Lines.LoadFromFile(FileName);
Button.Click;
end;
end;
procedure TForm6211.FormCreate(Sender: TObject);
begin
MainForm.Labs6211MenuItem.Enabled := False;
end;
procedure TForm6211.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
MainForm.Labs6211MenuItem.Enabled := True;
end;
procedure TForm6211.ButtonClick(Sender: TObject);
const
oldval = 'деревяный';
newval = 'деревянный';
var
fin, fout: TextFile;
errpos: Integer;
S: String;
begin
if Trim(FileName) = '' then
Raise Exception.Create('Сначала выбетере файл');
if not FileExists(FileName) then
Raise Exception.CreateFmt('Файл "%s" не найден', [FileName]);
FileNameOut := ChangeFileExt(FileName, '.out');
AssignFile(fin, FileName); // Задаем соответствие файлоой переменной с файлом
Reset(fin); // открываем файл
AssignFile(fout, FileNameOut);
Rewrite(fout); // перезаписываем файл
while not Eof(fin) do // пока не достигнут конец файла...
begin
Readln(fin, S); // читаем построчно файл
errpos := pos(oldval, S); // если подстрока с ошибкой существует
if errpos > 0 then // убираем её и заменяем верной
S := LeftStr(S, errpos-1) +
newval +
RightStr(S, Length(S) - errpos - Length(oldval)+1);
WriteLn(fout, S);
end;
CloseFile(fin); // закрываем файл
CloseFile(fout);
MemoOut.Clear; // Выводим результат в MemoOut
MemoOut.Lines.LoadFromFile(FileNameOut);
end;
end.
Лабораторная работа № 7
Задача № 166
Описать функцию TextSize(Name) целого типа, возвращающую число строк в текстовом файле с именем Name. Если файл не существует, то функция возвращает –1. С помощью этой функции определить размер трех файлов с данными именами.
unit Unit7166;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls;
type
TForm7166 = class(TForm)
LabelText: TLabel;
Button: TButton;
MainMenu5166: TMainMenu;
ActionMenuItem: TMenuItem;
SelectFileMenuItem: TMenuItem;
N2: TMenuItem;
FindMenuItem: TMenuItem;
OpenDialog: TOpenDialog;
LabelOut: TLabel;
procedure ButtonClick(Sender: TObject);
procedure SelectFileMenuItemClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
FileName: TFileName;
end;
var
Form7166: TForm7166;
implementation
uses MainUnit;
{$R *.dfm}
function TextSize(Name: TFileName): Integer;
var
f: TextFile;
S: String;
begin
Result := 0;
if not FileExists(Name) then
begin
Result := -1;
Exit;
end;
AssignFile(f, Name); // Задаем соответствие файлоой переменной с файлом
Reset(f); // открываем файл
while not Eof(f) do // пока не достигнут конец файла...
begin
Readln(f, S); // читаем построчно файл
inc(Result); // увеличиваем счетчик строк
end;
CloseFile(f); // закрываем файл
end;
{//P.S. Методами Delphi найти количество строк
// намного проще:
function TextSize(Name: TFileName): Integer;
begin
Result := 0;
if not FileExists(Name) then
begin
Result := -1;
Exit;
end;
with TStringList.Create do
try
LoadFromFile(Name);
Result := Count;
finally
Free;
end;
end;}
procedure TForm7166.FormCreate(Sender: TObject);
begin
MainForm.Labs7166MenuItem.Enabled := False;
end;
procedure TForm7166.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
MainForm.Labs7166MenuItem.Enabled := True;
end;
procedure TForm7166.SelectFileMenuItemClick(Sender: TObject);
begin
if OpenDialog.Execute then
begin
FileName := OpenDialog.FileName;
Button.Click;
end;
end;
procedure TForm7166.ButtonClick(Sender: TObject);
var
LineCount: Integer;
begin
LineCount := TextSize(FileName);
if LineCount < 0
then LabelOut.Caption := Format(
'Результут работы функции TextSize(Name):'#13#10 +
' Имя файла: "%s"'#13#10 +
' Файл не существует!',
[FileName])
else LabelOut.Caption := Format(
'Результут работы функции TextSize(Name):'#13#10 +
' Имя файла: "%s"'#13#10 +
' Строк в файле: %d',
[FileName, LineCount]);
end;
end.
Задание № 202
Даны натуральные числа а и b, обозначающие cooтветственно числитель и знаменатель дроби. Сократить дробь то есть найти такие натуральные числа р и q, не имеющие общих делителей, mop/q = a/b. Для этого определить функцию расчета наибольшего общего делителя двух натуральных чисел
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.