Уважаемые коллеги! Предлагаем вам разработку программного обеспечения под ключ.
Опытные программисты сделают для вас мобильное приложение, нейронную сеть, систему искусственного интеллекта, SaaS-сервис, производственную систему, внедрят или разработают ERP/CRM, запустят стартап.
Сферы - промышленность, ритейл, производственные компании, стартапы, финансы и другие направления.
Языки программирования: Java, PHP, Ruby, C++, .NET, Python, Go, Kotlin, Swift, React Native, Flutter и многие другие.
Всегда на связи. Соблюдаем сроки. Предложим адекватную конкурентную цену.
Заходите к нам на сайт и пишите, с удовольствием вам во всем поможем.
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. Для этого определить функцию расчета наибольшего общего делителя двух натуральных чисел
Уважаемые коллеги! Предлагаем вам разработку программного обеспечения под ключ.
Опытные программисты сделают для вас мобильное приложение, нейронную сеть, систему искусственного интеллекта, SaaS-сервис, производственную систему, внедрят или разработают ERP/CRM, запустят стартап.
Сферы - промышленность, ритейл, производственные компании, стартапы, финансы и другие направления.
Языки программирования: Java, PHP, Ruby, C++, .NET, Python, Go, Kotlin, Swift, React Native, Flutter и многие другие.
Всегда на связи. Соблюдаем сроки. Предложим адекватную конкурентную цену.
Заходите к нам на сайт и пишите, с удовольствием вам во всем поможем.
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.