Program JUmlah_Dua_Integer;
Uses Crt;
Const Max = 80;
Type Str80 = string[Max];
Simpul = ^Data;
Data = rECORD
Info : Char;
Kiri,Kanan : Simpul
End;
Var Bilangan1,
Bilangan2,
Bilangan3 : Simpul;
Angka1,
Angka2 : Str80;
I : Integer;
Lagi : char;
Function CEK_BILANGAN(Bil : Str80): boolean;
Var I : Integer;
Angka : set of char;
Valid : boolean;
begin
Angka := ['0'..'9'];
valid := true;
for I :=1 to length(Bil) do
if not(BIL[I] in Angka) then
begin
Valid := False;
I := length(Bil)
end;
Cek_Bilangan := valid;
end;
Procedure Awalan(Var Baru : Simpul);
Begin
New(Baru);
With Baru^ do
begin
Info := char(32);
Kiri := Baru;
Kanan := kiri
end;
end;
Procedure BUAT_LIST(Var List : Simpul;
Bil : Str80);
var I,Cch_Kar,J,Kode : Integer;
Baru : Simpul;
Begin
for I := 1 to length(Bil) do
begin
AWALAN(BARU);
Val(Bil[I],J,Kode);
Baru^.Info :=chr(J);
Baru^.Kiri :=List^.Kiri;
Baru^.Kanan :=List;
List^.Kiri^.Kanan := Baru;
List^.Kiri := Baru;
end;
List^.Info := chr(length(Bil))
end;
Procedure BACA (Kepala : Simpul);
Var Bantu : Simpul; Kode : Integer;
Begin
Bantu := Kepala^.Kanan;
Repeat
Kode := ord(Bantu^.Info);
If Kode = 32 then
Write(' ')
else
Write(Kode);
Bantu := Bantu^.Kanan
Until Bantu = Kepala;
Writeln
End;
Procedure CEK_OPERAND(Var Bil1, Bil2 : Simpul);
Var Jml1,Jml2 : Integer;
Procedure TAMBAH_NOL(Var T : Simpul; C : Integer);
Var Baru : Simpul;
I : Integer;
Begin
For I := 1 to C do
Begin
AWALAN(Baru);
Baru^.Kiri :=T;
Baru^.Kanan := T^.Kanan;
T^.Kanan^.Kiri := Baru;
T^.Kanan := Baru;
T^.Info := chr(ord(T^.Info)+1)
end
end;
begin
jml1 := ord(Bil1^.Info);
jml2 := ord(Bil2^.Info);
if jml1 <> jml2 then
Tambah_Nol(Bil1,Jml1-Jml2)
Else
Tambah_Nol(Bil1,Jml1-Jml1)
End;
Procedure HASIL(Var Bil1, Bil2, Bil3 : Simpul);
Var Sisa, Jumlah, Dgt,Dgt1 : Integer;
Bantu1, Bantu2, Baru : Simpul;
Procedure OPER;
Begin
Baru^.Kanan := Bil3^.Kanan;
Baru^.Kiri := Bil3;
Bil3^.Kanan^.Kiri := Baru;
Bil3^.Kanan := Baru;
End;
Begin
Bantu1 := Bil1^.Kiri;
Bantu2 := Bil2^.Kiri;
Sisa := 0;
{Program proses 2 Bilanagn}
Repeat
Dgt := Ord(Bantu1^.Info);
Dgt1 := Ord(Bantu2^.Info);
if Dgt1 = 32 then Dgt1 :=0;
if Dgt = 32 then Dgt :=0;
Jumlah := Dgt + Dgt1 + Sisa;
If Jumlah >= 10 then
begin
Jumlah := jumlah - 10;
Sisa := 1
end
Else
Sisa := 0;
New(Baru);
Baru^.Info := chr(Jumlah);
Oper;
Bantu1 := Bantu1^.Kiri;
Bantu2 := Bantu2^.Kiri;
Until Bantu1 = Bil1;
If Sisa = 1 then
Begin
AWALAN(Baru);
Baru^.INFO := chr(sisa);
OPER;
AWALAN(Baru); AWALAN(Bantu1);
BARU^.Kanan := Bil1^.Kanan;
BARU^.Kiri := Bil1;
BARU^.Kanan := Baru;
Bantu1^.Kanan := Bil2^.Kanan;
Bantu1^.Kiri := Bil2;
Bil2^.Kanan^.Kiri := Bantu1;
Bil2^.Kanan := Bantu1;
Bil1^.Info := Chr(ord(Bil1^.Info)+1);
end;
end;
{ Program Utama }
Begin
Repeat
clrscr;
Writeln('CONTOH PENGGUNAAN SENARAI BERANTAI PENJUMAHAN 2 BIL');
wRITEln('---------------------------------------------------');
write('Bilangan pertama : ');Readln(Angka1);
write('Bilangan kedua : ');Readln(Angka2);
Writeln;
if CEK_BILANGAN(Angka1) and
CEK_BILANGAN(Angka2) then
begin
Awalan(Bilangan1); Awalan(Bilangan2);
Awalan(Bilangan3);
BUAT_LIST(Bilangan1,Angka1);
BUAT_LIST(Bilangan2,Angka2);
Cek_Operand(Bilangan1,Bilangan2);
HASIL(Bilangan1,Bilangan2,Bilangan3);
Writeln; Writeln('Hasil perhitungan ');
Writeln;
BACA(Bilangan1);BACA(bilangan2);
For I := 1 to ord(Bilangan1^.Info) do
Write('-');
Write(' + ');Writeln;BACA(Bilangan3)
end
Else
Writeln('Ada Karakter tdk sah');
Writeln; Writeln('Akan coba Lagi ? (Y/T) : ');
Readln(Lagi);
Until Not (Lagi in ['Y','y']);
Readln
End.
Selamat Mencoba....
Semoga Berhasil....
Senin, 05 Mei 2014
Membuat List dengan Pascal
09.02
No comments
Langganan:
Posting Komentar (Atom)
0 komentar:
Posting Komentar