Предусмотреть вывод на экран ФИО, № группы студента, сделавшего работу - Turbo Pascal

Узнай цену своей работы

Формулировка задачи:

1. Задания В качестве условия задачи берется задание из 5 лабораторной работы, но работать не с одной матрицей, а с двумя А1 и А2. В основной программе предусмотреть вызовы подпрограмм к обеим матрицам. 2. Правила оформления работы 1. Предусмотреть вывод на экран ФИО, № группы студента, сделавшего работу. 2. Автоматическое формирование исходного массива. 3. Вывод исходного массива, промежуточных результатов и конечного результата с пояснениями. 4. Оформить программу с использованием подпрограмм (процедур и функций – по необходимости). Обосновать использование процедур и функций. Обязательны процедуры формирования и вывода матрицы. Вот 5я лаба (Найти число строк матрицы А(6,4), минимальный элемент которых равен 0.)

Решение задачи: «Предусмотреть вывод на экран ФИО, № группы студента, сделавшего работу»

textual
Листинг программы
unit matrix;
interface
uses crt;
const
x=10;
y=5;
type
   TELint=integer;
   TElem = double;
   IntARR =array[1 .. maxint div sizeof(TElint)
   ] of TElint;
   PARR = ^IntARR;
   TLine = array[1..maxint div sizeof(TElem)] of TElem;
   PLine = ^TLine;
 
   TCol = array[1..maxint div sizeof(PLine)] of PLine;
   PCol = ^TCol;
   PCmatr=^Cmatr;
   Cmatr=object
   private
     Fstr:word;
     Fstc:word;
     Fmatr:PCol;
     procedure F(err:word);
   public
     constructor Create(n,m:word);  //выделение памяти под матрицу
     constructor copy(matr:PCmatr); //создание копии матрицы
     destructor done();             //освобождение памяти, уничтожение матрицы матрицы
     procedure putelem(i,j:word; elem:TElem);
     procedure getelem(i,j:word; var x:TElem);
     procedure Swap(n,m:smallint);
     procedure QuickSort;
     function getstr:word;
     function getstc:word;
   end;
 
//**********************************************************************************************************************************
implementation
   procedure Cmatr.F(err:word);
     begin
        case err of
          1 : begin
                write('Ошибка выделения памяти');
              end;
          2 : begin
                write('Указаны нулевые индексы');
              end;
          3 : begin
                write('Указанных индексов в матрице нет');
              end;
          4 : begin
                write('Размеры таблицы превышают максимально допустимые размеры');
              end;
        end;
        readkey;
        halt;
     end;
   constructor Cmatr.Create(n,m:word);
   var i,j:TELint;
       error:boolean=true;
   begin
   returnnilifgrowheapfails := true;
   begin
   Fstr:=n;
   Fstc:=m;
   getmem(Fmatr,Fstr*sizeof(PLine));   //выделяем память под строки
   if Fmatr<>NIL then
   begin
      for j:=1 to Fstr do
      begin
         getmem(Fmatr^[j],Fstc*sizeof(TElem));//выделяем память под столбцы
         if Fmatr^[j]=NIL then   //если памяти недостаточно, то аварийный выход из цикла
         begin
            F(1);
            error:=false;
            F(1);
         end;
      end;
      if not(error) then for j:=j-1 downto 1 do freemem(Fmatr^[j],Fstc*sizeof(TElem));//освобождаем память
   end
   else
     begin
       freemem(Fmatr,Fstr*sizeof(PLine));
       error:=false;
       F(1);
     end;
   end;
   end;
//***********************************************************************************************************************************
   constructor Cmatr.copy(matr:PCmatr);
   var i,j:TELint;
     begin
       returnnilifgrowheapfails := true;
       Create(matr^.Fstr,matr^.Fstc);
       for i:=1 to Fstr do
           for j:=1 to Fstc do
               Fmatr^[i]^[j]:=matr^.Fmatr^[i]^[j]
     end;
//***********************************************************************************************************************************
   destructor Cmatr.done();
   var
     i, j: word;
     need: longint;
    begin
     need := longint(Fstc) * sizeof(TElem);
     {$R-}
     for i := 1 to Fstr do
         freeMem(Fmatr^[i], need);
         need:= longint(Fstr) * sizeof(PLine);
         freeMem(Fmatr, need);
     {$R+}
    end;
//*********************************************************************************************************************************
   procedure Cmatr.putelem(i,j:word; elem:TElem);
     begin
       if ((i=0) or (j=0)) then f(2)
          else
            if ((i>Fstr) or (j>Fstc)) then F(3)
               else
                 Fmatr^[i]^[j]:=elem;
     end;
//*********************************************************************************************************************************
   procedure Cmatr.getelem(i,j:word;var X:Telem);
     begin
       if ((i=0) or (j=0)) then f(2)
          else
            if ((i>Fstr) or (j>Fstc)) then F(3)
               else
                 X:=Fmatr^[i]^[j];
     end;
//***************************************************************************************************************************************
   function Cmatr.getstr:word;
     begin
       getstr:=Fstr;
     end;
//*************************************************************************************************************************************
   function Cmatr.getstc:word;
     begin
       getstc:=Fstc;
     end;
//***********************************************************************************************************************************
procedure Cmatr.Swap(n,m:smallint);
var
    j:smallint;
    u:TElem;
begin
    for j:=1 to y do
    begin
        u:=Fmatr^[j]^[n];
        Fmatr^[j]^[n]:=Fmatr^[j]^[m];
        Fmatr^[j]^[m]:=u;
    end;
end;
 
procedure Cmatr.QuickSort;
var
    Brr:PARR;
    i,j:word;
Procedure QSort(l,r:smallint);
var
    i,j,x,y:smallint;
begin
    i:=l;
    j:=r;
    x:=Brr^[(r+l) div 2];
    While i<j do
    begin
        While Brr^[i]>x do inc(i);
        While Brr^[j]<x do dec(j);
        if i<=j then
        begin
            Cmatr.Swap(i,j);
            y:=Brr^[i];
            Brr^[i]:=Brr^[j];
            Brr^[j]:=y;
            inc(i);
            dec(j);
        end;
    end;
    if i<r then QSort(i,r);
    if l<j then QSort(l,j);
end;
begin
    GetMem(Brr,Fstc*sizeof(TElem));
    for i:=1 to Fstc do Brr^[i]:=0;
    for i:=1 to Fstc do
        for j:=1 to Fstr do if Fmatr^[j]^[i]<0 then inc(Brr^[i]);
 
    QSort(1,Fstc);
    FreeMem(Brr,Fstc*sizeof(TElem));
end;
end.

Оцени полезность:

5   голосов , оценка 4.2 из 5
Похожие ответы