Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 18.04.2012, 19:10   #1
Nastya1221
Пользователь
 
Регистрация: 28.12.2011
Сообщений: 11
По умолчанию Перемещение по матрице

У меня есть программа с подключенным модулем,функция Tabl должна отвечать за перемещения по матрице с помощью стрелок, редактирование элемента матрицы с проверкой правильности введенного числа,выход.

Но я не понимаю как это сделать...Попыталась организовать перемещение с помощью стрелок,но ничего не происходит. Что нужно исправить??? И как это сделать?

Код:
Uses crt, AMatr;
Const np=8;
punct:array[1..np] of string=('1.Определить размеры таблицы','2.Заполнить таблицу с клавиатуры','3.Заполнить таблицу случайными числами','4.Показать элементы таблицы','5.Вызвать первую  подпрограмму’,'6.Сохранение файла','7.Открытие файла','8.Выход');


 CONST nmax=100;
       mmax=100;
       z=12;
       r=10;


  Type
       TLongSignedInt=longint;

       Procedure Tabl(x:PMatrix;w:Telem);
Var b,i,j,k:integer;
    di,dj:TUnSignedInt;
    c:char;
Begin repeat
      c:=Readkey;
   If c=#0 then begin c:=readkey;
    case c of
     #72: begin k:=k-1;
   If k<1 then k:=z-1;
          end;
     #80: begin k:=k+1;
   If k>r-1 then k:=1;
          end;
     #75:begin k:=k-1;
   If k<1 then k:=z-1;
         end;
     #77:begin k:=k+1; gotoxy(k,r);


        If i=k then TextColor(yellow) else TextColor(15);


   If k>r-1 then k:=1;
         end;

    end;{case}
   For i:=0 to z-1 do
 begin
     If i=k then TextColor(yellow) else TextColor(15);
   Writeln(i);

    Readln;
    For j:=0 to r-1 do
  Begin
   x^.Get(di+i,dj+j,w);

Write (w:8);
  end;
 end;
 end; Until c=#13;
end;


          Var n,m,i,j,k:integer;
              x:PMAtrix;
              w,G:Telem;
              H:file of Telem;
              Name_H:string;
              F:Telem;
              p:PMatrix;
              c:char;
Begin {$R-}
Repeat k:=1;
Repeat
CLRSCR;
For i:=1 to np do
 Begin
  If i=k then TextColor(green) else TextColor(15);
   Writeln(punct[i]);
 end;
  C:=Readkey;
   If c=#0 then begin c:=readkey;
    case c of
     #72: begin k:=k-1;
   If k<1 then k:=np;
          end;
     #80:begin k:=k+1;
   If k>np then k:=1;
 end;    end;
end;
Until c=#13;
case k of
1: Begin
if x<>nil then   Dispose(x,Done);

     Writeln('Введите значение n');
     Readln(n);
     Writeln(‘Введите значение  m');
     Readln(m);

    New(x,Init(1,n,1,m));
  end;

2: Begin  {$R-}
     CLRSCR;
     For i:=1 to n do
     For j:=1 to m do
     begin
        read(F);
        x^.Put(i,j,f);
                      end;
        readln;
   end;

3: begin
      For i:=1 to n do
          For j:=1 to m do
          x^.Put(i,j,Random(10));
   end;

4: Begin
     CLRSCR;
     For i:=1 to n do
     Begin
       For j:=1 to m do
          Begin
                 x^.Get(i,j,f);
       Write(F,'  ');
           end;
           Writeln;
      end;         Readln;
        Tabl(x,w);

   end;

5: begin
   Prog(x);
  Readln;
  end;

6:Begin
  Writeln('Введите имя файла');
  readln (name_h); {$I-}
     Assign(H,Name_H);
     Rewrite(H);
      if ioresult<>0 then
       begin
      Writeln('Файла не существует’);
            readln;
            end

       else
          Begin
        F:=n;
         Write(H,F);
        F:=m;
         Write(H,F);

        For i:=1 to n do


      For j:=1 to m do
         Begin
         x^.Get(i,j,f);
     Write(H,F);
          end;
         end;
     readln;
     close(h);  {$I+}
  end;



7:Begin
Writeln('Введите имя файла');
   readln(name_h);     {$I-}
      Assign(H,Name_H);
      Reset(H);
      if ioresult<>0 then Writeln('Файла не существует’) else
                                     begin
      if x<>nil then    Dispose(x,Done);


         Read(H,F);
      n:=round(F);
      Read(H,F);
      m:=round(F);
         New(x,Init(1,n,1,m));
       For i:=1 to n do
          For j:=1 to m do
     Begin
      read( H,F);
x^.Get(i,j,F);
     end;
     Close(H);     {$I+}                  end;
  end;


end; {case}
Until k=8;
Readln;  {$R+}  end.


________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

Последний раз редактировалось Serge_Bliznykov; 18.04.2012 в 23:57.
Nastya1221 вне форума Ответить с цитированием
Старый 18.04.2012, 19:16   #2
Nastya1221
Пользователь
 
Регистрация: 28.12.2011
Сообщений: 11
По умолчанию

Модуль

Код:
unit AMatr;
interface
Type
TSignedInt=integer;
TUnSignedInt=word;
TIndex1=TUnSignedInt;
TIndex2=TUnSignedInt;
TElem=TUnSignedInt;
PIntArr=^TIntArr;
TIntArr=array[1..1] of TUnSignedInt;
PLine=^TLine;
TLine=array[1..10] of TElem;
PCol=^TCol;
TCol=array[1..10] of PLine;
PMatrix=^CMatrix;
CMatrix=object
private
  Matr:PCol;
  low1,High1:TIndex1;
  low2,high2:TIndex2;
  Lines:TUnSignedInt;
  Cols:TUnSignedInt;
procedure Failure(ErrNum:TUnSignedInt);

public
Constructor Init(l1,h1:TIndex1;l2,h2:TIndex2);
Constructor Copy(p:PMatrix);
destructor Done;
procedure Put(i1:TIndex1;i2:TIndex2;x:TElem);
procedure Get(i1:TIndex1;i2:TIndex2;Var x:TElem);
function GetLow1:TIndex1;
function GetHigh1:TIndex1;
function GetLow2:TIndex2;
function GetHigh2:TIndex2;
function GetLines:TUnSignedInt;
function GetCols:TUnSignedInt;
end;

Function Prog(p:PMatrix):boolean;
implementation {$Q+,R-}

uses crt;
const
SElem=sizeof(TElem);
SegmentSize=65520;

Constructor CMatrix.Init(l1,h1:TIndex1;l2,h2:TIndex2);
Var i,n,m:TUnSignedInt;
  need:Longint;
Begin
if(l1<=h1) and (l2<=h2) then begin
  n:=1+ord(h1)-ord(l1);
  m:=1+ord(h2)-ord(l2);
  need:=Longint(n)*sizeof(Pline);
  if need<=SegmentSize then begin
    Getmem(Matr,need);
    Lines:=n;
    Low1:=l1;
    High1:=h1;
    need:=longint(m)*SElem;
    if need<=SegmentSize then begin
       for i:=1 to n do Getmem(Matr^[i],need);
       Cols:=m;
       Low2:=l2;
       High2:=h2;
    end
    else Failure(1);
   end else Failure(1);
   end {1}
   else Failure(2);
end;

constructor CMatrix.Copy(p:PMatrix);
Var
   i,j:TUnSignedInt;
   need:word;
Begin
 if p=nil then Failure(3) else
  Begin
   need:=p^.Lines*sizeof(PLine);
    begin
     Getmem(Matr,need);
     Lines:=p^.Lines;
     Low1:=p^.Low1;
     High1:=p^.High1;
     need:=p^.Cols*SElem;
     for i:=1 to p^.GetLines do
     Getmem(Matr^[i],need);
     Cols:=p^.Cols;
     Low2:=p^.Low2;
     High2:=p^.High2;
     for i:=1 to Lines do
       for j:=1 to Cols do
        Matr^[i]^[j]:=p^.Matr^[i]^[j];
    end;
  end;
end;

destructor CMatrix.Done;
Var i:TUnSignedInt;
Begin
 for i:=1 to Lines do
    freemem(Matr^[i],Cols*SElem);
 freemem(Matr,Lines*sizeof(PLine));
end;

procedure CMatrix.Put(i1:TIndex1;i2:TIndex2;x:TElem);
Begin
 if(i1<Low1) or (i1>High1) then Failure(5) else
 if(i2<Low2) or (i2>High2) then Failure(6) else
 Matr^[1+ord(i1)-ord(Low1)]^[1+ord(i2)-ord(Low2)]:=x;
end;

procedure CMatrix.Get(i1:TIndex1;i2:TIndex2;Var x:TElem);
Begin
 if(i1<Low1) or (i1>High1) then Failure(7) else
 if(i2<Low2) or (i2>High2) then Failure(8) else
 x:= Matr^[1+ord(i1)-ord(Low1)]^[1+ord(i2)-ord(Low2)];
end;


Function CMatrix.GetLow1:TIndex1;
Begin
 GetLow1:=Low1;
end;

Function CMatrix.GetHigh1:TIndex1;
Begin
 GetHigh1:=High1;
end;

Function CMatrix.GetLow2:TIndex2;
Begin
 GetLow2:=Low2;
end;

Function CMatrix.GetHigh2:TIndex2;
Begin
 GetHigh2:=High2;
end;

Function CMatrix.GetLines:TUnSignedInt;
Begin
 GetLines:=Lines;
end;

Function CMatrix.GetCols:TUnSignedInt;
Begin
 GetCols:=Cols;
end;

procedure CMatrix.Failure(ErrNum:TUnSignedInt);
begin
CLRSCR;
Write('Объект CMatrix.Ошибка  #',ErrNum,'.');
case ErrNum of
1:writeln('Конструктор Init.Не хватает памяти для создания матрицы');
2:writeln('Конструктор Init.Неверные границы индексы для создания матрицы');
3:writeln('Конструктор Copy.Не существует копируемый объект');
4:writeln('Конструктор Copy.Не хватает памяти для создания матрицы');
5:writeln('Метод Put.Неверный индекс строки');
6:writeln('Метод Put.Неверный индекс столбца ');
7:writeln('Метод Get.Неверный индекс строки');
8:writeln('Метод Get.Неверный индекс столбца ');
end;{case}
Readln;
halt(1);
end;
Function Prog(P:PMatrix):boolean;
Var
   b,t,k,n,m,i,j:TUnSignedInt;
   x:Telem;
   q1,q2:LongInt;
   buf:PLine;
   a:PIntArr;
Begin
if p=nil then Prog:=false else
Begin
  Prog:=true;
  n:=p^.Lines;
  m:=p^.Cols;
  GETMEM(a,n*sizeof(Telem));
  for i:=1 to n do
  Begin
     q1:=0;
     q2:=0;
  for j:=1 to n do begin
      x:=p^.Matr^[i]^[j];
      if x>0 then inc(q1) else q1:=0;;
      if q1>q2 then q2:=q1;
   end;
   a^[i]:=q2;
  end;
   t:=2;  b:=n;  i:=2;
  While (i<=n) and (t<>0) and (b<>n+1) do Begin
     k:=n+1;
     for j:=b downto t do
      if a^[j-1]>a^[j] then begin
       buf:=p^.Matr^[j-1];
       p^.Matr^[j-1]:= p^.Matr^[j];
       p^.Matr^[j]:=buf;
       q1:=a^[j-1];
       a^[j-1]:=a^[j];
       a^[j]:=q1;
       k:=j;
     end;
  t:=k;;
  If t=n+1 then break;
  k:=0;
  for j:=t+1 to b do
  if a^[j-1]>a^[j] then begin
  buf:=p^.Matr^[j-1];
  p^.Matr^[j-1]:=p^.Matr^[j];
  p^.Matr^[j]:=buf;
  q1:=a^[j-1];
  a^[j-1]:=a^[j];  a^[j]:=q1;
  k:=j-1;
  end;
 b:=k;
end;
end;
end;
end.
_____
Код нужно оформлять по правилам!
Модератор.

Последний раз редактировалось Serge_Bliznykov; 19.04.2012 в 00:07.
Nastya1221 вне форума Ответить с цитированием
Старый 18.04.2012, 20:24   #3
IQDDD
Пользователь
 
Регистрация: 12.09.2008
Сообщений: 17
По умолчанию

Используйте теги: разбираться в такой каше не найдётся много добровольцев.
IQDDD вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
В матрице... Avvakymova Паскаль, Turbo Pascal, PascalABC.NET 4 08.05.2011 13:53
задача по матрице myrka Помощь студентам 1 02.04.2011 04:09
Матрица в матрице Shift_sk Помощь студентам 0 20.11.2010 23:47
Произведение в матрице BaronVik Помощь студентам 2 05.05.2010 00:24