Program Looping

program looping;
uses wincrt;
var  i,j: integer;
begin
   for i:= 1 to 5 do
   begin
   writeln(' ');
   for j:= 1 to 4 do

   begin
   write('   ',i+j,'-',j,'=',i-j:2);
   end;
   writeln;
   end;
   end.

=============================================================

Program Asistensi

ini nih program yang aku dapat saat asistensi menjelang ETS. bersama kak siapa ya? aku lupa... hehehe...

program kuadratplus;
uses wincrt;
var i,n:integer;
begin
   read(n);
   if n=1 then write (1);
   if n>1 then
   begin
   for i:=n downto 2 do
   write (2*i-1,'+');
   write(1,'=');
   write (sqr(n));
   end;
   end.

Program Invers

MENCARI INVERS MATRIKS
MENGUNAKAN PASCAL
program invers;
uses wincrt;
label  hitung;

var
    mat,adj : array [1..5,1..5] of integer;
    det,i,j : integer;
    c:char;

begin

  clrscr;
         { tampilan awal keterangan matrik }
  gotoxy(20,4);
  writeln('Matriks Ordo 2 x 2');

  gotoxy(15,5);
  writeln('-------------------------');

  gotoxy(15,7);
  writeln('1. Input data matrik ');

  gotoxy(15,8);
  writeln('2. Menentukan Adjoin Matrik');

  gotoxy(15,9);
  writeln('3. Mencari determinan matriks');

  gotoxy(15,10);
  writeln('4. Mencari Invers matriks');
  readln;

   if c = #13 then goto hitung;

           {end tampilan awal keterangan matrik}

           {mulai proses input}
hitung:
      begin
        clrscr;
        writeln('Input Matrik Ordo 2x2');
        writeln('-------------------------');
        for i := 1 to 2 do begin
           for j:= 1 to 2 do begin
               write('matrik ke ',i,' ',j,': ');readln(mat[i,j]);
           end;
           writeln;
        end;

        for i := 1 to 2 do begin
         write('|');
          for j := 1 to 2 do begin
            write(' ',mat[i,j],' ');
              if j = 2 then write ('|');
          end;
          writeln;
        end;
                 {end proses input matrik}

        writeln;
        writeln;
                 {mulai adjoin matrik dan determinan}

        writeln('Adjoin matrik Ordo 2x2');
        writeln('-----------------------');

        adj[1,1] := mat[2,2];
        adj[1,2] := mat[1,2] * -1;
        adj[2,1] := mat[2,1] * -1;
        adj[2,2] := mat[1,1];

          for i := 1 to 2 do begin
           write('|');
             for j := 1 to 2 do begin
                 write(' ',adj[i,j],' ');
                   if j = 2 then write('|');
             end;
             writeln;
          end;
        writeln;

        det := (mat[1,1] * mat [2,2]) - (mat[1,2] * mat[2,1]);

        write('Determinan dari matrik diatas adalah ');
        writeln(det);
        writeln;
                  {end of adjoin and determinan}

                  {mulai menghitung invers matrik}

        writeln('Invers Matrik ');
        writeln('----------------');
        writeln;

        for i := 1 to 2 do begin
         write('|');
          for j := 1 to 2 do begin
            write(' ',adj[i,j]/det:3:2,' ');
              if j = 2 then write('|');
          end;
          writeln;writeln;writeln;
       end;
                    {end of hitung invers matrik}

       end;
readln;
end.

Program Feedback

Program median;
Uses Wincrt;
Var
x: array [1..100] of integer;
n,i,pos:integer;
md:real;
lagi:char;
Begin
lagi:='y';
while lagi='y' do
begin
writeln('=============');
Writeln('Program median');
Writeln('=============');
Writeln;
writeln('*dalam program mini ini, data yang harus dimasukkan nanti harus sudah urut*');
writeln;
Write('Masukkan Jumlah Data (n): ');
readln(n);
clrscr;
Writeln;
For i:= 1 to n do
Readln(x[i]);
Writeln;
For i:= 1 to n do
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('Median dari data berjumlah ', n,' tadi adalah : ',md:4:2);
writeln;
writeln('*terimakasih sudah menggunakan program ini*');
writeln('hitung lagi?');
readln(lagi);
end;
End.

Program XXX

program seling;
uses wincrt;
var i,j,n:integer;
a:string;        
begin
write ('banyak baris ');
readln (n);
for i:=1 to n do
begin
for j:=1 to i do
begin
if (j mod 2)=1 then
a:='*' else a:='1';
write(a,' ');
end;
writeln;end; end.


program bintang turun;
uses wincrt;
var i,n,j:integer;
begin readln (n);
for i:=1 to n do
begin for j:=1 to n do
begin if (j<i) then
write (' ') else
write ('*');
end;
writeln;
end;
end.


program angka;
uses wincrt;
var i,j,n,a:integer;
       
begin
write ('banyak suku ');
readln (n); a:=0;
for i:=1 to (n div 4)+1  do
begin
for j:=1 to 4 do
begin
a:=a+1;
if a<=n then
write (a,' ') else write(' ');
end;
writeln;
end;
 end.

Program Matriks

program matrik_penjumlahan;
uses wincrt;
var a,b,c: array[1..10,1..10] of integer;
    i,j,k1,k2,b1,b2,sum,r:integer;

begin
write('Masukkan baris Matrik A = ');readln(b1);
write('Masukkan kolom Matrik A = ');readln(k1);
write('Masukkan baris Matrik B = ');readln(b2);
write('Masukkan kolom Matrik B = ');readln(k2);
for i:=1 to b1 do
for j:=1 to k1 do
readln(a[i,j]);
writeln;
for i:=1 to b2 do
for j:=1 to k2 do
readln(b[i,j]);
writeln;
writeln('Matrik A');
writeln('==================');
for i:=1 to b1 do
begin
for j:=1 to k1 do
write(a[i,j],' ');
writeln;
end;
writeln;
writeln('Matrik B');
writeln('===================');
for i:=1 to b2 do
begin
for j:=1 to k2 do
write(b[i,j],' ');
writeln;

end;
writeln;
writeln('Matrik A*B');
writeln('================');
for i:=1 to b1 do
begin
for j:=1 to k2 do
begin
sum:=0;
for r:=1 to k1 do
sum:=sum+a[i,r]*b[r,j];
c[i,j]:=sum;
write(c[i,j]:2,' ');
end;
writeln;
end;
end.

Program Modus

program modusss;
uses wincrt;
var i,n,j,modus:integer;
A,frek:array[1..100] of integer;
begin
write('masukkan banyak bilangan');
readln(n);
writeln('masukan data');
for i:=1 to n do
readln(A[i]);
writeln;
for i:=1 to n-1 do
begin
for j:=i+1 to n do
if A[i]=A[j] then
frek[i]:=frek[i]+1;
end;
modus:=1;
for i:=1 to n do
begin
if frek[modus]<frek[i] then
modus:=i;
end;
write('Modus: ',A[modus],' sejumlah ',frek[modus]+1);
end.

Program Mean,Var,StDv

program rata2_var_stdev;

uses wincrt;

var i,j,n,a:integer;

k,rata,varian,stdev:real;

begin

writeln('masukkan jumlah data',' ');

i:=1;

readln(n);

while i<=n do begin

write('data ke-',i,'= ');

readln(a);

inc(i);

j:=j+a;

k:=k+sqr(a);

end;

rata:=j/n;

varian:= (k-n*sqr(rata))/(n-1);

stdev:=sqrt((k-n*sqr(rata))/(n-1));

writeln('nilai rata-ratanya adalah = ',rata:2:3);

writeln('nilai variannya adalah = ',varian:2:3);

write('nilai standar deviasinya adalah = ',stdev:2:3);

end.

Program Yes No Question

program Mean_YesNoQuestion;
uses wincrt;
var
   r,n:byte;
   sum,mean: real;
   x : array[1..100] of real;
   leave: char;
begin
     leave:= 'N';
     while leave='N' do
begin
     write ('jumlah data yang riskha masukkan = '); readln (n);
     writeln;
     sum:=0;
     for r:=1 to n do
begin
     write('nilai data ke- ',r,' ','=','  '); readln (x[r]);
     sum:= sum+ x[r];
     end;
     mean:=sum/n;
     writeln;
     writeln ('jumlah data yang telah riskha masukkan adalah  ',n);
     writeln;
     writeln ('sum nilai data adalah ',sum:6:2);
     writeln;
     writeln ('mean nilai data adalah  ',mean:6:2);
     writeln;
     writeln ('do you want to leave this program? (Y/N) ? ');
     readln(leave);
     end;
end.

Program Penjumlahan ++

program penjumlahan;
uses wincrt;
var i,a,n,hasil,f:integer;

begin
writeln('masukkan angka');readln(n);

a:=n;
for i:=n downto 2 do
begin

hasil:=n*n;
write ((n-1)+a,'+');
a:=a-2;

 end;
 begin

   if n<0 then write ('')
  else if(n<=1) then write ('1')
else write(1,'=',hasil);
end;
end.

Program Bintang

program pola;
uses wincrt;
var
i,n,j:integer;
a:string;
begin
write ('buat pola hingga baris ke_');
readln(n);
writeln ;
for i:=1 to n do
begin
for j:=1 to i do
begin
if (j mod 2)=1 then
a:='*' else a:='1';
write(a, ' ');
end;
writeln;
end;
end.

Introducing Array....^_^

Array adalah tipe data terstruktur yang terdiri dari sejumlah komponen-komponen yang mempunyai tipe sama. Komponen-komponen tersebut disebut sebagai komponen type, larik mempunyai jumlah komponen yang jumlahnya tetap. Banyaknya komponen dalam larik ditunjukkan oleh suatu index, dimana tiap komponen di array dapat diakses dengan menunjukkan nilai indexnya atau subskript. Array dapat bertipe data sederhana seperti byte, word, integer, real, bolean, char, string dan tipe data scalar atau subrange. Tipe larik mengartikan isi dari larik atau komponen- komponenya mempunyai nilai dengan tipe data tersebut. 

Program Faktorial

program faktorial;uses wincrt;var i,n,f :integer;beginreadln (n); f:=1; i:=0;repeati:= i+1;f:=f*i;until i=n;writeln (n, 'faktorial= ',f);end.

program faktorial;

uses wincrt;

var i,n,f :integer;

begin

readln (n); f:=1; i:=0;

for i:=1 to n do

begin

f:=f*i;

writeln (n, 'faktorial= ',f);

end;

end.

program faktorial;

uses wincrt;

var i,n,f :integer;

begin

readln (n); f:=1;

while i<n do

begin

i:= i+1;

f:=f*i;

writeln (n, 'faktorial= ',f);

end;

end.