percabangan pascal

uses wincrt;
var
ack: array [1..100] of integer;
i,x,n,sort: integer;

begin
clrscr;
for x:= 1 to n do
begin
writeln('input byk dta  : ');readln(n);
writeln('Bilangan [x]= '); read(ack[x]);
end;

for i:= 1 to n-1 do
for x:= i+1 to n do
begin
if(ack[i]) > (ack[x]) then
begin
sort:= ack [x];
ack [i]:= ack [x];
ack [x] := sort;
end;
end;

for x:= 1 to n do
begin
write(ack [x]);
end;
readln;
end.

contoh procedure pascal

uses wincrt;
var
   i    :integer;
   n    :byte;
procedure garis;
 begin
  for i:= 1 to 70 do
   begin
    write('-');
   end;
 end;

procedure garis2;
 begin
  for i:= 1 to 70 do
   begin
    write('=');
   end;
 end;

procedure penyakit;
 begin
  writeln('Hanya ada obat untuk penyakit dibawah ini');
   writeln('----------------------------------------------------------------');
   writeln('| No | Nama Penyakit | Total obat | Nama obatnya | Nama dokter |');
   writeln('================================================================');
   writeln('| 1  | kanker        |     3      |  ditetapkan  | hadi        |');
   writeln('| 2  | pilek         |     1      |     oleh     |             |');
   writeln('| 3  | batuk         |     2      |    dokter    | bolang      |');
   writeln('| 4  | DBD           |     3      | yang merawat |             |');
   writeln('----------------------------------------------------------------');
 end;

procedure input;
var
   m            :array [1..20] of integer;
   np, no,kit,rso,dok       :string;
   obt,ttlbt          :byte;
 begin
  penyakit;
  garis2;
  writeln;writeln;
  write('Nama pembeli                     : ');readln(np);
  write('Nama penyakit yang diderita      : ');readln(kit);
   if kit='kanker' then ttlbt:=3;
    if kit='pilek' then ttlbt:=1;
     if kit='batuk' then ttlbt:=2;
      if kit='DBD' then ttlbt:=3;
  write('Total obat                       : ',ttlbt);readln;
  write('Nama dokter yang merawat         : ');readln(dok);
   if ('kit'='kanker') and (dok='hadi') then; writeln('Nama resep yang diberikan        : paramex paracetamol dan bodrex ');
    if ('kit'='pilek') and (dok='hadi') then; writeln('Nama resep yang diberikan        : neozep');
     if ('kit'='batuk') and (dok='hadi') then; writeln('Nama resep yang diberikan       : paracetamol dan paramex');
      if ('kit'='DBD') and (dok='hadi') then; writeln('Nama resep yang diberikan        :  neozep dan sangobion');

 end;

 begin
 garis;
 writeln;
 input;
 readln;

 end.

matrik pascal

Program kali_matriks;
uses wincrt;
type
matriksint = array [1..20,1..20] of integer;
var
M,a,b : matriksint; p , q: integer;

procedure bacamatriks (var M:matriksint;Nbar,Nkol:integer);
var i,j: integer;
begin
 for i:=1 to Nbar do
   begin
    for j:= 1 to Nkol do
     begin
       write ('M[',i,',',j,'] = ');readln (M[i,j]);
     end;
   end;
end;

procedure tulismatriks (var M:matriksint;Nbar,Nkol:integer);
var i,j : integer;
begin
 for i:= 1 to Nbar do
 begin
   for j:= 1 to Nkol do
     begin
       write (M[i,j]);
     end;
   writeln;
 end;
end;

procedure kalimatriks (a,b:matriksint; Nbar,Nkol : integer);
var
hasil:matriksint;
i,j,z : integer;
begin
  for i := 1 to Nbar do
  begin
   for j := 1 to Nkol do
   begin
   hasil[i,j] := 0;
    for z := 1 to Nbar do
    hasil[i,j] := hasil[i,j]+a[i,z]*b[z,j];
    begin
    gotoxy (j*5,i*23);
    write(hasil[i,j]) ;
    end;
   end;
   writeln;
  end;
end;

begin
  writeln ('MATRIK A ');
  write ('masukkan jumlah baris : '); readln (p);
  write ('masukkan jumlah kolom : '); readln (q);
  bacamatriks (a,p,q);
  write ('A = ');
  writeln;
  tulismatriks (a,p,q);
  writeln;
  writeln ('MATRIKS B ');
  write ('masukkan jumlah baris : '); readln (p);
  write ('masukkan jumlah kolom : '); readln (q);
  bacamatriks (b,p,q);
  write ('B = ');
  writeln;
  tulismatriks (b,p,q);
  writeln ('hasil perkalian matriks adalah : ');
  kalimatriks (a,b,p,q);
end.