TURBO PASCAL

program pilihan_sederhana;

uses wincrt;

label awal, akhir;

var nilai : integer;

pil : char;

begin

awal:

clrscr;

write('Input Nilai Anda : ');readln(nilai);

clrscr;

if (nilai <= 100) and (nilai >= 70) then writeln('Anda Pintar')

Else if (nilai < 70) and (nilai > 0) then writeln('Anda Belum Beruntung ')else goto awal;

write('Apakah Anda Ingin Mengulang Lagi (Y/T) ? ');pil:=readkey;

if upcase(pil)='Y' then goto awal

else if upcase(pil)='T' then goto akhir;akhir:

end.

 program pilihan_sederhana;

uses wincrt;

label awal, akhir;

var

pil, jawab : char;

begin

awal:

writeln('Aplikasi Yang Digunakan Untuk Membuat Program Adalah ? ');

writeln('A. Microsoft Word');

writeln('B. Microsoft Excel');

writeln('C. Microsoft Power Point');

writeln('D. Turbo Pascal');

writeln('Jawaban Anda : ');jawab := readkey;

if upcase(jawab)='D' then writeln('Benar')

Else writeln('Salah');

write('Apakah Anda Ingin Mengulang Lagi (Y/T) ? ');pil:=readkey;

if upcase(pil)='Y' then goto awal

else if upcase(pil)='T' then goto akhir;akhir:

end.

 


 

Program Seleksi_IF_3;

uses wincrt;

var

Nilai : real;

Grade : char;

Begin

write('Berapa Nilai Yang Di Dapat = ');readln(Nilai);

If Nilai>90 then grade := 'A'

Else If Nilai>75 then grade := 'B'

Else If Nilai>60 then grade := 'C'

Else If Nilai>40 then grade := 'D'

Else grade := 'E';

write('Grade Anda : ',grade);read;

end.

 

 

 

Program Seleksi_IF_3;

uses wincrt;

label awal, akhir;

var

Nilai : integer;

Grade : char;

pil : char;

Begin

awal:

write('Berapa Nilai Yang Di Dapat = ');readln(Nilai);

case nilai of

91..100 : grade := 'A';

76..90 : grade := 'B';

61..75 : grade := 'C';

41..60 : grade := 'D';

else grade := 'E';

  end;

writeln('Grade Anda : ',grade);read;

writeln('Ingin Mengulang Lagi (Y/T) : ');

pil := readkey;

if upcase(pil)='Y' then goto awal

else goto akhir;akhir:

end.

Program tampilan;

uses wincrt;

label awal, akhir;

var

x,y : integer;

pil : char;

Begin

awal:

clrscr;

write('Input x = ');readln(x);

write('Input y = ');readln(y);

gotoxy(x,y);writeln('Halloooo...!!!');

writeln('Ingin Mengulang Lagi (Y/T) : ');

pil := readkey;

if upcase(pil)='Y' then goto awal

else goto akhir;akhir:

end.

 

Program Tampilan;

uses wincrt;

label awal, akhir;

var

i,n : integer;

pil : char;

Begin

awal:

clrscr;

write('Input Banyaknya Pengulangan  : ');readln(n);

for i:=1 to n do writeln(i);

writeln('Ingin Mengulang Lagi (Y/T) : ');

pil := readkey;

if upcase(pil)='Y' then goto awal

else goto akhir;akhir:

end.

 

Program Tampilan;

uses wincrt;

label awal, akhir;

var

i,n : integer;

pil : char;

Begin

awal:

clrscr;

write('Input Banyaknya Pengulangan  : ');readln(n);

i:=1;

while i <= n do

begin

writeln(i);

i:=i+1;

end;

writeln('Ingin Mengulang Lagi (Y/T) : ');

pil := readkey;

if upcase(pil)='Y' then goto awal

else goto akhir;akhir:

end.

Program Tampilan;

uses wincrt;

label awal, akhir;

var

i,n : integer;

pil : char;

Begin

awal:

clrscr;

write('Input Banyaknya Pengulangan  : ');readln(n);

i:=0;

repeat

inc(i);

writeln(i);

until i=n;

writeln('Ingin Mengulang Lagi (Y/T) : ');

pil := readkey;

if upcase(pil)='Y' then goto awal

else goto akhir;akhir:

end.

 

Program coba_for;

uses wincrt;

var i, j : integer;

begin

clrscr;

i:=5;

repeat

for j:=i to 5 do

if (i=2) and (j=3) then write('$')

else write('*');

dec(i);

writeln;

until i <1;;readln;

end.

program array_satu;

uses WinCrt;

var i: integer;

x: array[1..5] of integer;

begin

clrscr;

for i:=1 to 5 do

begin

write('Masukkan Data Ke-',i,' = ');

readln(x[i]);

end;

clrscr;

writeln('Data Keseluruhan Adalah : ');

for i:=1 to 5 do

begin

writeln('Data Ke-',i,' = ',x[i]);

end;

readln;

end.

 

program array_2_dimensi;

uses WinCrt;

var

Matrik : array[1..3,1..2] of string;

I, J : integer;

begin

clrscr;

Matrik[1,1] := 'A';

Matrik[2,1] := 'STMIK';

Matrik[3,1] := 'KSHF';

Matrik[1,2] := 'HH';

Matrik[2,2] := 'COBA';

Matrik[3,2] := 'SSS';

for I := 1 to 3 do

begin

for J := 1 to 2 do

write(Matrik[I,J]:8);

writeln;

end;

readln;

end.

program penampil_hari;

uses wincrt;

var

hari: array[1..7] of string;

i :integer;

begin

clrscr;

hari [1] :='senin';

hari [2] :='selasa';

hari [3] :='rabu';

hari [4] :='kamis';

hari [5] :='jumat';

hari [6] :='sabtu';

hari [7] :='minggu';

for i :=1 to 7 do

begin                     

write(hari[i]);

writeln;

end;

readln;

end.

 

Program coba_procedure;

uses wincrt;

var x,y,z : integer;

procedure kali(var a,b,hasil : integer);

begin

write('Input A : ');readln(a);

write('Input B : ');readln(b);

hasil :=a*b;

end;

begin

clrscr;

kali(x,y,z);

writeln('Hasil ',x,'*',y,' adalah ',z);

readkey;

end.

Program coba_procedure;

uses wincrt;

var x,y,z : integer;

procedure kali(var a,b:integer; var hasil : integer);

begin

hasil :=a*b;

end;

begin

clrscr;

for x:=2 to 3 do

for y:=1 to 10 do

begin

kali(x,y,z);

writeln(x, '*',y,'=',z);

end;

writeln;

readkey;

end

 

Program coba_procedure;

uses wincrt;

var x,y,z : integer;

procedure kali(var a,b:integer; var hasil : integer);

begin

hasil :=a*b;

end;

begin

clrscr;

for x:=13 to 14 do

for y:=10 downto 1 do

begin

kali(x,y,z);

writeln(x, '*',y,'=',z);

end;

writeln;

readkey;

end.

Program coba_procedure;

uses wincrt;

var x,y,z : integer;

procedure kali(var a,b:integer; var hasil : integer);

begin

hasil :=a*b;

end;

begin

clrscr;

x:=13;

repeat

y:=10;

while y>=1 do

begin

kali(x,y,z);

writeln(x, '*',y,'=',z);

dec(y);

end;

writeln;

inc(x);

until x>14;

readkey;

end.

 

uses wincrt;

var i, j, k, l, m, n :integer;

begin

clrscr;

k:=10;m:=1;

for i:=10 downto 1 do

begin

n :=1;gotoxy(k,m);

for j:=i to 10 do

begin

if n=m then

begin

for n:=m downto 1 do

write(n);

end else

begin

write(n);inc(n);

end;end;

dec(k);inc(m);

end;readkey;

end.

program login;

uses wincrt;

label x, y;

var user, pass : string;

c : char;

i, j : integer;

procedure bingkai;

begin

for j := 10 to 40 do

begin

gotoxy (j, 2);

write('#');

end;

for j := 10 to 40 do

begin

gotoxy (j, 7);

write('#');

end;

for j := 3 to 7 do

begin

gotoxy (10, j);

write('#');

end;

for j := 3 to 7 do

begin

gotoxy (40, j);

write('#');

end;

gotoxy (15, 4);

write('User      : ');

gotoxy (15, 5);

write('Password  : ');

end;

procedure cek_user;

begin

i := 1;

user :='';

gotoxy (26, 4);

repeat

c := readkey;

if (c = #08) and (length(user)<=11) then

begin

if i > 1 then

begin

delete (user, length(user), 1);

gotoxy (25 + i, 4);

write (c);

write (#32);

write (c);

dec (i);

end

end else

if ((c<>#13) and (c<>#08)) and (length (user) < 11) then

begin

user := user + c;

gotoxy (25 + i, 4);

write (c);

inc (i);

end;

until c = #13;

end;

procedure cek_pass;

begin

i := 1;

pass :='';

gotoxy (26, 4);

repeat

c := readkey;

if (c = #08) and (length(pass)<=11) then

begin

if i > 1 then

begin

delete (pass, length(pass), 1);

gotoxy (25 + i, 5);

write (c);

write (#32);

write (c);

dec (i);

end

end else

if ((c<>#13) and (c<>#08)) and (length (pass) < 11) then

begin

pass := pass + c;

gotoxy (25 + i, 5);

write ('*');

inc (i);

end;

until c = #13;

end;

procedure cek_login;

begin

if ( user ='admin') and (pass ='admin') then

begin

gotoxy (10, 10);

write ('LOGIN SUKSES');

end

else

begin

gotoxy (10, 10);

write ('LOGIN GAGAL');

end;

end;

begin

x :

clrscr;

bingkai;

cek_user;

cek_pass;

cek_login;

gotoxy (10, 12);

write ('Apakah ingin mengulag lagi (y/t) : ');

c := readkey;

if upcase (c)='Y' then goto x

else goto y;

y :

end.

 

uses wincrt;

var i, j, k, l, m, n,z :integer;

begin

clrscr;

k:=1;m:=1;z:=5;

for i:=1 to 5 do

begin

n :=1;

gotoxy(k,m); for j:=i to 5 do

begin

if n=z then

begin

for n:=z downto 1 do

write(n);

end else

begin

write(n);

inc(n);

end;end;

inc(k);inc(m);dec(z);end;readkey;end.

uses wincrt;

var

i,j: integer;

Begin

clrscr;

j:=25;

for i:=1 to 25 do

begin

gotoxy(20,i);write(i);

gotoxy(40,i);write(j);

gotoxy(60,i);write(i);

dec(j)

end;

end.