Program Antrian Statis Circular

Uses Wincrt;
Const Max_Antrian = 5;
Type Antri = Array [1..Max_Antrian] of Char;
Var Antrian         : Antri;
    Depan, Belakang : Integer;
    Elemen,Pil,Pil1 : Char;
Procedure InitAntrian;
Begin
  Depan:=0;
  Belakang:=0;
End;

Read More

Program Antrian Statis Geser

Uses Wincrt;
Const Max_Antrian = 5;
Type Antri = Array [1..Max_Antrian] of Char;
Var Antrian         : Antri;
    Depan, Belakang : Integer;
    Elemen,Pil,Pil1 : Char;
   
Procedure InitAntrian;
Begin
  Depan:=0;
  Belakang:=0;
End;

Read More

Program Antrian Statis Tanpa Geser

Uses Wincrt;
Const Max_Antrian = 10;
Type Antri = Array [1..Max_Antrian] of Char;
Var Antrian         : Antri;
    Depan, Belakang : Integer;
    Elemen,Pil,Pil1 : Char;   

Procedure InitAntrian;
Begin
  Depan:=0;
  Belakang:=0;
End;

Read More

Program data mahasiswa

Program Data_Mahasiswa;
Uses WinCrt;
Type Mahasiswa = Record
       NoMhs : Word;
       Nama  : String[20];      
       IPK   : Real;
       Usia  : Byte;
     End;
Var Filemhs  : File of Mahasiswa;
    Data     : Mahasiswa;
    Pil,Ul   : Char;

Read More

contoh kode pascal 5

Program Sorting;
Uses WinCrt,WinDos;
Const Max=1000;
Type Larik = Array [0..Max] Of Word;
Var X                         : Larik;
    n                         : Longint;
    PolaIns,PolaBub,PolaQck,
    PolaMrg,PolaSlk,PolaShl   : Longint;
    J1,J2,M1,M2,D1,D2,MD1,MD2 : Word;
    SI,SB,SQ,SM,SS,SH         : Longint;
    Lg                        : Char;

Procedure AcakData(Var A: Larik; m: Longint);
Var i:Longint;
Begin
  Writeln('Data Yang Di Acak: ');
  Randomize;
  For i:= 1 To m Do
    Begin
      A[i]:=Random(1000)+1;
      Write(A[i],'  ');
    End;
End;

Procedure Ganti(Var A,B: Word);
Var G:Word;
Begin
  G:=A;
  A:=B;
  B:=G;
End;

Procedure Insert(A: Larik; m: Longint; Var baca: Longint);
Var i,j,G: Longint;
Begin
  baca:=0;
  For i:= 2 To m Do
    Begin
      G:=A[i];
      j:=i-1;
      A[0]:=G;
      While G<A[j] Do
        Begin
          A[j+1]:=A[j];
          Dec(j);
          Inc(baca);
        End;
      A[j+1]:=G;
    End;

  Writeln('Hasil Pengurutan Insert: ');
  For i:= 1 To m Do
    Write(A[i],'  ');
End;

Procedure Buble(A: Larik; m:Longint; Var baca: Longint);
Var i,j: Longint;
Begin
  baca:=0;
  For i:= 1 To m-1 Do
    For j := 1 To m-i Do
      if A[j]>A[j+1] Then
         Begin
           Ganti(A[j],A[j+1]);
           Inc(baca);
         End;

  Writeln('Hasil Pengurutan Buble: ');
  For i:= 1 To m Do
    Write(A[i],'  ');
End;

Procedure Quick(A: Larik; m : Longint; Var baca:Longint);
Var i: Longint;
  Procedure Urut(awal, akhir: Longint);
  Var kiri, kanan, pusat : Longint;
  Begin
    pusat:=A[(awal+akhir) div 2];
    kiri:=awal;
    kanan:=akhir;
    While kiri<=kanan Do
      Begin
        While A[kiri]<pusat Do
          Inc(kiri);
        While A[kanan]>pusat Do
          Dec(kanan);
        If kiri<=kanan Then
          Begin
            Ganti(A[kiri],A[kanan]);
            Inc(kiri);
            Dec(kanan);
            Inc(baca);
          End;
      End;
    If kanan>awal Then
      Urut(awal,kanan);
    If akhir>kiri Then
      Urut(kiri,akhir);
  End;
Begin
  baca:=0;
  Urut(1,m);
  Writeln('Hasil Pengurutan Quick: ');
  For i:= 1 To m Do

Komunitas eLearning IlmuKomputer.Com
Copyright © 2003-2008 IlmuKomputer.Com
48
    Write(A[i],'  ');
End;

Procedure Merge(A: Larik; m : Integer; Var baca : Longint);
Var cch,i : Longint;
    B     : Larik;
    Procedure MergeSort(Var A,B: Larik; awal, tengah, akhir: Longint);
    Var i,j,k,t: Longint;
    Begin
      i:=awal;
      k:=awal;
      j:=tengah+1;
      Repeat
        If A[i]<A[j] Then
           Begin
             B[k]:=A[i];
             Inc(i);
           End
        Else
           Begin
             B[k]:=A[j];
             Inc(j);
           End;

Read More

contoh kode pascal 3

Program String1;
Uses WinCrt;
Var JumKal : Integer;
    Kal      : String;
    Ul       : Char;

Procedure CekJKal(Teks: String; Var JK: Integer);
Var i: Integer;
Begin
  If (Teks[1]=' ') Then
     JK:=0
  Else
     JK:=1;
  For i:= 1 To Length(Teks) Do
    Begin                                                
      If (Teks[i]=' ') And (Teks[i+1]<>' ') And (Teks[i+2]<>' ') Then
         Inc(JK)
      Else If (Teks[i]='-') And (Teks[i-1]<>' ') And (Teks[i+1]<>' ')

Read More

contoh kode pascal 2

Program Konversi_Decimal_Ke_Romawi_Pakai_Array;
Uses WinCrt;
Const
   Romawi : array [1..13] of String =
   ('M','CM','D','CD','C','XC','L','XL','X','IX','V','IV','I');
   Desimal : array [1..13] of integer =
   (1000,900,500,400,100,90,50,40,10,9,5,4,1);
Var
   B,B1,i : Integer;
   Ul:Char;
   Rom : String;

Read More

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;      

Read More

source kode pascal 8

Program Max1_Max2;
Uses Wincrt;
Var
  x: array[1..100] of integer;
  i,n,max,sec: integer;

Begin
  Write('Masukkan Jumlah Data: ');readln(n);
  for i := 1 to n do
    begin
      x[i]:=random(18);
      write(x[i],' ');
      {readln(x[i]);}
    end;
  max:=x[1];
  sec:=0;
  for i := 1 to n do

Read More

sourc kode pascal 7

Program Indeks_Larik;
Uses Wincrt;
Var
   x      : Array [1..100] of Integer;
   i,n    : Integer;
   Ul     : Char;

Procedure CekIndeks(m: integer);
Var t: Integer;
Begin
  Writeln;
  Write('Nomor Indeks > Total Nilai Larik Sebelumnya Adalah: ');
  t:=0;
  For i := 1 to m-1 do

Read More

Source kode pascal 6

Program Prosedur_aktual;
Uses Wincrt;
Var Y:char;
    m:byte;
Procedure Tampil(x:char;n:byte);
Var i:integer;
Begin
  for i := 1 to n do
    Write(x);
  Writeln;
End;
Begin
  Tampil('+',8);
  Tampil('*',10);
  Tampil('A',5);
  Y:='B';
  m:=11;
  Tampil(Y,m);
End.

Read More

Source kode pascal 5

Program DataPegawai;
Uses Wincrt;
Type Pegawai = record
     NIP       : String[9];
     Nama      : String[30];
     Golongan  : Char;
     Jamkerja  : Real;
End;
Var
  Data                  : Pegawai;
  Gapok                 : Real;
  Insentif,Gaber        : Real;
  Ul                    : Char;
Begin  
  Repeat
    Clrscr;
    Writeln('Entry Data Pegawai PT. XYZ');

Read More

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.

Read More

source kode pascal 3

Kumpulan program pascal ini merupakan kumpulan latihan saat saya belajar bahasa
pemrograman  pascal.  Penulis  menggunakan  Turbo  Pascal  for  Windows  (TPW)  Versi
1.5  sebagai  kompilernya.  Mungkin  ada  kekurangan  disana  sini,  tapi  mudah-mudahan
kumpulan  program  ini  bermanfaat  bagi  pembaca  yang  berminat  dan  baru  mempelajari
bahasa pemrograman pascal.

Program Menghitung_Jarak;
Uses WinCrt;  
var
  x1,x2,y1,y2:integer;
  d:real;
begin
  Writeln('Program Menghitung Jarak Titik A dan B');
  Writeln('======================================');
  Writeln;
  Write('Masukan Nilai A (X1): ');readln(x1);
  Write('Masukan Nilai B (X2): ');readln(x2);

Read More

contoh source kode pascal 2

Konversi Jarak



uses
     wincrt;
var
     jarak,km,m,cm,sisa   : longint;
     yt                   : char;
begin        
     yt :='Y';
     repeat
     clrscr;
            write('Semut telah berjalan sepanjang = '); readln(jarak);
            km :=jarak div 100000;
            sisa :=jarak mod 100000;
            m :=sisa div 100;
            cm := sisa mod 100;uses
    wincrt;
var
   suhu1,suhu2,suhu3 : integer;
   faren1,faren2,faren3 : real;
   ream1,ream2,ream3 : real;

Read More

contoh source kode pascal 1

Pembelian


uses
    wincrt;    
var              
   harga1,harga2,harga3 : longint;
   jumlah,total         : longint;
   disc                 : real;
   YT                   : char;
begin
     YT :='Y';
     repeat
     clrscr;
     write('harga barang 1 : '); readln(harga1);
     write('harga barang 2 : '); readln(harga2);
     write('harga barang 3 : '); readln(harga3);

Read More

Huruf Vokal

uses
    wincrt;
var
    huruf       :       char;
    YT          :       char;
begin
     YT :='Y';
     repeat
     clrscr;              
     write('Input sebuah karakter = '); readln(huruf);
     write('Termasuk '); case huruf of
                              'a'   :   writeln('HURUF VOKAL');
                              'i'   :   writeln('HURUF VOKAL');
                              'u'   :   writeln('HURUF VOKAL');
     

Read More

Mencari Nilai Akhir

uses
    wincrt;
var
   nama               :       string;
   uts,uas,prak       :       integer;
   uts1,uas1,prak1    :       integer;
   total              :       real;
begin
     writeln('NILAI AKHIR MAHASISWA STT DHARMA ISAWARA');
     write('Nama          : '); readln(nama);
     write('Uts           : '); readln(uts);
     write('Uas           : '); readln(uas);
     write('Praktikum     : '); readln(prak);
     writeln;                                                                            

Read More

Menghitung waktu gerhana

 Sebenarnya intinya hanya membuat prosedur yang menampilkan jumlah hari dalam bulan tertentu..waktu gerhana ini sebagai tambahan saja.


uses crt;
var b,ha,ger:integer;
bul:string;
procedure maks(s:integer);
var y,k:integer;
begin
case s of
1,3,5,7,8,10,12:ha:=31;
4,6,9,11:ha:=30;
2:begin
write('masukan tahun ');readln(y);
k:=y mod 4;
if k=0 then
ha:=28
else ha:=29;

Read More

Mengalikan dua buah angka yang dimasukan dengan angka tertentu.

uses crt;
var absis,ordinat,pengali:integer;
procedure dilat(a,b,peng:integer);
var c,d:integer;
begin
c:=a*peng;
d:=b*peng;
writeln('(',c,',',d,')');
end;
begin
writeln('Kordinat Awal');
write('Absis : ');readln(absis);
write('Ordinat : ');readln(ordinat);
writeln;

Read More