Умножение каждого элемента первой строки вещественного массива

Страницы работы

Фрагмент текста работы

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. Для этого определить функцию расчета наибольшего общего делителя двух натуральных чисел

Похожие материалы

Информация о работе