Showing posts with label PEMROGRAMAN. Show all posts
Showing posts with label PEMROGRAMAN. Show all posts

Thursday, 18 July 2013

MARHABAN YA RAMADHAN

Lama sekali tidak ngeposting dan kali ini baru nyadar blog belum ada postingan baru, kali ini cuma bisa posting tentang pusas Maap ye kalau punya@ salah
Selamat Menunaikan Ibadah Puasa
                                              BINTANG RIZKY GILANG RAMADHAN

Tuesday, 3 January 2012

listing program animasi dengan turbo pascal


MASIH DALAM RANGKA TAHUN BARU 2012 SAYA MASIH AKAN MEMBERIKAN POSTINGAN TENTANG PEMROGRAMAN DENGAN APLIKASI TURBO PASCAL
dan di bawah ini cntohnya listing program animasi menggunakan turbo pascal silahkan di copas listing programnya


uses wincrt;
type
point=^rec;
rec=record
isi:char;
next:point;
end;
queue=record
head:point;
tail:point;
end;
var
q:queue;
i,k:byte;


procedure selang;
var y:byte;
begin
gotoxy(37,8);write('\\         //');
for i:=1 to 10 do
begin
gotoxy(37,8+i);
if i=10 then write('|____   ____|')else write('|           |');
end;
gotoxy(39,19);write(' ');
gotoxy(59,21);write('\');
gotoxy(59,23);write('/');
end;

function empty:boolean;
begin
if q.head=nil then empty:=true
else
empty:=false;
end;

function full:boolean;
begin
if i=10 then
full:=true
else full:=false;
end;


procedure waktu;
var
i:longint;
begin
for i:=1 to 5000000 do
begin
i:=i;
end;
end;

procedure waktu2;
var
i:longint;
begin
for i:=1 to 90055000 do
begin
i:=i;
end;
end;

procedure create;
begin
q.head:=nil;
q.tail:=nil;
end;



procedure enqueue;
var
now:point;
begin
if full then
begin
gotoxy(1,6);write('queue wis penuh!!!');
waktu2;
gotoxy(1,6);clreol;
end else
begin
new(now);
gotoxy(1,6);clreol;write('Masukkan sembarang karakter = ');
now^.isi:=readkey;write(now^.isi);
now^.next:=nil;
for k:=1 to 12 do
begin
gotoxy(k+30,7);write(' ');
gotoxy(k+31,7);write(now^.isi);waktu;
end;
for k:=1 to 11 - i do
begin
gotoxy(43,k+6);write(' ');
gotoxy(43,k+7);write(now^.isi);waktu;
end;
inc(i);
gotoxy(1,7);clreol;
if empty then
begin
q.head:=now;
q.tail:=now;
end else
begin
q.tail^.next:=now;
q.tail:=now;
end;
end;
end;

procedure dequeue;
var u:byte;
now:point;
begin
if empty then
begin
gotoxy(1,6);write('queue kosong lo....');
waktu2;
gotoxy(1,6);clreol;
end else
begin
gotoxy(1,6);write('Hurup terbawah dikeluarkan....');
for k:=19 to 12 do
begin
gotoxy(43,k-1);write(' ');
gotoxy(43,k);write(q.head^.isi);waktu;
end;
for k:=43 to 53 do
begin
gotoxy(k,22);write(' ');
gotoxy(k+1,22);write(q.head^.isi);waktu;
end;
now:=q.head;
q.head:=q.head^.next;
dispose(now);
dec(i);
now:=q.head;
k:=18;
while now <> nil do
begin
gotoxy(43,k);write(now^.isi);
now:=now^.next;
dec(k);
end;
gotoxy(43,k);write(' ');
waktu;
end;
end;


{procedure create;
begin
q.head:=nil;
q.tail:=nil;
end; }

procedure clear;
begin
while not empty do dequeue;
end;



procedure menu;
var jawab:char;
begin
i:=0;
gotoxy(1,2);write('1. Enqueue');
gotoxy(1,3);write('3. Dequeue');
gotoxy(1,4);write('3. Quit');
create;
repeat
gotoxy(1,5);clreol;write('Pilihan[1/2/3]=');
jawab:=readkey;write(jawab);
case jawab of
'1':Enqueue;
'2':Dequeue;
end;
until jawab='3';
clrscr;
write('Program Selesai');
end;

BEGIN
clrscr;
selang;
menu;
end.



Monday, 2 January 2012

cara buat listing Program Animasi Bergerak dengan TURBO PASCAL

MASIH DALAM AREA TAHUN BARU SAYA AKAN MEMBERIKAN BEBERAPA LISTING PROGRAM DENGAN MENGGUNAKAN TURBO PASKAL PADA SAAT KULIAH PEMROGRAMAN PASCAL DI STMIK AMIKOM PURWOKERTO tempat saya berkuliah kuliah diwaktu semester 1 dan alhamdulilah sekarang saya sudah memasuki semester 3 dan maju terus STMIK AMIKOM PURWOKERTO TETAP JAYA
dan ini contohnya silahkan di COPAS ke aplikasi turbo pascal anda semoga bermanfaat tanks from DOKTERS BAND jangan lupa di kasih komentar

Program Animasi_Bergerak;
Uses wintypes,winprocs,wincrt;
var
a : integer;
Procedure
Delay (msec : integer);
var
time : longint;
msg : tmsg;
Begin
time := gettickcount;
inc (time,msec);

while gettickcount < time do
Begin
If peekmessage (msg,0,0,0,pm_remove) then
Begin
If msg.message = wm_quit then
Begin
postquitmessage (msg.wparam);
exit
end;
translatemessage (msg);
dispatchmessage (msg)

end;
end;
end;
Begin
For A :=1 to 11 do
Begin

clrscr;
GotoXY(A,10);Write('5 ULUL AZMI ');
Delay (100);

End;
For A :=11 to 22 do
Begin

clrscr;
GotoXY(A,9);Write(' NABI MUHAMMAD SAW');
Delay (100);

End;
For A :=22 to 33 do
Begin

clrscr;
GotoXY(A,8);Write(' NABI NUH AS');
Delay (100);

End;
For A :=33 to 44 do
Begin

clrscr;
GotoXY(A,9);Write(' NABI ISYA AS');
Delay (100);

End;
For A :=44 to 55 do
Begin
clrscr;

GotoXY(A,10);Write('NABI MUSA AS');
Delay (100);
End;
For A :=44 Downto 33 do

Begin
clrscr;
GotoXY(A,11);Write('NABI IBROHIM AS');
Delay (100);
End;
For A :=33 Downto 22 do
Begin

clrscr;
GotoXY(A,12);Write('BERJUANG DI JALAN ALLOH SWT ');
Delay (100);

End;
For A :=22 Downto 1 do
Begin

clrscr;
GotoXY(A,11);Write('ALLAHHU AKBAR');
Delay (100);

End;
For A :=1 to 29 do
Begin

clrscr;
GotoXY(A,9);Write('BINTANG JAYA KOMPUTER PURBALINGGA '');
Delay (100);

End;
For A :=29 to 48 do
Begin
GotoXY(A,8);Write('*');Delay (50);
GotoXY(A,10);Write('*');Delay (50);

End;
For A :=20 to 20 do
Begin
GotoXY(A,12);Write('BINTANG JAYA KOMPUTER PURBALINGGA');

End;
For A :=20 to 20 do
Begin
GotoXY(A,14);Write(' E-Mail : stmik_ikmi@yahoo.com');

End;
For A :=20 to 20 do
Begin
GotoXY(A,16);Write(' Website : http://www.ikmi.ac.id');
End;
End.