Rabu, 18 Agustus 2010

Source code Program Pascal

Ini adalah source code program pascal yang saya buat silahkan di copy paste dan di Run di program Turbo Pascal Anda.

Program PenjumlahanMatriks;
uses
Wincrt;
var m1,m2,mp:array[1..10,1..10] of integer;
i,j,k,l:integer;
begin
{Menginput nilai matriks}
writeln('Matriks ke 1');
for i:=1 to 3 do
for j:=1 to 3 do
begin
write('m1[',i,',',j,'] : ');readln(m1[i,j]);
end;
writeln;
writeln('Matriks ke 2');
for i:=1 to 3 do
for j:=1 to 3 do
begin
write('m2[',i,',',j,'] : ');readln(m2[i,j]);
end;
writeln;
{jumlahkan}
begin
for i:=1 to 3 do
for j:=1 to 3 do
begin
mp[i,j]:=m1[i,j]+m2[i,j];
end;
{lukis hasil penjumlahan}
writeln('Hasil Penambahan = ');
writeln;
for i:=1 to 3 do
begin
writeln;
for j:=1 to 3 do
write(mp[i,j],' ');
end;
readln;
end;
end.

-------------------------------------------------------------------------------------
program Jumlah_Matrik;
uses
WinCRT;
const
Orde = 3;
type
Matrik = array[1..orde,1..orde] of integer;
var
M1, M2, H : matrik;
I, J : integer;
procedure Awal;
begin
Writeln('Tugas Penjumlahan Matriks');
Writeln('------------------------------------');
Writeln;
Writeln('Nama : Moch. Sony. S');
Writeln('NIM : 063020017');
Writeln('Prodi: Teknik Kimia');
Writeln;
end;
procedure JumlahMatrik(var Mat1, Mat2, MatHasil : matrik);
begin
for I := 1 to orde do
for J := 1 to orde do
MatHasil[I,J] := Mat1[I,J] + Mat2[I,J];
end;
procedure BacaData(var Mat : matrik);
begin
for I := 1 to orde do
for J := 1 to orde do
begin
Write('Nilai[',I,',',J,'] = ');
Readln(Mat[I,J]);
end;
end;
procedure TulisMatrik(var Mat : matrik);
begin
for I := 1 to orde do
begin
for J := 1 to orde do
begin
Write(Mat[I,J]:5);
end;
Writeln;
end;
end;
begin

ClrScr;
Awal;
Writeln('Isi matrik pertama :');
BacaData(M1);
Writeln;
Writeln('Isi matrik kedua :');
BacaData(M2);
Writeln;
JumlahMatrik(M1, M2, H);
Writeln('Penjumlahan matrik pertama dan kedua :');
TulisMatrik(H);
Writeln;
Write('Tekan Enter...');
Readln;
end.

-------------------------------------------------------------------------------------
Program PerkalianMatriks;
uses
Wincrt;
type
mtrx = array[1..50,1..50] of integer;
var
mtrxa,mtrxb,mtrxc : mtrx;
l,m,n,o : integer;
Procedure Input(var a:mtrx;b,c:integer);
var s,k:integer;
begin
for s:=1 to b do
begin
for k:=1 to c do
begin
Write('Elemen [',s,',',k,'] : ');
Readln(a[s,k]);
end;
end;
end;
Procedure perkalian(var a,b,p:mtrx;d,e,f,g:integer);
var s,k,c,i:integer;
begin
for s:=1 to d do
begin
for k:=1 to g do
begin
p[s,k] := 0;
for c:=1 to e do
begin
p[s,k] := p[s,k] + a[s,c] * b[c,k];
end;
end;
end;
for s:=1 to d do
begin
for k:=1 to e do
begin
write(p[s,k]:3);
end;
writeln;
end;
end;
begin
Clrscr;
Writeln('Program Perkalian Matriks');
Writeln('Matriks I');
Write('Inputkan Banyaknya Baris : ');
Readln(l);
Write('Inputkan Banyaknya Kolom : ');
Readln(m);
Writeln('Program Perkalian Matriks');
Writeln('Matriks II');
Write('Inputkan Banyaknya Baris : ');
Readln(n);
Write('Inputkan Banyaknya Kolom : ');
Readln(o);
if(m <> n) then
begin
Write('Tidak Terdefinisi');
exit;
end
else
begin
clrscr;
Writeln('Matriks I');
Input(mtrxa,l,m);
Writeln;
Writeln('Matriks II');
Input(mtrxb,n,o);
perkalian(mtrxa,mtrxb,mtrxc,l,m,n,o);
end;
readln;
end.

-------------------------------------------------------------------------------------
Program PersamaanKuadrat;
uses wincrt;
var a,b,c,d,x1,x2 :real;
begin
clrscr;
writeln('Menghitung akar-akar persamaan kuadrat');
writeln('Nilai a,b,c dimasukkan dengan jeda spasi');
write('Masukkan nilai a,b,c:');
readln(a,b,c);
d:=(b*b) - (4*a*c);
if d < x1 ="',x1:6:2);" x2 ="',x2:6:2);" a="0">0 then

begin

writeln('persamaan kuadrat ini memiliki akar yang berbeda');

x1:= (-b+sqrt(d))/(2*a);

x2:= (-b-sqrt(d))/(2*a);

writeln('akar-akarnya:',x1:3:2,' dan ',x2:3:2);

end

else if d=0 then

begin

writeln('punya akar kembar');

x1:= -b/(2*a);

writeln ('akar-akarnya:',x1:3:2);

end

else

writeln ('persamaan kuadrat anda berakar kompleks');

end;

end.

Free Download Turbo Pascal For Windows, silakan di download dibawah:

Tidak ada komentar:

Posting Komentar