Вывести на дисплей календарь на текущий год - Turbo Pascal

Формулировка задачи:

Вывести на дисплей календарь на текущий год

Решение задачи: «Вывести на дисплей календарь на текущий год»

Листинг программы

uses crt,graph,dos;
const bm:array[1..12]of string=('Janury','February','March','April','May',
'June','July','August','Septamber','October','November','December');
bn:array[1..7]of string=('mo','tu','we','th','fr','sa','su');
 
allx=33;
ally=80;
allintx=130;
allinty=16;
xd=390;
 
tx=220;
ty=38;
trn:array[1..6] of integer=(xd+tx,ty+1,xd+tx+15,ty+1,xd+tx+4,ty+17);
trv:array[1..6] of integer=(xd+tx,ty-1,xd+tx+15,ty-1,xd+tx+11,ty-17);
tx1=230;
ty1=42;
trl:array[1..6] of integer=(xd+tx1+1,ty1-6,xd+tx1-1,ty1+6,xd+tx1-13,ty1-1);
trr:array[1..6] of integer=(xd+2+tx1+1,ty1-6,xd+2+tx1-1,ty1+6,xd+2+tx1+13,ty1+1);
 
var era,god,mesats,nediela,den,denned,godnow,mesatsnow,dy,dg,dm,dd,x,y,z:integer;
cha: char;
 
procedure initialization; var gd,gm:integer; begin gd:=detect; initgraph(gd,gm,''); end;
 
function dnei(god,mesats:integer):integer;
begin
if mesats in [1,3,5,7,8,10,12] then dnei:=31;
if mesats in [4,6,9,11] then dnei:=30;
if (mesats=2)and ( (god mod 4=0) or((god mod 100=0)and(god mod 400=0))) then dnei:=29;
if (mesats=2)and ( (god mod 4<>0) or((god mod 100=0)and(god mod 400<>0))) then dnei:=28;
 
end;
 
procedure casem(m:integer);
begin case m of
1:begin x:=1;y:=1; end; 2: begin x:=1; y:=2; end; 3: begin x:=1; y:=3; end; 4: begin x:=2; y:=1; end; 5: begin x:=2; y:=2; end;
6:begin x:=2;y:=3; end; 7: begin x:=3; y:=1; end; 8: begin x:=3; y:=2; end; 9: begin x:=3; y:=3; end; 10:begin x:=4; y:=1; end;
11:begin x:=4; y:=2; end; 12:begin x:=4; y:=3; end; end; end;
 
function tex(a:integer):string; var t:string; begin str(a,t); tex:=t; end;
 
procedure wcalendar; begin {setcolor(10); settextstyle(1,0,7); outtextxy(280,-7,'Calendar');}
setcolor(9); settextstyle(2,0,4); outtextxy(540,464,'Sheikin Alexandr'); end;
 
 
procedure wgod(god:integer);
const xden=-140;
xmesats=-70;
xsec=5;
var t:string;
begin
if abs(den)<10 then t:='0'+tex(abs(den)) else t:=tex(abs(den));
setfillstyle(9,1);bar(xd+23+xden,20,xd+146+xden,57);setcolor(10);settextstyle(7,0,6);outtextxy(xd+25+xden,5,t);
outtextxy(xd+25+xden+57,5,'.');
if abs(mesats)<10 then t:='0'+tex(abs(mesats)) else t:=tex(abs(mesats));
setfillstyle(9,1);bar(xd+23+xmesats,20,xd+146+xmesats,57);setcolor(10);
settextstyle(7,0,6);outtextxy(xd+25+xmesats,5,t); outtextxy(xd+25+xmesats+55,5,'.');
 
setfillstyle(9,1);bar(xd+23,20,xd+146,57);setcolor(10);settextstyle(7,0,6);outtextxy(xd+25,5,tex(abs(god)));
setfillstyle(9,1);bar(xd+150,27,xd+216,57);
setcolor(10);settextstyle(7,0,5);
if era=-1 then outtextxy(xd+150,15,'B.C.');
if era=1 then outtextxy(xd+150,15,'A.D.');
end;
 
procedure data(var god,mesats,den:integer);
var year,m,day,d:word;
begin getdate(year,m,day,d);god:=year;mesats:=m;den:=day; end;
 
procedure chasi;
const xsec=5;
d=8;
var t:string;
hou,mi,se,sse:word;
hour,min,sec,ssec,dh,dm,ds,dss:integer;
begin
repeat
gettime(hou,mi,se,sse); hour:=hou;min:=mi;sec:=se; ssec:=sse;
 
if abs(sec)<10 then t:='0'+tex(abs(sec)) else t:=tex(abs(sec));
if (sec<>ds) then begin ds:=sec;
setfillstyle(9,1);bar(23+xsec+140-d-d,20+5,23+61+xsec+140-d-d,57);setcolor(10);settextstyle(7,0,5);
outtextxy(25+xsec+140-d-d,5+10,t);
end;
 
if abs(min)<10 then t:='0'+tex(abs(min)) else t:=tex(abs(min));
if (min<>dm) then begin dm:=min; setfillstyle(9,1);bar(23+xsec+70-d,20+5,23+61+xsec+70-d,57);
setcolor(10);settextstyle(7,0,5);outtextxy(25+xsec+70-d,5+10,t); outtextxy(25+xsec+70+57-d-d,5+10,':'); end;
 
if abs(hour)<10 then t:='0'+tex(abs(hour)) else t:=tex(abs(hour));
if (hour<>dh) then begin dh:=hour;
setfillstyle(9,1);bar(23+xsec,20+5,23+61+xsec,57);
setcolor(10);settextstyle(7,0,5);outtextxy(25+xsec,5+10,t); outtextxy(25+xsec+57-d,5+10,':');
end;
 
if (sec=00)and(min=00)and(hour=00) then begin
data(god,mesats,den); wgod(god); end;
until keypressed;
end;
 
 
procedure wmesats;
begin
for dm:=1 to 12 do begin casem(dm);
if (dm=mesatsnow)and(god=godnow) then setcolor(10) else setcolor(11);
settextstyle(5,0,2); outtextxy(allx+12+150*(x-1),ally+allintx*(y-1)-21,bm[dm]);
 
setcolor(14); settextstyle(2,0,4);
for dd:=1 to 6 do outtextxy(allx+22+150*(x-1)+(dd-1)*15,ally+25+allintx*(y-1)-allinty,bn[dd]);
setcolor(12); settextstyle(2,0,4);
dd:=7; outtextxy(allx+22+150*(x-1)+(dd-1)*15,ally+25+allintx*(y-1)-allinty,bn[dd]);
end;end;
 
 
procedure wnedela;               begin setcolor(14); settextstyle(2,0,4);nediela:=nediela+1;
if nediela<>0 then outtextxy(allx+150*(x-1),ally+25+allintx*(y-1)+dy*allinty,tex(nediela));end;
 
procedure wden;
var c:integer; begin c:=15;
if denned=7 then c:=12;
{if z=2 then c:=7;}
if (dd=den)and(dm=mesats)and(godnow=god)then c:=10;
setcolor(c); settextstyle(2,0,4);
outtextxy(allx+22+150*(x-1)+(denned-1)*15,ally+25+allintx*(y-1)+dy*allinty,tex(dd)); end;
 
 
procedure pisat(var god:integer;cha:char);
var d:integer; t:string;
begin
repeat
repeat
chasi;
cha:=readkey;
if cha=#0 then cha:=readkey;
until (cha=#8)or(cha=#13)or(cha=#27)or(cha=#115)or(cha=#116)or(cha=#75)or(cha=#77)or(cha=#72)or(cha=#80)
or(cha=#48)or(cha=#49)or(cha=#50)or(cha=#51)or(cha=#52)or(cha=#53)or(cha=#54)or(cha=#55)or(cha=#56)or(cha=#57);
 
case cha of
#72,#75: god:=god-1;
#80,#77: god:=god+1;
#115,#116: begin era:=-era; god:=-god; end;
end;
t:=tex(god);
 
if (cha=#48)or(cha=#49)or(cha=#50)or(cha=#51)or(cha=#52)or
(cha=#53)or(cha=#54)or(cha=#55)or(cha=#56)or(cha=#57)then begin
if length(t)<=4 then t:=t+cha;
if length(t)>4 then begin t:=''; t:=t+cha; end;
end;
if (cha=#8)and(length(t)>=1) then begin delete(t,length(t),1);end;
val(t,god,d);
wgod(god);
 
if cha=#27 then begin closegraph; halt; end;
until (length(t)=4)or(cha=#13)or(cha=#115)or(cha=#116)or(cha=#75)or(cha=#77)or(cha=#72)or(cha=#80);
end;
 
 
 
begin
initialization;
era:=1;
data(god,mesats,den);
godnow:=god;
mesatsnow:=mesats;
 
cleardevice;setbkcolor(8); setfillstyle(9,1); bar(0,0,639,479);
 
repeat
z:=1;
denned:=7;
nediela:=1;
wcalendar;
wmesats;
 
setcolor(15);
setfillstyle(1,9);
fillpoly(3,trv);
fillpoly(3,trn);
 
for dg:=-9999 to god-1 do
for dm:=1 to 12 do
for dd:=1 to dnei(dg,dm) do
begin denned:=denned+1;if denned=8 then denned:=1;
z:=z+1;if z=5 then z:=1; end;
 
for dm:=1 to 12 do begin casem(dm);
setfillstyle(1,8);
bar(allx+150*(x-1),ally+25+allintx*(y-1),allx+22+150*(x-1)+(8-1)*15,ally+20+allintx*(y-1)+6*allinty);
setfillstyle(9,1);
bar(allx+150*(x-1),ally+25+allintx*(y-1),allx+22+150*(x-1)+(8-1)*15,ally+20+allintx*(y-1)+6*allinty); end;
 
wgod(god);
 
for dm:=1 to 12 do begin casem(dm); dy:=0;
if (denned<>7)then begin nediela:=nediela-1; wnedela; end;
if (dm=1)and(denned=7) then begin nediela:=nediela-2; wnedela; end;
for dd:=1 to dnei(god,dm) do
begin denned:=denned+1;if denned=8 then begin denned:=1;dy:=dy+1; wnedela; end;
z:=z+1;if z=5 then z:=1;
wden;  end;
end;
 
pisat(god,cha);
 
until (cha=#27); closegraph;
end.

Объяснение кода листинга программы

The code you provided is a mix of Turbo Pascal and Delphi code. It seems to be a calendar program written in Turbo Pascal that uses the God mode to display the current date. The code also includes a function to convert numbers to text and a function to draw a filled rectangle. The program also includes a function to calculate the number of days in a given month. The code has some issues and errors that need to be addressed:

The code assumes that the user will always use the same language settings as the programmer. This is not a good practice as it limits the program's usability.
The code uses the readkey function to read the key pressed by the user. However, this function is specific to Turbo Pascal and may not work in other languages or environments.
The code includes a lot of repetitive code that can be refactored to make it more maintainable and understandable.
The code does not handle the case where the user presses the key to close the program while the program is still processing input. This can cause unexpected behavior.
The code does not include any error handling mechanism, which means that if an error occurs, the program will crash. It is a good practice to add error handling to prevent such crashes.
The code does not include any form of user input validation, which means that the user can enter any character as a response to the prompt. This can lead to incorrect data being processed by the program.
The code does not include any form of output formatting, which means that the dates and times are displayed using a fixed format. It would be better to allow the user to choose the desired format.
The code does not include any form of date or time validation, which means that the program will accept any value for the year, month, and day. This can lead to incorrect data being displayed.
The code does not include any form of error checking to ensure that the month, day, and year are valid values. This can lead to incorrect calculations.
The code does not include any form of user interface enhancements, such as animations or graphics, which means that the program may appear very basic and uninteresting to the user. In conclusion, the code you provided needs to be cleaned up, refactored, and enhanced to address the issues and errors mentioned above.