帕斯卡日历

时间:2021-04-22 12:01:03

标签: calendar pascal

我想制作一整年的日历,但此代码仅显示具有给定第一天和一个月天长度的日历。我该如何处理此代码?有什么建议吗?不允许使用数组

这是我的代码输出:

enter image description here

Program Contoh81;
uses crt;
type Hari1pekan=(Sun,Mon,Tue,Wed,Thu,Fri,Sat);
     haribulan=1..31;

var i,awalbulan:hari1pekan;
    j,tglmaks:haribulan;
    x,y,k,lebar:integer;

begin
    clrscr;
    write('Hari pertama awal bulan: ');
    readln(awalbulan);
    write('Jumlah hari bulan ini: ');
    readln(tglmaks);writeln;
    
    lebar:=7;
    for i:=sun to sat do
        write(i:lebar);
    
    y:=5;
    x:=ord(awalbulan);
    for j:=1 to tglmaks do
    begin
        if x=7 then
        begin 
            x:=0;
            y:=y+1;
        end;
        gotoxy(lebar*x+1,y);write(j:3);
        x:=x+1;
    end;
    readln
end.

1 个答案:

答案 0 :(得分:1)

最后我得到了这个 :)。但是还有一个问题使我的代码闪烁。喜欢而不是打印:

January 2021
sun mon tue wed thu fri sat




February 2021 
sun mon tue wed thu fri sat
.
.
.
.
.

etc

但是我的代码像一月一样打印然后清除屏幕,然后打印二月清除屏幕等等。

在@TomBrunberg 的帮助下,我终于解决了所有出现的问题。这是我的最终代码。

program nomor_satu;
uses crt;
const Januari = 31;
Februari = 28;
Maret = 31;
April = 30;
Mei = 31;
Juni = 30;
Juli = 31;
Agustus = 31;
September = 30;
Oktober = 31;
Nopember = 30;
Desember = 31;
kabisat = 366 mod 7;
Normal = 365 mod 7;

type Blntype = record
jumlah : Byte;
NamaBln : String;
end;

var DataBln : array[1..12] of Blntype;
HariPertama, totalHari,
NumDays : word;
s:string;

var Bln,Thn:word;
    v:Integer;

procedure GetDataBln;
begin
        DataBln[1].jumlah:=31;
        DataBln[1].NamaBln:='Januari';
        DataBln[2].jumlah:=28;
        DataBln[2].NamaBln:='Februari';
        DataBln[3].jumlah:=31;
        DataBln[3].NamaBln:='Maret';
        DataBln[4].jumlah:=30;
        DataBln[4].NamaBln:='April';
        DataBln[5].jumlah:=31;
        DataBln[5].NamaBln:='Mei';
        DataBln[6].jumlah:=30;
        DataBln[6].NamaBln:='Juni';
        DataBln[7].jumlah:=31;
        DataBln[7].NamaBln:='Juli';
        DataBln[8].jumlah:=31;
        DataBln[8].NamaBln:='Agustus';
        DataBln[9].jumlah:=30;
        DataBln[9].NamaBln:='September';
        DataBln[10].jumlah:=31;
        DataBln[10].NamaBln:='Oktober';
        DataBln[11].jumlah:=30;
        DataBln[11].NamaBln:='Nopember';
        DataBln[12].jumlah:=31;
        DataBln[12].NamaBln:='Desember';
end;

function ThnKabisat(n:Word):Boolean;
begin
    if (N mod 4 = 0) and (N mod 100 <> 0) or (N mod 400 = 0) then
    ThnKabisat:=True
    else ThnKabisat:=False;
end;


procedure perhitungan(Thn, Bln:word);
var i : Word;
begin
    NumDays := 1;
    for I := 1 to Thn - 1 do
    begin
        if ThnKabisat(I) then 
            Inc(NumDays, kabisat) 
        else 
            Inc(NumDays, Normal); 
    end;
    for I := 1 to Bln - 1 do
        Inc(NumDays, DataBln[I].jumlah);
    totalHari := DataBln[Bln].jumlah;
    if ThnKabisat(Thn) then
    begin
        if Bln > 2 then Inc(NumDays)
        else if Bln = 2 then
        Inc(totalHari, 1);
    end;
    
    HariPertama := NumDays Mod 7
end;

Procedure KalenderKeluaran(Thn, Bln:word);
Var
i,v : Byte;
tanya : char;

begin
    perhitungan(Thn, Bln);
    gotoxy(6,WhereY);writeLn('Bulan ',DataBln[Bln].NamaBln,' Tahun ',Thn);
    writeLn;
    writeLn('-----------------------------------');
    writeLn('Ahad  Sen  Sel  Rab  Kam  Jum  Sab ');
    writeLn('-----------------------------------');
    GotoXY(5*HariPertama+1,WhereY);
    for i := 1 to TotalHari do
    begin
        if i<10 then write('  ',i,'  ');
        if i>9 then write('  ',i,' ');
        if WhereX > 32 then writeLn;
    end;
    writeLn('  ');
end;


begin
        GetDataBln;
        writeln(' Masukkan Tahun Kalender : ');readln(Thn);
        for v:=1 to 12 do 
            KalenderKeluaran(Thn,v);
        writeLn;
        writeLn('  ');
        writeLn('-----------------------------------');
    end.
end.

begin
        GetDataBln;
        writeln(' Masukkan Tahun Kalender : ');readln(Thn);
        for v:=1 to 12 do 
            KalenderKeluaran(Thn,v);
        gotoxy(1,9);
        gotoxy(1,8);
        writeLn;
        writeLn('  ');
        writeLn('-----------------------------------');
    end.
end.