Selasa, 03 April 2012

Source kode pascal 4

Program Menampilkan_Bintang;
Uses Wincrt;
Var i,j,n:integer;
Begin
  Writeln('Program Menampilkan Bintang');
  Writeln('===========================');
  Writeln;
  Write('Masukkan Jumlah Baris: ');readln(n);
  For i:= 1 to n do
    Begin
      For j:= 1 to i do
        Write('*');
      Writeln;
    End;
End.




Program Solusi_Bilangan_Bulat;
Uses Wincrt;
Var i,n,x,y,z:integer;
Begin
  Writeln('Program Solusi Bilangan Bulat');
  Writeln('=============================');
  Writeln;
  for x:= 0 to 25 do
    for y:= 0 to 25 do
      for z:= 0 to 25 do
        if (x+y+z=25) then
           begin
             writeln(x,' ',y,' ',z);
             readln;
           end;  
End.

Program Array1;

Uses Wincrt;
Var x   : array [1..100] of integer;
    n,i :integer;
Begin
  Writeln('Program Array');
  Writeln('=============');
  Writeln;
  Write('Masukkan Jumlah Data: ');readln(n);
  Writeln;
  For i:= 1 to n do
    Readln(x[i]);
  Writeln;
  Write('Data Yang Telah Dimasukkan: ');
  For i:= 1 to n do
    Write(x[i],'   ');
End.


Program Array2;
Uses Wincrt;
Var x : array [1..100] of integer;
    n,i,max,min : integer;
Begin
  Writeln('Program Array');
  Writeln('=============');
  Writeln;
  Write('Masukkan Jumlah Data: ');readln(n);
  Writeln;Writeln('Data Harus Urut');
  For i:= 1 to n do
    Readln(x[i]);
  Writeln;
  Write('Data Yang Telah Dimasukkan: ');
  max:=x[1];
  min:=x[1];
  For i:= 1 to n do
    Begin
      Write(x[i],'   ');
      if (max<x[i]) then
        max:=x[i]
      else
        min:=x[i];
    End;
  Writeln;
  Writeln('Nilai Maximal: ',max);
  Writeln('Nilai Minimal: ',min);
End.

Program Array3;
Uses Wincrt;
Var x: array [1..100] of integer;
    n,i,max,min,tot,pos:integer;
    rt,sdt,sd,md:real;
Begin
  Writeln('Program Array');
  Writeln('=============');
  Writeln;
  Write('Masukkan Jumlah Data (Data harus Urut): ');readln(n);
  Writeln;
  For i:= 1 to n do
    Readln(x[i]);
  Writeln;
  Write('Data Yang Telah Dimasukkan: ');
  max:=x[1];
  min:=x[1];
  tot:=0;
  sdt:=0;
  For i:= 1 to n do
    Begin
      Write(x[i],'   ');
      if (max<x[i]) then
        max:=x[i]
      else
        min:=x[i];
      tot:=tot+x[i];
    End;
  rt:=tot/n;
  For i:= 1 to n do
    Begin
      sdt:=sdt+sqr(x[i]-rt);
    End;
  sd:=sqrt(sdt/(n-1));
  if (n mod 2 = 1) then
    begin
      pos:=(n div 2)+1;
      md:=x[pos];
    end
  else
    begin
      pos:=(n div 2);
      md:=(x[pos]+x[pos+1])/2;
    end;
  Writeln;
  Writeln('Nilai Maximal   : ',max);
  Writeln('Nilai Minimal   : ',min);
  Writeln('Nilai Rata-Rata : ',rt:4:2);
  Writeln('Standar Deviasi : ',sd:4:2);
  Writeln('Median          : ',md:4:2);
End.


Program Polindrom;
Uses Wincrt;
Var kt,hkt,hkt1:string;
    i,j:integer;
Begin
  Writeln('Program Polindrom');
  Writeln('=================');
  Writeln;
  Write('Masukkan Kata: ');Readln(kt);
  Writeln;
  j:=length(kt);
  hkt:='';
  For i:= 1 to j do
    hkt:=hkt+kt[i];
  For i:= j downto 1 do
    hkt1:=hkt1+kt[i];
  Writeln('Asal: ',hkt,'       Dibalik: ',hkt1);
  Writeln;
  if (hkt=hkt1) then
    Writeln('Kata Tersebut Termasuk Polindrom!')
  else
    Writeln('Kata Tersebut Tidak Termasuk Polindrom!');
End.

Program Data_mahasiswa;

Uses Wincrt;
Type mhs = record
     NIM   : String[4];
     Nama  : String[20];
     Prodi : String[20];
     IP    : Real;
End;
Var data : mhs;
Begin
  With data do
  Begin
    Write('NIM           : ');Readln(NIM);
    Write('Nama          : ');Readln(Nama);
    Write('Program Studi : ');Readln(Prodi);
    Write('IP            : ');Readln(IP);
  End;
  Writeln;
  Writeln('NIM             : ',data.NIM);
  Writeln('Nama            : ',data.Nama);
  Writeln('Program Studi   : ',data.Prodi);
  Writeln('IP              : ',data.IP:2:2);
End.


Program Pecahan;
Uses Wincrt;
Var pmb,pny     : array [1..10] of integer;
    i,j,n,t1,t2 : integer;
Begin
  Writeln('Program Pecahan');
  Writeln('===============');
  Writeln;
  Write('Jumlah Data Pecahan: ');Readln(n);
  Writeln;
  For i := 1 to n do
    Begin
      Write('Pembilang ke-',i,' : ');Readln(pmb[i]);
      Write('Penyebut ke-',i,'  : ');Readln(pny[i]);
    End;
  Writeln;
  Writeln('Pecahan Yang Di Masukkan:');
  For i := 1 to n do
    Writeln(pmb[i],'/',pny[i]);
  For i := 1 to n-1 do
    For j := i+1 to n do
      Begin
        if ((pmb[i]/pny[i])>(pmb[j]/pny[j])) then
           Begin
             t1:=pmb[i];
             t2:=pny[i];
             pmb[i]:=pmb[j];
             pny[i]:=pny[j];
             pmb[j]:=t1;
             pny[j]:=t2;
           End;
      End;
  Writeln;
  Writeln('Hasilnya: ');
  For i := 1 to n do
    Writeln(pmb[i],'/',pny[i]);
End.


0 komentar: