
22.10.2012, 22:50
|
Прохожий
|
|
Регистрация: 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.
|