Полный текст модуля main.pas

unit main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Menus, Spin, Buttons;

type
TfMain = class(TForm)
MainMenu1: TMainMenu;
mmExecute: TMenuItem;
mmClose: TMenuItem;
Memo1: TMemo;
Label1: TLabel;
Label2: TLabel;
Memo2: TMemo;
Label3: TLabel;
Label4: TLabel;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
mmFile: TMenuItem;
mmSave: TMenuItem;
mmOpen: TMenuItem;
mmClear1: TMenuItem;
mmClear2: TMenuItem;
procedure mmExecuteClick(Sender: TObject);
procedure mmCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure mmSaveClick(Sender: TObject);
procedure mmOpenClick(Sender: TObject);
procedure mmClear1Click(Sender: TObject);
procedure mmClear2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

Const df = 'Datas.txt'; // файл исходных данных

Type // описание типов динамических массивов
TArr1 = array of Real; // одномерный
TArr2 = array of TArr1; // двумерный

var
fMain: TfMain;
a: TArr2;
u: TArr1;
n,m: Integer;

implementation

{$R *.DFM}

Function RealToStr(r: Real; p: byte): String;
{Конвертирует Real в строку, p - символов в дробной части}
BEGIN
Str(r:30:p,Result); // конвертация real - string
Result:=Trim(Result); // отбрасывание пробелов слева и справа
END;

Function LPad(s: String; d: Word): String;
{вставляет слева от строки пробелы, добирая ее до длины d}
BEGIN
Result:=Format('%*s',[d,s]);
END;

Function RealToStr2(R: Real; All,p: byte): String;
// конвертация real в строку длины All,
// p - цифр в дробной части
BEGIN
Result:=LPad(RealToStr(R,p),All);
END;

Function DaNet(S: String): boolean;
{Задает вопрос}
BEGIN
DaNet:=MessageDlg(S, mtConfirmation, [mbYes, mbNo], 0) = mrYes;
Screen.ActiveForm.Refresh; // удаление следов окна вопроса
END;

procedure ToMemo2(s: String);
// добавляет строку s в Memo2, слева вставляется пробел
begin
fMain.Memo2.Lines.Add(' '+s);
end;

function FromMemoToDinArray
    (Me: TMemo; var a: TArr1; var n: Integer): boolean;
// читает числа из Memo и автоматически создает
// одномерный массив А длины n (нумерация от 0)
Label Fin;
var i,j,Code: Integer; s,q: String; r: Real;
begin
n:=0; Result:=true;
With Me, Me.Lines do
if Count>0 then
for i:=0 to Count-1 do
begin
s:= Trim(Lines[i]);
if s <> '' then
repeat
    j:=Pos(' ',s);
    Case j>0 of
    true : begin
        q:= Copy(s,1,j-1);
        s:=Trim(Copy(s,j+1,Length(s)));
    end;
    false: begin
        q:= Trim(s);
        s:='';
    end;
    end; // Case
    Val(q,r,Code);
    Case Code = 0 of
    true: begin
    Inc(n);
    SetLength(a,n);
    a[n-1]:=r;
    end;
    false: begin
    ShowMessage('Ошибка в данных: '+q);
    Result:= false;
    Goto Fin;
    end;
    end; // Case
until s = '';
end;
Fin: end;

function FormVspomArrToA: boolean;
// из Memo1 читает числа в массив V,
// затем из него - в массив А.
// возвращает TRUE, если нет ошибок
var v: TArr1; k,i,j: Integer;
begin
Result:=false;
if FromMemoToDinArray(fMain.Memo1,v,k) then
if (k < n*m) then
ShowMessage('Недостаточно данных')
else
begin
k:=0; Result:=true;
SetLength(a,n+1,m+1);
for i:= 1 to n do
for j:= 1 to m do
begin
a[i,j]:=v[k];
Inc(k);
end;
end;
v:= Nil;
end;

procedure OutStr(Title: String);
// в Memo2 выводит пустую строку, затем строку s
begin
ToMemo2(' ');
ToMemo2(Title);
end;

procedure OutArr1(a: TArr1; d,p: Integer);
// выводит одномерный массив A в Memo2,
// каждое число длины d, в дробной части p символов
var i,j: Integer; s: String;
begin
s:= '';
for i:= 1 to High(a) do
s:=s+RealToStr2(a[i],d,p);
ToMemo2(s);
end;

procedure OutArr2(a: TArr2; d,p: Integer);
// выводит двумерный массив A в Memo2,
// каждое число длины d, в дробной части p символов
var i,j: Integer;
begin
for i:= 1 to High(a) do
OutArr1(a[i],d,p);
end;

procedure Revers(var a,b: Real);
// перестановка значений переменных a и b
var z: Real;
begin z:=a; a:=b; b:=z; end;

procedure SortArr1(var a: TArr1);
// сортировка одномерного массива А:
var i,j: Integer; L: boolean;
begin
if Length(a)>1 then
repeat
L:=true;
for i:=1 to Length(a)-2 do
if (a[i]>a[i+1]) then
begin
Revers(a[i],a[i+1]);
L:=false;
end;
until L;
end;

procedure Arr2SortAndFormU;
// сортировка строк двумерного массива А
// и формирование одномерного массива U
// из наибольших элементов строк массива А
var i,j: Integer;
begin
SetLength(u,n+1);
for i:= 1 to Length(a)-1 do // проход по строкам А
begin
SortArr1(a[i]); // сортировка i-строки массива A
u[i]:=a[i,m]; // передача набольшего элемента в U
end;
end;

procedure TfMain.mmExecuteClick(Sender: TObject);
// Эта процедура решает задачу в целом
begin
n:=SpinEdit1.Value;
m:=SpinEdit2.Value;
Memo2.Clear;
if FormVspomArrToA then
begin
OutStr('Исходная матрица A:');
OutArr2(a,7,2);
Arr2SortAndFormU;
OutStr('Матрица A после сортировки строк:');
OutArr2(a,7,2);
OutStr('Массив U до сортировки:');
OutArr1(u,7,2);
SortArr1(u);
OutStr('Массив U после сортировки:');
OutArr1(u,7,2);
end;
end;

procedure TfMain.mmSaveClick(Sender: TObject);
// сохранение данных из Memo1 в файле 'Datas.txt'
begin
if DaNet('Сохранить исходные данные в Memo1 ?') then
Memo1.Lines.SaveToFile(df);
end;

procedure TfMain.mmOpenClick(Sender: TObject);
// чтение данных из файла 'Datas.txt' в Memo1
begin
if FileExists(df) then
Memo1.Lines.LoadFromFile(df);
end;

procedure TfMain.mmClear1Click(Sender: TObject);
// очистка Memo1
begin
if DaNet('Очистить Memo1 ?') then Memo1.Clear;
end;

procedure TfMain.mmClear2Click(Sender: TObject);
// очистка Memo2
begin
  Memo2.Clear;
end;

procedure TfMain.mmCloseClick(Sender: TObject);
// закрытие формы и приложения
begin
  fMain.Close;
end;

procedure TfMain.FormClose(Sender: TObject;
            var Action: TCloseAction);
// освобождение памяти, занятой динамическими массивами
begin
  a:=Nil;
  u:=Nil;
end;

end.

Возврат

 
</body> </html> </plaintext></body></html>