Cliper Kelompok B

Bagi teman teman yang membutuhkan script ujian clipper kelompok B, bisa mengambil script di bawah ini. Silakan unduh dan copy ke notepad. Setelah dicompile file akan menjadi 6. Berekstensi TXT, OBJ, DBF, PRG, dan EXE. Jangan lupa saran dan kritiknya untuk blog ini. Untuk memberi saran bisa ke postingini atau ke Buku tamu. Trims


//Ujian Pemrograman Basis Data I



Do while .t.
set colo to
clea
set colo to w/b
@5,5 clea to 17,60
@5,5 to 17,60
@6,20 say "MENU UTAMA"
@08,10 SAY "1] ENTRY DATA"
@10,10 SAY "2] LAPORAN"
@12,10 SAY "3] SELESAI"
P=0
@16,15 SAY "PILIHAN : " GET P PICT "9"
READ



DO CASE
CASE P=1
MASUK()
CASE P=2
LAPOR()
CASE P=3
EXIT
ENDCASE
ENDDO

func formulir()
set colo to
clea
set colo to w/b
@5,5 clea to 17,60
@5,5 to 17,60
@06,20 say " ENTRI GAJI PEGAWAI"
@08,10 SAY "No. Induk Pegawai: [F2]-Lihat NIP"
@09,10 say "Nama Pegawai :"
@10,10 say "Kode :"
set colo to gr+*/b
@08,40 say "F2"
set colo to w/b
retu



FUNC LIHAT()
Local Layar:=savescreen()
set colo to w+/br,gr*+/r*
@7,27 clea to 17,71
@7,27 to 17,71
go top
dbedit(8,28,16,70,{"NIP","NAMA"},,,{"NIP","NAMA PEGAWAI "})
mNIP=Fieldget(1)
keyboard chr(13)
set color to
restscreen(,,,,layar)
retu


FUNC CT_LAYAR()
SETCURSOR(2)
SET COLO TO W+/B
@1,0 to 23,79
@24,1 clea to 24,78
@24,14 say "Pres Atas Bawah Batal ScUp ScDn"
set colo to GR+/b
@24,19 say chr(24)
@24,27 say chr(25)
@24,35 SAY 'ESC'
@24,47 say 'PgUp'
@24,57 say 'PgDn'
SET PRINT OFF
SET CONS ON
SET ALTER TO
SET COLO TO W+/B
geser:=memoedit(memoread("LAPOR.TXT"),2,1,22,78,.F.,,350,10)
return


//Program untuk menambah data
Func Masuk()
Close Data
set menu off
set score off
set date ital
set cent on


//Deteksi apakah database ada, jika tdk buat dulu
If ! file("Pegawai.dbf")
dbcreate("Pegawai.dbf",{{"NIP","C",5,0},;
{"NAMA","C",20,0},;
{"KODE","N",1,0}})
endif

//Deteksi apakah database sudah dindex, jika belum index dulu
If ! file("pegawai.ntx")
use pegawai
index on nip to pegawai
endif

// buka file database beserta indexnya
Use pegawai index pegawai

// awal perulangan/looping
Do while .t.
Formulir()
mNIP=spac(5)
set key -1 to lihat
set colo to w/b
@8,30 get mNIP
read

// cek apakah nim kosong, jika kosong lanjutkan
if empty(mNIP)
exit
endif


// cari apakah NIP ada jika tdk ada buat file baru,
//jika sudah ada tampilkan & edit

Seek mNIP
if ! found()
appe blank
repl nip with mNIP
endif
set colo to
@9,30 get NAMA
@10,30 get KODE
read


// Tanya masih ada data lagi, jika tidak maka proses berakhir

Tanya=spac(1)
set colo to w/b
@15,20 say "Masih ada Data [Y/T] " get tanya pict "@!" valid Tanya$"YT"
read
if Tanya="T"
exit
endif
enddo
retu

//Program untuk mencetak data
Func Lapor()
Close Data

//Deteksi apakah database ada, jika tdk ada beri respon
If ! file("Pegawai.dbf")
alert("Perhatian File pegawai.dbf Belum ada")
retu
endif

// buka file database beserta indexnya

Use Pegawai index pegawai

pilih=0
pilih:=alert("Media etakan",{"Layar","Printer","Batal"})
Do case
case pilih=1
set printer off
set cons off
set alter to lapor.txt
set alter on
case pilih=2
if ! isprinter()
alert("Printer Belum Siap")
return
endif
set cons off
set printer on
case pilih=3 .or. pilih=0
return
endcase
clea
NO=0
? " LAPORAN GAJI PEGAWAI"
? "====================================================================================="
? "|NO | NIP | NAMA PEGAWAI | KODE |GAJI POKOK | TUNJANGAN | GAJI TOTAL |"
? "-------------------------------------------------------------------------------------"
DO WHILE .NOT. EOF()
NO=NO+1

IF KODE=1
GAJI=450000
TUNJANGAN=45000

ELSEIF KODE=2
GAJI=350000
TUNJANGAN=35000

ELSE
GAJI=300000
TUNJANGAN=30000
ENDIF
JML=GAJI+TUNJANGAN

A="|"+TRAN(NO,"99")+" | "+NIP+" | "+NAMA
B=" | "+TRAN(KODE,"9")+" | "+TRAN(GAJI,"999,999")+" | "
C=TRAN(TUNJANGAN,"999,999")+" | "+TRAN(JML,"999,999")+" | "


? A+B+C
SKIP
ENDDO
? "====================================================================================="
IF PILIH=1
CT_LAYAR()
ENDIF
RETU

Posted in: