Contoh Procedure di Pascal

program procedure;
uses wincrt;
var
y,z: integer;
x : char;
i : integer;
procedure tambah(VAR a, b : integer);
var x : integer;
begin

x:=a+b;
WRITELN;
WRITELN('HASIL PENJUMLAHAN= ',x);
end;


procedure Kurang(var a,b : integer);
var
x : integer;
begin


x:=a-b;
WRITELN;
WRITELN('HASIL PENGURANGAN = ',x);
end;

procedure menu;
begin

GOTOXY(50,1);WRITELN(':::::::::KALKULATOR::::::::');WRITELN;
WRITELN(':::::::::::MENU:::::::::::');
WRITELN;
WRITELN(' 1. PENJUMLAHAN BILANGAN');
WRITELN(' 2. PENGURANGAN BILANGAN');
WRITELN(' 3. EXIT');
end;

begin
x:='y';
repeat
clrscr;
menu;
WRITE('PILIH SALAH SATU [1..3] = '); READLN(i);
WRITELN;
case i of
1 :begin
WRITE('MASUKKAN BILANGAN 1 = '); READLN (y);
    WRITE('MASUKKAN BILANGAN 2 = '); READLN (z);
    tambah(y,z);
end;
2 :begin
WRITE('MASUKKAN BILANGAN 1= ');READLN (y);
    WRITE('MASUKKAN BILANGAN 2= '); READLN (z);
        kurang(y,z);

end;
end;
write('APAKAH ANDA INGIN MENGULANG [Y/T] = ');
READLN(X);
CLRSCR;

UNTIL X <> 'Y';
donewincrt
END.

*SELAMAT MENCOBA*

YULIE

contoh Array Record

Program Nama_karyawan;
uses wincrt;

Type
karyawan = record
nama,jabat,gol : string;
jumlah,noa : integer;
gaji : longint;
end;

var
pekerja: karyawan;
i,n,o: integer;

begin
     write('INPUT JUMLAH DATA KARYAWAN = ');readln(n);
     writeln('MASUKKAN SEJUMLAH ',n,' DATA');
writeln;

begin
for i := 1 to n do

begin
writeln('Data ke',i);
write ('Input Nama   :: ');
readln(pekerja.nama);
write ('Input NIK    :: ');
readln(pekerja.noa);
write('Golongan      :: ');
readln(pekerja.gol);
writeln('Jabatan       :: ');
clrscr;
end;


begin
writeln('DAFTAR NAMA-NAMA KARYAWAN');
writeln('PT. XYZ');
writeln('=========================');
WRITELN;
writeln('No.  Nama Karyawan  NIK       Golongan     Jabatan      Gaji');
writeln('==============================================================');


begin
if (pekerja.gol='a') then
begin
pekerja.Jabat :='Direktur';
pekerja.gaji:=500;
end
else if (pekerja.gol='b') then
begin
pekerja.Jabat :='Manager';
pekerja.gaji:=400;
end
else if (pekerja.gol='c') then
begin
pekerja.Jabat :='Ass.Manager';
pekerja.gaji:=300;
end
else if (pekerja.gol='d') then
begin
pekerja.Jabat :='Staff';
pekerja.gaji:=200;
end
else if (pekerja.gol='e') then
begin
pekerja.Jabat :='CS';
pekerja.gaji:=100;
end;
o:=0;
for i:= 1 to n do
begin
inc(o);
writeln(o:1,'. ', pekerja.nama:5,' ', pekerja.noa:14,' ', pekerja.gol:11,' ',Pekerja.jabat:12,' ',pekerja.gaji:13);




pekerja.jumlah:=pekerja.jumlah+1;
end;

BEGIN

writeln;


WRITELN('JUMLAH KARYAWAN SEBANYAK ',pekerja.JUMLAH,' ORANG');
end;end;
end;

end;
end.

*SELAMAT MENCOBA *

YULIE

Contoh Array For to Do

program contoh_array;
uses wincrt;

var
angka : array [1..10] of integer;
i     : integer;

begin
     writeln(':::ARRAY FOR TO DO:::');
     writeln;
     for i := 1 to 10 do
begin
    
     write('Masukkan kedalam Index ke-',i,' = ');
     readln(angka[i]);

end;
    clrscr;
    writeln(':::Nilai Index:::');
    writeln;
    for i:= 1 to 10 do

begin
   
     writeln('Nilai Index ke-',i,' = ',angka[i]);
     end;

end.

Contoh penggunaan ARRAY

Array membuat IPK

uses wincrt;

var
   MK               : Array [1..20] of String [20];                                                       
   UAS,UTS,TM       : Array [1..20] of Integer;
   NA               : Array [1..20] of Real;
   NH               : Array [1..20] of Char;
   MT,SKS,BBT       : Array [1..20] of Integer;
   I,J,TMT,TKS,TBT  : Integer;
   IPK              : Real;
   Nama             : String [15];
   NIM              : String [7];
   Jur              : String [2];
Procedure Spasi;
   Begin
      Writeln ('');
   End;

Begin
   TMT := 0;
   TKS := 0;
   Write ('Masukan Nama: '); Readln (Nama);
   Write ('Masukan NIM: '); Readln (NIM);
   Write ('Masukan Jurusan (SI/KA): '); Readln (Jur);
   Write ('Mata Kuliah yg di ambil: '); Readln (J);
   Clrscr;

   For I := 1 to J do
   Begin
      clrscr;
      Writeln ('Mata Kuliah Ke ',i);
      Spasi;
      Write ('Nama Mata Kuliah: '); Readln (MK[i]);
      Write ('SKS Mata Kuliah: '); Readln (SKS[i]);
      Write ('Nilai UTS: '); Readln (UTS[i]);
      Write ('Nilai TM: '); Readln (TM[i]);
      Write ('Nilai UAS: '); Readln (UAS[i]);
      Spasi;
   End;

   For I := 1 to J do
   Begin
      NA[i] := 0.5 * UAS[i] + 0.3 * UTS[i] + 0.2 * TM[i];
   End;

   For I := 1 to J do
   Begin
      If (NA[i] <= 100) and (NA[i] >= 80) Then NH[i] := 'A'
      Else If (NA[i] <= 79) and (NA[i] >= 70) Then NH[i] := 'B'
      Else If (NA[i] <= 69) and (NA[i] >= 60) Then NH[i] := 'C'
      Else If (NA[i] <= 59) and (NA[i] >= 50) Then NH[i] := 'D'
      Else NH[i] := 'E';
   End;

   For I := 1 to J do
   Begin
      Case NH[i] of
      'A' : MT[i] := 4;
      'B' : MT[i] := 3;
      'C' : MT[i] := 2;
      'D' : MT[i] := 1;
      'E' : MT[i] := 0;
      End;
   End;

   For I := 1 to J do
   Begin
      TMT := TMT + MT[i];
      TKS := TKS + SKS[i];
      BBT[i] := MT[i] * SKS [i];
      TBT := TBT + BBT[i];
   End;
clrscr;
Writeln ('NAMA: ',Nama);
Writeln ('NOMOR INDUK MAHASISWA: ',NIM);
Writeln ('JURUSAN: ',Jur);
Spasi;
Writeln ('KARTU HASIL STUDI STMIK PUTERA BATAM');
Writeln ('=============================================================');
Writeln ('NO        MATA KULIAH  SKS  UTS   TM  UAS   NA   NH   MT  BBT');
Writeln ('=============================================================');

   For I:= 1 to J do
   Begin
      writeln (i,MK[i]:20,SKS[i]:5,UTS[i]:5,TM[i]:5,UAS[i]:5,NA[i]:5:0,
               NH[i]:5,MT[i]:5,BBT[i]:5);
   End;
Writeln ('==============================================================');
IPK := TBT / TKS;
Spasi;
Writeln ('Total SKS: ',TKS);
Writeln ('Total Mutu: ',TMT);
Writeln ('Total Bobot: ',TBT);
Writeln ('IPK: ',IPK:1:2);
End.

MEMBUAT PASSWORD DI DELPHI

1.  Form ini terdiri dari minimal field Username dan Password
2.  Jika pengguna memasukan username = ADMIN dan password=12345, maka form kedua akan tampil
3.  Jika salah memasukan username dan/atau password, maka munculkan pesan kesalahan.

JAWABANNYA

 

 

 

procedure TForm2.Button1Click(Sender: TObject);

begin

if (edit2.text<>'12345') then

        begin

        Messagedlg('Username anda salah!',mterror,[mbok],0);

        Edit1.setfocus;

        end

else

if (edit1.text<>'admin') then

        begin

        Messagedlg('Password anda salah!',mterror,[mbok],0);

        Edit1.setfocus;

        end

else

else

begin

form1.show;

form2.Hide;

end;

end;

procedure TForm2.Button3Click(Sender: TObject);

begin

edit1.Text:='';

edit2.Text:='';

edit1.SetFocus;

end;

procedure TForm2.Button2Click(Sender: TObject);

begin

if(application.MessageBox('Apakah Anda Yakin Akan keluar ?','Warning',MB_YESNO)=IDYES) then

        close;

end;

procedure TForm2.FormActivate(Sender: TObject);

begin

edit1.Text:='';

edit2.Text:='';

end;

end.