Selasa, 30 Juni 2015

cara membuat Primbon Perjodohan dengan turbo pascal


Program Primbon_perjodohan;

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('   **** Disusun oLeh :MIFTAKHUL HIDAYAH(14-550-0170)**** ');



      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.

Menentukan nilai variabel X dan Y dengan turbo pascal


x,y,nx,ny:real;

a1,a2,b1,b2,c1,c2:integer;

lagi:char;

begin

repeat

clrscr;

writeln('Persamaan pertama ax+by=c');

write('berapa nilai a:');

readln (a1);

write('berapa nilai b:');

readln(b1);

write ('berapa nilai c:');

readln (c1);

writeln('Persamaan kedua ax+by=c');

write('berapa nilai a:');

readln (a2);

write('berapa nilai b:');

readln(b2);

write ('berapa nilai c:');

readln (c2);

writeln('maka kedua persamaan:');

writeln(a1,'x + ',b1,'y = ',c1);

writeln(a2,'x + ',b2,'y = ',c2);

nx:=((b2*c1)+(-b1*c2)) div ((a1*b2)-(b1*a2));

ny:=((-a2*c1)+(a1*c2)) div ((a1*b2)-(b1*a2));

writeln('nilai x:',nx:2:2);

writeln('nilai y:',ny:2:2);

write('Apa Anda ingin mengulang? (y/t)');

readln(lagi);

until lagi='t'

end.