Program Sederhana dengan Pemrograman Basis data

// Membuat Menu Utama  


DO WHILE .T.
SET COLO TO
CLEA
set colo to B*+/G+
@5,5 clea to 20,60
@5,5 to 20,60
@6,25 SAY "MENU UTAMA"
@7,20 SAY "PERUSAHAAN GRAFIKA"
@10,8 SAY "1]. ENTRY DATA PELANGGAN"
@12,8 SAY "2]. HAPUS DATA"
@14,8 SAY "3]. LAPORAN"
@16,8 SAY "4]. KELUAR"
P=0
@18,17 SAY " MASUKKAN PILIHAN ANDA :" GET P PICT "9"
READ
DO CASE
   CASE P=1
     DO MASUKEGS
   CASE P=2
     DO HAPUS
   CASE P=3
     DO LAPOT
   CASE P=4
     EXIT
ENDCASE
ENDDO


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,{"ID","NAMA"},,,{"ID PELANGGAN","NAMA PELANGGAN"})
XID=FIELDGET (1)
KEYBOARD CHR(13)
SET COLO TO
RESTSCREEN (,,,,LAYAR)
RETU


// Program untuk entry data
CLOSE DATA
SET MENU OFF
SET SCORE OFF
SET DATE ITAL
SET CENT ON

IF ! FILE("EGS2.DBF")
        DBCREATE ("EGS2.DBF",{{"ID","C",5,0},;
                             {"NAMA","C",20,0},;
                             {"PERUSAHAAN","C",15,0},;
                             {"ALAMAT","C",25,0},;
                             {"HP","C",12,0}})

ENDIF

IF ! FILE("EGS2.NTX")
     USE EGS2
     INDEX ON ID TO EGS2
ENDIF

USE EGS2 INDEX EGS2

DO WHILE .T.
   DO FORM
    XID=SPACE(5)
    SET KEY -1 TO LIHAT
    SET COLO TO R*+/GR*
    @8,28 GET XID
   READ
   IF EMPTY(XID)
      EXIT
   ENDIF
     SEEK XID
     IF ! FOUND()
       APPE BLANK
       REPL ID WITH XID
     ENDIF
  SET COLO TO
  @10,28 GET NAMA
  @12,28 GET PERUSAHAAN
  @14,28 GET ALAMAT
  @16,28 GET HP
  READ
   TANYA=SPAC(1)
   SET COLO TO R*/GR*
   @18,20 SAY " MASIH ADA DATA LAGI [Y/T]" GET TANYA PICT "@!" VALID TANYA$ "YT"
  READ
    IF TANYA="T"
       EXIT
    ENDIF
ENDDO
RETU


// program untuk menampilkan Laporan dari data yang telah dimasukkan 
CLOSE DATA
IF ! FILE("EGS2.DBF")
  ALERT ("Perhatian file egs.dbf belum ada")
  retu
end if
use egs2 index egs2
pilih =0
pilih:=alert("Media cetakan",{"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
? "             DAFTAR PELANGGAN ENERGI GRAFIKA SOLO"
? "==================================================================="
? "|ID PLG|   NAMA PELANGGAN     |   PERUSAHAAN    |         ALAMAT            |  NO HP       |"
? "--------------------------------------------------------------------------------------------"
DO WHILE .NOT. EOF()
A="| " +ID+ "| "+NAMA+" | " +PERUSAHAAN+ " | "
B=ALAMAT+ " | " +HP+ " | "
? A+B
SKIP
ENDDO
? "===================================================================="
IF PILIH = 1
 DO CT_LAYAR
ENDIF
RETU
                                                        
// Program Untuk menghapus data
CLOSE DATA
SET MENU OFF
SET SCORE OFF
SET DATE ITAL
SET CENT ON

IF ! FILE ("EGS2.DBF")
     ALERT ("PERHATIAN FILE EGS2.DBF BELUM ADA")
     RETU
ENDIF

USE EGS2 INDEX EGS2
DO WHILE .T.
    DO FORM
    XID=SPAC(5)
    SET KEY -1 TO LIHAT
    SET COLO TO
    @08,28 GET XID
    READ
IF EMPTY (XID)
    ALERT("ID TIDAK BOLEH KOSONG")
    LOOP
ENDIF

SET COLO TO R*+/B
SEEK XID
IF ! FOUND ()
   ALERT ("XID TERSEBUT TDAK ADA,CARI YANG LAIN")
ELSE
  @10,28 SAY NAMA
  @12,28 SAY PERUSAHAAN
  @14,28 SAY ALAMAT
  @16,28 SAY HP
TANYA =SPAC(1)
SET COLO TO W/B
@15,15 CLEA TO 15,58
@18,20 SAY "YAKIN DIHAPUS[Y/T]" GET TANYA PICT "@!" VALID TANYA$ "YT"
   READ
   IF TANYA ="Y"
      DELE
      PACK
   ENDIF
   ENDIF
TANYA=SPACE(1)
SET COLO TO W/B
@15,15 CLEA TO 15,58                                                         
@15,20 SAY " INGIN HAPUS DATA LAGI [Y/T]" GET TANYA PICT "@!" VALID TANYA$ "YT"
  READ
  IF TANYA="T"
  EXIT
  ENDIF
  ENDDO
RETU

Selamat Mencoba

Semoga bisa bermanfaat