facebook rss daftar isi halaman depan

Laman

Sabtu, 30 Oktober 2010

pascal

nusinau.com
baca - pascal

array

uses wincrt;

var x : array[1..3] of string;
a : integer;
begin
for a := 1 to 3 do begin
write('input ', a, ' : ');
readln(x[a]);
end;

writeln;
write('output : ');
for a := 1 to 3 do
write(x[a],' ');
end.



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.





Var Nama : String
Nilai : Char



program aljan;

Uses winCrt;
Var
nil1 : Array[1..100] of Integer;
n,i,j,dum : Integer;
Begin
ClrScr;
Write('mau isi berapa data acak (integer) ='); readln(n);
For i := 1 to n Do
Begin
Write('Data Ke ',i,':');Readln(nil1[i]);
End;

{* penyapuan proses}
for i:= 1 to n-1 do
begin
for j:= i to n do
begin
if nil1[j]
begin
dum:=nil1[j];
nil1[j]:=nil1[i];
nil1[i]:=dum;
end;
end;
end;
writeln;
writeln('Hasil Sortir');
for i := 1 to n do
write(nil1[i]:3);
readln;
end.





uses wincrt;
type
Mahasiswa = Record
Nama :string[30];
NIM :string[10];
Alamat :string[50];
end;
var
mhs:Mahasiswa;
Begin
clrscr;
write('Nama : ');readln(Mhs.Nama);
write('NIM : ');readln(Mhs.NIM);
write('Alamat : ');readln(Mhs.Alamat);
writeln;
writeln('Nama Anda : ',Mhs.Nama);
writeln('NIM Anda : ',Mhs.NIM);
writeln('Alamat Anda : ',Mhs.Alamat);
end.





USES WINCRT;
TYPE DATA = RECORD
NAMA : STRING[25];
ALAMAT : STRING[30];
JK : STRING ;
TELP : STRING [10];
TANGGALLAHIR : STRING[20] ;
END;
VAR
a : data;
JAWABAN : CHAR;
BEGIN
REPEAT
CLRSCR;
BEGIN
WRITE ('NAMA :');READLN(a.NAMA);
WRITE ('ALAMAT :');READLN (a.ALAMAT);
WRITE ('JK ;');READLN (a.JK);
WRITE ('TELP :');READLN (a.TELP);
WRITE ('TANGGAL LAHIR :');READLN (a.TANGGALLAHIR);
WRITELN;
WRITELN('NAMA ANDA :',a.NAMA);
WRITELN ('ALAMAT ANDA : ',a.ALAMAT);
WRITELN ('JK :',a.JK);
WRITELN ('TELP :',a.TELP);
WRITELN ('TANGGAL LAHIR :', a.TANGGALLAHIR);
WRITELN ('APAKAH ANDA AKAN ENTRI DATA LAGI(Y/T):');
READLN(JAWABAN);
end;
UNTIL (JAWABAN='T');
end.




program arrayku;
uses wincrt;
var angka:array[1..100] of integer;
i,n:integer;
begin
clrscr;
writeln('Jumlah data : ');readln(n);
for i:=1 to n do
begin
writeln('Masukkan angka ke-',i,':');readln(angka[i]);
end;
writeln;
for i:=1 to n do writeln('Angka ke-',i,':',angka[i]);
End.



Program Mencari_Bilangan_Prima_Dengan_Array;
Uses Crt;
Var
Prima : Array[1..100] of Integer;
i,j : Integer;
bil : Integer;
Begin
ClrScr;
For i := 2 to 100 Do
Begin
Prima[i]:=i;
For j:= 2 to i-1 Do
Begin
bil := (i mod j); {* i dibagi j dicek apakah 0*}
If bil = 0 then Prima[i]:=0; {*jika habis dibagi,berarti bkn prima*}
End;
If Prima[i] <> 0 Then Write(Prima[i],' '); {*cetak array yg prima*}
End;
Readln;
End.
baca - array

input nilai

Program Input_nilai_mhs;
Uses WinCrt;
Const
garis='-------------------------------------------------------------------------------';
Var
nil1,nil2 : Array [1..10] Of 0..100; {Array dgn Type subjangkauan}
nim : Array [1..10] Of String [8];
nama : Array [1..10] Of String [50];
n,i,bar : Integer;
jum : Real;
tl : Char;
Begin
ClrScr;
{ pemasukan data dalam array }
Writeln ('Maximize dulu windows anda,');
Writeln ('untuk mendapat hasil yang maksimal!!!');
Write ('Berapa Data Mahasiswa yang aka diinput :');
Readln (n);
For i:= 1 To n Do
Begin
ClrScr;
GotoXY(30,4+1); Write('Data Ke-:',i:2);
GotoXY(10,5+i); Write('NIM :'); Readln(nim[i]);
GotoXY(10,6+i); Write('Nama :'); Readln(nama[i]);
GotoXY(10,7+i); Write('Nilai 1 :'); Readln(nil1[i]);
GotoXY(10,8+i); Write('Nilai 2 :'); Readln(nil2[i]);
End;
{ proses data dalam array }
ClrScr;
GotoXY(5,4); Write(Garis);
GotoXY(5,5); Write ('No');
GotoXY(9,5); Write ('NIM');
GotoXY(18,5); Write ('Nama');
GotoXY(38,5); Write ('Nilai 1');
GotoXY(45,5); Write ('Nilai 2');
GotoXY(52,5); Write ('Rata');
GotoXY(59,5); Write ('Abjad');
GotoXY(5,6); Write (Garis);
{ proses Cetak isi array dan seleksi kondisi }
bar := 7;
For i:= 1 To n Do
Begin
jum:=(nil1[i]+nil2[i])/2;
If jum>= 90 Then tl:='A'
Else
If jum>80 Then tl:='B'
Else
If jum>60 then tl:='C'
Else
If jum >50 Then tl:='D'
Else
tl:='E';
{ cetak hasil yang disimpan di array dan hasil }
{ penyeleksian kondisi }
GotoXY(5,bar); Writeln(i:2);
GotoXY(9,bar); Writeln (NIM[i]);
GotoXY(18,bar); Writeln (NAMA[i]);
GotoXY(38,bar); Writeln (NIL1[i]:4);
GotoXY(45,bar); Writeln (NIL2[i]:4);
GotoXY(52,bar); Writeln (jum:5:1);
GotoXY(59,bar); Writeln (tl);
bar:=bar+1;
End;
GotoXY(5,bar+1);Writeln(garis);
Readln;
End.
baca - input nilai

rata-rata

uses wincrt;

var a, siswa : integer;
nilai, total, tinggi, rendah, rata : real;

begin
total := 0;
write ('jumlah siswa : '); readln (siswa);
writeln;
for a := 1 to siswa do
begin
write ('nilai siswa ke ',a,' : '); readln (nilai);
total := total + nilai;
if a = 1 then begin
tinggi := nilai;
rendah := nilai;
end
else begin
if nilai > tinggi then tinggi := nilai
else begin
if nilai < rendah then rendah := nilai;
end;
end;
end;
rata := total / siswa;
writeln;
writeln ('nilai terendah : ', rendah :1:2);
writeln ('nilai tertinggi : ', tinggi :1:2);
writeln ('rata-rata : ',rata :1:2);
end.
baca - rata-rata

pascal

uses wincrt;
var a: integer;
ket: string;
begin
write ('suhu : '); readln (a);
if a <= 0 then
ket :='padat'
else
if (a > 0) and (a < 100) then
ket :='cair'
else
if a >=100 then
ket :='gas';
writeln('Air pada suhu tersebut berbentuk',' ',ket);
end.
baca - pascal

segitiga pascal

program bintang_piramid;
uses wincrt;

var c,a,b,n : integer;
begin
write ('masukkan angka : ');readln(n);
writeln;
if n mod 2 = 0 then
for a := 1 to (n div 2) do begin
for b := 1 to (n div 2)-a do
write (' ');
for c := 1 to (a*2) do
write ('*');
writeln;
end
else
for a := 1 to (n div 2)+1 do begin
for b := 1 to (n div 2)+(1-a) do
write (' ');
for c := 1 to (a*2)-1 do
write ('*');
writeln;
end;
end.
baca - segitiga pascal

konveksi suhu

Program Konversi_Suhu;
Uses WinCrt;

var f,c,r : real;
a,ul : char;

procedure farein_celcius;
begin
Writeln('Program Konversi Fareinheit Ke Celcius');
Writeln('======================================');
Writeln;
Write('Masukan Suhu dalam Farenheit: ');readln(f);
c:=5/9*(f-32);
Writeln;
Writeln('Jadi Suhu Dalam Celcius Adalah: ',c:4:2);
end;

procedure farein_reamur;
begin
Writeln('Program Konversi Fareinheit Ke Reamur');
Writeln('=====================================');
Writeln;
Write('Masukan Suhu dalam Farenheit: ');readln(f);
r:=4/9*(f-32);
Writeln;
Writeln('Jadi Suhu Dalam Reamur Adalah: ',r:4:2);
end;

procedure celcius_farein;
begin
Writeln('Program Konversi Celcius Ke Fareinheit');
Writeln('======================================');
Writeln;
Write('Masukan Suhu dalam Celcius: ');readln(c);
f:=(9/5)*c+32;
Writeln;
Writeln('Jadi Suhu Dalam Fareinheit Adalah: ',f:4:2);
end;

procedure celcius_reamur;
begin
Writeln('Program Konversi Celcius ke Reamur');
Writeln('==================================');
Writeln;
Write('Masukan Suhu dalam Celcius: ');readln(c);
r:=(4/5)*c;
Writeln;
Writeln('Jadi Suhu Dalam Reamur Adalah: ',r:4:2);
end;

procedure reamur_celcius;
begin
writeln('Program Konversi Reamur ke Celcius');
Writeln('==================================');
Writeln;
Write('Masukan Suhu dalam Reamur: ');readln(r);
c:=(5/4)*r;
Writeln;
Writeln('Jadi Suhu Dalam Celcius Adalah: ',c:4:2);
end;

procedure reamur_farein;
begin
writeln('Program Konversi Reamur ke Fareinheit');
Writeln('=====================================');
Writeln;
Write('Masukan Suhu dalam Reamur: ');readln(r);
f:= (9/4)*r+32;
Writeln;
Writeln('Jadi Suhu Dalam Fareinheit Adalah: ',f:4:2);
end;

begin
repeat
clrscr;
writeln ('Program konversi suhu');
writeln;
writeln ('1. fareinheit - celcius');
writeln ('2. fareinheit - reamur');
writeln ('3. celcius - reamur');
writeln ('4. celcius - fareinheit');
writeln ('5. reamur - celcius');
writeln ('6. reamur - farenheit');
writeln;
write ('pilih nomor konversi : '); read (a);
writeln;
case a of
'1' : farein_celcius;
'2' : farein_reamur;
'3' : celcius_reamur;
'4' : celcius_farein;
'5' : reamur_celcius;
'6' : reamur_farein;
else
writeln ('Nomor yang anda masukkan salah');
end;
Writeln;Writeln;
Write('Mau Coba Lagi [Y/T]: ');Readln(ul);
Until Upcase(ul) = 'Y';
End.
baca - konveksi suhu

pascal

uses wincrt;
var x,y,hasil:real;
jawab:char;
begin
write ('masukan angka ke-1:');readln (x);
write ('pilih operator: (+)/(-)/(*)/(/)');readln (jawab);
write ('masukan angka ke-2:');readln (y);
if ( jawab= '+') then
begin
hasil:= x+y
end;
if ( jawab = '-') then
begin
hasil:= x-y
end;
if ( jawab = '*') then
begin
hasil:= x*y
end;
if (jawab='/') then
begin
hasil:= x/y
end;
write ('hasilnya: ',(hasil):5:2);
end.
baca - pascal