contoh kode pascal 1

Program Segitiga_Pascal;
Uses Wincrt;
Var
  i,j,n:integer;
  x: array[1..100, 1..100] of integer;
Begin
  Write('Masukkan Jumlah Baris: ');Readln(n);
  For i:= 1 to n do
    For j:= 1 to i do
      Begin
        if j=1 then x[i,j]:=1
        else if j=i then x[i,j]:=1
        else x[i,j]:=x[i-1,j-1]+x[i-1,j];
      End;      



  For i:= 1 to n do
    Begin
      Gotoxy(40-3*i,2+i);
      For j:= 1 to i do
        write(x[i,j]:6);
    End;
End.


Program Menyusun_Angka;
Uses Wincrt;
Var i,j,n:integer;
Begin
  Write('Masukkan Jumlah Baris: ');Readln(n);
  For i:= 1 to n do
    Begin
      Gotoxy(40-3*i,1+i);
      For j:= 1 to i do
        write(i:6);
    End;
End.


Program Menyusun_Bintang;

Uses Wincrt;
Var i,j,n:integer;
Begin
  Write('Masukkan Jumlah Baris: ');Readln(n);
  For i:= 1 to n do
    Begin
      Gotoxy(40-3*i,1+i);
      For j:= 1 to i do
        write('*':6);
    End;
End.

Program Transpose_Matrix;
Uses Wincrt;
Var A: Array [1..10,1..10] of integer;
    i,j,baris,kolom :integer;
Begin
  Clrscr;
  Write('Masukkan Jumlah Baris : ');Readln(baris);
  Write('Masukkan Jumlah Kolom : ');Readln(kolom);
  Writeln;
  Gotoxy(1,5);Write('A= ');
  for i := 1 to baris do
    for j := 1 to kolom do
      begin
        Gotoxy(j*5,i*2+3);
        Readln(A[i,j]);
      end;
  Gotoxy(20,5);Write('AT=');
  for i := 1 to kolom do
    for j := 1 to baris do
      begin
        Gotoxy(j*5+20,i*2+3);
        Write(A[j,i]);
      end;
End.


Program Hitung_Nilai_Mhs;
Uses Wincrt;
Type Larik = array [1..100] of integer;
Var nilai,A,B,C,D,E : Larik;
    n,i,tot         : Integer;
    mean,sdt,sd     : real;
    iA,iB,iC,iD,iE  : Integer;

Procedure input;
Begin
  Writeln('Program Hitung Nilai');
  Writeln('====================');
  Write('Jumlah Data : ');readln(n);
  Writeln;
  Randomize;
  For i:= 1 to n do
    Begin
      Write('Masukan Nilai [0..100] ke-',i,' : ');Readln(nilai[i]);
    End;
  Writeln;
End;

Procedure hitung_mean_sd;
Begin
  tot:=0;
  sdt:=0;
  For i:= 1 to n do
    Begin
      tot:=tot+nilai[i];
    End;
  mean:=tot/n;
  For i:= 1 to n do
    Begin
      sdt:=sdt+sqr(nilai[i]-mean);
    End;
  sd:=sqrt(sdt/(n));
End;

Procedure cari_nilai;
Begin
  iA:=0; iB:=0; iC:=0; iD:=0; iE:=0;
  For i := 1 to n Do
    Begin
      If (nilai[i]>=(mean+(1.5*sd))) Then
        Begin
          Inc(iA);
          A[iA]:=nilai[i];          
        End
      Else If ((nilai[i]>=mean+(0.5*sd)) And (nilai[i]<mean+(1.5*sd)))
Then
        Begin
          Inc(iB);
          B[iB]:=nilai[i];          
        End
      Else If ((nilai[i]>=mean-(0.5*sd)) And (nilai[i]<mean+(0.5*sd)))
Then
        Begin
          Inc(iC);
          C[iC]:=nilai[i];          
        End
      Else If ((nilai[i]>=mean-(1.5*sd)) And (nilai[i]<mean-(0.5*sd)))
Then
        Begin
          Inc(iD);
          D[iD]:=nilai[i];          
        End
      Else
        Begin
          Inc(iE);
          E[iE]:=nilai[i];          
        End;
    End;
End;
Procedure urut_desc(z:Integer;Var X:Larik);
Var i,j,T: Integer;
Begin
  For i:= 1 to z-1 Do
    For j := 1 to z-1 Do
      If X[j]<x[j+1] Then       {kalau ascending X[j]>x[j+1]}
        Begin
          T:=X[j];
          X[j]:=X[j+1];
          X[j+1]:=T;
        End;
End;

Procedure tampil;
Begin
  Writeln('Rata-Rata Nilai : ',mean:3:2);
  Writeln('Standar Deviasi : ',sd:3:2);
  Writeln;
  Write('Nilai A: ');
  urut_desc(iA,A);
  For i:= 1 to iA Do
    Write(A[i]:3,' ');
  Writeln;

  Write('Nilai B: ');
  urut_desc(iB,B);
  For i:= 1 to iB Do
    Write(B[i]:3,' ');
  Writeln;

  Write('Nilai C: ');
  urut_desc(iC,C);
  For i:= 1 to iC Do
    Write(C[i]:3,' ');
  Writeln;

  Write('Nilai D: ');
  urut_desc(iD,D);
  For i:= 1 to iD Do
    Write(D[i]:3,' ');
  Writeln;

  Write('Nilai E: ');
  urut_desc(iE,E);
  For i:= 1 to iE Do
    Write(E[i]:3,' ');
  Writeln;
End;

Begin
  Clrscr;
  input;
  hitung_mean_sd;
  cari_nilai;
  tampil;  
End.