Новичок
Джуниор
Регистрация: 17.05.2015
Сообщений: 1
|
Помогите сохранить календарь в файл
Помогите, пожалуйста, переделать. Нужна подпрограмма (procedure zapis) сохранения созданного календаря в файл . Введенный год сохранять получается, данные расчета получается, а сам календарь выстраивается в один столбец и ерунда получается. заранее благодарна.
Код:
Program Menu;
uses Crt;
const
kd:array[1..7] of string=('Понед.','Вторник','Среда','Четверг','Пятница',
'Суббота','Воскр.');
month:array[1..12] of string=('Январь','Февраль','Март','Апрель','Май','Июнь','Июль',
'Август','Сентябрь','Октябрь','Ноябрь','Декабрь');
var
Y:word;
Ch:char;
f:text;
days:array[1..12] of byte=(31,28,31,30,31,30,31,31,30,31,30,31);
i,j,d,t:byte;
Procedure Pause;
begin
Writeln('Нажмите Enter для продолжения ...');
Readln
end;
procedure vvod;
begin
writeln('GOD');
read(Y);
end;
procedure schitivaniy;
var i:integer;
begin
Assign(f,'C:\Documents and Settings\Ната\Рабочий стол\TURBO\DAN.TXT');
reset(f);
for i:=1 to 7 do
read(f,kd[i]);
for i:=1 to 12 do
read(f, month[i]);
close(f);
Writeln('Данные считаны успешно!');
Pause;
end;
procedure vihod;
begin
halt;
end;
procedure raschet;
var
i,g,c:integer;
begin
g:=Y mod 100;
c:=Y div 100;
d:=(trunc(0.2*(13*11-1))+g+trunc(g/4)+trunc(c/4)-2*c) mod 7;
case d of
1:i:=1;
2: i:=2;
3: i:=3;
4:i:=4;
5: i:=5;
6: i:=6;
else
if d=0 then i:=7;;
end;
writeln (kd[i]);
readln;
end;
procedure zapis ;
var i,j,t:integer;
begin
Assign(f,'C:\Documents and Settings\Ната\Рабочий стол\DAN.TXT');
rewrite(f);
if d=0 then d:=7;
for i:=1 to 3 do
begin
for j:=1 to 7 do
begin
gotoxy(1,i+j+(i-1)*7);
write(kd[j]);
Write(f,'');
Writeln(f,kd[j]:2)
end;
for j:=1 to 4 do
begin
gotoxy (whereX+8,wherey-7);
Writeln(f,'');
write(month[j+4*(i-1)]);
Write(f,month[j+4*(i-1)]);
Writeln(f,'');
gotoxy(whereX-6-length(month[j+4*(i-1)]),wherey+d);
if Y mod 4=0 then days[2]:=29;
for t:=1 to days[j+(i-1)*4] do
begin
write(t);
Write(f,'');
Write(f,t);
Write(f,'');
if d+1=8 then
begin
if (t>=1) and (t<9) then gotoxy(wherex+2,wherey-6)
else gotoxy(wherex+1,wherey-6);
d:=1;
end
else
begin
d:=d+1;
if (t>=1) and (t<9) then gotoxy(wherex-1,i+(i-1)*7+d)
else gotoxy(wherex-2,i+(i-1)*7+d);
end;
end;
gotoxy(wherex+3,i+i*7);
Write(f,t);
end
end;
close(f);
Writeln('Данные считаны успешно!');
Pause;
end;
procedure vivod;
var
i,j,t:byte;
begin
window(0,0,100,200);
TextBackground(3);
clrscr;
if d=0 then d:=7;
writeln(Y);
for i:=1 to 3 do
begin
for j:=1 to 7 do
begin
gotoxy(1,i+j+(i-1)*7);
If j>=6 then TextColor(12)
else TextColor(15);
write(kd[j])
end;
for j:=1 to 4 do
begin
gotoxy (whereX+8,wherey-7);
TextColor(14);
write(month[j+4*(i-1)]);
TextColor(15);
gotoxy(whereX-6-length(month[j+4*(i-1)]),wherey+d);
if Y mod 4=0 then days[2]:=29;
for t:=1 to days[j+(i-1)*4] do
begin
If d>=6 then TextColor(12)
else TextColor(15);
write(t);
if d+1=8 then
begin
if (t>=1) and (t<9) then gotoxy(wherex+2,wherey-6)
else gotoxy(wherex+1,wherey-6);
d:=1;
end
else
begin
d:=d+1;
if (t>=1) and (t<9) then gotoxy(wherex-1,i+(i-1)*7+d)
else gotoxy(wherex-2,i+(i-1)*7+d);
end;
end;
gotoxy(wherex+3,i+i*7);
end
end;
readln;
pause;
end;
begin
repeat
Clrscr;
Gotoxy(30,2);
write('Главное меню');
Gotoxy(20,8);write ('1-vvod dannsx');
Gotoxy(20,10); write ('2-schitivaniy dannih iz fayla');
Gotoxy(20,12);write('3-formatirovanie kalendaray');
Gotoxy(20,14);write( '4-vivod dannih na ekran');
Gotoxy(20,16);write ( '5-zapis fayla');
Gotoxy(20,18);write ( '6-vihod');
gotoxy(20,20);write('dla vibora regima [1..6]');
writeln;
repeat
Ch:=ReadKey;
until Ch in ['1','2','3','4','5','6'];
case Ch of
'1':vvod;
'2':schitivaniy;
'3':raschet;
'4':vivod ;
'5':zapis ;
'6':vihod;
end
Until false;
end.
Последний раз редактировалось Stilet; 17.05.2015 в 13:03.
|