Здравствуйте!
Помогите пожалуйста далеко не юной зочнице справится с кусовиком.
Как с помощью Randomize создать линейный список из десяти положительных целых чисел?
Заранее благодарю.
program CreaChlist;
uses CRT;
type pt = ^elem;
elem = record
info : byte;
next : pt;
end;
var p,p1,q,first:pt;
M:integer;
procedure create_list(var p:pt);
var first,last,curr:pt;
i,X:byte;
begin
first:=nil;
last:=nil;
for i:=1 to 10 do
begin
X:=Random(98)+1;
new(curr);
curr^.info:=X;
curr^.next:=nil;
if first=nil then first:=curr
else last^.next:=curr;
last:=curr;
end;
p:=first;
end;
{___________________________________________________________________________}
procedure Cearch_element(var q:pt); {q -seach element}
var p:pt;
M:integer;
begin
p:=first;
writeln('input element: ');
ReadLn(M);
while ((p^.next<>Nil) and (p^.info<>M))do
p:=p^.next;
if (p^.info<>M) then
q:=Nil
else
q:=p;
end;
{----------------------------------------------------------------------------}
procedure Insert(var q:pt);
var newelem:pt;
X:byte;
begin
New(newelem);
X:=Random(98)+1;
newelem^.info:=X;
newelem^.next:=q^.next;
q^.next:=newelem;
end;
{---------------------------------------------------------------------------}
Begin
clrscr;
Randomize;
create_list(p1);
p:=p1;
while p<>nil do
begin
write(p^.info:4,' ');
p:=p^.next;
end;
writeln;
Cearch_element(q);
Insert(p1);
p:=p1;
while p<>nil do
begin
write(p^.info:4,' ');
p:=p^.next;
end;
ReadKey;
End.
Insert(p1);
Program Seachlst;
uses CRT;
type pt = ^elem;
elem = record
info : byte;
next : pt;
end;
var p,p1,q{,first}:pt;
M:integer;
{----------------------------------------------------------------------------}
procedure create_list(var p:pt);
var first,last,curr:pt;
i,X:byte;
begin
first:=nil;
last:=nil;
for i:=1 to 10 do
begin
X:=Random(98)+1;
new(curr);
curr^.info:=X;
curr^.next:=nil;
if first=nil then first:=curr
else last^.next:=curr;
last:=curr;
end;
p:=first;
end;
{___________________________________________________________________________}
procedure Cearch_element(var q:pt); {q -seach element}
var first,p:pt;
M:integer;
begin
first:=nil;
p:=first;
writeln('input element: ');
ReadLn(M);
while ((p^.next<>Nil) and (p^.info<>M))do
p:=p^.next;
function Cearch_element(const first: pt): pt;
var
p: pt;
M:integer;
begin
Cearch_element := nil;
write('input element: '); ReadLn(M);
p := first;
while ((p^.next<>nil) and (p^.info<>M))do p:=p^.next;
if (p^.info = M) then Cearch_element := p;
end;
...
Begin
clrscr;
Randomize;
create_list(p1);
p:=p1;
while p<>nil do begin
write(p^.info:4,' ');
p:=p^.next;
end;
writeln;
q := Cearch_element(p1);
{ Я бы еще добавил проверку, не вернулся ли NIL }
Insert(q);
p:=p1;
while p<>nil do begin
write(p^.info:4,' ');
p:=p^.next;
end;
ReadKey;
End.
j:=0;
While j<=10 do begin
j:=j+1;
SetFillStyle(SolidFill, White);
Bar(x+(r+l)*(j-1),115,x+(l+r)*(j-1)+l,130);
end;
SetFillStyle(SolidFill, White);
For j := 1 To 11 Do
Bar(x+(r+l)*(j-1),115,x+(l+r)*(j-1)+l,130);
if(ch='0') then beginвыделены в отдельные функции...
SetColor(LightRed);
OutTextXY(200,120, 'You input 0. Input another number');
end
const(зачем нужны 6 констант, если можно вычислить значение в любой момент по текущему индексу и стартовому значению?), и во-вторых, заменить булевские переменные n1, n2, n3 на массив
Y1=40;
Y2=115;
Y3=190;
Y4=265;
Y5=340;
Y6=415;
OutTextXY(10,45,'Create new list');- строки были записаны в массив и выведены в простом цикле...
OutTextXY(10,120,'Paste cell');
OutTextXY(10,195,'Delete cell');
OutTextXY(10,270,'Find cell ');
OutTextXY(10,345,'Move last cell');
OutTextXY(10,420,'Exit');
Case ReadKey OfКстати, у тебя была ошибка:
#0:
begin
{ Здесь - расширенные клавиши }
end;
#27: ; { а здесь начинается обработка обычных ... }
End;
While ch <> '27'do beginэто не везде будет компилироваться (зависит от настроек компилятора), ибо некорректно сравнивать символ со строкой...
...
end;
typeТо, что я добавил - это процедура отрисовки определенного элемента. Понимаешь? Тебя на этапе создания списка вообще не должно волновать, как именно будет отображаться этот элемент. Для этого есть Интерфейс. Ты ему передала все необходимые данные, и все. А как реализовать конкретно отрисовку этого элемента списка - это ты будешь думать уже потом, на этапе реализации интерфейса. Если он будет графическим, то функция ShowListItem, например, может быть такой:
pt = ^elem;
elem = record
info: Integer; { <--- Ничего не меняем !!! }
next : pt;
end;
procedure Create_list(var p, first, last, curr:pt); {Creation of new list}
var n, A:byte;
begin
first := nil; last := nil;
for n:=1 to 10 do begin
A:=Random(99)+1;
new(curr);
curr^.info := A;
curr^.next := nil;
ShowListItem(45, n, curr); { <--- Единственное, что добавить !!! }
if first=nil then first:=curr
else last^.next:=curr;
last:=curr;
end;
p:=first;
end;
Procedure ShowListItem(yPos, n: integer; p: pt);, будет текстовым - процедура будет другой. НО!!! Изменяться будет только эта процедура! Сам принцип формирования списка остается неизменным, и потому - неприкосновенным...
var s: string;
begin
str(p^.info, s);
SetColor(Black);
OutTextXY(GetX(n) + 5, yPos, s);
end;
var gd, gm: integer;? А используются где? Только в основном блоке? Вот и описывай их там. Во избежание... Конечно, именно эти переменные ничего не меняют в данном случае, это просто пример, но все же...
procedure P(i: integer; Ch: Char);, что позволило "разгрузить" текст программы...
begin
SetFillStyle(SolidFill, White);
Bar(156, 5 + GetY(i) - 4, 184, 5 + GetY(i) + 9);
SetColor(Black);
OutTextXY(160, 5 + GetY(i), Ch);
SetColor(DarkGray);
SetFillStyle(SolidFill, DarkGray);
Bar(195, 5 + GetY(i) - (10 + (4 - i)*5), GetMaxX-5, 5 + GetY(i) - (10 + (4 - i)*5) + 30);
end;
4:, не правда ли?
begin
if not CheckValueZero(2, M) then begin
SetFillStyle(SolidFill, White);
Bar(195, 265, 225, 280);
str(M, s); { <--- !!! Этого достаточно !!! }
SetColor(Black);
OutTextXY(200, 270, s);
end
end;
procedure Delafter(var q:pt;var temp:pt);{Delete cell after number}
var n:byte;
begin
temp:= q^.next; { <-- Ты запомнила значение ? }
q^.next:=q^.next^.next;
temp^.next:= nil;
temp := p1; { <-- И тут же его разрушила ??? }
n := 1;
while temp<>nil do begin
ShowListItem(195, n, temp);
inc(n);
temp:=temp^.next;
end;
end;
procedure Delafter(var q:pt;var temp:pt);{Delete cell after number}
var T: pt;
n:byte;
begin
temp:= q^.next;
q^.next:=q^.next^.next;
temp^.next:= nil;
T := p1;
n := 1;
while T<>nil do begin
ShowListItem(195, n, T);
inc(n);
T:=T^.next;
end;
end;