PRIMBON PERJODOHAN

Untuk menyelesaikan tugas terakhir mata kuliah komputer yaitu tugas membuat primbon.Berikut ini program membuat primbon perjodohan dengan menggunakan turbo pascal :

uses wincrt;

var

 nama,hari,weton:string;

 tgl,bln,thn:integer;

 nh,nw,x1,x2:integer;

procedure masuk;

  begin  

      writeln('        *********************************************      ');

      writeln('   ****                                               **** ');

      writeln('  ***      SELAMAT DATANG DI PRIMBON PERJODOHAN         ***');

      writeln('  ***           PROGRAM STUDI PENDIDIKAN MATEMATIKA     ***');

      writeln('  ***         UNIVERSITAS PGRI ADI BUANA SURABAYA       ***');

      writeln('   **** Dbuat oleh : Febry Fitria P (145500089)**** ');

      writeln('        *********************************************      ');

      writeln;

      write('     Masukkan Nama Anda          : ');  readln(nama);

      write('     Masukkan Tanggal Lahir Anda : ');  readln(tgl);

      write('     Masukkan Bulan Lahir Anda   : ');  readln(bln);

      write('     Masukkan Tahun Lahir Anda   : ');  readln(thn);  

  end;

procedure masuk2 ;

  begin              

      writeln;

      writeln(' **********************************************************');

      writeln;

      write('     Masukkan Nama Pasangan Anda          : '); readln(nama);

      write('     Masukkan Tanggal Lahir Pasangan Anda : '); readln(tgl);

      write('     Masukkan Bulan Lahir Pasangan Anda   : '); readln(bln);

      write('     Masukkan Tahun Lahir Pasangan Anda   : '); readln(thn);

  end; 

procedure proses;

  var

    a,b,c,d,x,y,hr,hp:integer;

  begin

    a:= (thn-1900) div 4;

    case bln of

     1: if thn mod 4 =0 then b:=0 else b:=1;

     2: if thn mod 4 = 0 then b:=31 else b:=32;

     3: b:=60;

     4: b:=91;

     5: b:=121;

     6: b:=152;

     7: b:=182;

     8: b:=213;

     9: b:=244;

    10:b:=274;

    11:b:=305;

    12:b:=335;

    end;

    c:=tgl;

    d:=thn-1900;

    x:=a+b+c+d;

    y:=a+b+c;

    hr:= x mod 7;

    case hr of

     1:hari:='Minggu';

     2:hari:='Senin';

     3:hari:='Selasa';

     4:hari:='Rabu';

     5:hari:='Kamis';

     6:hari:='Jumat';

     else hari:='Sabtu';

     end;   

    hp:=y mod 5;

    case hp of

     1:weton:='Legi';

     2:weton:='Pahing';

     3:weton:='Pon';

     4:weton:='Wage'; 

     else weton:='Kliwon';

     end;

  end;

procedure harri;

  begin

    if (hari= 'Minggu') then begin nh:=5; end;

    if (hari= 'Senin')  then begin nh:=4; end;

    if (hari= 'Selasa') then begin nh:=3; end;

    if (hari= 'Rabu' )  then begin nh:=7; end;

    if (hari= 'Kamis')  then begin nh:=8; end;

    if (hari= 'Jumat')  then begin nh:=6; end;

    if (hari= 'Sabtu')  then begin nh:=9; end;  

  end;

procedure pasaran;

  begin

    if (weton='Pahing') then begin nw:= 9 ;   end;

    if (weton='Pon' )   then begin nw:= 7 ;   end;

    if (weton='Wage')   then begin nw:= 4 ;   end;

    if (weton='Legi')   then begin nw:= 5 ;   end;

    if (weton='Kliwon') then begin nw:= 8 ;   end;

  end;

procedure neptu;

 begin

     x1:=nh+nw;

 end;

procedure neptu2;

  begin

     x2:=nh+nw;

  end;

procedure kelahiran ;

  begin

       writeln;

       write  ('   " Hari kelahiran, ',nama, ': ',hari,'','  ',weton,' "');   

  end;

procedure kecocokan;

  var

    z,w:integer;

    ket:string;

  begin

     z:= x1+x2;

     w := z mod 5 ;

     case w of

      1:ket:='Cocok';

      2:ket:='Lebih dari Cocok';

      3:ket:='Sangat Cocok';

      4:ket:='Kurang Cocok';

      else ket:='Sangat Tidak Cocok';

      end;

    writeln;

    writeln(' **********************************************************');

    writeln;

    write('** Hasil Kecocokan Anda dan pasangan anda :',ket,' **');

    writeln;

  end;

procedure awal;

var

pilihan:char;

label lagi;

begin

  lagi:

  clrscr;

    masuk;

      if (thn < 1900) or (bln > 12) or (tgl > 30) then

        begin

           writeln;

           writeln('^ Maaf tanggal lahir yang Anda masukkan di luar jangkauan ^');

           writeln;

           write('===================Coba diteliti lagi======================'); readln;

           goto lagi

        end;

    proses;

    harri;

    pasaran;

    neptu;

    kelahiran;

    masuk2;  

      if (thn < 1900) or (bln > 12) or (tgl > 30) then

        begin

           writeln;

           writeln('^ Maaf tanggal lahir yang Anda masukkan di luar jangkauan ^');

           writeln;

           write('===================Coba diteliti lagi======================'); readln;

           goto lagi

         end;

    proses;

    harri;

    pasaran;

    neptu2;

    kelahiran;

    kecocokan;

  writeln;   

  write('***************** Ingin mencoba lagi?(y/t) ****************  '); readln(pilihan);

    if (pilihan = 't') or (pilihan = 'T') then

    begin

        writeln;

        write('============Terima Kasih Atas Kunjungan Anda===============');

    end;           

      if (pilihan = 'y') or (pilihan = 'Y') then

      goto lagi;

  end;

BEGIN

  awal;

readln;

donewincrt;

END.