uses crt;

label
habis, lanjut;

const
max_panjang = 100;
batas_x = 80;
batas_y = 25;
speed   = 200;

type
tempat = record
x, y : integer;
end;

var
ekor : array[1..max_panjang] of tempat;
ujung, makanan : tempat;
tkn : char;
i,pjg,skor,spd  : integer;
mati : boolean;

procedure atur_posisi;
begin
ujung.x := ekor[pjg].x;
ujung.y := ekor[pjg].y;
for i:=pjg downto 2 do begin
ekor[i].x := ekor[i-1].x;
ekor[i].y := ekor[i-1].y;
end;
gotoxy(ekor[2].x, ekor[2].y); write(‘#’);
gotoxy(ekor[2].x, ekor[2].y); write(‘#’);
gotoxy(ekor[pjg-1].x, ekor[pjg-1].y); write(‘#’);
gotoxy(ujung.x, ujung.y); write(‘ ‘);
for i:=3 to pjg do if((ekor[2].x=ekor[i].x) and (ekor[2].y=ekor[i].y)) then mati:=true;
delay(speed-spd);
end;

procedure makan;
var beda : boolean;
begin
inc(skor,5);
gotoxy(10,26); write(‘Skor = ‘,skor);
repeat
beda := true;
makanan.x := random(batas_x-2)+2;
makanan.y := random(batas_y-2)+2;
for i:=1 to pjg do
if((makanan.x=ekor[i].x) and (makanan.y=ekor[i].y)) then beda:=false;
until beda;
gotoxy(makanan.x, makanan.y); write(‘o’);
inc(pjg);
inc(spd,2);
end;

procedure bergerak(c : char);
begin
if c = ‘d’ then begin
repeat
if((ekor[1].x = makanan.x) and (ekor[1].y = makanan.y)) then makan;
ekor[1].x := ekor[1].x+1;
atur_posisi;
if (ekor[1].x = batas_x) or (ekor[1].y = batas_y) or (ekor[1].x = 1) or (ekor[1].y = 1) then mati := true;
until keypressed or mati;
if mati then exit;
tkn:=readkey;
if tkn = ‘a’ then tkn:=’d’;
end
else if c = ‘s’ then begin
repeat
if((ekor[1].x = makanan.x) and (ekor[1].y = makanan.y)) then makan;
ekor[1].y := ekor[1].y+1;
atur_posisi;
if (ekor[1].x = batas_x) or (ekor[1].y = batas_y) or (ekor[1].x = 1) or (ekor[1].y = 1) then mati := true;
until keypressed or mati;
if mati then exit;
tkn:=readkey;
if tkn = ‘w’ then tkn:=’s’;
end
else if c = ‘w’ then begin
repeat
if((ekor[1].x = makanan.x) and (ekor[1].y = makanan.y)) then makan;
ekor[1].y := ekor[1].y-1;
atur_posisi;
if (ekor[1].x = batas_x) or (ekor[1].y = batas_y) or (ekor[1].x = 1) or (ekor[1].y = 1) then mati := true;
until keypressed or mati;
if mati then exit;
tkn:=readkey;
if tkn = ‘s’ then tkn:=’w’;
end
else if c = ‘a’ then begin
repeat
if((ekor[1].x = makanan.x) and (ekor[1].y = makanan.y)) then makan;
ekor[1].x := ekor[1].x-1;
atur_posisi;
if (ekor[1].x = batas_x) or (ekor[1].y = batas_y) or (ekor[1].x = 1) or (ekor[1].y = 1) then mati := true;
until keypressed or mati;
if mati then exit;
tkn:=readkey;
if tkn = ‘d’ then tkn:=’a’;
end;
end;

begin
tkn:=’d’;
mati := false;
randomize;
pjg := 10; spd := 0;
makanan.x := random(batas_x-2)+2;
makanan.y := random(batas_y-2)+2;
ekor[1].x := 40;
ekor[1].y := 3;
for i:=2 to pjg do begin
ekor[i].x := ekor[i-1].x;
ekor[i].y := 3;
end;
lanjut:
clrscr;
gotoxy(10,26); write(‘Skor = ‘,skor);
for i:=1 to 80 do begin
gotoxy(i,1); write(‘-‘);
gotoxy(i,25); write(‘-‘);
end;
for i:=2 to 24 do begin
gotoxy(1,i); write(‘|’);
gotoxy(80,i); write(‘|’);
end;
for i:=1 to pjg do begin
gotoxy(ekor[i].x, ekor[i].y);
write(‘&’);
end;
gotoxy(makanan.x, makanan.y); write(‘o’);
repeat
if((tkn=’w’) or (tkn=’a’) or (tkn=’s’) or (tkn=’d’)) then bergerak(tkn)
else begin
repeat

gotoxy(20,11); write(‘           ..Paus..’);
repeat
gotoxy(20,13); write(‘..Press w, a, s or d to lanjut..’); delay(200);
gotoxy(20,13); write(‘                                ‘); delay(200);
until keypressed;
tkn:=readkey;
until((tkn=’w’) or (tkn=’a’) or (tkn=’s’) or (tkn=’d’)); goto lanjut;
end;
if mati then goto habis;
until (tkn = #27) or mati;

habis:

gotoxy(20,11); write(‘   ..GAMES OVER..’);

readln;
end.

ular

Games unlar ini masih berbentuk sederhana jadi mohon di maaf kan jika games ini kurang menarik .

Trimakasih, Silahkan Copy paste aja nih program nya.

Iklan

Program Data_Barang;
uses crt;
Type
Barang = Record
KB     : word;
NB     : String[15];
Jenis  : String[15];
HS     : Real;
BB     : Integer;
Tb     : real;
end;

Var
Filebrg  : File Of Barang;
Data     : Barang;
Pil, Ul  : Char;

Procedure Menu;
Begin
ClrScr;
GotoXY(36,4) ; write(‘ * MENU PILIHAN *’);
GotoXY(27,5) ; write(‘=================================’);
GotoXY(27,7) ; write(‘1. Tambah Data Barang ‘);
GotoXY(27,9) ; write(‘2. Edit Barang ‘);
GotoXY(27,11); write(‘3. Hapus Data Barang’);
GotoXY(27,13); write(‘4. Tampilkan Data barang’);
GotoXY(27,15); write(‘5. View Barang Berdasarkan Jenis’);
GotoXY(27,17); write(‘6. Keluar (Exit) ‘);
GotoXY(27,19); write(‘=> Pilihan [1..6]  : ‘); Pil:=Readkey;
End;

Procedure Buka_File;
Begin
Assign (FileBrg,’Brg.Dat’);{$I-};
Reset  (Filebrg);{$I+};
End;

Procedure tambah;
Var
Lagi : char;
Ada  : boolean;
i    : integer;
NOCR : Word;
Begin
Ul   :=’Y’;
Lagi :=’Y’;
ClrScr;
Buka_file;
If IOResult<>0 then
Rewrite(FileBrg);
Repeat
ClrScr;
Ada   := False;
i     := 0;
GotoXY(30,2) ; write(‘*TAMBAH DATA BARANG*’);
GotoXY(20,3) ; write(‘=====================================’);
GotoXY(20,6) ; write(‘Kode Barang   : ‘); readln (NOCR);
While (Ada=False) And (i<>Filesize(FileBrg)) Do
Begin
Seek(FileBrg,i);
Read(FileBrg,Data);
If Data.KB = NOCR Then
Ada:= True
else
Inc(i);
End;
If ( Ada=True ) Then
Begin
GotoXY(20,10) ; write(‘Kode Barang “,NOCR,” Ini Sudah Ada ! ‘);
end
Else
Begin
Seek(FileBrg,Filesize(Filebrg));
Data.KB :=NOCR;
GotoXY(20,7) ; write(‘Nama Barang   : ‘); readln(Data.NB);
GotoXY(20,8) ; write(‘Harga Satuan  : Rp. ‘); readln(Data.HS);
GotoXY(20,9) ; write(‘Banyak barang : ‘); readln(Data.BB);
GotoXY(20,10); write(‘Jenis         : ‘); readln(Data.jenis);
Data.TB := data.HS * data.BB;
GotoXY(20,11); write(‘Total Belanja : Rp. ‘,Data.TB:6:2);
write(FileBrg,Data);
end;
GotoXY(20,12); write (‘Mau tambah Data Lagi [Y/T] : ‘); Lagi:=Upcase(readkey);
Until Lagi<> ‘Y’;
Close (FileBrg);
End;

Procedure Edit;
Var
Lagi : Char;
Ada  : Boolean;
i    : Integer;
NOCR : Word;
begin
Ul   := ‘Y’;
Lagi := ‘Y’;
ClrScr;
Buka_File;
If IOResult<>0 then
write (‘Data Masih Kosong…!’);
Begin
Repeat
ClrScr;
Ada:=False;
i  :=0;
GotoXY(30,2); write(‘ EDIT DATA BARANG’);
GotoXY(20,3); write(‘=====================================’);
GotoXY(20,6); write(‘Kode barang   : ‘); readln (NOCR);
while (Ada=False) And (i<>FileSize(FileBrg)) Do
Begin
Seek (FileBrg,i);
Read (FileBrg,Data);
If data.KB = NOCR then
Begin
Ada := True;
GotoXY(20,7) ; write(‘Nama Barang   : ‘,Data.NB);
GotoXY(20,8) ; write(‘Harga Satuan  : Rp. ‘,Data.HS:6:2);
GotoXY(20,9) ; write(‘Banyak Barang : ‘,Data.BB);
GotoXY(20,10); write(‘Jenis         : ‘,Data.jenis);
GotoXY(20,11); write(‘Total belanja : Rp. ‘,Data.TB:6:2);
End
Else
Inc(i);
End;
If (Ada=True) Then
Begin
Data.KB:= NOCR;
GotoXY(20,13) ; write (‘Nama Barang   : ‘); readln(Data.NB);
GotoXY(20,14) ; write (‘Harga Satuan  : ‘); readln(Data.HS);
GotoXY(20,15) ; write (‘Banyak Barang : ‘); readln(Data.BB);
GotoXY(20,16) ; write (‘Jenis         : ‘); readln(Data.jenis);
Data.TB := Data.HS * Data.BB;
GotoXY(20,17) ;writeln(‘Total Belanja : ‘, Data.TB:6:2);
Seek (FileBrg,i);
write(Filebrg,Data);
End
Else
Begin
GotoXY(20,20) ; write (‘Kode Barang “‘,NOCR,'” Ini Tidak Ada ! ‘);
End;
GotoXY(20,21); write (‘Mau Edit Data Lagi [Y/T] : ‘); lagi := Upcase(readkey);
Until Lagi<> ‘Y’;
End;
Close(FileBrg);
End;

Procedure Hapus;
Var
FileTmp      : File Of Barang;
Lagi, Hapus  : Char;
Ada          : Boolean;
i            : integer;
NOCR         : Word;
Begin
Ul   := ‘Y’ ;
Lagi := ‘Y’ ;
Clrscr;
Repeat
Buka_File;
If IOResult<>0 Then
Write(‘ Data Masih Kosong…! ‘);
Begin
ClrScr;
Assign(FileTmp,’Brg.tmp’);
Rewrite (FileTmp);
Ada := False;
i:=0;
GotoXY(30,2) ; write(‘HAPUS DATA MAHASISWA’);
GotoXY(20,3) ; write(‘=====================================’);
GotoXy(20,5) ; write(‘Kode Barang      : ‘); readln(NOCR);
While (Ada=False) And (i<>Filesize(FileBrg)) Do
Begin
Seek (FileBrg,i);
Read (FileBrg,Data);
If Data.KB=NOCR then
Ada:=True
Else
Inc(i);
End;
If (Ada=True) Then
Begin
GotoXY(20,6); Write(‘Nama Barang      : ‘,Data.NB);
GotoXY(20,7); Write(‘Harga Satuan     : Rp.’,Data.HS:12:2);
GotoXY(20,8); Write(‘Banyak Barang    : ‘,Data.BB);
GotoXY(20,9); Write(‘Jenis            : ‘,Data.Jenis);
GotoXY(20,10);Write(‘Total belanja    : Rp.’,Data.TB:6:2);
GotoXY(20,12);Write(‘Data Ini Mau DiHapus [Y/T] :’); readln (Hapus);
If Upcase (Hapus)=’Y’ Then
Begin
For i:= 1 to Filesize (Filebrg) Do
Begin
Seek(Filebrg,i-1);
Read(Filebrg,Data);
If Data.KB<>NOCR Then
Write(FileTmp,Data);
End;
Close  (FileBrg);
Assign (FileBrg,’Brg.Dat’);
Erase  (Filebrg);
Assign (FileTmp,’Brg.Tmp’);
Rename (FileTmp,’Brg.Dat’);
GotoXY(20,15); Write(‘Kode Barang “‘,NOCR,'” Sudah Dihapus !’);
End;
End
Else
Begin
GotoXY(20,15); Write(‘Kode Barang “‘,NOCR,'” Ini Tidak Ada !’);
End;
GotoXY(20,16) ; write(‘Mau Hapus Data Lagi [Y/T] : ‘);lagi:=Upcase(Readkey);
End;
Until Lagi <> ‘Y’;
End;

Procedure Tampil;
Var
i     : integer;
totbay: Real;
Begin
Ul := ‘Y’;
Buka_File;
If IOResult<> 0 Then
Write(‘Maaf Data Masih Kosong ! ‘)
Else
Begin
ClrScr;
Writeln;
Writeln(‘                         * DATA BARANG *’);
Writeln(‘=========================================**************************************’);
Writeln(‘  No  |   Kode     |    Nama     |   Harga  |  Banyak  |   Jenis    |  Total’);
Writeln(‘      |   Barang   |   Barang    |  Satuan  |  Barang  |  Barang    |  Bayar’);
Writeln(‘===============================================================================’);
i:=0;
While Not EoF (FileBrg) Do
Begin
Inc(i);
Read(FileBrg,Data);
Writeln(i:3,Data.KB:11,Data.NB:18,Data.HS:12:0,Data.BB:7,Data.Jenis:16,Data.TB:11:0);
TotBay:=totbay+Data.TB;
End;
Writeln(‘===============================================================================’);
Writeln(‘                                  TOTAL BAYAR                 : Rp’,totbay:6:0);
Writeln(‘===============================================================================’);
Close(FileBrg);
End;
Writeln;
Write(‘Press Any Key To Continue….!’);readkey;
End;

Procedure View_Jenis;
Var
i     : integer;
jenis : String[15];
Lagi  : Char;
Begin
Ul   :=’Y’;
Lagi :=’Y’;
Repeat
ClrScr;
Write(‘Tampilkan Jenis        :’); Readln(jenis);
Buka_File;
If IOResult<> 0 Then
Write(‘Maaf Data Masih Kosong !’);
Begin
Writeln;
Writeln;
Writeln(‘                                * DATA BARANG *’);
Writeln(‘===============================================================================’);
Writeln(‘  No  |   Kode     |    Nama     |   Harga  |  Banyak  |   Jenis    |  Total’);
Writeln(‘      |   Barang   |   Barang    |  Satuan  |  Barang  |  Barang    |  Bayar’);
Writeln(‘===============================================================================’);
i:=0;
While Not EoF(FileBrg) Do
Read(FileBrg,Data);
If Data.jenis =jenis then
Begin
Inc(i);
Writeln(i:3,Data.KB:11,Data.NB:18,Data.HS:12:0,Data.BB:7,Data.Jenis:16,Data.TB:11:0);
End;
Writeln(‘===============================================================================’);
Close(FileBrg);;
End;
Writeln;
Write(‘Mau Lihat Data lagi [Y/T]  : ‘);Lagi:=Upcase(Readkey);
Until Lagi<>’Y’;
End;

Begin
Repeat
Menu ;
Case Pil Of
‘1’   : Tambah;
‘2’   : Edit;
‘3’   : Hapus;
‘4’   : Tampil;
‘5’   : View_Jenis;
End;
Until (Ul<>’Y’) Or (Pil=’6′);
End.

Program Gabungan

jikan teman-teman menggunkan TPW 1.5 uses crt itu bisa di ganti menjadi uses wincrt.

Trimaskih atas kunjungan nya jika ada kata atau tulisan tidak jelas bisa di Komentar ^^

Kata Palindrom adalah sebuah kata, frasa, angka maupun susunan lainnya yang dapat dibaca dengan sama baik dari depan maupun belakang.

 Beberapa Kata yang termasuk palindrom misalnya:

  • ada
  • apa
  • ara
  • asa
  • bab
  • ini
  • katak
  • kodok
  • makam
  • malam
  •  radar,
  • taat, dll

Dibawah ini contoh program palindorm menggunakan program pascal 7.0:

program palindrom;

uses    crt;

var

   a,b : string;

   i     : integer;

begin

clrscr;

       write(‘masukkan kata:’); readln(a);

       for i:=length(a) downto 1 do

       b:=b+a[i];

if(a=b)then

           writeln(‘kata ‘,a,’ palindrom’)

           else

           writeln(‘kata ‘,a,’ tidak palindrom’);

           readln;

end.

palindrom

jika teman-teman yang menggunakan bahasa pascal 1.5 (TPW 1.5) kata uses crt bisa di ganti atau di tambah seperti ini  (uses wincrt;).

jiga ada ke salahan kalimat mohon di maaf kan.

silahankan copy pas saja program ini.

Ini salah satu Permaianan Denga Pemrograman Turbo Pascal 7.0
uses crt;
const
havetry=10;
s: array[0..18] of string=
(‘hello’, ‘mouse’, ‘hacher’, ‘programmer’, ‘killer’, ‘teacher’, ‘splotchier’,
‘butcher’, ‘computer’, ‘pascal’, ‘house’, ‘poor’, ‘children’, ‘museum’,
‘security’, ‘spillway’, ‘stupidity’, ‘corrigenda’, ‘freebooter’);
var ch: char;
gue,b,nowwrd,trynow: byte;
s1,wrs,alr: string;
r: boolean;
win: integer;
begin
win:=0;
clrscr;
writeln(‘Game Tebak Kata’);
writeln(‘*****************************************************’);
Writeln(‘Ketikkan huruf apa saja untuk menjawab! ESC for exit’);
writeln;
randomize;
repeat
writeln;
nowwrd:=random(18);
s1:=s[nowwrd];
gue:=0;
wrs:=”;
alr:=”;
trynow:=havetry;
for b:=1 to length(s[nowwrd]) do write(‘_’);
repeat
gotoxy(20,wherey);
write(‘You have ‘,trynow,’ tries ‘);
ch:=readkey;
r:=false;
if ch#0 then
repeat
b:=pos(ch,s1);
if (b0) and (s1[b]#0) then
begin
gotoxy(b,wherey);
write(s1[b]);
alr:=alr+ch;
s1[b]:=#0;
gue:=gue+1;
gotoxy(40,wherey);
write(‘ ‘);
r:=true;
end else
if (pos(ch,alr)0) and (r=false) then
begin
gotoxy(40,wherey);
write(‘Already tried!’);
end else
if (b=0) and (r=false) then
begin
trynow:=trynow-1;
alr:=alr+ch;
wrs:=wrs+ch;
gotoxy(57,wherey);
write(‘Wrong: ‘,wrs);
gotoxy(40,wherey);
write(‘ ‘);
end;
until (b=0) or (trynow=0);
until (ch=#27) or (gue=length(s1)) or (trynow=0);
if (trynow=0) then
begin
win:=win-1;
delline;
gotoxy(1,wherey);
write(s[nowwrd]);
gotoxy(20,wherey);
write(‘You lost! Your scores is ‘,win);
end else
if (gue=length(s1)) then
begin
win:=win+1;
delline;
gotoxy(1,wherey);
write(s[nowwrd]);
gotoxy(20,wherey);
write(‘You win! Your scores is ‘,win);
end;
until ch=#27;
end.

Dan ini gambar dari contoh program di atas

program jalan

untuk lebih jelas klik Gambar di atas….
Silahkan mencoba dan Copy Paste aja neh Programnya ^^