Guesuper
20th November 2011, 12:57 AM
Bismillah..Assalammualaikum agan2....
mohon bantuannya jika ada yang berkenan.....
ane sangat baru dalam pemrograman delphi visual (selalu pake console). ane punya tugas buat form, tapi ane kurang paham dengan aturan visual. kesulitannya adalah mentransfer console ke visual....
ane sudah punya script consolenya
Quote:
program InsertFirstLast;
{$APPTYPE CONSOLE}
uses
SysUtils;
Type node = ^data;
data = record
nama : string; {tipe data info}
next : node;
end;
linkedlist = record
first : node
end;
procedure InputData(var keterangan:string);
begin
write('Masukan Data : ');
readln(keterangan);
end;
function createlist:node;
var p:node;
keterangan:string;
begin
InputData(keterangan);
New(P);
P^.nama := keterangan;
P^.next := nil;
createlist:=P;
end;
procedure InsertFirst(var L:linkedlist;p:node);
begin
P^.next := L.first;
L.first := P;
end;
procedure ListTraversal(L:linkedlist);
var p:node;
begin
P:=L.first;
while (Pnil) do
begin
write(P^.nama:7);
P := P^.next;
end;
writeln;
end;
Procedure InsertAfter(var prec:node;baru:node);
begin
baru^.next := prec^.next;
prec^.next := baru;
end;
procedure InsertLast(var L:linkedlist;p:node);
var Last : node;
begin
if (L.first=nil) then
InsertFirst(L,P)
else
begin
Last := L.first;
while (Last^.nextnil) do
begin
Last:=last^.next;
end;
InsertAfter(Last,P);
end;
end;
procedure InsertBefore(var L:linkedlist;baru:node;x:string);
var P,precP : node;
Found : boolean;
begin
Found := false;
PrecP :=nil;
P :=L.first;
while(pnil) and (not found) do
begin
if p^.nama = x then
begin
baru^.next:=P;
PrecP.next:=baru;
Found :=true;
end
else
begin
PrecP := P;
P := P^.next;
end;
end;
end;
procedure DeleteFirst(var L:linkedlist);
var P: node;
begin
if (L.first nil) then
begin
P:=L.first;
L.first := L.first^.next;
Dispose(p);
end;
end;
procedure DeleteAfter(var prec:node);
var P: node;
begin
if (prec^.next nil) then
begin
P:= prec^.next;
prec^.next:= prec^.next^.next;
Dispose(p);
end;
end;
procedure ListSearch(var L:linkedlist;DataCari:string);
var found :boolean;
P : node;
begin
found:=false;
P:=L.first;
while(P.nextnil) and (not found) do
begin
if P^.nama = DataCari then
Found :=true
else
P := P^.next;
end;
if found = true then
writeln(P^.nama+', Data ketemu ')
else
writeln(DataCari+', Data TIDAK ketemu ');
end;
procedure DeleteLast(var L:linkedlist);
var Last, precLast,P: node;
begin
if (L.first nil) then
begin
Last :=L.first;
PrecLast :=nil;
while (Last^.nextnil) do
begin
PrecLast :=Last;
Last :=Last^.next;
end;
P:=last;
if (precLast=nil) then
L.first:=nil
else precLast^.next :=nil;
Dispose(p);
end;
end;
var pilih:integer;
baru : node;
L:linkedlist;
data_cari:string;
begin
repeat
writeln('MENU ');
writeln('1. Masukan Data dari Depan (INSERT FIRST)');
writeln('2. Masukan Data dari Akhir (INSERT LAST)');
writeln('3. Masukan Data Setelah (INSERT BEFORE)');
writeln('4. Hapus Data dari Depan (DELETE FIRST)');
writeln('5. Hapus Data dari Akhir (DELETE LAST)');
writeln('6. Cari Data (LIST SEARCH)');
writeln('7. Tampilkan Data (DISPLAY LIST)');
writeln('8. Keluar ');
write('Masukan pilihan anda : ');
readln(pilih);
case(pilih) of
1: begin
writeln('Masukan Data dari Depan (INSERT FIRST)');
baru:=createlist;
InsertFirst(L,baru);
end;
2: begin
writeln('Masukan Data dari Akhir (INSERT LAST)');
baru:=createlist;
InsertLast(L,baru);
end;
3: begin
writeln('Masukan Data Sebelum (INSERT BEFORE)');
baru:=createlist;
write('Sisipkan Data Sebelum ');
readln(data_cari);
InsertBefore(L,baru,data_cari);
end;
4: begin
writeln('Hapus Data dari Depan (DELETE FIRST)');
DeleteFirst(L);
writeln('Data Sudah Terhapus');
end;
5: begin
writeln('Hapus Data dari Akhir (DELETE LAST)');
DeleteLast(L);
writeln('Data Sudah Terhapus');
end;
6: begin
writeln('Percarian Data (LIST SEARCH)');
write('Masukan Data yang dicari : ');
readln(data_cari);
ListSearch(L,data_cari);
end;
7: begin
writeln('Tampilan Data');
writeln('=============');
ListTraversal(L);
end;
end;
until pilih=8;
end.
di konversi ke dalam bentuk visual seperti ini :
http://i744.photobucket.com/albums/xx90/youanda/visual.png
Terima Kasih Sebelumnya http://static.kaskus.us/images/smilies/sumbangan/004.gifmatabelo:hope:
</div>
mohon bantuannya jika ada yang berkenan.....
ane sangat baru dalam pemrograman delphi visual (selalu pake console). ane punya tugas buat form, tapi ane kurang paham dengan aturan visual. kesulitannya adalah mentransfer console ke visual....
ane sudah punya script consolenya
Quote:
program InsertFirstLast;
{$APPTYPE CONSOLE}
uses
SysUtils;
Type node = ^data;
data = record
nama : string; {tipe data info}
next : node;
end;
linkedlist = record
first : node
end;
procedure InputData(var keterangan:string);
begin
write('Masukan Data : ');
readln(keterangan);
end;
function createlist:node;
var p:node;
keterangan:string;
begin
InputData(keterangan);
New(P);
P^.nama := keterangan;
P^.next := nil;
createlist:=P;
end;
procedure InsertFirst(var L:linkedlist;p:node);
begin
P^.next := L.first;
L.first := P;
end;
procedure ListTraversal(L:linkedlist);
var p:node;
begin
P:=L.first;
while (Pnil) do
begin
write(P^.nama:7);
P := P^.next;
end;
writeln;
end;
Procedure InsertAfter(var prec:node;baru:node);
begin
baru^.next := prec^.next;
prec^.next := baru;
end;
procedure InsertLast(var L:linkedlist;p:node);
var Last : node;
begin
if (L.first=nil) then
InsertFirst(L,P)
else
begin
Last := L.first;
while (Last^.nextnil) do
begin
Last:=last^.next;
end;
InsertAfter(Last,P);
end;
end;
procedure InsertBefore(var L:linkedlist;baru:node;x:string);
var P,precP : node;
Found : boolean;
begin
Found := false;
PrecP :=nil;
P :=L.first;
while(pnil) and (not found) do
begin
if p^.nama = x then
begin
baru^.next:=P;
PrecP.next:=baru;
Found :=true;
end
else
begin
PrecP := P;
P := P^.next;
end;
end;
end;
procedure DeleteFirst(var L:linkedlist);
var P: node;
begin
if (L.first nil) then
begin
P:=L.first;
L.first := L.first^.next;
Dispose(p);
end;
end;
procedure DeleteAfter(var prec:node);
var P: node;
begin
if (prec^.next nil) then
begin
P:= prec^.next;
prec^.next:= prec^.next^.next;
Dispose(p);
end;
end;
procedure ListSearch(var L:linkedlist;DataCari:string);
var found :boolean;
P : node;
begin
found:=false;
P:=L.first;
while(P.nextnil) and (not found) do
begin
if P^.nama = DataCari then
Found :=true
else
P := P^.next;
end;
if found = true then
writeln(P^.nama+', Data ketemu ')
else
writeln(DataCari+', Data TIDAK ketemu ');
end;
procedure DeleteLast(var L:linkedlist);
var Last, precLast,P: node;
begin
if (L.first nil) then
begin
Last :=L.first;
PrecLast :=nil;
while (Last^.nextnil) do
begin
PrecLast :=Last;
Last :=Last^.next;
end;
P:=last;
if (precLast=nil) then
L.first:=nil
else precLast^.next :=nil;
Dispose(p);
end;
end;
var pilih:integer;
baru : node;
L:linkedlist;
data_cari:string;
begin
repeat
writeln('MENU ');
writeln('1. Masukan Data dari Depan (INSERT FIRST)');
writeln('2. Masukan Data dari Akhir (INSERT LAST)');
writeln('3. Masukan Data Setelah (INSERT BEFORE)');
writeln('4. Hapus Data dari Depan (DELETE FIRST)');
writeln('5. Hapus Data dari Akhir (DELETE LAST)');
writeln('6. Cari Data (LIST SEARCH)');
writeln('7. Tampilkan Data (DISPLAY LIST)');
writeln('8. Keluar ');
write('Masukan pilihan anda : ');
readln(pilih);
case(pilih) of
1: begin
writeln('Masukan Data dari Depan (INSERT FIRST)');
baru:=createlist;
InsertFirst(L,baru);
end;
2: begin
writeln('Masukan Data dari Akhir (INSERT LAST)');
baru:=createlist;
InsertLast(L,baru);
end;
3: begin
writeln('Masukan Data Sebelum (INSERT BEFORE)');
baru:=createlist;
write('Sisipkan Data Sebelum ');
readln(data_cari);
InsertBefore(L,baru,data_cari);
end;
4: begin
writeln('Hapus Data dari Depan (DELETE FIRST)');
DeleteFirst(L);
writeln('Data Sudah Terhapus');
end;
5: begin
writeln('Hapus Data dari Akhir (DELETE LAST)');
DeleteLast(L);
writeln('Data Sudah Terhapus');
end;
6: begin
writeln('Percarian Data (LIST SEARCH)');
write('Masukan Data yang dicari : ');
readln(data_cari);
ListSearch(L,data_cari);
end;
7: begin
writeln('Tampilan Data');
writeln('=============');
ListTraversal(L);
end;
end;
until pilih=8;
end.
di konversi ke dalam bentuk visual seperti ini :
http://i744.photobucket.com/albums/xx90/youanda/visual.png
Terima Kasih Sebelumnya http://static.kaskus.us/images/smilies/sumbangan/004.gifmatabelo:hope:
</div>