Featured
Home
Posts filed under PEMROGRAMAN
Showing posts with label PEMROGRAMAN. Show all posts
Showing posts with label PEMROGRAMAN. Show all posts
Thursday, 18 July 2013
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.
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.
Subscribe to:
Posts (Atom)
