Program-Program Turbo Pascal

Beberapa program-program turbo pascal dapat kalian baca selengkapnya di sini :) =======================================================

program pelajar;
uses wincrt ;
var
   nrp :longint;

begin
     nrp := 1311123 ;
     writeln(nrp);
end.

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

program faktorial;
uses wincrt;
var
i, f : longint ;
n : real;
begin
     readln(n); f:=1; i:=0;
     repeat
           i:=i+1;
           f:=f*i;
           until i=n ;
           writeln (n,' faktorial= ',f);
           end.

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

program expo;
uses wincrt;
var i,n :integer;
e,f :real;
begin
     e:=1; i:=0; n:=10; f:=1;
repeat
     i:=i+1;
     f:=f*i;
     e:=e+1/f;   

until i=n;
writeln ('e= ',e:11:4);
end.

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

CASE OF

program huruf;
uses wincrt;
var
data:char;
begin
readln (data);

case data of
'A','I','U','E','O' :writeln ('huruf besar vokal');
'a','i','u','e','o' :writeln ('huruf kecil vokal');
else
writeln ('bukan huruf vokal');
end;
end.

=======================================================
 
WHILE

program faktorial;
uses wincrt;
var
i, f : longint ;
n : real;
begin
readln (n);f:=1;
while i<n do
begin
i:=i+1;
f:=f*i;
writeln (n,'faktorial=',f);
end;
end.

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

FOR
 
program faktorial;
uses wincrt;
var
i, n, f : integer;
begin
     readln(n); f:=1;
     for i:=1 to n do;
     begin f:=f*i;
     end;
     writeln(n,'faktorial=',f);
     end.

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

IF

program faktorial;
uses wincrt;
var
i, n : longint ;
f : real;
begin
     readln(n); f:=1; i:=0;
    if (n=0) then
    writeln (i);

    repeat
    i:=i+1;
    f:=f*i;
    until i=n;
    writeln (n, 'faktorial' ,f);
    end.

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

program pangkat;
uses wincrt;
function Pkt(x:real;n:integer):real;
var t :real;
m:integer;
begin
m:=abs(n);
if(x<>0)and (n=0)then pkt:=1
else if n>0 then
pkt:=x*pkt(x,n-1)
else if (n<0)then pkt:=1/(x*pkt(x,m-1));
end;
var x:real;
n:integer;
begin
write('bilangan yang dipangkatkan:');readln(x);
write('bilangan pangkat:');readln(n);
writeln(x:10:8,'pangkat',n,'=',Pkt(x,n):4:100);
end.

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

PROGRAM DERET ANGKA

1
1 2
1 2 3
1 2 3 4

program deret_angka;
uses wincrt ;
var
i,j : integer;
begin
for i:=1 to 5 do
begin
for j:=1 to i do
write (j,' ');
writeln;
end;
end.

-----------------------------------------------------------------------------------

1 2 3 4
1 2 3
1 2
1
 
program deret_angka;
uses wincrt ;
var
i,j : integer;
begin
for i:=5 downto 1 do
begin
for j:=1 to i do
write (j,' ');
writeln;
end;
end. 

-----------------------------------------------------------------------------------

1
2 3
4 5 6
7 8 9 10

program deret_angka;
uses wincrt;
var n, i, j :integer;
 begin
 n:=1;
 for i:=1 to 4 do
 begin
 for j:=1 to i do
 begin
 write (n,' ');
 n:=n+1;
 end;
 writeln (' ');
 end;
 end.

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

ARRAY
 
Program Bilangan_Genap;
uses wincrt;
var genap : array[1..100] of integer;
    a, b, jum : integer;
begin
  a := 0;
  b := 2;
  write('Jumlah bilangan genap : ');readln(jum);

  while a <> jum do begin
    inc(a);
    genap[a] := b;
    b := b + 2;
  end;

  writeln;
  writeln('Hasil yang disimpan di array : ');
  for b := 1 to jum do
    writeln('Bilangan genap ke-',b,' : ',genap[b]);
end.
 
-----------------------------------------------------------------------------------

program data_sering_muncul;
uses wincrt;
var i,n,j,modus:integer;
A,frek:array[1..100] of integer;
begin
readln(n);
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
write(frek[i],' ');
if frek[modus]<frek[i] then
modus:=i;
end;
write('modus: ',A[modus],' sebanyak ',frek[modus]+1);
end.
 
-----------------------------------------------------------------------------------

program dimensi;
uses wincrt;
var
x:array[1..100,1..100]of integer;
p,l,i,j:integer;
begin
write ('p=');readln (p);
write ('l=');readln (l);
for i :=1 to l do
for j:=1 to p do
readln (x[i , j]);
writeln ;
writeln('bentuk matriksnya') ;
for i:=1 to l do
begin
for j:=1 to p do
write (x[i , j]);
writeln;
end;
end.

-----------------------------------------------------------------------------------



MATRIK

program matrik;
uses wincrt;
type data = array[1..10,1..10] of integer;
var matrikI,matrikII : data;
baris,kolom,pil : integer;
procedure isimatrik;
var i,j : integer;
begin
writeln('Penentuan ORDO MATRIK I');
write('Masukan banyak baris matrik I = ');readln(baris);
write('Masukan banyak kolom matrik I = ');readln(kolom);
for i:=1 to baris do
for j:=1 to kolom do
begin
gotoxy(j*10,i*5);
readln(matrikI[i,j]);
end;
clrscr;
writeln('Penentuan ORDO MATRIK II');
write('Masukan banyak baris matrik II = ');readln(baris);
write('Masukan banyak kolom matrik II = ');readln(kolom);
for i:=1 to baris do
for j:=1 to kolom do
begin
gotoxy(j*10,i*5);
readln(matrikII[i,j]);
end;
end;
procedure jumlahmatrik(m1,m2 : data);
var hasil : data;
i,j : integer;
begin
for i:=1 to baris do
for j:=1 to kolom do
begin
hasil[i,j]:=m1[i,j]+m2[i,j];
end;
clrscr;
writeln('Hasil Penjumlahan MATRIK');
for i:=1 to baris do
for j:=1 to kolom do
begin
gotoxy(j*10,i*5);
write(hasil[i,j]);
end;
end;
procedure kurangmatrik(m1,m2 : data);
var hasil : data;
i,j : integer;
begin
for i:=1 to baris do
for j:=1 to kolom do
begin
hasil[i,j]:=m1[i,j]-m2[i,j];
end;
clrscr;
writeln('Hasil Pengurangan MATRIK');
for i:=1 to baris do
for j:=1 to kolom do
begin
gotoxy(j*10,i*5);
write(hasil[i,j]);
end;
end;
procedure kalimatrik(m1,m2 : data);
var hasil : data;
i,j,z : integer;
begin
for i:=1 to baris do
for j:=1 to kolom do
begin
hasil[i,j]:=0;
for z:=1 to baris do
hasil[i,j]:=hasil[i,j]+matrikI[i,z]*matrikII[z,j];
end;
clrscr;
writeln('Hasil Perkalian MATRIK');
for i:=1 to baris do
for j:=1 to kolom do
begin
gotoxy(j*10,i*5);
write(hasil[i,j]);
end;
end;
begin
writeln(' M E N U');
writeln('(1) Penjumlahan Matrik');
writeln('(2) Pengurangan Matrik');
writeln('(3) Perkalian Matrik');
write('Pilihan = ');readln(pil);
clrscr;
case pil of
1 : begin
isimatrik;
jumlahmatrik(matrikI,matrikII);
end;
2 : begin
isimatrik;
kurangmatrik(matrikI,matrikII);
end;
3 : begin
isimatrik;
kalimatrik(matrikI,matrikII);
end;
end;
end.

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