Показать сообщение отдельно
Старый 17.11.2014, 16:47   #9 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Ну вот, пожалуйста:
Код:
Uses CRT;

Const
 N_max=10;
 M_max=16;
 V_min=-20;
 V_max=10;

Type
 Matrix=Array[1..N_max,1..M_max] of Integer;
 Vector=Array[1..2*(N_max+M_max)-3] of Integer;

Var
 N,M,Nv,k,p,i,j:Byte;
 A:Matrix;
 V:Vector;

Procedure Vect(Av:Matrix; var Vv:Vector);
var q,r,d:byte;
begin
 d:=0;
 for r:=k to M-k do
  begin
   Inc(d);
   Vv[d]:=A[k,r];
  end;
 for q:=k to N-k do
  begin
   Inc(d);
   Vv[d]:=A[q,M-k+1];
  end;
 for r:=M-k+1 downto k+1 do
  begin
   Inc(d);
   Vv[d]:=A[N-k+1,r];
  end;
 for q:=N-k+1 downto k+1 do
  begin
   Inc(d);
   Vv[d]:=A[q,k];
  end;
end;

Procedure Sh(var Vs:vector);
var
 q,r:byte;
begin
 for q:=1 to p do
  begin
   for r:=Nv downto 1 do Vs[r+1]:=Vs[r];
   Vs[1]:=Vs[Nv+1];
  end;
end;

Procedure Matr(Vm:Vector);
var q,r,d:byte;
begin
 d:=0;
 for r:=k to M-k do
  begin
   Inc(d);
   A[k,r]:=Vm[d];
  end;
 for q:=k to N-k do
  begin
   Inc(d);
   A[q,M-k+1]:=Vm[d];
  end;
 for r:=M-k+1 downto k+1 do
  begin
   Inc(d);
   A[N-k+1,r]:=Vm[d];
  end;
 for q:=N-k+1 downto k+1 do
  begin
   Inc(d);
   A[q,k]:=Vm[d];
  end;
end;

Begin
 ClrScr;
 Randomize;
 Write('  Number of lines = ');
 Readln(N);
 Write('Number of columns = ');
 Readln(M);
 Repeat
  Write('  Number of layer = ');
  Readln(k);
  If (k>(N div 2)) or (k>(M div 2)) then writeln ('Too big!!!');
 Until (k<=(N div 2)) and (k<=(M div 2));
 Nv:=2*(N+M)-8*k+4;
 Write('            Shift = ');
 Readln(p);
 Writeln;
 for i:=1 to N do
  begin
   for j:=1 to M do
    begin
     A[i,j]:=V_min+ Random(V_max-V_min+1);
     if (((i=k) or (i=N-k+1)) and ((j>=k) and (j<=M-k+1))) or
        (((j=k) or (j=M-k+1)) and ((i>k) and (i<M-k))) then textcolor(12);
     write(A[i,j]:4);
     NormVideo;
    end;
   writeln;
  end;
 Writeln;
 Writeln;
 Vect(A,V);
 Sh(V);
 Matr(V);
 for i:=1 to N do
  begin
   for j:=1 to M do
    begin
     if (((i=k) or (i=N-k+1)) and ((j>=k) and (j<=M-k+1))) or
        (((j=k) or (j=M-k+1)) and ((i>k) and (i<M-k))) then textcolor(12);
     write(A[i,j]:4);
     NormVideo;
    end;
   writeln;
  end;
 Readkey
End.
Изображения
 
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070