Coding Clipper

ini merupakan function-function yang saya pakai untuk mengembangkan program dengan clipper versi DOS.

Function ini sampai detik ini masih saya pakai  , jika pembaca blog ini mau mencoba coding ini silahkan bebas dan jika ada pertanyaan silahkan hubungi saya.

untuk para suhu mohon masukannya mengenai coding clipper saya

SILAHKAN DICOBA YA :

// NAMA PROGRAM  : GLSERVER.PRG
// Dated         : 23 Maret 09

#include “INKEY.CH”
#include “SETCURS.CH”
#include “SUPMENU.CH”
#include “BOX.CH”
#define COMPILE(c_expr) &(“{||” + c_expr + “}”)

FUNCTION FRAME
CLEAR
HEADER = CURDIR()
SETCOLOR(“GR+/w+”)
@  0, 0 TO 24,79
@  2, 1 CLEAR TO 23,78
@  2, 1 TO  2,78
SETCOLOR(“W+/rb”)
@  1, 1 CLEAR TO 1,78
@  1, 1 SAY PADC(FNAMAGRP,78)
@  1, 2 SAY DATE()
@  1, 77-LEN(HEADER) SAY HEADER
SETCOLOR(“W”)
RETURN

FUNCTION RRLOCK
DO WHILE .NOT. DbRlock()
ENDDO
RETURN (DbRlock())

Function UseUdf ( cDataFile, lUseMode )

IF lUseMode
USE (cDataFile) NEW EXCLUSIVE
ELSE
USE (cDataFile) NEW SHARED
ENDIF
// If successfully opened.
IF ! NetErr()
RETURN (.T.)
ELSE
TONE(10,10)
// ALERT(“File yaa”+cDATAFILE+” sedang di pakai “)
ALERT(“File yang anda pangil sedang di pakai “)
SETCOLOR()
RETURN (.F.)
ENDIF
RETURN

FUNCTION LINE2401(SHEADER,SBLINK)
SETCOLOR(IIF(SBLINK=0,”W+/R”,”W+*/R”))
@  23, 1 CLEAR TO 1,78
@  23, 1 SAY PADC(SHEADER,78)
SETCOLOR(“W”)
RETURN

FUNCTION LINE2402(SVAR,SVAR1)
LOCAL SVAR2 := SPACE(1)
SETCOLOR(“/W”)
SET CONFIRM OFF
@ 23,      1 CLEAR TO 23,78
@ 23,      1 SAY SVAR
@ 23,COL()-2 GET SVAR2 PICTURE “!@” VALID SVAR2 $ SVAR1
READ
SET CONFIRM ON
RETURN SVAR2

FUNCTION FFILE(FLG,VAR,WIDTH)
IF FLG == “1”
ALERT(“Kode sudah ada”)
ELSE
ALERT(“Kode tidak ada”)
ENDIF
RETURN

FUNCTION INPCHAR1(VAR1,TROW,TCOL)
TONE(1000,1)
@ TROW,TCOL GET VAR1
READ
@ TROW,TCOL SAY SPACE(LEN(VAR1))
@ TROW,TCOL SAY VAR1
RETURN VAR1

FUNCTION INPTGL1(VAR1,TROW,TCOL)
TONE(1000,1)
@ TROW,TCOL GET VAR1
READ
@ TROW,TCOL SAY SPACE(10)
@ TROW,TCOL SAY VAR1
RETURN VAR1

FUNCTION GESER

// Program tampilan data
waktu = time()
If waktu >=’00:00′ .and. waktu <=’10:00′
m_salam = ‘ SELAMAT PAGI ‘
endif
If waktu >=’10:01′ .and. waktu <=’14:00’
m_salam = ‘ SELAMAT SIANG’
endif
IF waktu >=’14:01′ .and. waktu <=’17:00′
m_salam = ‘ SELAMAT SORE ‘
Endif
If waktu >=’17:00′ .and. waktu <=’24:00’
m_salam = ‘SELAMAT MALAM / good night ‘
Endif

pw=0
nm_bank := “”
xx=40-len(nm_bank)
xx=xx/2
m_bank := ” ANDA MASUK DALAM SYSTEM & KONEKSITAS DI SERVER ”
m_bank=m_salam+spac(3)+m_bank
set cursor on
tulis1=m_bank
Do Whil Pw=0
set colo to gr+/b,gr+/b
Tulis1 = Right(Tulis1,Len(Tulis1)-1)+Left(Tulis1,1)
Pw = inkey(.3)
@00,01 Say Tulis1
EndDo

RETURN

FUNCTION INPTGL2(VAR1,TROW,TCOL)
TONE(1000,1)
@ TROW,TCOL GET VAR1
READ
@ TROW,TCOL SAY SPACE(10)
@ TROW,TCOL SAY VAR1
RETURN VAR1

FUNCTION INPCHAR3(VAR1,TROW,TCOL,VAR2)
TONE(1000,1)
@ TROW,TCOL GET VAR1 PICTURE VAR2
READ
@ TROW,TCOL SAY SPACE(LEN(VAR1))
@ TROW,TCOL SAY VAR1
RETURN VAR1

FUNCTION INPNUM1(VAR1,TROW,TCOL,VAR2)
TONE(1000,1)
@ TROW,TCOL SAY SPACE(LEN(VAR2))
@ TROW,TCOL GET VAR1
READ
@ TROW,TCOL SAY VAL(VAR1) PICTURE VAR2
RETURN VAR1

FUNCTION INPCHAR4(VAR1,TROW,TCOL,VAR2)
TONE(1000,1)
@ TROW,TCOL GET VAR1 VALID VAR1 $ VAR2
READ
@ TROW,TCOL SAY VAR1
RETURN VAR1

FUNCTION VARIABLE(VAR,WIDTH,VAR1)
VAR := RTRIM(VAR)
VAR := LTRIM(VAR)
VAR := REPLICATE(VAR1,WIDTH-LEN(VAR))+VAR
RETURN VAR

FUNCTION INP_CHAR(SVAR1,SROW,SCOL,SPICC,SSEK,SKEY,SVAR2,SVAR3,SBLANK)
XLEN := LEN(SVAR1)
DO WHILE .T.
IF EMPTY(SPICC)
SVAR1 := INPCHAR1(SVAR1,SROW,SCOL)
ELSE
SVAR1 := INPCHAR3(SVAR1,SROW,SCOL,SPICC)
ENDIF
IF LASTKEY() == 27
RETURN
ENDIF
IF AT(“?”,SVAR1) > 0
IF SSEK == 1
DbGoTop()
cIndexKey := SKEY
i_key_cb  := COMPILE(indexkey())
SEEK cIndexKey
if eof()
loop
endif
ELSE
DbGoTop()
cIndexKey := ”
ENDIF
SVAR1 := TBPick2(cIndexKey,{ || EVAL(SVAR2)+”  “+EVAL(SVAR3)},SSEK,{||EVAL(SVAR2)})
SVAR1 := SVAR1+SPACE(XLEN-LEN(SVAR1))
ENDIF
IF SBLANK == 1 .AND. EMPTY(SVAR1)
LOOP
ENDIF
@ SROW,SCOL SAY SVAR1 PICTURE SPICC
CLEAR GETS
EXIT
ENDDO
RETURN SVAR1

FUNCTION INCLAST(c)
LOCAL VAR1 := substr(c, 1, len(c) – 1) + ;
chr( asc( substr( c, len(c) ) ) + 1)
RETURN VAR1

FUNCTION TBPick2(cKeyValue,bDisplay,nK,nK2)

STATIC oCol
LOCAL nT := 3
LOCAL nL := 75 – IIF(LEN(EVAL(bDisplay))<13,13,LEN(EVAL(bDisplay)))
LOCAL nB := 23
LOCAL nR := 77
LOCAL oTBobj    // Var for TBrowse object.
LOCAL cKey      // Var for hold keystrokes.
LOCAL cols[3],i
LOCAL lScrlBar
LOCAL nThumbPos := nT + 1
LOCAL cScrlClr := ‘W/B’
LOCAL cThumbClr := ‘W+/B’
LOCAL cAppClr := SetColor()
LOCAL nRecsSkipped := 1
LOCAL nRow, nCol, nRetVal := 0
LOCAL cPrevScr := SaveScreen(nT, nL, nB, nR)
LOCAL nCursor
SetColor(‘b/w,gr+/r,,,n/g’)
IF Pcount() < 4
SetColor(“W+/R”)
@ 23, 3 SAY PadR(“ERROR. Invalid screen ” + ;
“coordinates. Press any key.”, 76)
Inkey(0)
SetColor(cAppClr)
@ 23, 3 SAY PadR(” “, 76)
RETURN NIL
ENDIF

IF Alias() == “”
SetColor(“W+/R”)
@ 23, 3 SAY PadR(“ERROR. No Date File Open. Press any key.”, 76)
Inkey(0)
SetColor(CAppClr)
@ 23, 3 SAY PadR(” “, 76)
RETURN NIL
ENDIF

lScrlBar := If(LastRec() > 10, .T., .F. )

oTBobj := TBrowseDB(nT, nL+1, nB-4, nR-1)

*oTBobj:HeadSep := CHR(205)+CHR(209)+CHR(205)
*oTBobj:ColSep := CHR(32)+CHR(179)+CHR(32)

oTBobj:HeadSep := CHR(32)+CHR(32)+CHR(32)
oTBobj:ColSep  := CHR(32)+CHR(32)+CHR(32)

//oTBobj:FootSep := CHR(205)+CHR(207)+CHR(205)

IF nK = 1
oTBobj:Skipblock := {|n| movepointer(n, cKeyValue, i_key_cb)}
oTBobj:GoTopBlock := {| | gototop(cKeyValue)}
oTBobj:GoBottomBlock := {|| gotobott(cKeyValue)}
ENDIF

// Create a TBcolumn object.
oNewCol := TBcolumnNew(“”, bDisplay)
oNewCol:width := nR – nL – 1

// Attach the column object to the browse object.
oTBobj:AddColumn(oNewCol)

// Create the window.
WinShade(nT,nL,nB,nR,’ON’)
@ nB – 3, nL+1 SAY Replicate(Chr(196), (nR – nl – 1)  )
@ nB – 2, nL+1 SAY “Searching For: ”

// If a scroll bar is needed, paint it.

IF lScrlBar
SetColor(cScrlClr)
@ nT+1, nR, nB-4, nR box chr(177)
SetColor(cThumbClr)
@ nThumbPos, nR SAY Chr(178)
SetColor(cAppClr)
ENDIF

SeekIt(nL+1, nB, nR, 0)
nCursor := SetCursor(SC_NONE)

DO WHILE .T.

// Activate.
DO WHILE ! oTBobj:Stabilize()

// If keystrokes are pending, interrupt the browse.
cKey := INKEY()
IF cKey <> 0
EXIT
ENDIF

ENDDO

IF lScrlBar
IF nThumbPos <> Int((nRecsSkipped/LastRec()) * ;
((nB-4) – (nT+1)) + (nT+1))
nRow := Row()
nCol := Col()
SetColor(cScrlClr)
@nThumbPos, nR SAY Chr(177)
// Changed, compute the new value.
nThumbPos := Int((nRecsSkipped/LastRec()) * ;
((nB-4) – (nT+1)) + (nT+1))

IF nThumbPos < nT + 1
nThumbPos := nT + 1
nRecsSkipped := 1
ELSEIF nThumbPos > nB – 4
nThumbPos := nB – 4
nRecsSkipped := LastRec()
ENDIF
SetColor(cThumbClr)
@nThumbPos, nR SAY Chr(178)
DevPos(nRow, nCol)
SetColor(cAppClr)
ENDIF
ENDIF

IF oTBobj:stable  // When the TBrowse object is stable,
// allow keystrokes.

IF oTBobj:Hittop
nRecsSkipped := 1
TONE(200,1)
ELSEIF oTBobj:HitBottom
nRecsSkipped := LastRec()
TONE(200,1)
ENDIF
ckey := INKEY(0)
ENDIF
IF cKey == K_F9
ELSEIF cKey == K_F10
ELSEIF cKey == K_DOWN
//IF cKey == K_DOWN
oTBobj:Down()
nRecsSkipped++
SeekIt(nL+1, nB, nR, 0)
ELSEIF cKey == K_UP
oTBobj:Up()
nRecsSkipped–
SeekIt(nL+1, nB, nR, 0)
ELSEIF cKey == K_PGDN
oTBobj:PageDown()
nRecsSkipped += oTBobj:RowCount
SeekIt(nL+1, nB, nR, 0)
ELSEIF cKey == K_PGUP
oTBobj:PageUp()
nRecsSkipped -= oTBobj:RowCount
SeekIt(nL+1, nB, nR, 0)
ELSEIF cKey == K_CTRL_PGUP
oTBobj:GoTop()
nRecsSkipped := 1
SeekIt(nL+1, nB, nR, 0)
oTBobj:Refreshall()
ELSEIF cKey == K_CTRL_PGDN
oTBobj:GoBottom()
nRecsSkipped := LastRec()
SeekIt(nL+1, nB, nR, 0)
oTBobj:Refreshall()
ELSEIF cKey == K_ESC
nRetVal := space(LEN(EVAL(nK2)))
SetColor(cAppClr)
EXIT
ELSEIF cKey == K_RETURN
nRetVal := rtrim(EVAL(nK2))
SetColor(cAppClr)
//   CLEAR GETS
EXIT
ELSEIF cKey == K_BS
oTBobj:GoTop()
Seekit(nL+1, nB, nR, -1)

nRecsSkipped := 1
oTBobj:Refreshall()
ELSEIF cKey > 31 .AND. cKey < 127
oTBobj:GoTop()
nRecsSkipped := 1
SeekIt(nL+1, nB, nR, cKey)
oTBobj:Refreshall()
ENDIF
ENDDO

// Clean up and terminate.
WinShade(nT,nL,nB,nR,’OFF’)
Set Cursor ON
RETURN nRetval

FUNCTION WinShade(nT,nL,nB,nR,cSet)
STATIC cWinScr := {}
STATIC nEl := 0

IF cSet == ‘ON’
Aadd(cWinScr, SaveScreen(nT,nL,nB+1,nR+1) )
nEl++
RestScreen( nT+1, nL+1, nB+1, nR +1, ;
Transform( SaveScreen( nT+1, nL+1, nB+1, nR+1), ;
Replicate(“X” + Chr(17), Len(SaveScreen(nT+1, nL+1, nB+1, nR+1)) )))
//  Now, just clear out the area for the window and paint it.
@ nT,nL CLEAR TO nB,nR
@ nT,nL CLEAR TO nB,nR
ELSE
RestScreen(nT,nL,nB+1,nR+1,cWinScr[nEl])
Adel(cWinScr, nEl )
Asize(cWinScr, –nEl)
ENDIF
RETURN NIL

FUNCTION SeekIt(nL, nB, nR, nCode)
LOCAL lSoft := Set(_SET_SOFTSEEK, .F.)
STATIC cSearch

IF nCode == 0       // Reset search string –don’t move pointer.
cSearch := “”
@ nB-1, nL+1 SAY PadR(cSearch, nR – nL -1)
RETURN NIL
ELSEIF nCode == -1

cSearch := Substr(cSearch, 1, Len(cSearch)-1)
ELSE
cSearch := cSearch + Chr(nCode)
ENDIF

SEEK cIndexkey+UPPER(cSearch)      // Locate proper record.

// If not found, trim string and reposition to last found record.
IF EOF()
cSearch := SubStr(cSearch, 1, Len(cSearch)-1)
SEEK cIndexkey+UPPER(cSearch)
Tone(1800,1)
ENDIF

Set(_SET_SOFTSEEK, lSoft)
@ nB-1, nL+1 SAY PadR(cSearch, nR – nL -1)
RETURN NIL
* End of file

FUNCTION gototop(cKeyValue)
SEEK cKeyValue
RETURN NIL
FUNCTION gotobott(cKeyValue)

* Save current SOFTSEEK setting and turn it on
LOCAL save_soft := set(_SET_SOFTSEEK, .T.)

SEEK substr(cKeyValue, 1, len(cKeyValue) – 1) + ;
chr(asc(substr(cKeyValue, len(cKeyValue))) + 1)
SKIP -1
set(_SET_SOFTSEEK, save_soft)

RETURN NIL

FUNCTION movepointer(num_to_skip,cKeyValue , i_key_cb)

LOCAL num_skipped := 0

IF num_to_skip = 0
SKIP 0
ELSE

DO WHILE !eof() .AND. !bof() .AND. num_skipped != num_to_skip ;
.AND. eval(i_key_cb) = cKeyValue

IF num_to_skip > 0
SKIP
num_skipped++
ELSE
SKIP -1
num_skipped–
ENDIF
ENDDO

IF eof()
SKIP -1
num_skipped–
ELSEIF bof()
num_skipped++
GOTO recno()       // Note: not in book printings 1 – 3
ELSEIF eval(i_key_cb) != cKeyValue
IF num_to_skip > 0
SKIP -1
num_skipped–
ELSE
SKIP
num_skipped++
ENDIF
ENDIF
ENDIF

RETURN num_skipped

// for index
#include “fileio.ch”
#define NULLC “”
* Size of index expression …
#define NTX_EXPR_SIZE 256
* Offset of the start of the index key into the header
#define NTX_KEY_START 22
* Initialize the index display data. The cursor is saved and
* turned off, the external static first_time set to .T.,
* and the initial display text shown

FUNCTION ip_start

save_curs = set(_SET_CURSOR, .F.)

first_time = .T.
set color to w+/R+
@ 23, 60 SAY “Indexing      % ”
set color to
RETURN NIL

* This function is part of the index key. It determines the
* percentage complete and displays it. The first time it
* is called the record number is at end of file so a display
* would show 100%. We recognize this special case and ignore it.

FUNCTION ip_disp

IF first_time
first_time = .F.
ELSE
SET COLOR TO GR+/B
@ 23, 69 SAY str(recno() / reccount() * 100, 4)
SET COLOR TO
ENDIF

RETURN NULLC

* This function is called when indexing is complete. The index file
* must be closed. The file name is passed as a parameter. ip_end
* opens the file, searches for the string +ipdisp(), then
* writes a chr(0) over the + effectively removing +ip_disp() from
* the key. The cursor is reset to the state it was in when ip_start
* was called

FUNCTION ip_end(f_name)

LOCAL ntx_handle, buff, ntx_expr, where_at
set(_SET_CURSOR, save_curs)

ntx_expr = space(NTX_EXPR_SIZE)
ntx_handle = fopen(f_name, FO_READWRITE)

* Seek to start of index expression …
fseek(ntx_handle, NTX_KEY_START, FS_SET)
fread(ntx_handle, @ntx_expr, NTX_EXPR_SIZE)

* Trim off trailing blanks
ntx_expr = trim(ntx_expr)

* search for +ip_disp().
where_at = at(“+ ip_disp()”, ntx_expr)

* Write it back without  + ip_disp, followed by a chr(0) to
* terminate the expression …

* Seek back to start of index expression …
fseek(ntx_handle, NTX_KEY_START, FS_SET)

fwrite(ntx_handle, substr(ntx_expr, 1, where_at – 1) + chr(0))
fclose(ntx_handle)

RETURN NIL

FUNCTION SeekIt1(nL, nB, nR, nCode)
LOCAL lSoft := Set(_SET_SOFTSEEK, .F.)
STATIC cSearch
*   cSearch := “M”

IF nCode == 0       // Reset search string –don’t move pointer.
cSearch := “”
@ nB-1, nL+1 SAY PadR(cSearch, nR – nL -1)
RETURN NIL
ELSEIF nCode == -1

cSearch := Substr(cSearch, 1, Len(cSearch)-1)
ELSE
cSearch := cSearch + Chr(nCode)
ENDIF

SEEK UPPER(cSearch)      // Locate proper record.

// If not found, trim string and reposition to last found record.
IF EOF()
cSearch := SubStr(cSearch, 1, Len(cSearch)-1)
SEEK cSearch
Tone(1800,1)
ENDIF

Set(_SET_SOFTSEEK, lSoft)
@ nB-1, nL+1 SAY PadR(cSearch, nR – nL -1)
RETURN NIL

FUNCTION DISP(trow,lrow,leng,fix,incr,headers1,headers2,headers3,headers4,spc)

xkey = inkey()

DbGoTop()

frec = RECNO()

if eof()
RETURN
endif

DbGoBottom()

lrec = RECNO()

DbGoTo(frec)

i    = 1
sw   = 0
bld  = ”

SETCOLOR(“GR+/R”)
@ 23,1 SAY SPACE(78)
@ 23,1 SAY SPACE(3)+CHR(26)+SPACE(6)+CHR(27)+SPACE(6)+CHR(24)+SPACE(6)+CHR(25)+SPACE(6)+;
“Home”+ SPACE(6) + “End”+ SPACE(6) +;
“PgUp       PgDn      Esc”

DO WHILE .T.

setcolor(“w/B”)

if xkey = 5 .or. xkey = 24 .or. xkey = 3 .or. xkey = 18 .or. xkey = 22 .or. xkey = 7
@ trow-spc, fix CLEAR TO lrow,78
endif
setcolor(“rb/B”)
@ trow-4, 1 say substr(headers4,1,fix)+substr(headers4,i+fix,77-fix)
@ trow-3, 1 say substr(headers3,1,fix)+substr(headers3,i+fix,77-fix)
@ trow-2, 1 say substr(headers1,1,fix)+substr(headers1,i+fix,77-fix)
@ trow-1, 1 say substr(headers2,1,fix)+substr(headers2,i+fix,77-fix)
setcolor(“g/B”)
cnt  = trow
trec = recno()
DO WHILE .NOT. EOF() .AND. cnt <= lrow
@ cnt, 1 say substr(lines1,1,fix)+substr(lines1,i+fix,77-fix)
skip
cnt = cnt + 1
ENDDO

IF sw = 0
DbGoTo(trec)
scrnrow = trow
ELSE
SKIP -1
scrnrow = cnt – 1
ENDIF

@ scrnrow , 1 say substr(lines1,1,fix)+substr(lines1,i+fix,77-fix)

wndht   = (lrow-trow)+1

do while .t.

xkey = 0
DO WHILE xkey = 0
xkey = INKEY()
ENDDO

skey = UPPER(CHR(ABS(xkey)))
IF (skey >= ‘A’ .AND. skey <= ‘Z’) .OR. (skey >= ‘0’ .and. skey <= ‘9’)
bld = bld+skey
ELSE
bld = ”
ENDIF

DO CASE
CASE xkey = 27 .or. xkey = 13
IF xkey = 27
DbGoBottom()
SKIP 1
ENDIF
SETCOLOR(“/B”)
RETURN
CASE xkey = 5
IF RECNO() <> frec
IF scrnrow > trow
@ scrnrow , 1 say substr(lines1,1,fix)+substr(lines1,i+fix,77-fix)
scrnrow = scrnrow – 1
point1 = recno()
SKIP -1
if bof() .or. eof()
DbGoTo(point1)
endif
@ scrnrow , 1 say substr(lines1,1,fix)+substr(lines1,i+fix,77-fix)
ELSE
point1 = recno()
SKIP -1
if bof() .or. eof()
DbGoTo(point1)
endif
sw = 0
exit
ENDIF
ENDIF
CASE xkey = 24
IF RECNO() <> lrec
IF scrnrow < lrow
@ scrnrow , 1 say substr(lines1,1,fix)+substr(lines1,i+fix,77-fix)
scrnrow = scrnrow + 1
point1  = recno()
SKIP 1
if bof() .or. eof()
DbGoTo(point1)
endif
@ scrnrow , 1 say substr(lines1,1,fix)+substr(lines1,i+fix,77-fix)
ELSE
point1 = recno()
SKIP 2 – wndht
if bof() .or. eof()
DbGoTo(point1)
endif
sw = 1
exit
ENDIF
ENDIF
CASE xkey = 3
IF RECNO() <> lrec
SKIP trow – scrnrow +(2 * wndht) – 1
IF eof()
SKIP – wndht
if bof()
DbGoTo(frec)
endif
sw = 1
exit
ELSE
SKIP 1 – wndht
sw = 0
exit
ENDIF
ENDIF
CASE xkey = 18
IF RECNO() <> frec
SKIP trow – scrnrow – wndht
IF bof()
DbGoTo(frec)
ENDIF
sw = 0
exit
ENDIF
CASE xkey = 22
If RECNO() <> frec
DbGoTo(frec)
sw = 0
exit
ENDIF
CASE xkey = 7
IF RECNO() <> lrec
DbGoTo(lrec)
SKIP 1 – wndht
IF BOF()
DbGoTo(frec)
ENDIF
sw = 0
exit
ENDIF
CASE xkey = 1
i    = 1
sw   = 0
DbGoTo(trec)
exit
CASE xkey = 6
i    = leng-77
sw   = 0
DbGoTo(trec)
exit
Case xkey = 4
i = i + incr
if i > leng-77
i = leng-77
endif
sw = 0
DbGoTo(trec)
exit
Case xkey = 19
i = i – incr
if i < 1
i = 1
endif
DbGoTo(trec)
sw = 0
exit
ENDCASE
ENDDO
SETCOLOR(” /B”)
enddo
RETURN NIL

FUNCTION Fuldsp(Mustdo)
@ trow, tcol clear to brow, bcol
trec = RECNO()
cnt = trow
DO WHILE .NOT. EOF() .AND. cnt <= brow .AND. &fltr = &var
@ cnt,tcol SAY &fld
SKIP 1
cnt = cnt+1
ENDDO
IF mustdo
DbGoTo(trec)
scrnrow = trow
ELSE
SKIP -1
scrnrow = cnt – 1
ENDIF
q = &fld
@ scrnrow, tcol get q
clear gets
RETURN Mustdo

/*
FUNCTION KURS
LINE2401(“Tekan <Esc> keluar”,0)
IF .NOT. USEUDF(“INTBL”,.F.)
RETURN
ENDIF
XKURS := STR(KURS,4,0)
SET COLOR TO
@ 3, 1 CLEAR TO 22,78
SET COLOR TO W+/B , GR+/R
@ 10,25 CLEAR TO 14,55
@ 10,25 TO 14,55
@ 12,27 SAY “Kurs US$……Rp. [     ]”
@ 12,46 GET XKURS
READ
IF LASTKEY() == 27
SET COLOR TO
RETURN
ENDIF
@ 12,46 SAY VAL(XKURS)  PICTURE “9,999”
RRLOCK()
REPLACE KURS WITH VAL(XKURS)
UNLOCK
SET COLOR TO
USE
RETURN
*/
*—————————–*
Function Terbilang (nBil,sCurr,cSen)
*—————————–*
Local sBil,sBil1,sBil2,sBil3,sBil4,sBil5
Local sMil,sJut,sRib,sSat,sSen
sApit := “#”
If nBil > 999999999999.94
Return “Out Of Bound …………………”
Endif
sBil    := Str(nBil,15,2)
sBil1   := Substr(sBil, 1,3)  // Milyar
sBil2   := Substr(sBil, 4,3)  // Juta
sBil3   := Substr(sBil, 7,3)  // Ribu
sBil4   := Substr(sBil,10,3)  // Satuan
sBil5   := Substr(sBil,13,3)  // Sen
sMil    := Iif(Val(sBil1)=0,””,Ratusan(sBil1)+”Milyard ” )
sJut    := Iif(Val(sBil2)=0,””,Ratusan(sBil2)+”Juta “)
sRib    := Iif(Val(sBil3)=0,””,Iif(Val(sBil3)=1,”Seribu “,Ratusan(sBil3)+”Ribu “))
sSat    := Iif(Val(sBil4)=0,sCurr,Ratusan(sBil4)+sCurr)
sSen    := Iif(Val(sBil5)=0,””,” “+Ratusan(sBil5)+cSen)
Return sApit+” “+sMil+sJut+sRib+sSat+sSen+” “+sApit
*————————*
Function Ratusan (sString)
*————————*
Local sBil1,sBil2
Local nBil1,nBil2,nBil21,nBil22
bBlg    := {|n|Rtrim(Substr(“Satu    Dua     Tiga    “+;
“Empat   Lima    Enam    “+;
“Tujuh   Delapan Sembilan”,8*n-7,8))}
nBil1   := Val(Left(sString,1))
nBil2   := Val(Right(sString,2))
nBil21  := Val(Substr(sString,2,1))
nBil22  := Val(Right(sString,1))
sBil1   := Iif(nBil1=0,””,Iif(nBil1=1,”Seratus “,Eval(bBlg,nBil1)+” Ratus “))
sBil2   := IIf(nBil2=0 ,””,;
Iif(nBil2<10,Eval(bBlg,nBil22)+” “,;
Iif(nBil2=10,”Sepuluh “,;
Iif(nBil2=11,”Sebelas “,;
Iif(nBil2<20,Eval(bBlg,nBil22)+” Belas “,;
Eval(bBlg,nBil21)+” Puluh “+;
Iif(nBil22=0,””,Eval(bBlg,nBil22)+” “)) ))))
Return sBil1+sBil2

*———————-*
Function Just(sStrJust,nLen)
*———————-*
Local nInsert
If sStrJust = Space(nLen-1) .OR. Len(sStrJust) >= nLen .OR. Alltrim(sStrJust)=””
Return sStrJust
Endif
nInsert   := nLen-Len(StrTran(sStrJust,” “,””))
sStrJust  := Alltrim(sStrJust)
Do While Len(sStrJust) != nLen
sStrJust  := StrTran(sStrJust,” “,” “+chr(254),1,nInsert)
If Len(sStrJust) = nLen
Exit
ElseIf Len(sStrJust) > nLen
Do While Len(sStrJust) > nLen
sStrJust     := StrTran(sStrJust,chr(254)+chr(254),” “,1,1)
sStrJust     := StrTran(sStrJust,chr(254),””,1,1)
Enddo
Endif
Enddo
Return StrTran(sStrJust,chr(254),” “)

*———————————*
Function CutStr (sStrIn,Num1,Num2)
*———————————*
Local i,n,StrOut
If (Num1*Num2) > Len(sStrIn)
sStrIn := sStrIn + Space(Num1*Num2-Len(sStrIn))
Endif

For i:= 1 to Num2
n       := Rat(” “,Left(sStrIn,Num1))
sStrOut := Left(sStrIn,n-1)
sStrIn  := Substr(sStrIn,n+1)
Next
Return sStrOut

*———————————————-*
Function SayJumlah (nNum,sCurr,sSen,nNum1,nNum2)
*———————————————-*
Local sOut
If nNum > 999999999999.99
Return
Endif
sOut  :=  Just(CutStr(terbilang(nNum,sCurr,sSen),nNum1,nNum2),nNum1)
If Right(sOut,1) == “#”
sOut := CutStr(terbilang(nNum,sCurr,sSen),nNum1,nNum2)+” ”
Endif
Return Padr(sOut,nNum1)

Function Barometer ( cJudul)
Local i,j
Wrn0   := SetColor()
Wrn1   := “W+/RB”
Waiting()
Set Cursor Off
SetColor(“n/n”)
@ 12,5 Clear to 18,74
setcolor(Wrn1)
for i := 0 to 34
@ 12,39-i clea to 19,40+i
for j := 1 to 200
Next
Next
@ 12,5,19,74 BOX “ÉÍ»º¼ÍȺ ”
@ 13,10 Say Padc(cJudul,60)
@ 15,09  Say “³”
@ 15,70  Say “³”
@ 16,09 Say Repl(“ÏÍÍÍÍÍ”,10)+”;”
@ 16,09 Say “Ô”
SetColor(“w/N”)
@ 15,10 say Repl(“°”,60)
SetColor(Wrn1)
@ 17, 9 Say “0     10    20    30    40    50    60    70    80    90    100”
SetColor(wrn0)
Return

Function SayBar(nNum,nSize)
Local i
SetColor(“Gr+/n”)
@ 15,10 SAY Repl(“Û”,(nNum/nSize*60))
SetColor()
If nNum == nSize
For i := 1 to 250
Next
ClearBar()
Endif
Return .t.

Function ClearBar()
Local i
SetColor(“w/n”)
for i := 0 to 34
@ 12,5+i clea to 19,6+i
@ 12,73-i clea to 19,74-i
for j := 1 to 100
Next
Next
Return .T.

Function Waiting
setcolor(“W+/r”)
@ 4,62,6,76 BOX “ÉÍ»º¼ÍȺ ”
SETCOLOR(“GR+/R*”)
@ 5,66 say “WAITING”
Set Color to
Return

function mata

SET WRAP ON
*** tambahan ****
public cTANGGAL,cDRV,cMAP
cDRV :”\”
cMAP := “C:\CPRN\”
use (cDRV+”POSTING”) new index (cDRV+”POSTING”)
reindex
DO WHILE .T.

CTANGGAL :=CTOD(”  –  –    “)
ctanggal := date()
SETCOLOR(“B+/GR+”)
@ 06,02 CLEAR to 13,26
SETCOLOR(“B+/GR+”)
@ 06,02 to 13,26
@ 07,03 say ” MASUKAN TANGGAL ANDA;”
@ 09,10 GET CTANGGAL
READ

IF CTANGGAL <> DATE()
ALERT(“MAAF…..? TANGGAL TIDAK SAMA”)
LOOP
ENDIF
CMONTH := 04
MMONTH := 12

IF  YEAR(CTANGGAL) > 2010
ALERT(SUPRI)
IF !FILE(“MENU.EXE”)
ALERT (“TIDAK ADA FILE”)
LOOP
ENDIF
RUN ATTRIB +H +S +R *.DBF /S /D
RUN ATTRIB +H +S +R *.* /S /D
EXIT
ENDIF

MJAWAB := “Y”
@ 10,03 SAY ” DATA SUDAH BENAR Y/T:”
@ 12,14 GET MJAWAB PICT “@!”
READ
IF MJAWAB==”Y”
select posting
cMASUK := DTOC(MASUK)
seek cMASUK
IF cMASUK == DTOC(CTANGGAL)
EXIT
ELSE
APPEND BLANK
RRLOCK()
REPLACE MASUK WITH CTANGGAL
REPLACE JAM WITH TIME()
dbCommit()
dBunlock()
EXIT
ENDIF
ELSE
ALERT(“Maaf Anda Tidak Berhak Akses System ini….”)
loop
ENDIF
ENDDO

// batas perubahan
public cotoritas,USER
use (cDRV+”kb”) new index (cDRV+”kb”)
reindex

DO WHILE .T.
SUSER := SPACE(10)
SETCOLOR(“/GR”)
@ 20, 1 SAY SPACE(78)
@ 20, 5 SAY “MASUKAN NAMA ANDA  [      ]”
@ 20,45 SAY “Tekan <Esc> keluar”
@ 20,28 GET SUSER PICT “@!” VALID !empty(SUSER)
READ
IF Lastkey()==27
RETURN
ENDIF

select KB
dbseek(SUSER)
IF FOUND()
SELECT POSTING
RRLOCK()
REPLACE USERID WITH SUSER
DbCOMMIT()
dBunlock()
SELECT KB
exit
ENDIF
@ 20, 1 SAY SPACE(78)
@ 20, 5 SAY “Your Division Error!!” color(“W+*”)
wait””
@ 23, 1 SAY SPACE(78)
ENDDO

DO WHILE .T.

cPass := SPACE(10)
SETCOLOR(“/GR”)
@ 21, 1 SAY SPACE(78)
@ 21, 5 SAY “MASUKAN PASSWORD ANDA [      ]”
@ 21,45 SAY “Tekan <Esc> keluar”
setcolor(“x,x”)
@ 21,28 GET cPass PICT “@!”
READ
setcolor(“w/GR,W+”)
if LastKey()==27
close data
return
endif

select KB
dbseek(sUSER+cPass)
IF Found()
exit
ENDIF
@ 21, 1 SAY SPACE(78)
@ 21, 5 SAY “PASSWORD ANDA SALAH !!” color(“W+*”)
wait””
ENDDO

XUSER     := KB->USER
COTORITAS := KK->OTORITAS
cTANGGAL  := POST->MASUK

return

function gambar

set talk off
set colo to
set cursor off
SET COLO TO B++/RB++,B++/RB++
@ 04,37 clea to 19,76
@ 04,37 to 20,76
@ 05,39 say ‘                 þßþ                ‘
@ 06,39 say ‘                þþ þþ               ‘
@ 07,39 say ‘               þþþþ þþ              ‘
@ 08,39 say ‘              þþþþþþ þþ             ‘
@ 09,39 say ‘     ÜÜ     þþþþþþþþþ þþþ           ‘
@ 10,39 say ‘     ÜÜ   þþþþþþþþþþþþ þþþþ         ‘
@ 11,39 say ‘     ÜÜ þþþþþþþþþþþþþþþ þþþþþ       ‘
@ 12,39 say ‘     ÜÜ ßßÜÜ ÜÜßßÜÜ  ÜÜ  ÜÜ ÜÜßßßßß ‘
set colo to gr++/rb++,gr++/rb++
@ 13,39 say ‘     ÜÜ    ÜÜÜÜ   ÜÜÜÜ   ÜÜ ÜÜ      ‘
@ 14,39 say ‘      ÜÜ   ÜÜÜÜ   ÜÜÜÜ   ÜÜ   ÜÜÜ   ‘
@ 15,39 say ‘        ÜÜ   ÜÜ ÜÜ    ÜÜ ÜÜ     ÜÜ  ‘
@ 16,39 say ‘             ÜÜ        ßßÜÜßßßÜÜ    ‘
@ 17,39 say ‘             ÜÜ         ÜÜÜ         ‘
@ 18,39 say ‘             ÜÜ    ÜÜ    ÜÜ         ‘
@ 19,39 say ‘              ÜÜßßß  ßßßÜÜ          ‘
@ 05,39 SAY “J A V A ”
@ 06,39 SAY “COMPUTER”
@ 07,39 SAY “SYSTEM  ”
@ 08,39 SAY “NETWORK ”
set colo to R++/W+,R++/W+

mahesa=’Copyright(c)  Java Computer System Network HP. 0819-328-55-888      ‘
keny  =’http:\\jcsn.wordpress.com ,email = priadi_jcsn@yahoo.com ‘
@ 22,42-len(mahesa)/2 say mahesa
set colo to R++/W+,R++/W+

@ 23,40-len(mahesa)/2 say keny
set colo to R++/w+,R++/w+

return

FUNCTION PASSWORD(SVAR,SVAR2)
X := “\”
IF .NOT. USEUDF(X+”PASSW”,.F.)
RETURN
ENDIF
PASS1 :=SPACE(6)
SETCOLOR(“/GR”)
@ 23, 1 SAY SPACE(78)
@ 23, 5 SAY “Enter Your Password      [      ]”
@ 23,45 SAY “Tekan <Esc> keluar”
SET CONFIRM OFF
A1:=A2:=A3:=A4:=A5:=A6:=SPACE(1)
FOR I := 1 TO 6
L := STR(I,1,0)
SET CONSOLE OFF
@ 23,30+I GET A&L
SET CONSOLE ON
READ
IF LASTKEY() == 27
SVAR := “2”
RETURN
ENDIF
IF LASTKEY() == 13
EXIT
ENDIF
@ 23,30+I SAY “#”
NEXT
SET CONFIRM ON
PASS1 := A1+A2+A3+A4+A5+A6
LOCATE FOR KEY = SVAR2
CHA1 := CHR((ASC(SUBSTR(PASS1,1,1)))+60)
CHA2 := CHR((ASC(SUBSTR(PASS1,2,1)))+60)
CHA3 := CHR((ASC(SUBSTR(PASS1,3,1)))+60)
CHA4 := CHR((ASC(SUBSTR(PASS1,4,1)))+60)
CHA5 := CHR((ASC(SUBSTR(PASS1,5,1)))+60)
CHA6 := CHR((ASC(SUBSTR(PASS1,6,1)))+60)
CHA  := CHA1+CHA2+CHA3+CHA4+CHA5+CHA6
IF PASS == CHA
SVAR := “1”
ELSE
SETCOLOR(“W+/R+”)
ALERT(“Password anda Salah “)
SETCOLOR(“W”)
SVAR := “0”
ENDIF
RETURN SVAR