Правила форума
Прочтите прежде чем задавать вопрос!
1 ) Посчитать дату за m дней до текущей.
Помогите, пожалуйста, исправить. Программа неправильно считает високосный год
progrAM DFHSDJFKSD;
USES CRT;
type
Date=record
Day: integer;
Month: integer;
Year: longint;
end;
Mon=array[1..12] of word;
const
MYV: Mon=(31,29,31,30,31,31,30,31,30,31,30,31);
MYP: Mon=(31,28,31,30,31,31,30,31,30,31,30,31);
var
Date1, DateNext, DateBefore:Date;
m,k,y,plus,i,j:integer;
d,d1:longint;
begin
clrscr;
textcolor(11);
textcolor(15);
writeln;
textcolor(12);
writeln('Vvedite daty');
writeln;
textcolor(15);
with Date1 do
begin
write('Day: ');
readln(Day);
write('Month: ');
readln(Month);
write('Year: ');
readln(Year);
write('Vvedite m: ');
readln(m);
d:=Year*365;
d:=d+(Year div 4);
for i:=1 to Month do
begin
if Year mod 4=0 then
begin
k:=MYV[i]+k;
end
else
begin
k:=MYP[i]+k;
end;
end;
d:=d+k;
d:=d+Day;
d1:=d+m;
while d1>=365 do
begin
y:=y+1;
if y mod 4<>0 then
begin
d1:=d1-365;
end
else
begin
d1:=d1-366;
end;
end;
i:=1;
if y mod 4=0 then
begin
while d1>MYV[i] do
begin
d1:=d1-MYV[i];
i:=i+1;
end;
d1:=d1-2;
end
else
begin
while d1>MYP[i] do
begin
d1:=d1-MYP[i];
i:=i+1;
end;
end;
d1:=d1;
i:=i-1;
writeln(d1);
writeln(i);
writeln(y);
readln;
end;
end.
2-я программа: помогите дописать : Составить программу, которая вставляет в список temp за первым вхождением элемента Е все элементы списка temp2, если Е входит в temp.
program task3;
uses
crt;
type
pl = ^list;
str = string[7];
list = record
field : str;
next : pl;
end;
var
e:str;
first,temp,temp2:pl;
begin
highvideo;
clrscr;
{}
new(temp);
first := nil;
temp := first;
{INPUT}
writeln('Type temp ( if u want to finish type END)');
readln(temp^.field);
repeat
new(temp^.next);
temp := temp^.next;
readln(temp^.field);
until temp^.field = 'END';
writeln('Type temp2 ( if u want to finish type END)');
readln(temp2^.field);
repeat
new(temp2^.next);
temp := temp2^.next;
readln(temp2^.field);
until temp2^.field = 'END';
temp := nil;
temp := first;
writeln('Type e-element');
readln(e);
{OUTPUT}
temp^.next := first^.next;
while (temp^.field <> 'END') do
begin
if temp^.field = e then
begin
writeln(temp^.field);
temp := temp^.next^.next;
end
else
begin
writeln(temp^.field);
temp := temp^.next;
end;
end;
writeln('Press any key.');
readkey;
end.
