Developing.ru

ylika писал(а):у меня не получается программа помогите позязя!!!!! тема: 0.3. Оператор перехода GOTO. Цикл. Метки.
34) Напечатать 1 2 3 4 . . . 99 100 99 . . . 3 2 1.
вот моя программа:
program pr8;
label m1, m2, m3, m4, m5;
var f: integer;
begin
f:= 1;
m1: if f>100 then goto m2 else goto m3
m3:f:=f+1;
goto m1;
m2:f:=f-1;
m5: if f>1 then goto m2 else goto m4;
m4: writeln;
readln;
end.

program mgoto;

uses crt;

var
   m_inc: boolean;
   f: integer;
   needstop: boolean;

label incr, decr, mexit, body;

begin
clrscr;
f := 0;
m_inc := true;
needstop := false;

body:
while(not needstop) do
 if (m_inc) then
  goto incr
 else
  goto decr;
 goto mexit;

incr:
  inc(f);
  write(f, ' ');
  if(f = 100) then
   m_inc := false;
  goto body;

decr:
  dec(f);
  write(f, ' ');
  if(f = 1) then
   needstop := true;
  goto body;

mexit:
readkey;
end.

Program Suslik;
Uses crt;
Const
_COUNT = 20;
type
maxArr = record
index,value: integer;
end;
var
i,b_len,num:integer;
A:array[0.._COUNT] of integer;
B:array[0.._COUNT] of maxArr;

procedure fillArr(var A:array of integer);

begin
randomize;
for i:=0 to _COUNT do A:=random(100);
end;

procedure Compare(number:integer; A:array of integer;
var b_len:integer; var B:array of maxArr);
var
index:integer;
begin
for i:=0 to _COUNT-1 do
if A > number then
begin
B[b_len].value:=A;
B[b_len].index:=i;
inc(b_len);
end;
end;

procedure sortSwap(var x,y: maxArr);
var t:integer;
begin
{Value}
t:=x.value;
x.value:=y.value;
y.value:=t;
{Index}
t:=x.index;
x.index:=y.index;
y.index:=t;
end;

procedure Sort(var B:array of maxArr);
var
i,j: integer;
begin
for i:=0 to b_len-1 do
for j:=i+1 to b_len-1 do
if B.value > B[j].value then
sortSwap(B, B[j]);
end;

procedure writeA(A:array of integer);
var i:integer;
begin
writeln('====>>Posledovatelnost "A"<<====');
for i:=0 to _COUNT-2 do
write(A,', ');
write(A[_COUNT-1]);
writeln;
writeln;
end;

procedure writeB(B:array of maxArr);
var i:integer;
begin
writeln('====>>Posledovatelsnost "B"<<====');
for i:=0 to b_len-1 do
write(B.value,' ');
writeln;
writeln;
end;

procedure writeElements(B:array of maxArr);
begin
writeln('====>>NUMBERS<<====');
writeln('Nomer pervogo elem: ', B[0].index+1);
writeln('Nomer poslednego elem: ', B[b_len-1].index+1);
end;

BEGIN
ClrScr;
fillArr(A);
writeA(A);
write('Vvedite 4islo dlya sravneniya: ');
read(num);
b_len:=0;
Compare(num, A, b_len, B);
Sort(B);

writeB(B);
writeElements(B);
{writeln('Dlina B: ', b_len);}
readln;
readln;

END.

Newbie писал(а):такое ощущение, что вы сами се яму роете...
я за 10 мин написал и у меня все работает, с учетом того что я не разу не писал с использованием меток. (логика мб храмает, но для сдчи лабы должно быть достаточно)

Код: Выделить всё

program mgoto;

uses crt;

var
   m_inc: boolean;
   f: integer;
   needstop: boolean;

label incr, decr, mexit, body;

begin
clrscr;
f := 0;
m_inc := true;
needstop := false;

body:
while(not needstop) do
 if (m_inc) then
  goto incr
 else
  goto decr;
 goto mexit;

incr:
  inc(f);
  write(f, ' ');
  if(f = 100) then
   m_inc := false;
  goto body;

decr:
  dec(f);
  write(f, ' ');
  if(f = 1) then
   needstop := true;
  goto body;

mexit:
readkey;
end.

ЗЫ inc\dec встроенные функции паскаля аналогично i := i + 1\i := i - 1

label l1;
var i,d: shortint;
begin
  k:=1;
  i:=1;
l1:writeln(i)
  inc(i,k);
  if i=100 then k:=-1;
  if i<>1 then goto l1;
end.

Suslik писал(а):Всё, прога готова..