Показать сообщение отдельно
  #6  
Старый 22.10.2012, 22:50
js_m1m js_m1m вне форума
Прохожий
 
Регистрация: 22.10.2012
Сообщения: 5
Репутация: 10
По умолчанию

Cделал без чистки консоли. И чистить ее все-таки заодно научился. Теперь со второй программой.

Сделал, но опять не работает. Что не так?

Код:
program laba_5;

{$APPTYPE CONSOLE}

uses
SysUtils;
var
   l,i,j,m: integer;
   a: array[0..255,0..255] of char;
procedure filling;
var i,j,m:integer;
b: array[0..2] of char;
begin
b[0]:='*';
b[1]:='?';
b[2]:='$';
randomize;
 for i:= 1 to m do
  for j:=1 to m do
    a[i,j]:=b[random(3)];
  end;
procedure cut;
var m1,m2,d1,d2,i1,i2,s2,m,k:integer;
begin
m1:=m;
m2:=m;
  repeat
  m2:=1+m2 div sqr(m2)*(m-1);
  m1:=1+(m1 div m2)*(m2 div m1)*(m-1);
  d2:=1-2*(m2 div sqr(m2));
  d1:=1-2*(m1 div sqr(m1));
  i1:=m1-d1*k;
  s2:=m2;
    while i1 <> m1 do begin
    i1:=i1+d1;
    s2:=s2-d2;
    i2:=s2;
      while i2<> m2 do begin
      i2:=i2+d2;
      a[i1,i2]:=' ';
      end;
    end;
  until (m1=m) and (m2=m);
end;

procedure print;
var i,j,m:integer;
begin
  for i:=1 to m do begin
    for j:=1 to m do
      write(a[i,j]);
      writeln;
    end;
  end;
begin
Writeln('Enter the length of the square');
Readln(m);
filling;
cut;
print;
Writeln('Press enter to exit.');
readln;
end.
Ответить с цитированием