PROCEDURE AddRoot(o) IF JENIS$'AHMPBS' oNode=o.add(,1,ALLTRIM(NOPER)+'_',ALLTRIM(NOPER)+' '+ALLTRIM(NAPER),0) ELSE oNode=o.add(,1,ALLTRIM(NOPER)+'_',ALLTRIM(NAPER),0) ENDIF oNode.Sorted=.T. oNode.Expanded=.F. ENDPROC

IF Buka(.f.,'Alamat','Alamat') SELECT LEFT(KODE,1) AS KRU,Alamat AS ALAMATKR FROM Alamat WHERE KLP=='AKR' INTO CURSOR KRU_JNS SELECT KRU_JNS GO TOP IF EOF() Inipesan('Cek File'+CHR(13)+'Alamat data kredit tidak ditemukan') CLOSE TABLES ALL RETURN ENDIF TUTUP("GASYKLAS") ELSE Inipesan('Cek File'+CHR(13)+'Alamat data kredit tidak ditemukan') CLOSE TABLES ALL RETURN ENDIF Tunggu("Buka file",1) Select KRU_JNS Go TOP DO WHILE Not Eof() MFILEMST=ALLTRIM(ALAMATKR)+'KM'+ALLTRIM(KRU)+'MST' MFILETRS=ALLTRIM(ALAMATKR)+'KK'+Alltrim(KRU)+'TRS' MFILERCS=ALLTRIM(ALAMATKR)+'KK'+Alltrim(KRU)+'RCS' MFILERLSH=ALLTRIM(ALAMATKR)+'KT'+ALLTRIM(KRU)+'RLS_H' MFILETRSH=ALLTRIM(ALAMATKR)+'KT'+ALLTRIM(KRU)+'TRS_H' MFILERCSH=ALLTRIM(ALAMATKR)+'KT'+ALLTRIM(KRU)+'RCS_H' MFILERLSB=ALLTRIM(ALAMATKR)+'KR'+ALLTRIM(KRU)+GS_NTOC(GASY_TGL)+STR(YEAR(GASY_TGL),4) MFILETRSB=ALLTRIM(ALAMATKR)+'KU'+ALLTRIM(KRU)+GS_NTOC(GASY_TGL)+STR(YEAR(GASY_TGL),4) MFILERCSB=ALLTRIM(ALAMATKR)+'KC'+ALLTRIM(KRU)+GS_NTOC(GASY_TGL)+STR(YEAR(GASY_TGL),4) BUKA(.T.,(MFILEMST),'KR_MST',(MFILEMST+'1'),(MFILEMST+'2'),(MFILEMST+'3')) If Used("KR_MST") BUKA(.T.,(MFILETRSH),'KR_TRS_H') If Used("KR_TRS_H") BUKA(.T.,(MFILERLSH),'KR_RLS_H') If Used("KR_RLS_H") BUKA(.T.,(MFILERCSH),'KR_RCS_H') If Used("KR_RCS_H") BUKA(.T.,(MFILETRSB),'KR_TRS_B') If Used("KR_TRS_B") BUKA(.T.,(MFILERCSB),'KR_RCS_B') If Used("KR_RCS_B") BUKA(.T.,(MFILERLSB),'KR_RLS_B') If Used("KR_RLS_B") BUKA(.T.,(MFILETRS),'KR_TRS',(MFILETRS)) If Used("KR_TRS") BUKA(.T.,(MFILERCS),'KR_RCS',(MFILERCS)) Endif Endif Endif Endif Endif Endif Endif Endif If Used("KR_MST") And Used("KR_TRS") And Used("KR_RCS") ; And Used("KR_TRS_H") And Used("KR_TRS_B") And Used("KR_RLS_H") ; And Used("KR_RLS_B") And Used("KR_RCS_H") And Used("KR_RCS_B") SELECT KR_TRS_H Go TOP If !Eof() Tunggu("Update Data harian - ANGSURAN",1) Select KR_TRS Append From (MFILETRSH) FOR ANG_POKOK+ANG_BUNGA+DENDA+BY_TAGIH>0 Select KR_TRS_B Append From (MFILETRSH) FOR ANG_POKOK+ANG_BUNGA+DENDA+BY_TAGIH>0 Tunggu("Update Data harian - ANGSURAN",100) Endif SELECT KR_RLS_H Go TOP If !Eof() Tunggu("Update Data harian - REALISASI",1) Select KR_RLS_B Append From (MFILERLSH) Tunggu("Update Data harian - REALISASI",100) Endif SELECT KR_RCS_H Go TOP If !Eof() Tunggu("Update Data harian - RC ",1) Select KR_RCS_B Append From (MFILERCSH) Tunggu("Update Data harian - RC ",100) Endif Select KR_TRS_H Go TOP Do While Not Eof() Delete Skip Enddo Pack Select KR_RCS_H Go TOP Do While Not Eof() Delete Skip Enddo Pack Select KR_RLS_H Go TOP Do While Not Eof() Delete Skip Enddo Pack TUTUP("KR_TRS","KR_RCS","KR_TRS_H","KR_TRS_B","KR_RLS_H","KR_RLS_B","KR_MST","KR_RCS_H","KR_RCS_B") Endif Select KRU_JNS Skip Enddo CLOSE TABLES ALL Tunggu("Proses selesai",100,0) ENDPROC

LOCAL mSeri, mFileTrs, mAlamatD, mFileKrt, mTgl, mKali IF Buka(.f.,'Alamat','Alamat') SELECT LEFT(KODE,1) AS TBU,Alamat AS ALAMATDATA FROM Alamat WHERE KLP=='ATB' INTO CURSOR TBU_JNS SELECT TBU_JNS GO TOP IF EOF() Inipesan('Cek File'+CHR(13)+'Alamat data tabungan tidak ditemukan') CLOSE TABLES ALL RETURN ENDIF TUTUP("GASYKLAS") ELSE Inipesan('Cek File'+CHR(13)+'Alamat data tabungan tidak ditemukan') CLOSE TABLES ALL RETURN ENDIF Tunggu("Proses akhir hari tabungan",1) mTgl=Gasy_Tgl mKali=0 Select TBU_JNS Go TOP Do While Not Eof() MSERI=TBU MFILETRS=ALLTRIM(ALAMATDATA)+'TT'+Alltrim(mSERI)+'TRS_H' MALAMATD=Alltrim(ALAMATDATA) BUKA(.T.,MFILETRS,'TB_TRS_H') If Used("TB_TRS_H") Select TB_TRS_H Go TOP MTGL=TGL_TRS If !Empty(MTGL) MFILEKRT=MALAMATD+'TK'+Alltrim(mSERI)+GS_NTOC(mTGL)+STR(YEAR(mTGL),4) MFILESLD=MALAMATD+'TS'+Alltrim(mSERI)+GS_NTOC(mTGL)+STR(YEAR(mTGL),4) BUKA(.T.,MFILEKRT,'TB_KRT',MFILEKRT) BUKA(.T.,MFILESLD,'TB_SLD',MFILESLD) Endif Endif If Used("TB_TRS_H") And Used("TB_KRT") AND USED("TB_SLD") mKali=mKali+1 SELECT TB_TRS_H IF !EOF() Tunggu("Update data seri "+TBU_JNS.TBU,1) SELECT TB_KRT APPEND FROM (MFILETRS) FOR NILAI_RP>0 FLUSH Tunggu("Update data seri "+TBU_JNS.TBU,100) ENDIF SELECT TB_TRS_H mJml=RECCOUNT() mMulai=0 GO TOP DO WHILE NOT EOF() mKode=Kode mNilaiRp=Nilai_Rp mSd=Sd mGrp=GRP mMulai=mMulai+1 SELECT TB_SLD SET ORDER TO 1 SEEK MkODE IF !FOUND() APPEND BLANK REPLACE KODE WITH MKODE, GRP WITH mGRP ENDIF REPLACE TBS_KINI WITH TBS_KINI+IIF(MSD$'013567',MNILAIRP,0),; TBT_KINI WITH TBT_KINI+IIF(MSD$'2468',MNILAIRP,0) Tunggu("Update data..."+mKode,mMulai/mJml*100) SELECT TB_TRS_H DELETE SKIP ENDDO SELECT TB_TRS_H Pack TUTUP("TB_TRS_H","TB_KRT","TB_SLD") Endif Select TBU_JNS Skip Enddo Close Tables all MALAMATD=alamatnya('ADA') MFILETRS=MALAMATD+'DA_TRS_H' BUKA(.T.,MFILETRS,'DA_TRS_H') If Used("DA_TRS_H") Select DA_TRS_H Go TOP MTGL=TGL_TRS If !Empty(MTGL) MFILEKRT=MALAMATD+'DH_'+GS_NTOC(mTGL)+STR(YEAR(mTGL),4) MFILESLD=MALAMATD+'DA_'+GS_NTOC(mTGL)+STR(YEAR(mTGL),4) BUKA(.T.,MFILEKRT,'DH_KRT',MFILEKRT) BUKA(.T.,MFILESLD,'DA_SLD',MFILESLD) Endif Endif If Used("DA_TRS_H") And Used("DH_KRT") AND USED("DA_SLD") mKali=mKali+1 SELECT DA_TRS_H IF !EOF() Tunggu("Update data ",1) SELECT DH_KRT APPEND FROM (MFILETRS) FOR NILAI_RP>0 FLUSH Tunggu("Update data",100) ENDIF SELECT DA_TRS_H mJml=RECCOUNT() mMulai=0 GO TOP DO WHILE NOT EOF() mKode=Kode mNilaiRp=Nilai_Rp mSd=Sd mGrp=GRP mMulai=mMulai+1 SELECT DA_SLD SET ORDER TO 1 SEEK MkODE IF !FOUND() APPEND BLANK REPLACE KODE WITH MKODE, GRP WITH mGRP ENDIF REPLACE TBS_KINI WITH TBS_KINI+IIF(MSD$'013567',MNILAIRP,0),; TBT_KINI WITH TBT_KINI+IIF(MSD$'2468',MNILAIRP,0) Tunggu("Update data..."+mKode,mMulai/mJml*100) SELECT DA_TRS_H DELETE SKIP ENDDO SELECT DA_TRS_H Pack TUTUP("DA_TRS_H","DH_KRT","DA_SLD") Endif Tunggu("Proses selesai",100,0) ENDPROC

IF Buka(.f.,'Alamat','Alamat') SELECT LEFT(KODE,1) AS TBP,Alamat AS ALAMATDATA FROM Alamat WHERE KLP=='ATP' INTO CURSOR TBP_JNS SELECT TBP_JNS GO TOP IF EOF() Inipesan('Cek File'+CHR(13)+'Alamat data tabungan tidak ditemukan') CLOSE TABLES ALL RETURN ENDIF TUTUP("GASYKLAS") ELSE Inipesan('Cek File'+CHR(13)+'Alamat data tabungan tidak ditemukan') CLOSE TABLES ALL RETURN ENDIF Tunggu("Proses akhir hari tabungan program",1) SELECT TBP_JNS GO TOP DO WHILE NOT EOF() mFILETRS=ALLTRIM(ALAMATDATA)+'TP_KRT'+ALLTRIM(TBP) mFILETRSH=ALLTRIM(ALAMATDATA)+'TP_TRSH'+ALLTRIM(TBP) BUKA(.T.,mFILETRS,'TP_KRT',mFILETRS) BUKA(.T.,mFILETRSH,'TP_TRS_H') IF USED("TP_TRS_H") AND USED("TP_KRT") SELECT TP_TRS_H GO TOP IF !EOF() Tunggu("Update data harian",1) SELECT TP_KRT APPEND FROM (MFILETRSH) FOR NILAI_RP+JML_BUNGA+JML_PAJAK+JML_ADMIS>0 FLUSH Tunggu("Update data harian OK",100) ENDIF SELECT TP_TRS_H GO TOP DO WHILE NOT EOF() Tunggu("Hapus....."+Kode,RECNO()/RECCOUNT()*100) DELETE SKIP ENDDO PACK USE ENDIF SELECT TBP_JNS SKIP ENDDO Close Tables ALL Tunggu("Proses selesai",100,0) ENDPROC

FUNCTION AK_JCN(x11) IF !USED("AK_JCN") BUKA(x11,ALAMATDL+"AK_JCN","AK_JCN",ALAMATDL+"AK_JCN") ENDIF RETURN (USED('AK_JCN')) ENDFUNC

FUNCTION AK_MST(lExcl,xxTgl) LOCAL mKey0, mKey1, mKey2, mKey3 IF !USED("AK_MST") IF EMPTY(xxTgl) RETURN .F. ENDIF ALAMATAK=ALAMATNYA('AAK') IF !EMPTY(ALAMATAK) mKEY0=ALAMATAK+'AKM_'+STR(YEAR(xxTGL),4) mKEY1=ALAMATAK+'AK1_'+STR(YEAR(xxTGL),4) mKEY2=ALAMATAK+'AK2_'+STR(YEAR(xxTGL),4) mKEY3=ALAMATAK+'AK3_'+STR(YEAR(xxTGL),4) BUKA(lExcl,mKEY0,'AK_MST',mKEY1,mKEY2,mKEY3) RELEASE mKey* ENDIF ENDIF RETURN (USED("AK_MST")) ENDFUNC

PROCEDURE AK_MST(lSHARE,pTgl,lReindeks) cLokasi=ALAMATNYA("AAK") cTgl=DATE() IF TYPE("pTGL")="D" AND !EMPTY(pTGL) cTGL=pTgl ENDIF mFILE=cLokasi+"AKM_"+STR(YEAR(cTGL),4) mFILEKEY1=cLokasi+"AK1_"+STR(YEAR(cTGL),4) mFILEKEY2=cLokasi+"AK2_"+STR(YEAR(cTGL),4) mFILEKEY3=cLokasi+"AK3_"+STR(YEAR(cTGL),4) Tutup("AK_MST") IF !FILE(mFILE+".DBF") Tunggu("Proses indek file master rekening akuntansi"+CHR(13)+mFile,1) CHEKFOLDER(MFILE+".DBF") CREATE TABLE (mFILE) ; (; NOPER C(10),; NAPER C(30),; JENIS C(1),; SIFAT C(1),; LEPEL N(1),; UMUM C(10),; Kode C(30),; DBBLA N(15,2),; KRBLA N(15,2),; DBBLI01 N(15,2),; KRBLI01 N(15,2),; DBBLI02 N(15,2),; KRBLI02 N(15,2),; DBBLI03 N(15,2),; KRBLI03 N(15,2),; DBBLI04 N(15,2),; KRBLI04 N(15,2),; DBBLI05 N(15,2),; KRBLI05 N(15,2),; DBBLI06 N(15,2),; KRBLI06 N(15,2),; DBBLI07 N(15,2),; KRBLI07 N(15,2),; DBBLI08 N(15,2),; KRBLI08 N(15,2),; DBBLI09 N(15,2),; KRBLI09 N(15,2),; DBBLI10 N(15,2),; KRBLI10 N(15,2),; DBBLI11 N(15,2),; KRBLI11 N(15,2),; DBBLI12 N(15,2),; KRBLI12 N(15,2),; DBHRI N(15,2),; KRHRI N(15,2); ) USE IF BUKA(.T.,mFILE,"AK_MST") SELECT AK_MST INDEX ON NOPER TO (mFILEKEY1) INDEX ON UPPER(NAPER) TO (mFILEKEY2) ADDITIVE INDEX ON UMUM TO (mFILEKEY3) ADDITIVE ENDIF Tutup("AK_MST") ENDIF IF lReindeks Tunggu("Proses indek file master rekening akuntansi"+CHR(13)+mFile,1) IF BUKA(.T.,mFILE,"AK_MST") SELECT AK_MST PACK INDEX ON NOPER TO (mFILEKEY1) INDEX ON UPPER(NAPER) TO (mFILEKEY2) ADDITIVE INDEX ON UMUM TO (mFILEKEY3) ADDITIVE ENDIF Tutup("AK_MST") ENDIF RETURN (BUKA(lShare,mFILE,"AK_MST",mFileKey1,mFileKey2,mFileKey3)) ENDPROC

FUNCTION AK_SALDO(xJENIS,nBULAN) LOCAL mDB, mKR STORE 0 TO mDB, mKR IF nBULAN>0 mDB=JML_SDK(nBULAN,"DBBLI") mKR=JML_SDK(nBULAN,"KRBLI") ENDIF RETURN IIF(xJENIS$"AB",DBBLA-KRBLA+mDB-mKR,KRBLA-DBBLA+mKR-mDB) ENDFUNC

FUNCTION AK_STD(x11) IF !USED("AK_STD") BUKA(x11,ALAMATDL+"AK_STD","AK_STD",ALAMATDL+"AK_STD") ENDIF RETURN (USED('AK_STD')) ENDFUNC

FUNCTION ANGKAKOMA(XANGKA,NDES) Local MANGKA, MPENUH, MDES1, MDES2, MDES3, MDES4 NDES=Iif(Pcount()=1,2,4) Do Case Case NDES=2 MANGKA=Alltrim(Transform(XANGKA,'999999999999.99')) Do Case Case XANGKA=0 Return ("Nol") Case XANGKA>0 MDES1=Alltrim(Konversi(Val(Left(Right(MANGKA,2),1)))) MDES2=Alltrim(Konversi(Val(Right(Right(MANGKA,2),1)))) MPENUH=Alltrim(Konversi(XANGKA-Val(Right(MANGKA,2)))) Return (MPENUH+" Koma "+MDES1+" "+MDES2) Endcase Case NDES=4 MANGKA=Alltrim(Transform(XANGKA,'999999999999.9999')) Do Case Case XANGKA=0 Return "Nol" Case XANGKA>0 MDES1=Alltrim(Konversi(Val(Left(Right(MANGKA,4),1)))) MDES2=Alltrim(Konversi(Val(Substr(Right(MANGKA,4),2,1)))) MDES3=Alltrim(Konversi(Val(Substr(Right(MANGKA,4),3,1)))) MDES4=Alltrim(Konversi(Val(Substr(Right(MANGKA,4),3,1)))) MPENUH=Alltrim(Konversi(XANGKA-Val(Right(MANGKA,4)))) Return (MPENUH+" Koma "+MDES1+" "+MDES2+" "+MDES3+" "+MDES4) Endcase Endcase Return "" ENDFUNC

PROCEDURE BK_ALAMAT(nDATA1) IDATA='BMPS\ALAMATDATA\ALAMAT_'+TRANSFORM(NDATA1)+'.DBF' TUTUP(JUSTSTEM(IDATA),"TUTUP") IF !FILE(IDATA) CHEKFOLDER(IDATA) CREATE TABLE (IDATA) ; (; KLP C(3),; KODE C(2),; KETERANGAN C(60),; ALAMAT C(250); ) USE ENDIF RETURN (BUKA(.F.,(IDATA),"ALAMAT")) ENDPROC

************************************************** *-- Class: _gede (c:\gasybali\akhirbln.vcx) *-- ParentClass: custom *-- BaseClass: custom *-- Time Stamp: 03/15/04 05:35:06 AM * oGasyLah=NEWOBJECT('_gede') oGasyLah.AturForm DEFINE CLASS _gede AS custom Width = 17 Name = "_gede" PROCEDURE aturform * to stagger existing forms with current frame. * Returns number of forms arranged. LPARAMETERS tcFormName,tlOmitAutoCenteredForms,tnStartTop, tnStartLeft, tnStartColumn #DEFINE WINDOW_STAGGER_FACTOR SYSMETRIC(9) * window title height ASSERT EMPTY(tcFormName) OR (VARTYPE(tcFormName) = "C" AND WEXIST(tcFormName)) LOCAL lnArranged, lnColumn, lnTop, lnLeft, loFormRef, ; lnParentHeight, lnScaleMode, lnIndex, llAllForms, loFrame, llInScreen, ; llRightFrame, llMoreTopForms loFrame = THIS.GetCurrentTopFormRef() llInScreen = (loFrame.ShowWindow = 0) lnScaleMode = loFrame.ScaleMode loFrame.ScaleMode = 3 lnArranged = 0 lnTop = IIF(VARTYPE(tnStartTop) = "N", tnStartTop, 0) lnLeft = IIF(VARTYPE(tnStartLeft) = "N", tnStartLeft,0) lnColumn = IIF(VARTYPE(tnStartColumn) = "N" AND tnStartColumn > 0, ; tnStartColumn, 1) lnParentHeight = loFrame.Height llAllForms = EMPTY(tcFormName) FOR lnIndex = _SCREEN.FormCount TO 1 STEP -1 loFormRef = _SCREEN.Forms(lnIndex) IF UPPER(loFormRef.BaseClass) == "TOOLBAR" LOOP ENDIF DO CASE CASE llInScreen AND ; lnIndex = _SCREEN.FormCount AND ; INLIST(loFormRef.ShowWindow,0,1) llRightFrame = .T. * go right ahead and process these windows CASE llInScreen AND ; loFormRef.ShowWindow = 0 llRightFrame = .T. CASE llInScreen AND ; loFormRef.ShowWindow = 2 LOOP * the real problem is ShowWindow = 1 * where you are mixing them some in Screen * and some in top forms. This has to be * taken care of separately in 5, but in 6 * apparently these windows show up with ShowWindow = 0!! CASE INLIST(loFormRef.ShowWindow,0,1) AND ; NOT llRightFrame * we haven't gotten to the right group of windows yet LOOP CASE llRightFrame AND loFormRef.ShowWindow = 2 * we've reached another frame EXIT CASE loFormRef.ShowWindow = 2 AND loFormRef # loFrame * still wrong group LOOP CASE loFormRef.ShowWindow = 2 llRightFrame = .T. LOOP * now we can work on the window group * we'll see next in the stack... OTHERWISE * we're in an appropriate window, cascade it ENDCASE IF (llAllForms OR UPPER(loFormRef.Name) == UPPER(tcFormName)) AND ; loFormRef.WindowState = 0 AND loFormRef.Visible AND ; (NOT (tlOmitAutoCenteredForms AND loFormRef.AutoCenter)) lnArranged = lnArranged + 1 loFormRef.Top = lnTop loFormRef.Left = (lnLeft * lnColumn) loFormRef.AutoCenter = .F. IF lnTop > lnParentHeight - WINDOW_STAGGER_FACTOR STORE WINDOW_STAGGER_FACTOR TO lnTop, lnLeft lnColumn = lnColumn + 1 ENDIF lnTop = lnTop + WINDOW_STAGGER_FACTOR lnLeft = lnLeft + WINDOW_STAGGER_FACTOR ELSE * do nothing ENDIF ENDFOR loFrame.ScaleMode = lnScaleMode RETURN lnArranged ENDPROC PROCEDURE getcurrenttopformref LOCAL loForm, loTopForm * first top form in the list * will be the current top form. * DON"T USE THIS METHOD in VFP 5 IF YOU MIX * _SCREEN-owned forms with topform-Owned * forms unless you use ShowWindow = 0 for * all _screen-owned forms! In 6 it appears okay ASSERT TYPE("_SCREEN.ActiveForm") # "O" OR ; INLIST(_SCREEN.ActiveForm.ShowWindow, 0,1,2) DO CASE CASE _SCREEN.FormCount = 0 OR ; (TYPE("_SCREEN.ActiveForm") = "O" AND ; _SCREEN.ActiveForm.ShowWindow = 0 ) && ShowWindow In Screen loTopForm = _SCREEN CASE (TYPE("_SCREEN.ActiveForm") = "O" AND ; _SCREEN.ActiveForm.ShowWindow = 2 ) && ShowWindow As Top Form loTopForm = _SCREEN.ActiveForm OTHERWISE FOR EACH loForm IN _SCREEN.Forms && note: these may be toolbars && if undocked, but that's okay -- && they are only ShowWIndow 0 or 1. IF loForm.ShowWindow = 2 && the first one in the collection will && be "active top form" loTopForm = loForm EXIT ENDIF ENDFOR IF VARTYPE(loTopForm) # "O" loTopForm = _SCREEN ENDIF ENDCASE RETURN loTopForm ENDPROC ENDDEFINE * *-- EndDefine: _gede **************************************************

FUNCTION BOLEH PARAMETERS MKODE,nPos LOCAL mCari mCari=mKode+mPhoto IF GASYKLAS() SELECT GASYKLAS SET ORDER TO 1 SEEK mCari IF FOUND() RETURN IIF(SUBSTR(Keterangan,nPos,1)=="1",.T.,.F.) ENDIF ENDIF RETURN .F. ENDFUNC

FUNCTION BOM(xTGL) RETURN xTGL-DAY(xTGL)+1 ENDFUNC

FUNCTION BUKA(lEXC, cTABLE, cALIAS, cIDX1, cIDX2, cIDX3 ) If Used(cALIAS) Select (cALIAS) Use Endif If !Used(cALIAS) IF lEXC USE (cTABLE) IN 0 ALIAS (cALIAS) EXCLUSIVE ELSE USE (cTABLE) IN 0 ALIAS (cALIAS) SHARED Endif Endif If !Used(cALIAS) Return .F. Endif SELECT (cALIAS) IF PCOUNT()=4 SET INDEX TO (cIDX1) ENDIF IF PCOUNT()=5 SET INDEX TO (cIDX1),(cIDX2) ENDIF IF PCOUNT()=6 SET INDEX TO (cIDX1),(cIDX2),(cIDX3) ENDIF RETURN .T. ENDFUNC

PROCEDURE BUKADBF( lExcl, mP1, cLokasi, cJns, mP2) DO case mP1=UPPER(mP1) CASE mP1=="DP_MST" IF !USED('DP_MST') BUKA(lExcl,cLokasi+'DP_MST','DP_MST',cLokasi+'DP_MST1',cLokasi+'DP_MST2',cLokasi+'DP_MST3') ENDIF RETURN USED('DP_MST') CASE mP1=="DP_BNG" IF !USED('DP_BNG') BUKA(lExcl,cLokasi+'DP_BNG','DP_BNG',cLokasi+'DP_BNG') ENDIF RETURN USED('DP_BNG') CASE mP1=="DP_TRS_H" IF !USED('DP_TRS_H') BUKA(lExcl,cLokasi+'DP_TRS_H','DP_TRS_H') ENDIF RETURN USED('DP_TRS_H') CASE mP1=="KR_MST" IF !USED('KR_MST') MFILEMST=cLokasi+'KM'+ALLTRIM(cJns)+'MST' BUKA(lExcl,(MFILEMST),'KR_MST',(MFILEMST+'1'),(MFILEMST+'2'),(MFILEMST+'3')) ENDIF RETURN USED('KR_MST') CASE mP1=="KR_RLS_H" IF !USED('KR_RLS_H') MFILERLSH=cLokasi+'KT'+ALLTRIM(cJns)+'RLS_H' BUKA(lExcl,(MFILERLSH),'KR_RLS_H') ENDIF RETURN USED('KR_RLS_H') CASE mP1=="KR_TRS_H" IF !USED('KR_TRS_H') MFILETRSH=cLokasi+'KT'+ALLTRIM(cJns)+'TRS_H' BUKA(lExcl,(MFILETRSH),'KR_TRS_H') ENDIF RETURN USED('KR_TRS_H') CASE mP1=="KR_RCS_H" IF !USED('KR_RCS_H') MFILERCSH=cLokasi+'KT'+ALLTRIM(cJns)+'RCS_H' BUKA(lExcl,(MFILERCSH),'KR_RCS_H') ENDIF RETURN USED('KR_RCS_H') CASE mP1=="KR_TRS" IF !USED('KR_TRS') MFILETRS=cLokasi+'KK'+Alltrim(cJns)+'TRS' BUKA(lExcl,(MFILETRS),'KR_TRS',(MFILETRS)) ENDIF RETURN USED('KR_TRS') CASE mP1=="KR_MSTB" IF !USED('KR_MSTB') MFILETRS=cLokasi+'KB'+Alltrim(cJns)+GS_NTOC(MP2)+STR(YEAR(MP2),4) BUKA(lExcl,(MFILETRS),'KR_MSTB') ENDIF RETURN USED('KR_MSTB') CASE mP1=="KR_RCS" IF !USED('KR_RCS') MFILERCS=cLokasi+'KK'+Alltrim(cJns)+'RCS' BUKA(lExcl,(MFILERCS),'KR_RCS',(MFILERCS)) ENDIF RETURN USED('KR_RCS') CASE mP1=="KR_JAM" IF !USED('KR_JAM') MFILEJAM=clokasi+'KJ'+Alltrim(cJns)+'JAM' BUKA(lExcl,(MFILEJAM),'KR_JAM',(MFILEJAM)) ENDIF RETURN USED('KR_JAM') CASE mP1=="KR_BNG" IF !USED('KR_BNG') MFILEBNG=cLokasi+'KA'+Alltrim(cJns)+'BNG' BUKA(lExcl,(MFILEBNG),'KR_BNG',(MFILEBNG)) ENDIF RETURN USED('KR_BNG') CASE mP1=="TB_TRS_H" IF !USED('TB_TRS_H') MFILETRS=cLOKASI+'TT'+Alltrim(cJns)+'TRS_H' BUKA(lExcl,MFILETRS,'TB_TRS_H') ENDIF RETURN USED('TB_TRS_H') CASE mP1=="TB_MST" IF !USED('TB_MST') MFILEMST=cLokasi+'TM'+Alltrim(cJns)+'MST' BUKA(lExcl,MFILEMST,'TB_MST',MFILEMST+'1',MFILEMST+'2') ENDIF RETURN USED('TB_MST') CASE mP1=='TB_KRT' IF !USED('TB_KRT') MFILEKRT=cLOKASI+'TK'+Alltrim(cJns)+GS_NTOC(mP2)+STR(YEAR(mP2),4) BUKA(lExcl,MFILEKRT,'TB_KRT',MFILEKRT) ENDIF RETURN USED('TB_KRT') CASE mP1=='TB_SLD' IF !USED('TB_SLD') MFILESLD=cLOKASI+'TS'+Alltrim(cJns)+GS_NTOC(mP2)+STR(YEAR(mP2),4) BUKA(lExcl,MFILESLD,'TB_SLD',MFILESLD) ENDIF RETURN USED('TB_SLD') CASE mP1=="TP_MST" IF !USED('TP_MST') mFILEMST=cLokasi+'TP_MST'+ALLTRIM(cJns) BUKA(lExcl,mFILEMST,'TP_MST',mFILEMST+'1',mFILEMST+'2') ENDIF RETURN USED('TP_MST') CASE mP1=="TP_KRT" IF !USED('TP_KRT') mFILETRS=cLOkasi+'TP_KRT'+ALLTRIM(cJns) BUKA(lExcl,mFILETRS,'TP_KRT',mFILETRS) ENDIF RETURN USED('TP_KRT') CASE mP1=="TP_TRS_H" IF !USED('TP_TRS_H') mFILETRSH=cLokasi+'TP_TRSH'+ALLTRIM(cJns) BUKA(lExcl,mFILETRSH,'TP_TRS_H') ENDIF RETURN USED('TP_TRS_H') CASE mP1=="AK_BBB" IF !USED("AK_BBB") mFILEDBF=cLokasi+"BB_"+GS_NTOC(mP2)+STR(YEAR(mP2),4) BUKA(lExcl,mFILEDBF,"AK_BBB",mFILEDBF) ENDIF RETURN USED("AK_BBB") CASE mP1=="DN_MST" IF !USED('DN_MST') BUKA(lExcl,cLokasi+'DN_MST','DN_MST',cLokasi+'DN_MST1',cLokasi+'DN_MST2') ENDIF RETURN USED("DN_MST") CASE mP1=="AK_MST" IF !USED("AK_MST") mKEY0=cLokasi+'AKM_'+STR(YEAR(mP2),4) mKEY1=cLokasi+'AK1_'+STR(YEAR(mP2),4) mKEY2=cLokasi+'AK2_'+STR(YEAR(mP2),4) mKEY3=cLokasi+'AK3_'+STR(YEAR(mP2),4) BUKA(lExcl,mKEY0,'AK_MST',mKEY1,mKEY2,mKEY3) ENDIF RETURN USED("AK_MST") CASE mP1=="CJHARIAN" IF !USED("CJHARIAN") BUKA(lExcl,(cLokasi+"CJHARIAN"),"CJHARIAN",(cLokasi+"CJHARIAN")) ENDIF RETURN USED("CJHARIAN") CASE mP1=="GJHARIAN" IF !USED("GJHARIAN") BUKA(lExcl,(cLokasi+"GJHARIAN"),"GJHARIAN",(cLokasi+"GJHARIAN")) ENDIF RETURN USED("GJHARIAN") ENDCASE RETURN .f. ENDPROC

PROCEDURE BUKADBF(lExcl, mP1, cLokasi, cJns, mP2) DO case mP1=UPPER(mP1) CASE mP1=="DP_MST" IF !USED('DP_MST') BUKA(lExcl,cLokasi+'DP_MST','DP_MST',cLokasi+'DP_MST1',cLokasi+'DP_MST2',cLokasi+'DP_MST3') ENDIF RETURN USED('DP_MST') CASE mP1=="DP_BNG" IF !USED('DP_BNG') BUKA(lExcl,cLokasi+'DP_BNG','DP_BNG',cLokasi+'DP_BNG') ENDIF RETURN USED('DP_BNG') CASE mP1=="DP_TRS_H" IF !USED('DP_TRS_H') BUKA(lExcl,cLokasi+'DP_TRS_H','DP_TRS_H') ENDIF RETURN USED('DP_TRS_H') CASE mP1=="KR_MST" IF !USED('KR_MST') MFILEMST=cLokasi+'KM'+ALLTRIM(cJns)+'MST' BUKA(lExcl,(MFILEMST),'KR_MST',(MFILEMST+'1'),(MFILEMST+'2'),(MFILEMST+'3')) ENDIF RETURN USED('KR_MST') CASE mP1=="KR_RLS_H" IF !USED('KR_RLS_H') MFILERLSH=cLokasi+'KT'+ALLTRIM(cJns)+'RLS_H' BUKA(lExcl,(MFILERLSH),'KR_RLS_H') ENDIF RETURN USED('KR_RLS_H') CASE mP1=="KR_TRS_H" IF !USED('KR_TRS_H') MFILETRSH=cLokasi+'KT'+ALLTRIM(cJns)+'TRS_H' BUKA(lExcl,(MFILETRSH),'KR_TRS_H') ENDIF RETURN USED('KR_TRS_H') CASE mP1=="KR_RCS_H" IF !USED('KR_RCS_H') MFILERCSH=cLokasi+'KT'+ALLTRIM(cJns)+'RCS_H' BUKA(lExcl,(MFILERCSH),'KR_RCS_H') ENDIF RETURN USED('KR_RCS_H') CASE mP1=="KR_TRS" IF !USED('KR_TRS') MFILETRS=cLokasi+'KK'+Alltrim(cJns)+'TRS' BUKA(lExcl,(MFILETRS),'KR_TRS',(MFILETRS)) ENDIF RETURN USED('KR_TRS') CASE mP1=="KR_RCS" IF !USED('KR_RCS') MFILERCS=cLokasi+'KK'+Alltrim(cJns)+'RCS' BUKA(lExcl,(MFILERCS),'KR_RCS',(MFILERCS)) ENDIF RETURN USED('KR_RCS') CASE mP1=="KR_JAM" IF !USED('KR_JAM') MFILEJAM=clokasi+'KJ'+Alltrim(cJns)+'JAM' BUKA(lExcl,(MFILEJAM),'KR_JAM',(MFILEJAM)) ENDIF RETURN USED('KR_JAM') CASE mP1=="KR_BNG" IF !USED('KR_BNG') MFILEBNG=cLokasi+'KA'+Alltrim(cJns)+'BNG' BUKA(lExcl,(MFILEBNG),'KR_BNG',(MFILEBNG)) ENDIF RETURN USED('KR_BNG') CASE mP1=="TB_TRS_H" IF !USED('TB_TRS_H') MFILETRS=cLOKASI+'TT'+Alltrim(cJns)+'TRS_H' BUKA(lExcl,MFILETRS,'TB_TRS_H') ENDIF RETURN USED('TB_TRS_H') CASE mP1=="DA_TRS_H" IF !USED('DA_TRS_H') MFILETRS=cLOKASI+'DA_TRS_H' BUKA(lExcl,MFILETRS,'DA_TRS_H') ENDIF RETURN USED('DA_TRS_H') CASE mP1=="DA_MST" IF !USED('DA_MST') MFILEMST=cLokasi+'DA_MST' BUKA(lExcl,MFILEMST,'DA_MST',MFILEMST+'1',MFILEMST+'2') ENDIF RETURN USED('DA_MST') CASE mP1=='DH_KRT' IF !USED('DH_KRT') MFILEKRT=cLOKASI+'DH_'+GS_NTOC(mP2)+STR(YEAR(mP2),4) BUKA(lExcl,MFILEKRT,'DH_KRT',MFILEKRT) ENDIF RETURN USED('DH_KRT') CASE mP1=='DA_SLD' IF !USED('DA_SLD') MFILESLD=cLOKASI+'DA_'+GS_NTOC(mP2)+STR(YEAR(mP2),4) BUKA(lExcl,MFILESLD,'DA_SLD',MFILESLD) ENDIF RETURN USED('DA_SLD') CASE mP1=="TB_MST" IF !USED('TB_MST') MFILEMST=cLokasi+'TM'+Alltrim(cJns)+'MST' BUKA(lExcl,MFILEMST,'TB_MST',MFILEMST+'1',MFILEMST+'2') ENDIF RETURN USED('TB_MST') CASE mP1=='TB_KRT' IF !USED('TB_KRT') MFILEKRT=cLOKASI+'TK'+Alltrim(cJns)+GS_NTOC(mP2)+STR(YEAR(mP2),4) BUKA(lExcl,MFILEKRT,'TB_KRT',MFILEKRT) ENDIF RETURN USED('TB_KRT') CASE mP1=='TB_SLD' IF !USED('TB_SLD') MFILESLD=cLOKASI+'TS'+Alltrim(cJns)+GS_NTOC(mP2)+STR(YEAR(mP2),4) BUKA(lExcl,MFILESLD,'TB_SLD',MFILESLD) ENDIF RETURN USED('TB_SLD') CASE mP1=="TP_MST" IF !USED('TP_MST') mFILEMST=cLokasi+'TP_MST'+ALLTRIM(cJns) BUKA(lExcl,mFILEMST,'TP_MST',mFILEMST+'1',mFILEMST+'2') ENDIF RETURN USED('TP_MST') CASE mP1=="TP_KRT" IF !USED('TP_KRT') mFILETRS=cLOkasi+'TP_KRT'+ALLTRIM(cJns) BUKA(lExcl,mFILETRS,'TP_KRT',mFILETRS) ENDIF RETURN USED('TP_KRT') CASE mP1=="TP_TRS_H" IF !USED('TP_TRS_H') mFILETRSH=cLokasi+'TP_TRSH'+ALLTRIM(cJns) BUKA(lExcl,mFILETRSH,'TP_TRS_H') ENDIF RETURN USED('TP_TRS_H') CASE mP1=="AK_BBB" IF !USED("AK_BBB") mFILEDBF=cLokasi+"BB_"+GS_NTOC(mP2)+STR(YEAR(mP2),4) BUKA(lExcl,mFILEDBF,"AK_BBB",mFILEDBF) ENDIF RETURN USED("AK_BBB") CASE mP1=="DN_MST" IF !USED('DN_MST') BUKA(lExcl,cLokasi+'DN_MST','DN_MST',cLokasi+'DN_MST1',cLokasi+'DN_MST2') ENDIF RETURN USED("DN_MST") CASE mP1=="AK_MST" IF !USED("AK_MST") mKEY0=cLokasi+'AKM_'+STR(YEAR(mP2),4) mKEY1=cLokasi+'AK1_'+STR(YEAR(mP2),4) mKEY2=cLokasi+'AK2_'+STR(YEAR(mP2),4) mKEY3=cLokasi+'AK3_'+STR(YEAR(mP2),4) BUKA(lExcl,mKEY0,'AK_MST',mKEY1,mKEY2,mKEY3) ENDIF RETURN USED("AK_MST") CASE mP1=="CJHARIAN" IF !USED("CJHARIAN") BUKA(lExcl,(cLokasi+"CJHARIAN"),"CJHARIAN",(cLokasi+"CJHARIAN")) ENDIF RETURN USED("CJHARIAN") CASE mP1=="GJHARIAN" IF !USED("GJHARIAN") BUKA(lExcl,(cLokasi+"GJHARIAN"),"GJHARIAN",(cLokasi+"GJHARIAN")) ENDIF RETURN USED("GJHARIAN") ENDCASE RETURN .f. ENDPROC

PROCEDURE BUKAHTML(tcFileName,tcWorkDir,tcOperation) LOCAL lcFileName,lcWorkDir,lcOperation IF EMPTY(tcFileName) RETURN -1 ENDIF _SCREEN.WINDOWSTATE=2 lcFileName=ALLTRIM(tcFileName) lcWorkDir=IIF(TYPE("tcWorkDir")="C",ALLTRIM(tcWorkDir),"") lcOperation=IIF(TYPE("tcOperation")="C" AND NOT EMPTY(tcOperation),ALLTRIM(tcOperation),"Open") DECLARE INTEGER ShellExecute ; IN SHELL32.DLL ; INTEGER nWinHandle,; STRING cOperation,; STRING cFileName,; STRING cParameters,; STRING cDirectory,; INTEGER nShowWindow RETURN ShellExecute(0,lcOperation,lcFilename,"",lcWorkDir,3) ENDPROC

PROCEDURE BUKAXFILE(tcFileName,tcWorkDir,tcOperation) LOCAL lcFileName,lcWorkDir,lcOperation IF EMPTY(tcFileName) RETURN -1 ENDIF _SCREEN.WINDOWSTATE=2 lcFileName=ALLTRIM(tcFileName) lcWorkDir=IIF(TYPE("tcWorkDir")="C",ALLTRIM(tcWorkDir),"") lcOperation=IIF(TYPE("tcOperation")="C" AND NOT EMPTY(tcOperation),ALLTRIM(tcOperation),"Open") DECLARE INTEGER ShellExecute ; IN SHELL32.DLL ; INTEGER nWinHandle,; STRING cOperation,; STRING cFileName,; STRING cParameters,; STRING cDirectory,; INTEGER nShowWindow RETURN ShellExecute(0,lcOperation,lcFilename,"",lcWorkDir,3) ENDPROC

FUNCTION BULATAN(nAngka,nBulat,lNAIK) LOCAL mSISA mSISA=IIF(nANGKA%nBULAT=0,0,nANGKA%nBULAT) RETURN IIF(mSisa=0,nANGKA,nANGKA+IIF(lNAIK,nBULAT-mSISA,mSISA*-1)) ENDFUNC

PROCEDURE BUNYI(nKALI) SET BELL ON FOR NOM=1 TO nKALI ?? CHR(7) NEXT SET BELL OFF ENDPROC

IF TYPE("ALAMATDL")<>"C" PESAN("ALAMAT DATA LANGGANAN BELUM DI SETEL") RETURN .F. ENDIF IF EMPTY(ALAMATDL) PESAN("ALAMAT DATA LANGGANAN BELUM DI SETEL") RETURN .F. ENDIF RETURN .T.

IF TYPE("ALAMATDL")<>"C" PESAN("ALAMAT DATA LANGGANAN BELUM DI SETEL") RETURN .F. ENDIF IF EMPTY(ALAMATDL) PESAN("ALAMAT DATA LANGGANAN BELUM DI SETEL") RETURN .F. ENDIF RETURN .T.

PROCEDURE cekTgl(dTgl) LOCAL iTgl iTgl=DATE() IF TYPE('dTgl')='D' AND !EMPTY(dTGL) iTgl=dTgl ENDIF RETURN iTgl ENDPROC

PROCEDURE CETAKLAH(vKon1,vKon2,nTujuan,nMulai,nAkhir,nCopy) nCopy1=IIF(PCOUNT()=5,1,nCopy) XXKondisi=vKon1 IF !EMPTY(vKon1) AND nTujuan<4 IF RIGHT(ALLTRIM(VKON1),3)='FXP' DO (Alamatdl+'Proses\'+VKON1) IF EMPTY(XXJUDUL) RETURN ENDIF ELSE EXECSCRIPT(vKon1) ENDIF ENDIF If !Empty(vKon2) IF BETWEEN(nTujuan,1,3) IF !FILE(vKon2+IIF(UPPER(RIGHT(ALLTRIM(vKon2),3))='FRX','','.FRX')) IniPesan('File laporan, belum disediakan'+CHR(13)+vKon2) RETURN ENDIF ENDIF IF nTujuan=1 REPORT FORM (vKon2) NOCONSOLE RANGE nMULAI,nAKHIR PREVIEW ENDIF IF nTujuan=2 FOR nom=1 TO nCopy1 REPORT FORM (vKon2) NOCONSOLE RANGE nMULAI,nAKHIR TO PRINTER NEXT ENDIF IF nTujuan=3 REPORT FORM (vKon2) NOCONSOLE RANGE nMULAI, nAKHIR TO PRINTER PROMPT ENDIF IF nTujuan=4 AND Dadi(54) SET RESOURCE OFF MODIFY REPORT (vKon2) SET RESOURCE ON ENDIF ENDIF ENDPROC

FUNCTION CJHARIAN(x11) IF !USED("CJHARIAN") ALAMATAK=ALAMATNYA('AAK') IF !EMPTY(ALAMATAK) BUKA(x11,(ALAMATAK+"CJHARIAN"),"CJHARIAN",(ALAMATAK+"CJHARIAN")) ENDIF ENDIF RETURN (USED("CJHARIAN")) ENDFUNC

FUNCTION CKLAS PARAMETERS ccKLAS, ccVALUE IF !EMPTY(ccValue) If GASYKLAS() SELECT GASYKLAS SET ORDER TO 1 SEEK ccKLAS+ccVALUE IF FOUND() RETURN 1 ENDIF MESSAGEBOX("Isian tidak ada di file interface, Kode = "+ccKlas,0,'Kode Interface') RETURN 0 ENDIF ENDIF Return 1 ENDFUNC

FUNCTION DADI PARAMETERS nPos RETURN IIF(SUBSTR(DADIMENU,nPos,1)=="1",.T.,.F.) ENDFUNC

FUNCTION DAFTAR PARAMETERS lJelas,Lkode,oNilai LOCAL HASIL HASIL=oNilai IF GASYKLAS() SELECT GASYKLAS SELECT KODE,KETERANGAN FROM GASYKLAS WHERE KLP==lKode ORDER BY KODE INTO CURSOR DAFTAR SELECT DAFTAR DEFINE POPUP Daftar FONT "Courier",8 PROMPT FIELD ; ALLTRIM(KODE)+" "+ALLTRIM(KETERANGAN) SCROLL SHORTCUT TITLE ; "["+lKode+"] Daftar "+lJelas FROM MROW(),MCOL() ON SELECTION POPUP Daftar BAR() ACTIVATE POPUP Daftar DEACTIVATE POPUP Daftar SELECT Daftar IF BAR()>0 GOTO BAR() HASIL=KODE ENDIF TUTUP("DAFTAR") ENDIF RETURN HASIL ENDPROC

proc da_mst(lShare,lReindeks) cLokasiDA=alamatnya('ADA') if empty(cLokasiDA) return .f. endif MFILE=cLokasiDA+'DA_MST' TUTUP("DA_MST") IF !FILE(MFILE+'.DBF') Tunggu('Indeks file master anggota'+CHR(13)+MFILE,1) ChekFolder(mFile) CREATE TABLE (MFILE) (KODE C(9),; NAMA C(30),; ALAMAT C(30),; INDUK C(8),; KTP C(30),; GRP C(3),; WLY C(4),; TGL_TRS D(8),; YES_BUNGA C(1),; PRS_BUNGA N(6,2),; GOL C(3),; JOB C(4),; KPT C(4),; BLOKIR C(1),; STD_JURNAL C(2),; UMUR N(3),; TGL_LAHIR D,; NOMOR_HP C(30),; NIK C(20),; PEKERJAAN C(30)) USE IF BUKA(.T.,(MFILE),'DA_MST') SELECT DA_MST Pack INDEX ON KODE TO (MFILE+'1') INDEX ON NAMA TO (MFILE+'2') ENDIF TUTUP("DA_MST") ENDIF if lReindeks Tunggu('Indeks file master anggota'+CHR(13)+MFILE,1) IF BUKA(.T.,(MFILE),'DA_MST') SELECT DA_MST INDEX ON KODE TO (MFILE+'1') INDEX ON NAMA TO (MFILE+'2') ENDIF TUTUP("DA_MST") endif IF !BUKA(lShare,(MFILE),'DA_MST',MFILE+'1',MFILE+'2') return .f. endif sele da_mst return .t. endproc

procedure da_sld(lShare,pTgl,lReindeks) cTGL=dATE() cLokasiDA=alamatnya('ADA') if empty(cLokasiADA) RETURN .F. ENDIF IF TYPE("pTgl")="D" and !empty(pTgl) cTgl=pTgl endif MFILE=ADDBS(cLokasiDA)+'DA_'+GS_NTOC(cTGL)+STR(YEAR(cTGL),4) TUTUP("DA_SLD") IF !FILE(MFILE+'.DBF') Tunggu('Indeks file mutasi dan saldo tabungan'+CHR(13)+MFILE,1) ChekFolder(mFile+".dbf") CREATE TABLE (MFILE) (KODE C(9),; GRP C(3),; TBS_LALU N(16),; TBS_KINI N(16),; TBT_KINI N(16),; TBS_HARI N(16),; TBT_HARI N(16),; DSB_KINI N(16),; BUNGA N (16),; PAJAK N (16)) USE IF BUKA(.T.,(MFILE),'DA_SLD') SELECT DA_SLD INDEX ON KODE TO (MFILE) ENDIF TUTUP("DA_SLD") ENDIF if lReindeks IF BUKA(.T.,(MFILE),'DA_SLD') SELECT DA_SLD INDEX ON KODE TO (MFILE) ENDIF TUTUP("DA_SLD") endif IF !BUKA(.T.,(MFILE),'DA_SLD',(Mfile)) return .f. endif sele da_sld return .t. endproc

procedure da_trs_h(lShare,pTgl,lReindeks) cLokasiDA=alamatnya('ADA') if empty(cLokasiDA) return .f. endif MFILE=addbs(cLokasiDA)+'DA_TRS_H' if type("pTgl")="D" and !empty(pTgl) cLokasiDA=alamatnya('ADT') if empty(cLokasiDA) return .f. endif MFILE=addbs(cLokasiDA)+; 'th'+trans(year(pTgl))+; "\bulan_"+gs_ntoc(pTgl)+; "\dtaa\DA_TRS_H_"+dtos(pTgl) endif TUTUP("DA_TRS_H") If !File(MFILE+'.DBF') Tunggu('Indeks file TRANSAKSI ANGGOTA '+CHR(13)+MFILE,1) CREATE TABLE (MFILE) ; (; BUKTI C(4),; TGL_TRS D(8),; KODE C(9),; GRP C(3),; SD C(1),; NILAI_RP N(12),; CTK N(3),; WLY C(4),; KPT C(4),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; BLWN C(4),; POSTING C(1),; SALDO N(12); ) USE ENDIF IF !BUKA(lShare,(MFILE),'DA_TRS_H') return .f. endif sele da_trs_h return .t. endproc

FUNCTION DBBLIAK(nBULAN) LOCAL mDb mDb="AK_MST.DBBLI"+RIGHT('00'+LTRIM(STR(nBULAN,2)),2) RETURN &mDb Endfunc

FUNCTION DN_MST(X11) IF !USED('DN_MST') DATAFOTO=ALLTRIM(ALAMATNYA("ADF")) IF !EMPTY(DATAFOTO) BUKA(X11,DATAFOTO+'DN_MST','DN_MST',DATAFOTO+'DN_MST1',DATAFOTO+'DN_MST2') ENDIF ENDIF RETURN (USED("DN_MST")) ENDFUNC

Function EndOfMonth Parameters dTanggal Do Case Case Month(dTanggal)=4 Or Month(dTanggal)=6 Or Month(dTanggal)=9 Or Month(dTanggal)=11 Return Date(Year(dTanggal),Month(dTanggal),30) Case Month(dTanggal)=2 If Year(dTanggal)%4=0 Return Date(Year(dTanggal),Month(dTanggal),29) Else Return Date(Year(dTanggal),Month(dTanggal),28) Endif Otherwise Return Date(Year(dTanggal),Month(dTanggal),31) Endcase ENDFUNC

Function EOM Parameters dTanggal RETURN (EndOfMonth(dTanggal)) Endfunc

FUNCTION FIELDGET PARAMETERS nFIELD LOCAL mKODE mKODE=FIELD(nFIELD) RETURN &mKODE ENDFUNC

FUNCTION FIELDPUT PARAMETERS nFIELD,cFIELD LOCAL mKODE mKODE=FIELD(nFIELD) REPLACE &mKODE WITH cFIELD RETURN ENDFUNC

FUNCTION GASYKLAS IF !USED("GASYKLAS") Return(BUKA(.F.,ALAMATDL+"GASYKLAS","GASYKLAS",ALAMATDL+"GASYKLAS")) ENDIF RETURN (USED("GASYKLAS")) ENDFUNC

LPARAMETERS OPSI,OXMENU IF TYPE('OXMENU')<>'O' OXMENU=OMENU ENDIF OPSI=IIF(TYPE("OPSI")<>'N',0,OPSI) OPSI1=PADL(TRANSFORM(OPSI),4,'0') H0=PADL(TRANSFORM(0),4,'0') HA=PADL(TRANSFORM(MAX(OPSI-1,0)),4,'0') HE=PADL(TRANSFORM(MIN(OPSI+1,9999)),4,'0') IHTML='GASY/BMPS/GAE_'+PADL(TRANSFORM(OPSI),4,'0')+'.HTML' TEXT TO TXT TEXTMERGE NOSHOW <!DOCTYPE html> <HTML> <HEAD> <TITLE>GASY SOFTWARE <<OPSI1>></TITLE> <STYLE> a:link, a:visited { width:auto; color: black; padding: 5px 5px; text-align: left; text-decoration: none; display: inline-block; } a:hover, a:active { color: black; background-color: white; } BUTTON {font-size:18px;} </STYLE> </HEAD> <BODY style="background-color:powderblue;margin:0;"> <form name="menu" id="menu"> <TABLE STYLE="width:100%;background-color:white;"> <TR> <TR> <TD WIDTH="1%" NOWRAP><IMG SRC="<<FULLPATH('GASY\BMPS\GASYLOGO.PNG')>>" onClick="window.open('Gasy:GASYTOOLS()','_self');"></TD> <TD TITLE="KLIK DISINI UNTUK MENAMPILKAN FORM PROSES DAN LAPORAN" STYLE="FONT-SIZE:36PX;cursor:hand;" onClick="window.open('Gasy:DO FORM PROSES','_self');">MENU APLIKASI</TD> <TD WIDTH="1%" NOWRAP ALIGN="RIGHT"> <BUTTON onClick="window.open('Gasy:GASY_HTML(9999,THISFORM)','_self');">PANDUAN</BUTTON> </TD> </TR> </TABLE> <P STYLE="text-align:center;"> <INPUT TYPE="TEXT" onkeyup="window.open('Gasy:GASY_9000(THIS,1)','_self');" onclick="window.open('Gasy:GASY_9000(THIS,1)','_self');" name="carimenuproses" style="font-size:18px;padding-left:15px;"> <br><br><br> </P> <P> <TABLE WIDTH="100%" cellpadding="5" border="1"> <TR> <Td style="font-size:27px;" ID="proses1"><center>MENU PROSES DAN LAPORAN</center> </Td> </TABLE> </P> <DIV STYLE="margin:10px;"> <P> <TABLE ALIGN="CENTER" BORDER="0" CELLPADDING="5"> <TR> <TH><BUTTON onClick="window.open('Gasy:GASY_HTML(0,THISFORM)','_self');">HOME</BUTTON></TH> <TH><BUTTON onClick="window.open('Gasy:GASY_HTML(<<HA>>,THISFORM)','_self');">BACK</BUTTON></TH> <TH><BUTTON onClick="window.open('Gasy:GASY_HTML(<<HE>>,THISFORM)','_self');">NEXT</BUTTON></TH> <TH><BUTTON onClick="window.open('Gasy:MODIFY FILE <<IHTML>>','_self');">UBAH HTML</BUTTON></TH> <TH><BUTTON onClick="window.open('Gasy:THISFORM.REKORD.RIGHTCLICK','_self');">CODE</BUTTON></TH> <TH><BUTTON onClick="window.open('Gasy:ALAMAT()','_self');">DATA</BUTTON></TH> </TR> </TABLE> </P> <P STYLE="text-align:center;"> <TABLE CELLPADDING="5"> <TR> <TD> <A HREF="GASY:GASY_0000(THIS,900)">FILE CODE PROGRAM</A> </TD> <TD> <INPUT TYPE="TEXT" onkeyup="window.open('Gasy:GASY_0000(THIS,901)','_self');" onclick="window.open('Gasy:GASY_0000(THIS,901)','_self');" name="pro" style="font-size:18px;padding-left:15px;"></TD> <TD><BUTTON onclick="window.open('Gasy:GASY_0000(THIS,899)','_self');">SIMPAN</BUTTON></TD> </TR> </TABLE> </P> <P> <TABLE CELLPADDING="5" WIDTH="100%"> <TR> <TD STYLE="FONT-SIZE:18PX;" ID="MENU1" ></TD> </TR> </TABLE> </P> </DIV> </FORM> </BODY> </HTML> ENDTEXT IHTML='GASY\BMPS\GAE_'+PADL(TRANSFORM(OPSI),4,'0')+'.HTML' IF !FILE(IHTML) STRTOFILE(TXT,IHTML) ENDIF IHTML1='GASY\GASY_'+PADL(TRANSFORM(OPSI),4,'0')+'.HTML' IF !FILE(IHTML1) STRTOFILE(TXT,IHTML1) ENDIF OXMENU.REKORD.VALUE=OPSI OXMENU.OLEHTML.NAVIGATE(FULLPATH(IHTML))

FUNCTION gLookup(lJudul,oNilai,ccCursor,nKolom,nKembali) LOCAL HASIL HASIL=oNilai SELECT (ccCursor) IF EOF() Tutup(ccCursor) RETURN oNilai ENDIF IF nKolom>0 DEFINE POPUP Daftar FROM MROW(),MCOL() TO MROW()+10,MCOL()+nKolom FONT "Courier",8 PROMPT FIELD ; FIELDGET(1)+" "+ALLTRIM(FIELDGET(2)) SCROLL SHORTCUT TITLE lJudul ELSE DEFINE POPUP Daftar FONT "Courier",8 PROMPT FIELD ; FIELDGET(1)+" "+ALLTRIM(FIELDGET(2)) SCROLL SHORTCUT TITLE lJudul ; RELATIVE FROM MROW(),MCOL() ENDIF ON SELECTION POPUP Daftar BAR() ACTIVATE POPUP Daftar DEACTIVATE POPUP Daftar SELECT (ccCursor) IF BAR()>0 GOTO BAR() mSERI=IIF(PCOUNT()=5,FIELDGET(1),"") HASIL=FIELDGET(IIF(PCOUNT()=5,nKembali,1)) ENDIF TUTUP(ccCursor) RETURN HASIL ENDFUNC

FUNCTION GS_NTOC(xTGL) IF EMPTY(xTGL) DO FORM LIBS\TGLPROSES TO xTGL IF EMPTY(xTGL) RETURN TO MASTER ENDIF ENDIF RETURN SUBSTR('ABCDEFGHIJKL',MAX(MONTH(xTGL),1),1) ENDFUNC

FUNCTION JENISKREDIT(mTampil) LOCAL MKODE JENISKREDITNYA='Umum' mKODE='1' IF BUKA(.F.,'ALAMAT','ALAMAT') SELECT LEFT(KODE,1) as KRU,KETERANGAN,ALAMAT AS ALAMATDATA FROM ALAMAT WHERE KLP=='AKR' INTO CURSOR KRU_JNS SELECT KRU_JNS GO TOP IF RECCOUNT()>1 AND PCOUNT()=0 DEFINE POPUP SANDI FROM MROW(),MCOL() FONT "Courier",8 PROMPT FIELD KRU+" "+ALLTRIM(KETERANGAN) ; SHORTCUT TITLE "JENIS KREDIT" COLOR SCHEME 4 ON SELECTION POPUP SANDI BAR() ACTIVATE POPUP SANDI DEACTIVATE POPUP SANDI IF BAR()>0 MKODE=KRU JENISKREDITNYA=ALLTRIM(KETERANGAN) ENDIF RELEASE POPUPS Sandi EXTENDED ENDIF TUTUP('ALAMAT') ENDIF RETURN MKODE ENDFUNC

PROCEDURE ItemAdd(o,cParent,nLevel) SELECT * FROM SQL_Item ; WHERE ALLTRIM(KEYID1)==ALLTRIM(cPARENT) ; INTO CURSOR ('SQL_'+TRANSFORM(nLevel)) SELECT ('SQL_'+TRANSFORM(nLevel)) SCAN IF JENIS$'AHMPBS' oNode=o.add(ALLTRIM(cParent)+'_',4,ALLTRIM(NOPER)+'_',ALLTRIM(NOPER)+' '+ALLTRIM(NAPER),0) ELSE oNode=o.add(ALLTRIM(cParent)+'_',4,ALLTRIM(NOPER)+'_',ALLTRIM(NAPER),0) ENDIF oNode.Sorted=.T. oNode.Expanded=.F. ItemAdd(o,ALLTRIM(Noper),nLevel+1) ENDSCAN TUTUP('SQL_'+TRANSFORM(nLevel)) ENDPROC

PARA GAESQL if type('GAESQL')#'C' RETURN "Syntax - Error" endif loXmlHttp = CREATEOBJECT("MSXML2.XMLHTTP") loXmlHttp.open("GET",ALLTRIM(GAESQL)+[&pc=]+PSN()+[&t=]+TRANSFORM(DATETIME()),.F.) loXmlHttp.Send() RETURN loXmlHttp.responseText

PARA GAESQL if type('GAESQL')#'C' RETURN "Syntax - Error" endif loXmlHttp = CREATEOBJECT("MSXML2.XMLHTTP") loXmlHttp.open("GET",ALLTRIM(GAESQL)+[&pc=]+PSN()+[&t=]+TRANSFORM(DATETIME()),.F.) loXmlHttp.Send() RETURN loXmlHttp.responseText

LOCAL mDb, mKr, mDb1, mKr1, mTgl1, mTgl2, ALAMATAK ALAMATAK=ALAMATNYA('AAK') IF EMPTY(ALAMATAK) IniPesan('Cek Alamat:'+CHR(13)+'Alamat data akuntansi tidak ditemukan') RETURN ENDIF BUKA(.T.,ALAMATAK+"GJHARIAN","GJHARIAN",ALAMATAK+"GJHARIAN") BUKA(.T.,ALAMATAK+"CJHARIAN","CJHARIAN",ALAMATAK+"CJHARIAN") BUKA(.T.,ALAMATAK+"BBHARIAN","AK_BBH",ALAMATAK+"BBHARIAN") If !Used("CJHARIAN") Or !Used("GJHARIAN") Or !Used("AK_BBH") CLOSE TABLES ALL Return ENDIF Select CJHARIAN STORE 0 TO mDb, mKr GO TOP MTGL1=TANGGAL DO WHILE NOT EOF() mDb=mDb+IIF(D_K="D",NILAI,0) mKr=mKr+IIF(D_K="K",NILAI,0) SKIP ENDDO IF mDb<>mKr Tunggu("Jurnal Kas Harian Tidak Seimbang!",1,5) RETURN ENDIF SELECT GJHARIAN STORE 0 TO mDb1, mKr1 GO TOP MTGL2=TANGGAL DO WHILE NOT EOF() mDb1=mDb1+IIF(D_K="D",NILAI,0) mKr1=mKr1+IIF(D_K="K",NILAI,0) SKIP ENDDO IF mDb1<>mKr1 Tunggu("Jurnal Non Kas Harian Tidak Seimbang!",1,5) RETURN ENDIF IF mDb+mKr>0 AND mDb1+mKr1>0 IF mTgl1<>mTgl2 Tunggu("Tanggal Transaksi Kas dan Non Kas Tidak Sama",1,5) RETURN ENDIF ENDIF IF mDb+mKr+mDb1+mKr1=0 Tunggu("Data harian kosong",1,5) Return ENDIF Tunggu("Pengecekan keseimbangan saldo mutasi",1) mTgl=MAX(mTgl1,mTgl2) Gasy_Tgl=mTgl mFILEDBF=ALAMATAK+"AKM_"+STR(YEAR(mTGL),4) mFILEKEY1=ALAMATAK+"AK1_"+STR(YEAR(mTGL),4) mFILEKEY2=ALAMATAK+"AK2_"+STR(YEAR(mTGL),4) mFILEKEY3=ALAMATAK+"AK3_"+STR(YEAR(mTGL),4) BUKA(.T.,mFILEDBF,"AK_MST",mFILEKEY1,mFILEKEY2,mFILEKEY3) mFILEDBF=ALAMATAK+"BB_"+GS_NTOC(mTGL)+STR(YEAR(mTGL),4) BUKA(.T.,mFILEDBF,"AK_BBB",mFILEDBF) mFILEDBF=ALAMATAK+"GJ_"+GS_NTOC(mTGL)+STR(YEAR(mTGL),4) BUKA(.T.,mFILEDBF,"AK_GJB") MFILEDBF=ALAMATAK+"CJ_"+GS_NTOC(mTGL)+STR(YEAR(mTGL),4) BUKA(.T.,mFILEDBF,"AK_CJB") If !Used("AK_MST") Or !Used("AK_BBB") Or Not Used("AK_GJB") Or !Used("AK_CJB") Return Endif SELECT AK_MST mDBBLI="DBBLI"+RIGHT("00"+ALLTRIM(STR(MONTH(Gasy_TGL))),2) mKRBLI="KRBLI"+RIGHT("00"+ALLTRIM(STR(MONTH(Gasy_TGL))),2) Tunggu("Posting data harian",1) GO top DO WHILE !EOF() REPLACE &mDbbli WITH 0, &mKrBli WITH 0 SKIP ENDDO Tunggu("Posting data harian",100) SELECT AK_CJB APPEND FROM (ALAMATAK+"CJHARIAN") FOR NILAI>0 AND !EMPTY(NOPER) FLUSH SELECT AK_GJB APPEND FROM (ALAMATAK+"GJHARIAN") FOR NILAI>0 AND !EMPTY(NOPER) FLUSH SELECT AK_BBB APPEND FROM (ALAMATAK+"CJHARIAN") FOR NILAI>0 AND !EMPTY(NOPER) APPEND FROM (ALAMATAK+"GJHARIAN") FOR NILAI>0 AND !EMPTY(NOPER) FLUSH SELECT AK_BBB mRekord=RECCOUNT() mMulai=0 GO TOP DO WHILE NOT EOF() mMulai=mMulai+1 Tunggu('Proses Posting'+CHR(13)+'Nomer: '+Noper,mMulai/mRekord*100) mNILAID=IIF(D_K="D",NILAI,0) mNILAIK=IIF(D_K="K",NILAI,0) mNOPER=NOPER SELECT AK_MST SEEK mNOPER ORDER 1 IF FOUND() REPLACE &mDBBLI WITH &mDBBLI+mNILAID, &mKRBLI WITH &mKRBLI+mNILAIK LEV=LEPEL-1 DO WHILE LEV>=0 UMU=UMUM SEEK UMU REPLACE &mDBBLI WITH &mDBBLI+mNILAID, &mKRBLI WITH &mKRBLI+mNILAIK LEV=LEPEL-1 IF LEV=0 EXIT ENDIF ENDDO ENDIF SELECT AK_BBB SKIP ENDDO SELECT CJHARIAN GO TOP DO WHILE NOT EOF() Tunggu("Hapus data kas harian : "+Noper,RECNO()/RECCOUNT()*100) DELETE SKIP ENDDO PACK FLUSH SELECT GJHARIAN GO TOP DO WHILE NOT EOF() Tunggu("Hapus data kas harian : "+Noper,RECNO()/RECCOUNT()*100) DELETE SKIP ENDDO PACK FLUSH SELECT AK_BBH GO TOP DO WHILE NOT EOF() Tunggu("Hapus data kas buku besar harian : "+Noper,RECNO()/RECCOUNT()*100) DELETE SKIP ENDDO PACK FLUSH CLOSE TABLES ALL Tunggu("Proses sudah selesai",100,0) ENDPROC

PARAMETERS Kodenya PUBLIC oGasyHelp AUSED(OLDTABEL) IF !GASYHELP() RETURN ENDIF oGasyHelp=CREATEOBJECT("oGasyHelp",Kodenya) oGasyHelp.Height=510 oGasyHelp.Width=792 oGasyHelp.Autocenter=Tengah oGasyHelp.Show(0) DEFINE CLASS oGasyHelp AS form Top = 0 Left = 0 Height = 510 Width = 792 DoCreate = .T. Closable = .T. ControlBox = .T. TitleBar = 1 MaxButton= .F. Icon = "bmps\arw03up.ico" WindowType = 1 WindowState = 0 BackColor = RGB(144,176,168) Name = "_form" ADD OBJECT edit1 AS editbox WITH ; FontBold = .F., ; FontName = "MS Sans Serif", ; FontSize = 12, ; BackStyle = 1, ; BorderStyle = 1, ; Height = 401, ; Left = 24, ; SpecialEffect = 1, ; Top = 20, ; Width = 748, ; BackColor = RGB(192,192,192), ; BorderColor = RGB(128,128,128), ; Name = "Edit1" ADD OBJECT text1 AS textbox WITH ; Height = 24, ; Left = 24, ; Top = 458, ; Width = 492, ; Name = "Text1" ADD OBJECT cmdrekam AS commandbutton WITH ; Top = 457, ; Left = 521, ; Height = 27, ; Width = 84, ; Caption = "\<Rekam", ; Name = "cmdRekam" ADD OBJECT cmdcetak AS commandbutton WITH ; Top = 457, ; Left = 605, ; Height = 27, ; Width = 84, ; Caption = "\<Cetak", ; Name = "cmdCetak" ADD OBJECT cmdSelesai AS commandbutton WITH ; Top = 457, ; Left = 689, ; Height = 27, ; Width = 84, ; Caption = "E\<xit", ; Name = "cmdSelesai" PROCEDURE Init PARAMETERS iKode This.Edit1.Value="File bantuan tidak bisa dibuka" IF USED("GASYHELP") SELECT GASYHELP LOCATE FOR ALLTRIM(UPPER(TOPIK))==ALLTRIM(UPPER(iKode)) IF !FOUND() IF Kunci_fi(5) APPEND BLANK REPLACE TOPIK WITH iKode FLUSH UNLOCK Endif ENDIF This.Edit1.Value=Help_detil This.Text1.Value=Help_Topik This.Caption=Help_Topik ENDIF ENDPROC PROCEDURE Destroy TutupDbf() ENDPROC PROCEDURE edit1.RightClick SALIN() ENDPROC PROCEDURE cmdrekam.Click IF USED("GASYHELP") SELECT GASYHELP IF KUNCI_RC(5) REPLACE Help_detil WITH This.Parent.Edit1.Value, Help_topik WITH This.Parent.Text1.Value UNLOCK ENDIF ENDIF ENDPROC PROCEDURE cmdcetak.Click SELECT * From GasyHelp WHERE ALLTRIM(Help_Topik)==ALLTRIM(This.Parent.Text1.Value) INTO CURSOR GasyCTK SELECT GasyCtk REPORT FORM (Alamatdl+'GasyHelp') PREVIEW ENDPROC PROCEDURE cmdcetak.RightClick SELECT GasyHelp REPORT FORM (Alamatdl+'GasyHelp') PREVIEW ENDPROC PROCEDURE cmdSelesai.Click RELEASE oGasyHelp ENDPROC ENDDEFINE * *-- EndDefine: sihelp **************************************************

FUNCTION Konversi(XANGKA) LOCAL XHURUF, XHASIL, XH1, XH2, XH3, i, ii, J If XANGKA>0 STORE ' ' to XHURUF, XHASIL, XH1, XH2, XH3 DECLARE XHUR[9], XSAT[9] XHUR[1] = 'Satu ' XHUR[2] = 'Dua ' XHUR[3] = 'Tiga ' XHUR[4] = 'Empat ' XHUR[5] = 'Lima ' XHUR[6] = 'Enam ' XHUR[7] = 'Tujuh ' XHUR[8] = 'Delapan ' XHUR[9] = 'Sembilan ' XSAT[1] = 'Ratus ' XSAT[2] = 'Puluh ' XSAT[3] = ' ' XSAT[4] = 'Ratus ' XSAT[5] = 'Puluh ' XSAT[6] = ' ' XSAT[7] = 'Ratus ' XSAT[8] = 'Puluh ' XSAT[9] = ' ' XANGKA= INT(XANGKA) XHURUF = ALLTRIM(STR(XANGKA)) XHURUF = SPACE(9-LEN(XHURUF))+XHURUF i = LEN(XHURUF) XH1 = '0' XH3 = '' XHASIL = '' do while (i > 0) AND (XH1 <> ' ') if (substr(XHURUF, i, 1) <> ' ') AND (i = 3) XHASIL = 'Juta ' + XHASIL endif if i = 6 XH3 = substr(XHURUF, 4, 3) if (substr(XHURUF, i, 1) <> ' ') AND (XH3 <> '000') XHASIL = 'Ribu ' + XHASIL endif endif XH1 = substr(XHURUF, i, 1) ii = i % 3 if (ii > 0) OR (XH3 = '001') OR (XH3 = ' 1') XHUR[1] = 'Se' else XHUR[1] = 'Satu ' endif j = VAL(XH1) if ii = 0 XH2 = substr(XHURUF, i - 1, 1) if XH2 = '1' XHUR[1] = 'Se' if XH1 <> '0' XHASIL = XHUR[j] + 'belas ' + XHASIL else XHASIL = 'Sepuluh ' + XHASIL endif i = i - 2 else if j = 0 XHASIL = LTRIM(XSAT[i]) + XHASIL else XHASIL = XHUR[j] + LTRIM(XSAT[i]) + XHASIL endif i = i - 1 endif else if XH1 = '0' i = i - 1 endif if (j > 0) XHASIL = XHUR[j] + XSAT[i] + alltrim(XHASIL) i = i - 1 endif endif enddo XHASIL = LTRIM(XHASIL) XHASIL = UPPER(left(XHASIL,1)) + substr(XHASIL, 2) ELSE XHASIL='Nol ' ENDIF RETURN XHASIL ENDFUNC

Function Kunci_Fi(Dly) Local Dly1 dly=IIF(PCOUNT()=0,5,dly) Dly=Dly*100 Dly1=Dly DO Whil .T. DO Whil Dly>0 AND INKEY()<>27 If Flock() Return(.T.) Endif Dly=Dly-1 ENDDO IF MESSAGEBOX('User lain sedang menggunakan secara Exclusive',5,'File Locking')=2 RETURN (.F.) ENDIF Dly=Dly1 Loop EndDO Return(.F.) ENDFUNC

Function Kunci_Rc(Dly) Local Dly1, OLDW dly=IIF(PCOUNT()=0,5,dly) Dly=Dly*100 Dly1=Dly DO While .T. DO Whil Dly>0 AND INKEY()<>27 If Rlock() Return(.T.) Endif Dly=Dly-1 ENDDO IF MESSAGEBOX('User lain sedang menggunakan secara Exclusive',5,'Record Locking')=2 RETURN (.F.) ENDIF Dly=Dly1 Loop Enddo Return(.F.) ENDFUNC

FUNCTION LAMA_BLN(xTGLT,xTGLB) RETURN IIF(xTGLT>xTGLB,12*(YEAR(xTGLT)-YEAR(xTGLB))+MONTH(xTGLT)-MONTH(xTGLB),0) ENDFUNC

PUBLIC oGasyLangganan IF !FILE(ALAMATDL+'KLIENT.DBF') CREATE TABLE ALAMATDL+'KLIENT' (NAMA C(60), ALAMAT C(60), KOTA C(60), SERI_NYA C(9)) Use ENDIF IF !USED('KLIENT') BUKA(.T.,ALAMATDL+'KLIENT','KLIENT') Endif If !Used("KLIENT") Return ENDIF oGasyLangganan=CREATEOBJECT("oLangganan") oGasyLangganan.Show DEFINE CLASS oLangganan AS form Autocenter=.t. DESKTOP=.T. Caption="Setup Nama Perusahaan" Height = 170 Width = 496 MaxButton= .F. MinButton= .F. Icon = "bmps\arw03up.ico" WindowType = 1 BackColor = RGB(144,176,168) ADD OBJECT label2 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; BorderStyle = 0, ; Caption = " Nama", ; Left = 38, ; Top = 42 ADD OBJECT tnama AS textbox WITH ; FontName = "MS Sans Serif", ; Height = 25, ; Left = 90, ; MaxLength = 60, ; Top = 38, ; Width = 373 ADD OBJECT label3 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; BorderStyle = 0, ; Caption = " Alamat", ; Left = 34, ; Top = 69 ADD OBJECT talamat AS textbox WITH ; FontName = "MS Sans Serif", ; ControlSource = "", ; Height = 25, ; Left = 90, ; MaxLength = 60, ; Top = 65, ; Width = 373 ADD OBJECT label4 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; BorderStyle = 0, ; Caption = " Kota", ; Left = 47, ; Top = 93 ADD OBJECT tkota AS textbox WITH ; FontName = "MS Sans Serif", ; Height = 25, ; Left = 90, ; MaxLength = 60, ; Top = 91, ; Width = 373 ADD OBJECT label5 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; BorderStyle = 0, ; Caption = " Nomor Seri", ; Left = 9, ; Top = 121 ADD OBJECT tserial AS textbox WITH ; FontName = "MS Sans Serif", ; Alignment = 0, ; Enabled = .T., ; Height = 25, ; Left = 90, ; MaxLength = 9, ; ReadOnly = .F., ; Top = 117, ; Width = 150 ADD OBJECT tserialnya AS textbox WITH ; Height = 23, ; Left = 300, ; MaxLength = 9, ; Top = 121, ; Visible = .F., ; Width = 100 ADD OBJECT crekam AS commandbutton WITH ; Top = 120, ; Left = 252, ; Height = 23, ; Width = 32, ; FontName = "MS Sans Serif", ; Caption = "\<Ok" ADD OBJECT cSelesai AS commandbutton WITH ; AutoSize = .T., ; Top = 122, ; Left = 422, ; Cancel=.t.,; Caption = "E\<XIT" PROCEDURE Init This.TSERIALNYA.Value='1234567'+SUBSTR('GASYSOFTWARE',MONTH(DATE()),1)+'9' This.cRekam.Enabled=.F. If Used("KLIENT") Select KLIENT Go TOP This.TNAMA.Value=Nama This.TALAMAT.Value=ALAMAT THIS.TKOTA.Value=KOTA This.TSERIal.Value=SERI_NYA Endif ENDPROC PROCEDURE Destroy Tutup("KLIENT") ENDPROC PROCEDURE cSelesai.Click RELEASE oGasyLangganan ENDPROC PROCEDURE crekam.Click If Used("KLIENT") SELECT KLIENT GO TOP If Eof() Append Blank Endif REPLACE NAMA WITH THIS.Parent.TNAMA.Value,; ALAMAT WITH THIS.Parent.TALAMAT.Value,; KOTA WITH THIS.Parent.TKOTA.Value,; SERI_NYA WITH 'GOOD_USER' Flush Endif ENDPROC PROCEDURE tserial.LostFocus IF Alltrim(This.Value)==Alltrim(This.Parent.TSERIALNYA.Value) This.Parent.cRekam.Enabled= .T. ENDIF ENDPROC ENDDEFINE

FUNCTION LASTDAYOM PARAMETERS dTanggal RETURN DAY(EOM(dTanggal)) ENDFUNC

Sql_KSE=[https://www.aissssia.com/dbf/sqlkse.php?gs=] SQL1=[select gaid,noper,naper,jenis,sifat,lepel,umum,kode from mst_ak order by noper] jsonString=JSON(SQL_KSE+sql1) messagebox(jsonString) BARIS=STREXTRACT(JSONSTRING,'{','}',2) _cliptext=GETWORDNUM(baris,2,",") messagebox(_cliptext) _cliptext=GETWORDNUM(_cliptext,3,["]) messagebox(_cliptext) *"gaid":"1","noper":"1","naper":"AKTIVA","jenis":"A","sifat":"G","lepel":"1","umum":"","kode":"" *"gaid":"2","noper":"1.100","naper":"KAS","jenis":"A","sifat":"D","lepel":"2","umum":"1","kode":"" RETURN Sql_i=[https://www.aissssia.com/dbf/sqlkiu.php?gs=] iTabel="mst_ak" xSql=[ CREATE TABLE IF NOT EXISTS `]+ITABEL+[` (]+; [ `noper` varchar(10) NOT NULL,]+; [ `naper` varchar(70) NOT NULL,]+; [ `jenis` char(1) NOT NULL,]+; [ `sifat` char(1) NOT NULL,]+; [ `lepel` decimal(1,0) NOT NULL,]+; [ `umum` varchar(10) NOT NULL,]+; [ `kode` varchar(30) NOT NULL,]+; [ `gaid` int(10) NOT NULL auto_increment,]+; [ PRIMARY KEY (`gaid`),]+; [ UNIQUE KEY `noper` (`noper`)]+; [) ENGINE=MyISAM DEFAULT CHARSET=latin1;] oJson=JSON(sql_i+xSql) MESSAGEBOX(OJSON) PROCEDURE COPY iDbf="D:\D\KOPNUSA\DATA\DTAK\AKM_2023.DBF" IF !FILE(iDBF) return endif SELE NOPER,NAPER,JENIS,SIFAT,LEPEL,UMUM,KODE ; FROM (IDBF) ; ORDER BY NOPER ; INTO CURSOR HASIL SELE HASIL Sql_i=[https://www.aissssia.com/dbf/sqlkiu.php?gs=] iTabel="mst_ak" xSql=[ CREATE TABLE IF NOT EXISTS `]+ITABEL+[` (]+; [ `noper` varchar(10) NOT NULL,]+; [ `naper` varchar(70) NOT NULL,]+; [ `jenis` char(1) NOT NULL,]+; [ `sifat` char(1) NOT NULL,]+; [ `lepel` decimal(1,0) NOT NULL,]+; [ `umum` varchar(10) NOT NULL,]+; [ `kode` varchar(30) NOT NULL,]+; [ `gaid` int(10) NOT NULL auto_increment,]+; [ PRIMARY KEY (`gaid`),]+; [ UNIQUE KEY `noper` (`noper`)]+; [) ENGINE=MyISAM DEFAULT CHARSET=latin1;] oJson=koperasi(sql_i+xSql) IF UPPER(OJSON)<>"OK" messagebox(oJSON) RETURN ENDIF SELE HASIL SCAN p1=alltrim(noper) p2=alltrim(naper) p3=jenis p4=sifat p5=TRANS(lepel) p6=alltrim(umum) p7=alltrim(kode) sqla=[insert into mst_ak (noper,naper,jenis,sifat,lepel,umum,kode) values (']+; alltrim(p1)+[',']+; alltrim(p2)+[',']+; alltrim(p3)+[',']+; alltrim(p4)+[',']+; p5+[',']+; alltrim(p6)+[',']+; alltrim(p7)+[')] *xsql=[insert into mst_ak (noper,naper,jenis,sifat,lepel,umum,kode) values (?p1,?p2,?p3,?p4,?p5,?p6,?p7)] wait "Tunggu: "+p1 window nowait oJson=koperasi(sql_i+Sqla) IF UPPER(OJSON)<>"OK" messagebox(xSqla) EXIT ENDIF ENDSCAN ENDPROC

PROCEDURE menugasy PARAMETERS iPara1 SET DATE ITALIAN IF TYPE('OTOOL')<>'O' OR ISNULL(OTOOL) oTools() ENDIF SET SYSMENU SAVE SET SYSMENU TO IF !FILE(Alamatdl+'Proses\XMENU'+iPara1+'.FXP') DEFINE PAD MnGasy01 OF _Msysmenu PROMPT "\<User" COLOR SCHEME 3 KEY ALT+U, "" DEFINE PAD MnGasy02 OF _Msysmenu PROMPT "\<File" COLOR SCHEME 3 KEY ALT+F, "" DEFINE PAD MnGasy03 OF _Msysmenu PROMPT "\<Transaksi" COLOR SCHEME 3 KEY ALT+T, "" DEFINE PAD MnGasy04 OF _Msysmenu PROMPT "\<Laporan" COLOR SCHEME 3 KEY ALT+L, "" DEFINE PAD MnGasy05 OF _Msysmenu PROMPT "\<Akhir" COLOR SCHEME 3 KEY ALT+A, "" DEFINE PAD MnGasy06 OF _Msysmenu PROMPT "Utilit\<y" COLOR SCHEME 3 KEY ALT+Y, "" ON PAD MnGasy01 OF _Msysmenu ACTIVATE POPUP MnGasy01 ON PAD MnGasy02 OF _Msysmenu ACTIVATE POPUP MnGasy02 ON PAD MnGasy03 OF _Msysmenu ACTIVATE POPUP MnGasy03 ON PAD MnGasy04 OF _Msysmenu ACTIVATE POPUP MnGasy04 ON PAD MnGasy05 OF _Msysmenu ACTIVATE POPUP MnGasy05 ON PAD MnGasy06 OF _Msysmenu ACTIVATE POPUP _Cetakan DEFINE POPUP MnGasy01 MARGIN RELATIVE SHADOW COLOR SCHEME 4 DEFINE BAR 1 OF MnGasy01 PROMPT "Log\<in" SKIP FOR NOT EMPTY(MPHOTO) DEFINE BAR 2 OF MnGasy01 PROMPT "Log\<out" SKIP FOR EMPTY(MPHOTO) DEFINE BAR 3 OF MnGasy01 PROMPT "\-" DEFINE BAR 4 OF MnGasy01 PROMPT "\<Nama Langganan" DEFINE BAR 5 OF MnGasy01 PROMPT "\<Setup" SKIP FOR NOT DADI(1) DEFINE BAR 6 OF MnGasy01 PROMPT "\-" DEFINE BAR 7 OF MnGasy01 PROMPT "E\<XIT" KEY CTRL+X, "CTRL+X" ON SELECTION BAR 1 OF MnGasy01 USERMASUK() ON SELECTION BAR 2 OF MnGasy01 USERKELUAR() ON SELECTION BAR 4 OF MnGasy01 LANGGANAN() ON SELECTION BAR 5 OF MnGasy01 NAMAUSER() ON SELECTION BAR 7 OF MnGasy01 SELESAI() DEFINE POPUP MnGasy02 MARGIN RELATIVE SHADOW COLOR SCHEME 4 DEFINE BAR 1 OF MnGasy02 PROMPT "R\<ekening" SKIP FOR NOT DADI(12) DEFINE BAR 2 OF MnGasy02 PROMPT "\-" DEFINE BAR 3 OF MnGasy02 PROMPT "\<Interface" SKIP FOR NOT DADI(9) DEFINE BAR 4 OF MnGasy02 PROMPT "\<Sandi Mutasi Transaksi" SKIP FOR NOT DADI(8) DEFINE BAR 5 OF MnGasy02 PROMPT "\-" DEFINE BAR 6 OF MnGasy02 PROMPT "In\<deks" SKIP FOR NOT DADI(55) DEFINE BAR 7 OF MnGasy02 PROMPT "\<Backup/Restore File" SKIP FOR NOT DADI(57) DEFINE BAR 8 OF MnGasy02 PROMPT "\-" DEFINE BAR 9 OF MnGasy02 PROMPT "\<Master Nasabah" ON SELECTION BAR 1 OF MnGasy02 Akmst() ON SELECTION BAR 3 OF MnGasy02 GasyTbl() ON SELECTION BAR 4 OF MnGasy02 SandiMutasi() ON SELECTION BAR 6 OF MnGasy02 ProIndek() ON SELECTION BAR 7 OF MnGasy02 Do Form Libs\BakupRes ON BAR 9 OF MnGasy02 ACTIVATE POPUP _Nasabah DEFINE POPUP _Nasabah MARGIN RELATIVE SHADOW COLOR SCHEME 4 DEFINE BAR 1 OF _Nasabah PROMPT "\<1.Register Induk" SKIP FOR NOT Dadi(10) DEFINE BAR 2 OF _Nasabah PROMPT "\<2.Tabungan Umum" SKIP FOR NOT Dadi(28) OR !USED("TB_MST") DEFINE BAR 3 OF _Nasabah PROMPT "\<3.Tabungan Program" SKIP FOR NOT Dadi(36) OR !USED("TP_MST") IF FILE('KSP.TXT') DEFINE BAR 4 OF _Nasabah PROMPT "\<4.Data Anggota" SKIP FOR NOT Dadi(10) ENDIF ON SELECTION BAR 1 OF _Nasabah DN00() ON SELECTION BAR 2 OF _Nasabah TB00() ON SELECTION BAR 3 OF _Nasabah TP00() IF FILE('KSP.TXT') ON SELECTION BAR 4 OF _Nasabah Do Form Libs\Kop001 ENDIF DEFINE POPUP MnGasy03 MARGIN RELATIVE SHADOW COLOR SCHEME 4 DEFINE BAR 1 OF MnGasy03 PROMPT "\<Kas" SKIP FOR NOT DADI(42) DEFINE BAR 2 OF MnGasy03 PROMPT "\-" DEFINE BAR 3 OF MnGasy03 PROMPT "\<Non Kas" SKIP FOR NOT DADI(43) DEFINE BAR 4 OF MnGasy03 PROMPT "Bunga \<Tabungan Umum" SKIP FOR NOT DADI(33) DEFINE BAR 5 OF MnGasy03 PROMPT "Bunga Tabungan \<Program" SKIP FOR NOT DADI(38) DEFINE BAR 6 OF MnGasy03 PROMPT "Bunga \<Deposito" SKIP FOR NOT DADI(27) DEFINE BAR 7 OF MnGasy03 PROMPT "\-" DEFINE BAR 8 OF MnGasy03 PROMPT "\<Penyesuaian" SKIP FOR NOT DADI(44) DEFINE BAR 9 OF MnGasy03 PROMPT "\<Validasi" ON SELECTION BAR 1 OF MnGasy03 Do Form Libs\Kasir With 'CJ' ON SELECTION BAR 3 OF MnGasy03 Do Form Libs\Kasir With 'GJ' ON SELECTION BAR 4 OF MnGasy03 DO FORM LIBS\BNG_TBU ON SELECTION BAR 5 OF MnGasy03 DO FORM LIBS\BNG_TBP ON SELECTION BAR 6 OF MnGasy03 DO FORM libs\BNG_DPU ON SELECTION BAR 8 OF MnGasy03 DO FORM Libs\AKUBAH ON SELECTION BAR 9 OF MnGasy03 DO FORM Libs\Otorisasi DEFINE POPUP MnGasy04 MARGIN RELATIVE SHADOW COLOR SCHEME 4 DEFINE BAR 1 OF MnGasy04 PROMPT "\<Transaksi" SKIP FOR NOT DADI(45) DEFINE BAR 2 OF MnGasy04 PROMPT "\<Performance" SKIP FOR NOT DADI(46) DEFINE BAR 3 OF MnGasy04 PROMPT "\-" DEFINE BAR 4 OF MnGasy04 PROMPT "\<Buku Besar" SKIP FOR NOT DADI(47) DEFINE BAR 5 OF MnGasy04 PROMPT "Laporan \<Khusus" SKIP FOR NOT DADI(48) ON SELECTION BAR 1 OF MnGasy04 DO FORM LIBS\PROSES WITH 'LT_','Laporan Transaksi' ON SELECTION BAR 2 OF MnGasy04 DO FORM LIBS\PROSES WIth 'LP_','Laporan Performance' ON SELECTION BAR 4 OF MnGasy04 DO FORM LIBS\Ledger ON SELECTION BAR 5 OF MnGasy04 DO FORM LIBS\PROSES WITH 'LK_','Laporan Khusus' DEFINE POPUP MnGasy05 MARGIN RELATIVE SHADOW COLOR SCHEME 4 DEFINE BAR 1 OF MnGasy05 PROMPT "\<Hari" SKIP FOR NOT DADI(49) DEFINE BAR 2 OF MnGasy05 PROMPT "\-" DEFINE BAR 3 OF MnGasy05 PROMPT "\<Bulan" SKIP FOR NOT DADI(50) DEFINE BAR 4 OF MnGasy05 PROMPT "\<T a h u n" SKIP FOR NOT DADI(51) ON SELECTION BAR 1 OF MnGasy05 Akhirh() ON SELECTION BAR 3 OF MnGasy05 AKHIRB() ON SELECTION BAR 4 OF MnGasy05 DO FORM LIBS\AKHIRT DEFINE POPUP _Cetakan MARGIN RELATIVE SHADOW COLOR SCHEME 4 DEFINE BAR 1 OF _Cetakan PROMPT "\<Help" DEFINE BAR 2 OF _Cetakan PROMPT "\<Kalkulator" DEFINE BAR 3 OF _Cetakan PROMPT "Atur Layar \<Tampilan" DEFINE BAR 4 OF _Cetakan PROMPT "View ToolBar Standar" DEFINE BAR 5 OF _Cetakan PROMPT "Kalender" DEFINE BAR 6 OF _Cetakan PROMPT "\-" DEFINE BAR _mfi_pgset OF _Cetakan PROMPT "Set\<up Halaman" DEFINE BAR _mfi_save OF _Cetakan PROMPT "\<Simpan" DEFINE BAR _mfi_savas OF _Cetakan PROMPT "Simpan dengan \<nama lain" DEFINE BAR _med_sp100 OF _Cetakan PROMPT "\-" PICTRES _med_sp100 DEFINE BAR _med_undo OF _Cetakan PROMPT "\<Undo" KEY CTRL+Z, "Ctrl+Z" PICTRES _med_undo DEFINE BAR _med_redo OF _Cetakan PROMPT "Re\<do" KEY CTRL+R, "Ctrl+R" PICTRES _med_redo DEFINE BAR _med_sp100 OF _Cetakan PROMPT "\-" PICTRES _med_sp100 DEFINE BAR _med_cut OF _Cetakan PROMPT "Cu\<t" KEY CTRL+X, "Ctrl+X" PICTRES _med_cut DEFINE BAR _med_copy OF _Cetakan PROMPT "\<Copy" KEY CTRL+C, "Ctrl+C" PICTRES _med_copy DEFINE BAR _med_paste OF _Cetakan PROMPT "\<Paste" KEY CTRL+V, "Ctrl+V" PICTRES _med_paste DEFINE BAR _med_sp200 OF _Cetakan PROMPT "\-" PICTRES _med_sp200 DEFINE BAR _med_slcta OF _Cetakan PROMPT "Se\<lect All" KEY CTRL+A, "Ctrl+A" PICTRES _med_slcta DEFINE BAR _med_sp300 OF _Cetakan PROMPT "\-" PICTRES _med_sp300 DEFINE BAR _med_find OF _Cetakan PROMPT "\<Find..." KEY CTRL+F, "Ctrl+F" PICTRES _med_find DEFINE BAR _med_repl OF _Cetakan PROMPT "R\<eplace..." KEY CTRL+L, "Ctrl+L" PICTRES _med_repl DEFINE BAR _med_goto OF _Cetakan PROMPT "Go to Line..." PICTRES _med_goto FONT "Arial",10 DEFINE BAR 11 OF _Cetakan PROMPT "\-" DEFINE BAR _mfi_close OF _Cetakan PROMPT "Cl\<ose" DEFINE BAR _mfi_clall OF _Cetakan PROMPT "Clo\<se All" ON SELECTION BAR 1 OF _Cetakan Help ON SELECTION BAR 2 OF _Cetakan Do Form Libs\Kalkulator ON SELECTION BAR 3 OF _Cetakan AturLayar() ON SELECTION BAR 4 OF _Cetakan oTools() ON SELECTION BAR 5 OF _Cetakan Do Form Libs\Wariga ACTIVATE MENU _Msysmenu NOWAIT IF !EMPTY(MPHOTO) ZPROSES() ENDIF ELSE DO (Alamatdl+'Proses\XMENU'+iPara1+'.FXP') ENDIF ENDPROC

xSql=[CREATE TABLE IF NOT EXISTS `mst_psn` (]+; [ `pcsn` varchar(8) NOT NULL,]+; [ `info` text NOT NULL,]+; [ `dadi` char(1) NOT NULL,]+; [ UNIQUE KEY `pcsn` (`pcsn`)]+; [) ENGINE=MyISAM DEFAULT CHARSET=latin1;] wait "proses koneksi dan membuat tabel mst_psn" window nowait oJson=SQLKIU(xSql) if ALLTRIM(UPPER(oJson))=="OK" wait "proses koneksi dan membuat tabel mst_psn .. SUKSES" window nowait ELSE wait "proses koneksi dan membuat tabel mst_psn .. GAGAL" window nowait ENDIF

PROCEDURE MY_ERROR PARAMETERS gnError, gcMess, gcProg, gnLineNo LOCAL cMESS, mNilai cMESS='Kode: ' + LTRIM(STR(gnError))+CHR(13)+; 'Jenis: ' + gcMess+CHR(13)+; 'Prosedur: ' + gcProg+CHR(13)+; 'Nomor Baris: '+ LTRIM(STR(gnLineNo))+CHR(13) DO CASE case gnError=152 and occurs('KALKULATOR',cMess)>0 MESSAGEBOX('ISIAN BELUM LENGKAP',0+48,'GASY') RETURN CASE gnError=1705 IF MESSAGEBOX(cMess,5,'File tidak bisa dibuka bersama-sama!!')=4 RETRY ENDIF RETURN CASE gnError=1771 IF MESSAGEBOX(cMess,5,'Pilihan obyek ini sudah diaktifkan')=4 RETRY ENDIF RETURN CASE gnError=1 IF MESSAGEBOX(cMess,5+48,'File tidak ditemukan')=4 RETRY ENDIF RETURN OTHERWISE mNilai=MESSAGEBOX(cMess,2,'Gagal Proses') DO CASE CASE mNilai=4 RETRY CASE mNilai=3 RETURN TO MASTER CASE mNilai=5 RETURN ENDCASE ENDCASE ENDPROC

PROCEDURE onKolom parameters cBaris,nkolom return (GETWORDNUM(GETWORDNUM(cBaris,nKolom,","),3,["])) ENDPROC

PROCEDURE oToolS PUBLIC oTool oTool=NEWOBJECT('_Menu','PRG\PROGASY.VCX') oTool.Show oTool.Dock(0) oTool.Visible=.T. ENDPROC

Para iFile PUBLIC ocetak ocetak=NEWOBJECT("cetak") ocetak.Init(iFile) ocetak.Show RETURN ************************************************** *-- Form: cetak (c:\gasy\libs\tcetak.scx) *-- ParentClass: form *-- BaseClass: form *-- Time Stamp: 05/21/04 12:27:07 AM * DEFINE CLASS cetak AS form Height = 216 Width = 478 MinHeight = 216 MinWidth = 478 DoCreate = .T. AutoCenter = .T. BorderStyle = 3 Caption = "Print" ControlBox = .F. Icon = "bmps\note07.ico" WindowType = 1 THEMES=.F. Name = "Cetak" namafile = .F. ADD OBJECT cmd1 AS commandbutton WITH ; AutoSize = .T., ; Top = 10, ; Left = 14, ; Height = 36, ; Width = 63, ; FontBold = .T., ; FontSize = 12, ; Caption = "\<View", ; TabIndex = 1, ; SpecialEffect = 2, ; Name = "cmd1" ADD OBJECT cmd2 AS commandbutton WITH ; AutoSize = .T., ; Top = 46, ; Left = 14, ; Height = 36, ; Width = 135, ; FontBold = .T., ; FontSize = 12, ; Caption = "Default \<Printer", ; TabIndex = 2, ; SpecialEffect = 2, ; Name = "cmd2" ADD OBJECT cmd3 AS commandbutton WITH ; AutoSize = .T., ; Top = 82, ; Left = 14, ; Height = 36, ; Width = 128, ; FontBold = .T., ; FontSize = 12, ; Caption = "\<Select Printer", ; TabIndex = 3, ; SpecialEffect = 2, ; Name = "cmd3" ADD OBJECT label1 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; Caption = "Rangkap:", ; Height = 17, ; Left = 26, ; Top = 182, ; Width = 55, ; TabIndex = 9, ; Name = "Label1" ADD OBJECT label2 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; Caption = "Halaman:", ; Height = 17, ; Left = 139, ; Top = 182, ; Width = 56, ; TabIndex = 10, ; Name = "Label2" ADD OBJECT rangkap AS spinner WITH ; Height = 24, ; Left = 84, ; TabIndex = 5, ; Top = 180, ; Width = 48, ; Value = 1, ; Name = "Rangkap" ADD OBJECT hal1 AS spinner WITH ; Height = 24, ; Left = 199, ; TabIndex = 6, ; Top = 180, ; Width = 48, ; Value = 1, ; Name = "Hal1" ADD OBJECT hal2 AS spinner WITH ; Height = 24, ; Left = 288, ; TabIndex = 7, ; Top = 180, ; Width = 61, ; Value = 6500, ; Name = "Hal2" ADD OBJECT label3 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; Caption = "S/d", ; Height = 17, ; Left = 261, ; Top = 182, ; Width = 20, ; TabIndex = 11, ; Name = "Label3" ADD OBJECT cmd4 AS commandbutton WITH ; AutoSize = .T., ; Top = 118, ; Left = 14, ; Height = 36, ; Width = 103, ; FontBold = .T., ; FontSize = 12, ; Caption = "\<Modifikasi", ; TabIndex = 4, ; SpecialEffect = 2, ; Name = "cmd4" ADD OBJECT selesai AS commandbutton WITH ; AutoSize = .F., ; Top = 178, ; Left = 370, ; Height = 27, ; Width = 96, ; Caption = "E\<xit", ; TabIndex = 8, ; Name = "selesai" ADD OBJECT line1 AS line WITH ; Height = 0, ; Left = 0, ; Top = 164, ; Width = 480, ; Name = "Line1" PROCEDURE Init PARAMETERS iFile Thisform.Namafile=iFile ENDPROC PROCEDURE cmd1.Click Cetaklah('',Thisform.Namafile,1,1,6500,1) ENDPROC PROCEDURE cmd2.Click Cetaklah('',Thisform.Namafile,2,Thisform.Hal1.Value,Thisform.Hal2.Value,Thisform.Rangkap.Value) ENDPROC PROCEDURE cmd3.Click Cetaklah('',Thisform.Namafile,3,Thisform.Hal1.Value,Thisform.Hal2.Value,Thisform.Rangkap.Value) ENDPROC PROCEDURE cmd4.Click CHEKFOLDER(THISFORM.NAMAFILE) MODIFY REPORT (Thisform.Namafile) ENDPROC PROCEDURE cmd4.RightClick IF DADI(56) Gbrowse() ENDIF ENDPROC PROCEDURE cmd4.Init This.Enabled=Dadi(54) ENDPROC PROCEDURE selesai.Click Thisform.Release ENDPROC ENDDEFINE * *-- EndDefine: cetak **************************************************

PROCEDURE PSN(iDrive) LOCAL lcComputerName, loWMI, lowmiWin32Objects, lowmiWin32Object,HddID lcComputerName = GETWORDNUM(SYS(0),1) loWMI = GETOBJECT("WinMgmts://" + lcComputerName) lowmiWin32Objects = loWMI.InstancesOf("Win32_LogicalDisk") iDRIVE1="C:" IF TYPE("iDRIVE")="C" iDRIVE1=iDRIVE ENDIF FOR EACH lowmiWin32Object IN lowmiWin32Objects WITH lowmiWin32Object IF INLIST(.Name,iDRIVE1) RETURN (.VolumeSerialNumber) EXIT ENDIF ENDWITH ENDFOR RETURN DTOS(DATE()) ENDPROC

FUNCTION LASTDAYOM PARAMETERS dTanggal RETURN DAY(EOM(dTanggal)) ENDFUNC

Procedure NamaUser PUBLIC oGasyUser IF !KR_USR() RETURN ENDIF oGasyUser=CREATEOBJECT("NamaUser") oGasyUser.Show endproc DEFINE CLASS NamaUser AS form Caption="Setup User" AutoCenter=.T. Top =0 Left =0 Height = 320 Width = 650 MinHeight = 320 MinWidth = 650 MAXHeight = 320 MAXWidth = 650 DoCreate = .T. Closable = .T. ControlBox = .T. TitleBar = 1 MaxButton= .F. MinButton= .F. BorderStyle=3 Icon = _screen.icon WindowType = 1 desktop = .F. BackColor = RGB(144,176,168) ADD OBJECT cbaru AS commandbutton WITH ; AutoSize = .T., ; OLEDropMode = 0, ; Top = 276, ; Left = 156, ; Height = 23, ; Width = 49, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 9, ; Caption = "\<Baru", ; Style = 0, ; TabIndex = 17, ; ToolTipText = "Membuat user baru", ; ForeColor = RGB(0,0,0), ; RightToLeft = .F., ; Name = "cBaru" ADD OBJECT crekam AS commandbutton WITH ; AutoSize = .T., ; Top = 276, ; Left = 207, ; Height = 23, ; Width = 70, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 9, ; Caption = " \<Rekam", ; TabIndex = 12, ; ToolTipText = "Menyimpan ke disk", ; ForeColor = RGB(0,0,0), ; Name = "cRekam" ADD OBJECT chapus AS commandbutton WITH ; AutoSize = .T., ; OLEDropMode = 0, ; Top = 276, ; Left = 278, ; Height = 23, ; Width = 67, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 9, ; Caption = " \<Hapus", ; Style = 0, ; TabIndex = 13, ; ToolTipText = "Menghapus rekord", ; ForeColor = RGB(0,0,0), ; Name = "cHapus" ADD OBJECT label2 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 1, ; BackStyle = 0, ; BorderStyle = 0, ; Caption = " Identitas", ; Enabled = .T., ; Height = 18, ; Left = 87, ; Top = 51, ; Width = 55, ; TabIndex = 20, ; DisabledForeColor = RGB(0,0,64), ; Name = "Label2" ADD OBJECT label3 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 1, ; BackStyle = 0, ; BorderStyle = 0, ; Caption = " Level", ; Enabled = .T., ; Height = 18, ; Left = 104, ; Top = 151, ; Width = 38, ; TabIndex = 22, ; DisabledForeColor = RGB(0,0,64), ; Name = "Label3" ADD OBJECT tidentitas AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Enabled = .T., ; Height = 24, ; Left = 155, ; MaxLength = 15, ; TabIndex = 1, ; ToolTipText = "Identitas user, maksimum 15 karakter", ; Top = 50, ; Width = 139, ; Name = "tIdentitas" ADD OBJECT label4 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 1, ; BackStyle = 0, ; BorderStyle = 0, ; Caption = " N a m a", ; Enabled = .T., ; Height = 18, ; Left = 91, ; Top = 174, ; Width = 51, ; TabIndex = 21, ; DisabledForeColor = RGB(0,0,64), ; Name = "Label4" ADD OBJECT tlevel AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 3, ; Value = 0, ; Enabled = .T., ; Format = "999", ; Height = 24, ; InputMask = "999", ; Left = 155, ; MaxLength = 3, ; TabIndex = 5, ; ToolTipText = "Tentukan level user, untuk validasi akses", ; Top = 149, ; Width = 49, ; Name = "tLevel" ADD OBJECT label5 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 1, ; BackStyle = 0, ; BorderStyle = 0, ; Caption = " Old password", ; Enabled = .T., ; Height = 18, ; Left = 54, ; Top = 76, ; Width = 88, ; TabIndex = 24, ; DisabledForeColor = RGB(0,0,64), ; Name = "Label5" ADD OBJECT oldpassword AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Enabled = .T., ; Height = 24, ; Left = 155, ; MaxLength = 15, ; TabIndex = 2, ; ToolTipText = "Isi password sebelumnya", ; Top = 75, ; Width = 250, ; PasswordChar = "x", ; Name = "oldPassword" ADD OBJECT label6 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 1, ; BackStyle = 0, ; BorderStyle = 0, ; Caption = " Jabatan", ; Enabled = .T., ; Height = 18, ; Left = 88, ; Top = 200, ; Width = 54, ; TabIndex = 27, ; DisabledForeColor = RGB(0,0,64), ; Name = "Label6" ADD OBJECT tjabatan AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Enabled = .T., ; Height = 24, ; Left = 155, ; MaxLength = 30, ; TabIndex = 7, ; ToolTipText = "Isi jabatan yang sesuai", ; Top = 199, ; Width = 250, ; Name = "tJabatan" ADD OBJECT label7 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 0, ; BackStyle = 0, ; BorderStyle = 0, ; Caption = "Kode Validasi", ; Enabled = .T., ; Height = 18, ; Left = 59, ; Top = 225, ; Width = 86, ; TabIndex = 26, ; DisabledForeColor = RGB(0,0,64), ; Name = "Label7" ADD OBJECT tfoto AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Enabled = .T., ; Height = 24, ; Left = 155, ; MaxLength = 3, ; TabIndex = 8, ; ToolTipText = "Isi nama file foto anda", ; Top = 224, ; Width = 50, ; Name = "tFoto" ADD OBJECT chkfoto AS checkbox WITH ; Top = 232, ; Left = 430, ; Height = 18, ; Width = 149, ; FontName = "MS Sans Serif", ; FontSize = 10, ; AutoSize = .T., ; BackStyle = 0, ; Caption = "Foto tidak ditampilkan", ; TabIndex = 10, ; ToolTipText = "Clik untuk mengubah kondisi", ; Name = "chkFoto" ADD OBJECT cekpassword AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Height = 29, ; Left = 27, ; MaxLength = 15, ; TabIndex = 19, ; Top = 146, ; Visible = .F., ; Width = 69, ; Name = "cekPassword" ADD OBJECT label9 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 1, ; BackStyle = 0, ; BorderStyle = 0, ; Caption = " New password", ; Enabled = .T., ; Height = 18, ; Left = 48, ; Top = 103, ; Width = 94, ; TabIndex = 23, ; DisabledForeColor = RGB(0,0,64), ; Name = "Label9" ADD OBJECT label10 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 1, ; BackStyle = 0, ; BorderStyle = 0, ; Caption = " Retype new password", ; Enabled = .T., ; Height = 18, ; Left = 4, ; Top = 127, ; Width = 138, ; TabIndex = 25, ; DisabledForeColor = RGB(0,0,64), ; Name = "Label10" ADD OBJECT newpassword AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Enabled = .T., ; Height = 24, ; Left = 155, ; MaxLength = 15, ; TabIndex = 3, ; ToolTipText = "Isi password yang baru", ; Top = 100, ; Width = 250, ; PasswordChar = "x", ; Name = "newPassword" ADD OBJECT newrpassword AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Enabled = .T., ; Height = 24, ; Left = 155, ; MaxLength = 15, ; TabIndex = 4, ; ToolTipText = "Isi dengan password yang baru", ; Top = 124, ; Width = 250, ; PasswordChar = "x", ; Name = "newRPassword" ADD OBJECT ifoto AS image WITH ; Stretch = 2, ; Height = 175, ; Left = 429, ; Top = 50, ; Width = 193, ; Name = "iFoto" ADD OBJECT tnama AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Enabled = .T., ; Height = 24, ; Left = 155, ; MaxLength = 30, ; TabIndex = 6, ; ToolTipText = "Isi nama lengkap dan benar", ; Top = 174, ; Width = 250, ; Name = "tNama" ADD OBJECT oldphoto AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Height = 29, ; Left = 12, ; MaxLength = 15, ; TabIndex = 19, ; Top = 181, ; Visible = .F., ; Width = 69, ; Name = "OLDPHOTO" ADD OBJECT _close AS commandbutton WITH ; AutoSize = .T., ; OLEDropMode = 0, ; Top = 276, ; Left = 411, ; Height = 23, ; Width = 62, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 9, ; Caption = " E\<xit", ; Style = 0, ; TabIndex = 15, ; ToolTipText = "Kembali", ; ForeColor = RGB(0,0,0), ; Name = "_close" PROCEDURE cbaru.Click This.Parent.tIdentitas.Value='' This.Parent.tNama.Value='' This.Parent.tJabatan.Value='' This.Parent.tLevel.Value=0 This.Parent.oldPassword.Value='' This.Parent.newPassword.Value='' This.Parent.newRPassword.Value='' This.Parent.tFoto.Value='' This.Parent.chkFoto.Value=0 This.Parent.iFoto.Picture=ALAMATDL+'DTFOTO\K00.JPG' This.Parent.tIdentitas.SetFocus ENDPROC PROCEDURE crekam.Click IF !KR_USR() RETURN ENDIF IF !EMPTY(This.Parent.tIDENTITAS.Value) SELECT KR_USR LOCATE FOR IDENTITAS==This.Parent.tIDENTITAS.Value IF !FOUND() IF KUNCI_FI(10) APPEND BLANK REPLACE IDENTITAS WITH This.Parent.tIdentitas.Value,; NAMA WITH This.Parent.tNama.Value,; JABATAN WITH This.Parent.tJABATAN.Value,; PHOTO WITH This.Parent.tFoto.Value,; TINGKAT WITH This.Parent.tlevel.Value,; TAMPIL WITH This.Parent.chkFoto.Value,; KODE_AKSES WITH This.Parent.newRPassword.Value UNLOCK FLUSH ENDIF ELSE IF KUNCI_RC(10) REPLACE IDENTITAS WITH This.Parent.tIdentitas.Value,; NAMA WITH This.Parent.tNama.Value,; JABATAN WITH This.Parent.tJABATAN.Value,; PHOTO WITH This.Parent.tFoto.Value,; TINGKAT WITH This.Parent.tlevel.Value,; TAMPIL WITH This.Parent.chkFoto.Value,; KODE_AKSES WITH This.Parent.newRPassword.Value UNLOCK FLUSH ENDIF ENDIF KunciPassword(alltrim(Identitas),alltrim(kode_akses),photo) This.Parent.cBaru.Click ENDIF ENDPROC PROCEDURE chapus.Click IF !KR_USR() RETURN ENDIF SELECT KR_USR LOCATE FOR IDENTITAS==This.Parent.tIDENTITAS.Value IF FOUND() IF KUNCI_RC(5) DELETE ENDIF UNLOCK FLUSH ENDIF This.Parent.cBaru.Click ENDPROC PROCEDURE tidentitas.GotFocus This.Parent.cHapus.Enabled=.F. This.Parent.cRekam.Enabled=.F. ENDPROC PROCEDURE tidentitas.Valid IF LASTKEY()=5 RETURN -1 ENDIF IF !KR_USR() RETURN ENDIF SELECT KR_USR LOCATE FOR Alltrim(IDENTITAS)==Alltrim(This.Value) IF FOUND() This.Parent.OldphOTO.Value=PHOTO This.Parent.oldPassword.Value='' This.Parent.newPassword.Value='' This.Parent.newRPassword.Value='' This.Parent.cekPassword.Value=KODE_AKSES This.Parent.cRekam.Enabled=.T. This.Parent.cHapus.Enabled=.T. This.Parent.tNama.Value=NAMA This.Parent.tJabatan.Value=JABATAN This.Parent.tLevel.Value=TINGKAT This.Parent.tFoto.Value=PHOTO This.Parent.chkFoto.Value=TAMPIL IF This.Parent.chkFoto.Value=1 This.Parent.iFoto.Picture=ALAMATDL+'DTFOTO\K'+ALLTRIM(PHOTO)+'.JPG' ELSE This.Parent.iFoto.Picture=ALAMATDL+'DTFOTO\K00.JPG' ENDIF This.Parent.oldPassword.Enabled=.T. Else This.Parent.OldphOTO.Value="" This.Parent.oldPassword.Enabled=.F. This.Parent.cRekam.Enabled=.T. ENDIF RETURN 1 ENDPROC PROCEDURE oldpassword.Valid IF LASTKEY()=5 RETURN -1 ENDIF IF This.Value==This.Parent.cekPassword.Value RETURN 1 ENDIF IniPesan('Cek Password'+CHR(13)+'Password yang diketik salah') RETURN 0 ENDPROC PROCEDURE tfoto.Valid IF LASTKEY()=5 RETURN -1 ENDIF IF !KR_USR() RETURN ENDIF Select KR_USR LOCATE FOR ALLTRIM(PHOTO)==ALLTRIM(THIS.Value) IF FOUND() IF ALLTRIM(THis.Value)<>ALLTRIM(This.Parent.Oldphoto.Value) IniPesan('Cek Kode Validasi'+CHR(13)+'Kode validasi sudah digunakan') Return 0 Endif IF This.Parent.chkFoto.Value=1 This.Parent.iFoto.Picture=ALAMATDL+'DTFOTO\K'+ALLTRIM(This.Parent.tFoto.Value)+'.JPG' ELSE This.Parent.iFoto.Picture=ALAMATDL+'DTFOTO\K00.JPG' ENDIF ENDIF RETURN 1 ENDPROC PROCEDURE chkfoto.Click IF This.Value=1 This.Caption='Foto ditampilkan' This.Parent.iFoto.Picture=ALAMATDL+'DTFOTO\K'+ALLTRIM(This.Parent.tFoto.Value)+'.JPG' ELSE This.Caption='Foto tidak ditampilkan' This.Parent.iFoto.Picture=ALAMATDL+'DTFOTO\K00.JPG' ENDIF ENDPROC PROCEDURE newrpassword.Valid IF LASTKEY()=5 RETURN -1 ENDIF IF This.Parent.newPassword.Value==This.Value RETURN 1 ENDIF IniPesan('Cek Password'+CHR(13)+'Password baru tidak sama dengan yang di ulangi!') RETURN 0 ENDPROC PROCEDURE _close.Click RELEASE oGasyUser ENDPROC PROCEDURE Destroy TUTUP('KR_USR') ENDPROC PROCEDURE tFoto.Rightclick Kode_pro(This.Value) ENDPROC ENDDEFINE * *-- EndDefine: form1 **************************************************

PROCEDURE KUNCIPASSWORD lPara p1,p2,p3 mdbf=ALAMATDL+'USR'+ALLTRIM(p1) MTEKS='LPARAMETERS MPASSWORD'+CHR(13)+CHR(10)+; 'IDENTITAS="'+p1+'"'+CHR(13)+CHR(10)+; 'PASSWORD="'+p2+'"'+CHR(13)+CHR(10)+; 'VALIDASI="'+p3+'"'+CHR(13)+CHR(10)+; 'IF PCOUNT()=0'+CHR(13)+CHR(10)+; ' MPHOTO=""'+CHR(13)+CHR(10)+; ' DADIMENU=""'+CHR(13)+CHR(10)+; ' RETURN'+CHR(13)+CHR(10)+; 'ENDIF'+CHR(13)+CHR(10)+; 'IF PASSWORD==ALLTRIM(MPASSWORD) AND !EMPTY(MPASSWORD)'+CHR(13)+CHR(10)+; ' MPHOTO=VALIDASI'+CHR(13)+CHR(10)+; 'ENDIF'+CHR(13)+CHR(10) STRTOFILE(MTEKS,MDBF+'.PRG') IF FILE(MDBF+'.PRG') COMPILE (MDBF) ENCRYPT NODEBUG ENDIF IF FILE(MDBF+'.PRG') DELETE FILE (MDBF+'.PRG') ENDIF IF FILE(MDBF+'.BAK') DELETE FILE (MDBF+'.BAK') ENDIF IF KR_USR(.T.) SELE KR_USR LOCATE FOR ALLTRIM(IDENTITAS)==P1 IF FOUND() REPL KODE_AKSES WITH '********' ENDIF ENDIF TUTUP('KR_USR') ENDPROC

PROCEDURE CREATPRO PUBLIC oprologik oprologik=NEWOBJECT("prologik") oprologik.Show RETURN ************************************************** *-- Form: prologik (c:\gasy\libs\prologik.scx) *-- ParentClass: form *-- BaseClass: form *-- Time Stamp: 05/01/04 11:39:00 PM * DEFINE CLASS prologik AS form Height = 450 Width = 750 DoCreate = .T. AutoCenter = .T. BorderStyle = 3 Caption = "Gasy Software" ControlBox = .F. BackColor = RGB(144,176,168) Name = "ProLogik" ADD OBJECT label1 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; Caption = "Nama File Database", ; Height = 17, ; Left = 12, ; Top = 141, ; Width = 116, ; TabIndex = 8, ; Name = "Label1" ADD OBJECT namapros AS textbox WITH ; Height = 23, ; Left = 132, ; TabIndex = 1, ; Top = 138, ; Width = 430, ; Name = "NamaPros" ADD OBJECT bukalah AS commandbutton WITH ; AutoSize = .F., ; Top = 137, ; Left = 588, ; Height = 24, ; Width = 120, ; Caption = "\<Buka File/Edit", ; TabIndex = 4, ; Name = "Bukalah" ADD OBJECT namap AS textbox WITH ; Height = 23, ; Left = 132, ; MaxLength = 10, ; TabIndex = 2, ; Top = 166, ; Width = 91, ; Name = "NamaP" ADD OBJECT label2 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; Caption = "Prosedur", ; Height = 17, ; Left = 75, ; Top = 170, ; Width = 53, ; TabIndex = 9, ; Name = "Label2" ADD OBJECT namafxp AS textbox WITH ; Height = 23, ; Left = 132, ; MaxLength = 100, ; TabIndex = 3, ; Top = 195, ; Width = 430, ; Name = "NamaFxp" ADD OBJECT proses AS commandbutton WITH ; AutoSize = .F., ; Top = 165, ; Left = 588, ; Height = 26, ; Width = 120, ; Caption = "\<Compile", ; TabIndex = 5, ; Name = "Proses" ADD OBJECT jalankan AS commandbutton WITH ; AutoSize = .F., ; Top = 194, ; Left = 588, ; Height = 26, ; Width = 120, ; Caption = "\<Test/Run", ; TabIndex = 6, ; Name = "Jalankan" ADD OBJECT selesai AS commandbutton WITH ; AutoSize = .F., ; Top = 384, ; Left = 588, ; Height = 27, ; Width = 120, ; Caption = "Exit", ; TabIndex = 7, ; Name = "Selesai" ADD OBJECT label3 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; Caption = "Program", ; Height = 17, ; Left = 77, ; Top = 197, ; Width = 50, ; TabIndex = 10, ; Name = "Label3" ADD OBJECT namapj AS textbox WITH ; Height = 23, ; Left = 224, ; MaxLength = 100, ; TabIndex = 11, ; Top = 166, ; Width = 338, ; Style = 1, ; Name = "NamaPJ" ADD OBJECT label4 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; FontName = "Arial Narrow", ; FontSize = 45, ; Caption = "Modifikasi Prosedur", ; Height = 72, ; Left = 132, ; Top = 30, ; Width = 433, ; Name = "Label4" ADD OBJECT image1 AS image WITH ; Picture = "logo.jpg", ; Height = 82, ; Left = 12, ; Top = 24, ; Width = 97, ; Name = "Image1" ADD OBJECT line1 AS line WITH ; Height = 0, ; Left = 12, ; Top = 106, ; Width = 744, ; Name = "Line1" ADD OBJECT namalapor AS textbox WITH ; Height = 23, ; Left = 132, ; MaxLength = 100, ; TabIndex = 3, ; Top = 294, ; Width = 430, ; Name = "NamaLapor" ADD OBJECT label5 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; Caption = "Laporan", ; Height = 17, ; Left = 78, ; Top = 297, ; Width = 48, ; TabIndex = 10, ; Name = "Label5" ADD OBJECT laporan AS commandbutton WITH ; AutoSize = .F., ; Top = 293, ; Left = 588, ; Height = 27, ; Width = 120, ; Caption = "\<Modifikasi Laporan", ; TabIndex = 6, ; Name = "Laporan" ADD OBJECT ctkini AS commandbutton WITH ; AutoSize = .T., ; Top = 321, ; Left = 588, ; Height = 27, ; Width = 120, ; Caption = "Cetak Prosedur Ini", ; Name = "Ctkini" ADD OBJECT ctkall AS commandbutton WITH ; AutoSize = .F., ; Top = 348, ; Left = 588, ; Height = 27, ; Width = 120, ; Caption = "Cetak Seluruhnya", ; Name = "CtkAll" ADD OBJECT ubahsrc AS commandbutton WITH ; AutoSize = .F., ; Top = 228, ; Left = 588, ; Height = 27, ; Width = 120, ; Caption = "\<Modifikasi Source", ; TabIndex = 6, ; Name = "UbahSrc" ADD OBJECT cthprg AS commandbutton WITH ; AutoSize = .F., ; Top = 255, ; Left = 588, ; Height = 24, ; Width = 120, ; Caption = "\<Contoh Prg", ; TabIndex = 4, ; Name = "CthPrg" ADD OBJECT usermenu AS commandbutton WITH ; AutoSize = .T., ; Top = 386, ; Left = 132, ; Height = 23, ; Width = 121, ; FontBold = .T., ; FontName = "MS Sans Serif", ; WordWrap = .F., ; Caption = "Setup Menu User", ; TabIndex = 13, ; Name = "UserMenu" ADD OBJECT kodeuser AS textbox WITH ; FontBold = .T., ; Alignment = 2, ; Height = 22, ; Left = 255, ; MaxLength = 3, ; Top = 386, ; Width = 51, ; Style = 1, ; Name = "KodeUser" ADD OBJECT gouser AS commandbutton WITH ; AutoSize = .T., ; Top = 386, ; Left = 309, ; Height = 23, ; Width = 48, ; FontBold = .T., ; FontName = "MS Sans Serif", ; WordWrap = .F., ; Caption = "Test", ; TabIndex = 13, ; Name = "GoUser" ADD OBJECT salinfile AS commandbutton WITH ; AutoSize = .T., ; Top = 386, ; Left = 433, ; Height = 23, ; Width = 129, ; FontBold = .T., ; FontName = "MS Sans Serif", ; WordWrap = .F., ; Caption = "Copy File Prosedur", ; TabIndex = 13, ; Name = "SalinFile" PROCEDURE namapros.RightClick This.Value=GETFILE('dbf') ENDPROC PROCEDURE bukalah.Click CLOSE TABLES All IF !EMPTY(ALLTRIM(Thisform.NamaPros.Value)) IF !FILE(ALLTRIM(Thisform.NamaPros.Value)) CREATE TABLE (ALLTRIM(Thisform.NamaPros.Value)) ; (KODE C(10), KETERANGAN C(60), KONDISI M(4), NAMAFXP C(60)) USE ENDIF IF Buka(.T.,ALLTRIM(Thisform.NamaPros.Value),'Logika') SELECT Logika GO Top IF EOF() APPEND BLANK ENDIF Gbrowse('LOGIKA') ENDIF ELSE Thisform.NamaPros.Value=GETFILE('dbf') ENDIF ENDPROC PROCEDURE namap.RightClick IF USED('LOGIKA') SELECT LOGIKA SELECT KODE,KETERANGAN FROM LOGIKA ORDER BY KODE INTO CURSOR DAFTAR SELECT DAFTAR DEFINE POPUP Daftar FONT "Courier",8 PROMPT FIELD ; KODE+" "+ALLTRIM(KETERANGAN) SCROLL SHORTCUT TITLE ; "DAFTAR KODE PROGRAM APLIKASI" FROM MROW(),MCOL() ON SELECTION POPUP Daftar BAR() ACTIVATE POPUP Daftar DEACTIVATE POPUP Daftar SELECT Daftar IF BAR()>0 GOTO BAR() This.Value=KODE ENDIF TUTUP("DAFTAR") ENDIF ENDPROC PROCEDURE namap.LostFocus IF USED('LOGIKA') SELECT LOGIKA LOCATE FOR ALLTRIM(KODE)==ALLTRIM(This.Value) IF FOUND() Thisform.NamaPJ.Value=Keterangan Thisform.NamaFxp.Value=NAMAFXP ELSE Thisform.NamaPJ.Value='' Thisform.NamaFxp.Value='' ENDIF ENDIF ENDPROC PROCEDURE namafxp.RightClick This.Value=GETFILE('Fxp') ENDPROC PROCEDURE proses.RightClick IF USED('LOGIKA') SELECT Logika GO TOP DO WHILE NOT EOF() mNamaFxp=ALLTRIM(NAMAFXP) IF !EMPTY(mNamaFxp) mTemp=mNamaFxp+'.Prg' COPY MEMO KONDISI TO (mTemp) COMPILE (mTemp) ENCRYPT NODEBUG DELETE FILE (mTemp) ENDIF SKIP ENDDO ENDIF ENDPROC PROCEDURE proses.Click IF USED('LOGIKA') SELECT Logika LOCATE FOR ALLTRIM(Kode)==ALLTRIM(Thisform.NamaP.Value) IF !FOUND() WAIT WINDOW 'Kode prosedur tidak ditemukan' ELSE IF !EMPTY(ALLTRIM(Thisform.NamaFxp.Value)) mTemp=ALLTRIM(Thisform.NamaFxp.Value)+'.Prg' COPY MEMO KONDISI TO (mTemp) COMPILE (mTemp) ENCRYPT NODEBUG DELETE FILE (mTemp) ENDIF ENDIF ENDIF ENDPROC PROCEDURE jalankan.Click mTemp=ALLTRIM(Thisform.NamaFxp.Value) DO (mTemp) ENDPROC PROCEDURE selesai.Click CLOSE TABLES All Thisform.Release ENDPROC PROCEDURE namalapor.RightClick This.Value=GETFILE('Frx') ENDPROC PROCEDURE laporan.Click mTemp=ALLTRIM(Thisform.NamaLapor.Value) MODIFY REPORT (mTemp) ENDPROC PROCEDURE ctkini.Click IF USED('LOGIKA') SELECT * FROM LOGIKA WHERE ALLTRIM(KODE)==ALLTRIM(THISFORM.NamaP.Value) INTO CURSOR CETAKPRO SELECT CETAKPRO REPORT FORM ('Libs\GASYHELP') PREVIEW TUTUP('CETAKPRO') ENDIF ENDPROC PROCEDURE ctkall.Click IF USED('LOGIKA') SELECT * FROM LOGIKA ORDER BY KODE INTO CURSOR CETAKPRO SELECT CETAKPRO REPORT FORM ('Libs\GASYHELP') PREVIEW TUTUP('CETAKPRO') ENDIF ENDPROC PROCEDURE ubahsrc.Click IF USED('LOGIKA') SELECT Logika LOCATE FOR ALLTRIM(Kode)==ALLTRIM(Thisform.NamaP.Value) IF !FOUND() WAIT WINDOW 'Kode prosedur tidak ditemukan' RETURN ENDIF MODIFY MEMO KONDISI ENDIF ENDPROC PROCEDURE cthprg.Click mPrg=GETFILE('PRG') IF !EMPTY(mPrg) MODIFY COMMAND (mPRG) ENDIF ENDPROC PROCEDURE usermenu.Click IF !KR_USR() RETURN ENDIF SELECT PHOTO,IDENTITAS,NAMA FROM KR_USR INTO CURSOR NAMAUSER SELECT NAMAUSER GO TOP IF !EOF() DEFINE POPUP JNSLAPORAN FONT 'Courier',8 FROM MROW(), MCOL() PROMPT FIELD IDENTITAS+' - '+ALLTRIM(NAMA) SCROLL SHORTCUT ; TITLE "DAFTAR USER" COLOR SCHEME 3 ON SELECTION POPUP JNSLAPORAN BAR() ACTIVATE POPUP JNSLAPORAN DEACTIVATE POPUP JNSLAPORAN IF BAR()>0 GO BAR() mPHOTO=PHOTO RELEASE POPUPS JNSLAPORAN EXTENDED mDbf=ALAMATDL+'PROS_'+ALLTRIM(MPHOTO) IF !FILE(mDbf+".Dbf") CREATE TABLE (mDbf) (KODE C(3), NMR C(3), NMMENU C(60), NMPROSEDUR C(100), NMLAPORAN C(100), SBR C(1), CATATAN C(100)) USE ELSE IF BUKA(.T.,mDbf,"GASYPROS") SELECT GASYPROS PACK TUTUP("GASYPROS") ENDIF ENDIF Thisform.KodeUser.Value=MPHOTO TUTUP('GASYPROS') BUKA(.F.,mDbf,"GASYPROS") SELECT GASYPROS GBROWSE('GASYPROS') ENDIF ENDIF TUTUP("NAMAUSER") ENDPROC PROCEDURE gouser.Click IF !EMPTY(Thisform.KodeUser.Value) MPHOTO=Thisform.KodeUser.Value DADIMENU=REPLICATE('1',150) DO FORM Libs\Proses ENDIF ENDPROC PROCEDURE salinfile.Click IF !EMPTY(Thisform.NamaPros.Value) CLOSE TABLES all mFile=ALLTRIM(Thisform.NamaPros.Value) DO FORM LIBS\GASYCARI WITH 'Nama File' TO mFile IF !EMPTY(mFile) COPY FILE (ALLTRIM(Thisform.NamaPros.Value)) TO ALLTRIM(mFile) ENDIF ENDIF ENDPROC ENDDEFINE * *-- EndDefine: prologik **************************************************

PROCEDURE SCRIPT(nRekord,lxRUN,O,OPSI,OPSI1,OPSI2) IF TYPE('nRekord')<>'N' IF TYPE('O')<>'O' RETURN ENDIF nRekord=o.parent.rekord.value ENDIF IPRG='GASY\GASY_'+PADL(TRANSFORM(nRekord),4,'0')+'.PRG' IFXP='GASY\GASY_'+PADL(TRANSFORM(nRekord),4,'0')+'.FXP' IF lxRUN IF FILE(IFXP) DO (IFXP) WITH O,OPSI,OPSI1,OPSI2 ENDIF RETURN ENDIF GAE(IPRG) ENDPROC

public oGasyTools oGasyTools=CreateObject('Form_6x') oGasyTools.SHow ************************************************** *-- Class: form_6 (d:\j\gasy\prg\gforms.vcx) *-- ParentClass: form *-- BaseClass: form *-- Time Stamp: 05/25/24 11:53:13 PM * DEFINE CLASS form_6x AS form Top = 0 Left = 0 Height = 540 Width = 819 DoCreate = .T. ShowTips = .T. AutoCenter = .F. Caption = "Tools - Code Library" MaxButton = .T. MinButton = .T. MinHeight = 540 MinWidth = 819 Icon = "bmps\ico\tools.ico" iCodeLibs='d:\gasy\codelibs\gs\' iFolder='' add object lblJudul as Label With ; Top = 27,; Left = 18,; Caption = "Nama",; FontSIze = 27,; BackStyle = 0,; AutoSIze = .T. ADD OBJECT cmdclose AS cmdpf__ WITH ; Top = 90, ; Left = 9, ; Width = 273, ; Height = 36, ; BackStyle = 1, ; BorderWidth = 0, ; Visible = .T., ; TabIndex = 3, ; BackColor = RGB(0,0,128) ADD OBJECT pf AS pf__ WITH ; ErasePage = .T., ; Top = 54, ; Left = 9, ; Width = 273, ; Height = 180,; Visible=.t. ADD OBJECT PRG1 AS ComboBox__az WITH ; Top = 9,; Left = 9 ADD OBJECT PRG2 AS ComboBox__az WITH ; Top = 9,; Left = 54 ADD OBJECT PRG3 AS ComboBox__az WITH ; Top = 9,; Left = 99 ADD OBJECT PRG4 AS ComboBox__az WITH ; Top = 9,; Left = 144 ADD OBJECT gaid AS Spinner__gs WITH ; Top = 9,; Left = 189 ADD OBJECT cmdGasy AS commandbutton WITH ; AutoSize = .F., ; Top = 9, ; Left = 261, ; Height = 24, ; Width = 24, ; ForeColor = RGB(0,0,255),; FontName = "Wingdings", ; FontSize = 14,; FontBold = .T.,; Caption = "v", ; ToolTipText = "Gasy", ; Visible = .T., ; SpecialEffect = 2,; iPRG='' add object line1x as line with ; top=81,; left=0,; width=540,; height=0 ADD OBJECT CheckCode1 AS CheckBox WITH ; AutoSize = .F., ; BorderStyle = 0,; BackStyle = 0,; Top = 9, ; Height = 33, ; Width = 27, ; ForeColor = RGB(0,0,255),; FontName = "Wingdings", ; FontSize = 16,; FontBold = .T.,; Caption = "", ; ToolTipText = "Mode User/Modifikasi", ; Visible = .T., ; SpecialEffect = 2,; Value = 0 add object iCari as Textbox with ; top = 90,; Left = 9,; Width = 273,; FontSize = 16,; FontBold = .f.,; FontName = "Courier New",; Visible = .T.,; Height = 36 add object ListProduk as Listbox with ; top = 135,; Left = 9,; Width = 273,; FontSize = 27,; FontBold = .T.,; FontName = "Courier New",; Visible = .T.,; backcolor=rgb(240,240,240),; JumlahMenu=0,; iMenu=0,; ItemTips=.T.,; Sorted=.F.,; Nilai=0 add object iCari1 as Textbox with ; top = 90,; Left = 288,; Width = 207,; FontSize = 16,; FontBold = .f.,; FontName = "Courier New",; Visible = .T.,; Height = 36 ADD OBJECT cmdRefresh1 AS commandbutton WITH ; AutoSize = .F., ; Top = 90, ; Left = 495, ; Height = 36, ; Width = 36, ; ForeColor = RGB(0,0,255),; FontName = "WebDings", ; FontSize = 18,; FontBold = .T.,; Caption = "q", ; ToolTipText = "Refresh'", ; Visible = .T., ; SpecialEffect = 2 add object IDScript1 as SPinner__GS with ; top = 90,; Left = 288,; ToolTipText = "ID Script" ADD OBJECT Check1 AS CheckBox WITH ; AutoSize = .F., ; BorderStyle = 0,; BackStyle = 0,; Top = 90, ; Left = 369, ; Height = 27, ; Width = 27, ; ForeColor = RGB(0,0,255),; FontName = "Wingdings", ; FontSize = 16,; FontBold = .T.,; Caption = "", ; ToolTipText = "Tampikan Script atau Menu", ; Visible = .T., ; SpecialEffect = 2 ADD OBJECT cmdSimpan1 AS commandbutton WITH ; AutoSize = .F., ; Top = 90, ; Left = 396, ; Height = 27, ; Width = 27, ; ForeColor = RGB(0,0,255),; FontName = "Wingdings", ; FontSize = 16,; FontBold = .T.,; Caption = "=", ; ToolTipText = "Klik = Simpan Script, Klik Kanan = Ubah Script", ; Visible = .T., ; SpecialEffect = 2 ADD OBJECT comboMenu1 AS ComboBox WITH ; AlignMent = 2,; Top = 90, ; Left = 432, ; Height = 27, ; Width = 63, ; FontName = "Courier New", ; FontBold = .T.,; FontSize = 14,; ToolTipText = "Daftar Menu", ; Visible = .T., ; Style = 2, JumlahMenu = 0, iMenu=0 ADD OBJECT cmdGo1 AS commandbutton WITH ; AutoSize = .F., ; Top = 90, ; Left = 504, ; Height = 27, ; Width = 25, ; FontName = "Courier New", ; FontSize = 14,; FontBold = .T.,; Caption = "a", ; ToolTipText = "Buka Script", ; Visible = .T., ; SpecialEffect = 2,; Visible=.f. add object edit1 as editbox with ; top = 135,; Left = 288,; AllowTabs = .t.,; TabStop = .F.,; FontSize = 20,; FontName = "Courier New",; Margin = 10,; Visible = .F.,; backcolor=rgb(240,240,240) add object ListMenu1 as Listbox with ; top = 135,; Left = 288,; FontSize = 27,; FontBold = .T.,; FontName = "Courier New",; Visible = .T.,; backcolor=rgb(240,240,240),; JumlahMenu=0,; iMenu=0,; ItemTips=.T.,; Sorted=.T. add object IDScript2 as spinner__GS with ; top = 297,; Left = 9,; ToolTipText = "ID Script" ADD OBJECT cmdSimpan2 AS commandbutton WITH ; AutoSize = .F., ; Top = 297, ; Left = 135, ; Height = 36, ; Width = 36, ; FontSize = 18,; FontName = "Wingdings", ; FontBold = .T.,; Caption = "=", ; ToolTipText = "Simpan Code Script", ; Visible = .T., ; SpecialEffect = 2 ADD OBJECT cmdGo2 AS commandbutton WITH ; AutoSize = .F., ; Top = 297, ; Left = 154, ; Height = 36, ; Width = 36, ; FontSize = 18,; FontName = "Webdings", ; FontBold = .T.,; Caption = "@", ; ForeColor = RGB(0,0,255),; ToolTipText = "View/Modifikasi Script", ; Visible = .T., ; SpecialEffect = 2 add object edit2 as editbox with ; top = 343,; Left = 540,; Height = 81,; AllowTabs = .t.,; TabStop = .F.,; FontSize = 20,; FontName = "Courier New",; Margin = 10,; ReadOnly = .T.,; backcolor=rgb(240,240,240) procedure cmdGasy.RightClick with This.parent This.iPRG=thisform.xFile()+'.PRG' gae(This.iPrg) endwith endproc procedure cmdGasy.Click with This.parent .ListProduk.Clear .ListProduk.RowSource='' .ListProduk.RowSourceType=0 .idscript1.valid_1() .idscript2.valid_1() This.iPRG=thisform.xFile()+'.FXP' IF FILE(This.iPrg) DO (This.iPrg) With ThisForm,Thisform.ListProduk ENDIF endwith endproc PROCEDURE ListProduk.AddK2(xKol1,xKol2) With This if empty(.parent.iCari.value) .iMenu=.iMenu+1 .addlistItem(' '+xKol1,.iMenu,1) .addlistItem(xKol2,.iMenu,2) else if occurs(alltrim(upper(.Parent.iCari.Value)),upper(xKol1))>0 .iMenu=.iMenu+1 .addlistItem(' '+xKol1,.iMenu,1) .addlistItem(xKol2,.iMenu,2) endif endif EndWith ENDPROC PROCEDURE ListProduk.AddKX(xKol1,xKol2,xNOPER,xNAPER,xJENIS,xSIFAT,xLEPEL,xUMUM,xKode) With This iCetak=0 if empty(.parent.iCari.value) .iMenu=.iMenu+1 iCetak=1 else if occurs(alltrim(upper(.Parent.iCari.Value)),upper(xKol1))>0 .iMenu=.iMenu+1 iCetak=1 endif endif if iCetak=1 .addlistItem(' '+xKol1,.iMenu,1) .addlistItem(xKol2,.iMenu,2) if PCount()>2 .addlistItem(xNoper,.iMenu,3) endif if PCount()>3 .addlistItem(xNaper,.iMenu,4) endif if PCount()>4 .addlistItem(xJenis,.iMenu,5) endif if PCount()>5 .addlistItem(xSifat,.iMenu,6) endif if PCount()>6 .addlistItem(xLepel,.iMenu,7) endif if PCount()>7 .addlistItem(xUmum,.iMenu,8) endif if PCount()>8 .addlistItem(xKode,.iMenu,9) endif endif EndWith ENDPROC Procedure xFile with This .iFolder=.iCodeLibs .iFolder=addbs(.iFolder+alltrim(.Prg1.value)) .iFolder=addbs(.iFolder+alltrim(.Prg2.Value)) .iFolder=addbs(.iFolder+alltrim(.Prg3.Value)) .iFolder=addbs(.iFolder+alltrim(.Prg4.Value)) .iFolder=alltrim(.iFolder)+'gs'+; alltrim(.prg1.value)+; alltrim(.prg2.value)+; alltrim(.prg3.value)+; alltrim(.prg4.value)+Padl(Trans(.Gaid.value),4,'0') ENDWITH return This.iFolder Endproc Procedure prg1.Click This.Parent.cmdGasy.Click EndProc Procedure prg1.InteractiveChange This.Click EndProc Procedure prg2.Click This.Parent.cmdGasy.Click EndProc Procedure prg2.InteractiveChange This.Click EndProc Procedure prg3.Click This.Parent.cmdGasy.Click EndProc Procedure prg3.InteractiveChange This.Click EndProc Procedure prg4.Click This.Parent.cmdGasy.Click EndProc Procedure prg4.InteractiveChange This.Click EndProc Procedure gaid.Valid This.Parent.cmdGasy.Click EndProc Procedure Gaid.DownClick This.Valid EndProc Procedure Gaid.UpClick This.Valid EndProc Procedure iCari.InteractiveChange This.Parent.cmdGasy.Click EndProc Procedure iCari.dblClick This.Value='' This.InteractiveChange EndProc procedure ListProduk.Klik lpara opsi with This.parent ThisPRG=thisform.xFile()+'.FXP' IF FILE(ThisPrg) DO (ThisPrg) With ThisForm,This,opsi RETURN .T. ELSE RETURN .F. ENDIF endwith endproc PROCEDURE ListProduk.Click IF THIS.KLIK(1) RETURN ENDIF this.submenu() ENDPROC PROCEDURE ListProduk.submenu if this.rowsourcetype=5 this.nilai=this.ahasil[this.listItemId,2] else this.nilai=Val(this.listitem(this.listitemID,2)) endif this.parent.idScript1.value=this.nilai this.parent.idScript1.valid ENDPROC PROCEDURE ListProduk.InteractiveChange This.Click ENDPROC PROCEDURE iCari1.DBLCLICK THIS.VALUE='' THIS.InteractiveChange ENDPROC PROCEDURE iCari1.InteractiveChange THIS.PARENT.COMBOMENU1.Refresh ENDPROC PROCEDURE ComboMenu1.Refresh WITH THIS .CLEAR .COLUMNCOUNT=2 .COLUMNWIDTHS=TRANS(.WIDTH-20) .COLUMNLINES=.F. .DISPLAYVALUE='' .PARENT.CMDGO1.VISIBLE=.F. .JumlahMenu=Occurs('{/',.Parent.Edit1.Value) .iMenu=0 FOR i=1 TO .JumlahMenu ii=strextract(this.parent.Edit1.Value,'{/','}',i) .ToolTipText=strextract(This.Parent.Edit1.Value,'{'+ii+'}','{/'+ii+'}',1) adaMenu=0 if !empty(.ToolTipText) if empty(.Parent.iCari1.Value) adaMenu=1 else if occurs(upper(alltrim(.Parent.iCari1.Value)),upper(.ToolTipText))>0 adaMenu=1 endif endif if adaMenu=1 .iMenu=.iMenu+1 .ADDLISTITEM(ii,.iMenu,1) .ADDLISTITEM(.ToolTipText,.iMenu,2) endif endif ENDFOR .parent.ListMenu1.Refresh_1 endwith ENDPROC PROCEDURE ListMenu1.Click this.parent.comboMenu1.Value=this.listitem(this.ListItemId,2) this.parent.comboMenu1.CLICK ENDPROC PROCEDURE ListMenu1.InteractiveChange this.click ENDPROC PROCEDURE ListMenu1.dblclick THIS.PARENT.CMDGO1.CLICK ENDPROC PROCEDURE ListMenu1.Refresh_1 WITH THIS .CLEAR .JumlahMenu=Occurs('{/',.Parent.Edit1.Value) .iMenu=0 FOR i=1 TO .JumlahMenu ii=strextract(this.parent.Edit1.Value,'{/','}',i) .Comment=strextract(This.Parent.Edit1.Value,'{'+ii+'}','{/'+ii+'}',1) adaMenu=0 if !empty(.Comment) if empty(.Parent.iCari1.Value) adaMenu=1 else if occurs(upper(alltrim(.Parent.iCari1.Value)),upper(.Comment))>0 adaMenu=1 endif endif if adaMenu=1 .iMenu=.iMenu+1 .ADDLISTITEM(' '+.Comment,.iMenu,1) .ADDLISTITEM(ii,.iMenu,2) endif endif ENDFOR endwith ENDPROC PROCEDURE ComboMenu1.Click with this.parent.cmdGo1 .Caption=this.ListItem(This.ListIndex,2) .ToolTipText=this.ListItem(This.ListIndex,2) if .Width<50 .Caption='a' .FontName = 'WebDings' else .Caption=.ToolTipText .FontName = 'Courier New' endif .VISIBLE=!EMPTY(THIS.VALUE) endwith ENDPROC PROCEDURE ComboMenu1.InteractiveChange THIS.Click ENDPROC PROCEDURE EDIT1.RIGHTCLICK IF EMPTY(THIS.Value) THIS.Tag='0' ELSE THIS.Tag=TRANSFORM(OCCURS('{\',THIS.Value)) ENDIF THIS.COMMENT='{'+THIS.Tag+'}{/'+THIS.Tag+'}{'+THIS.Tag+'\}{\'+THIS.Tag+'}{'+THIS.Tag+'/}'+TTOC(DATETIME()) IF EMPTY(THIS.Value) THIS.Value=THIS.COMMENT ELSE THIS.Value=THIS.COMMENT+CHR(13)+THIS.Value ENDIF ENDPROC PROCEDURE EDIT1.gotFocus if empty(this.value) this.parent.idscript1.valid endif ENDPROC PROCEDURE IDScript1.Valid_1 this.parent.edit1.value='' This.Tag=this.xFile() if file(this.tag) this.parent.edit1.value=filetostr(this.tag) endif this.parent.ComboMenu1.Refresh endproc PROCEDURE IDScript1.Valid THIS.VALID_1() endproc PROCEDURE IDScript1.DownClick This.Valid_1() Endproc PROCEDURE IDScript1.UpClick This.Valid_1() Endproc PROCEDURE IDScript1.KlikKanan This.Tag=this.xFile() if !empty(this.parent.edit1.value) chekFolder(this.tag) strtofile(this.parent.edit1.value,this.tag) wait window nowait "Script disimpan..." endif endproc PROCEDURE IDScript1.XFILE this.iFile=thisform.xFile()+'\mnu\mnu'+padl(trans(this.value),4,'0')+'.gasy' Return This.iFile endproc procedure cmdGo1.Click with this.parent this.tag=strextract(.edit1.value,'{/'+.comboMenu1.Value+'}','{'+.comboMenu1.Value+'\}',1) if !empty(this.tag) execscript(this.tag) endif endwith Endproc procedure cmdSimpan1.RightClick this.tag='prg\script\ubah_script.gasy' chekfolder(this.tag) strtofile(this.parent.edit1.value,this.tag) modify command (this.tag) this.parent.edit1.value=filetostr(this.tag) Endproc procedure cmdSimpan1.Click this.parent.idscript1.KlikKanan this.parent.comboMenu1.Refresh Endproc procedure cmdRefresh1.Click this.parent.comboMenu1.Refresh Endproc procedure cmdGo2.Click this.tag='prg\script\c\ubah_code_script.gasy' chekfolder(this.tag) strtofile(this.parent.edit2.value,this.tag) modify command (this.tag) this.parent.edit2.value=filetostr(this.tag) Endproc procedure cmdSimpan2.Click this.parent.idscript2.rightclick Endproc PROCEDURE IDScript2.Valid This.Valid_1() endproc PROCEDURE IDScript2.Valid_1 this.parent.edit2.value='' This.Tag=THIS.XFILE() if file(this.tag) this.parent.edit2.value=filetostr(this.tag) endif endproc PROCEDURE IDScript2.DownClick This.Valid_1() Endproc PROCEDURE IDScript2.UpClick This.Valid_1() Endproc PROCEDURE IDScript2.XFILE this.iFile=thisform.xFile()+'\fxp\fxp'+padl(trans(this.value),4,'0')+'.gasy' Return This.iFile ENDPROC PROCEDURE IDScript2.RightClick This.Tag=THIS.XFILE() if !empty(this.parent.edit2.value) chekFolder(this.tag) strtofile(this.parent.edit2.value,this.tag) wait window nowait "Code Script disimpan..." endif endproc PROCEDURE Init THIS.CMDCLOSE.COMBO1.INIT_1() this.IDSCRIPT1.VALID_1() This.CheckCode1.Value=1 This.iCari.DblClick this.Resize THIS.EDIT2.LEFT=THIS.CMDCLOSE.LEFT ENDPROC Procedure Check1.InteractiveChange with this.parent .listMenu1.Visible=this.value=0 .edit1.Visible=this.value=1 endwith endproc PROCEDURE Resize with this .PRG1.Top=.HEIGHT-.EDIT2.Height-9 .PRG2.TOP=.PRG1.Top .PRG3.TOP=.PRG1.Top .PRG4.TOP=.PRG1.Top .GAID.TOP=.PRG1.Top .CMDGASY.TOP=.PRG1.Top .ListProduk.Height=.PRG1.TOP-.ListProduk.Top-9 .checkCode1.Left=This.Width-.CheckCode1.Width .line1x.width=.width if .checkCode1.Value=1 .EDIT2.Top=.HEIGHT-.EDIT2.Height-9 .EDIT2.WIDTH=.Width-.EDIT2.LEFT-90 .edit1.height=.Edit2.Top-.Edit1.Top-9 .listMenu1.Height=.Edit1.Height if .cmdGo1.Width<50 .cmdGo1.Caption='a' .cmdGo1.FontName = 'WebDings' else .cmdGo1.Caption=.cmdGo1.ToolTipText .cmdGo1.FontName = 'Courier New' endif .cmdGo2.Top=.Height-.cmdGo2.Height-9 .cmdGo2.Left=.Width-.cmdGo2.Width-9 .IDSCRIPT1.TOP=.Edit2.Top .check1.Top=.IDSCRIPT1.TOP .cmdSimpan1.Top=.IDSCRIPT1.TOP .comboMenu1.Top=.IDSCRIPT1.TOP .cmdGo1.Top=.IDSCRIPT1.TOP .IDSCRIPT2.TOP=.Edit2.Top .IDSCRIPT2.LEFT=.Width-.IDScript2.Width-9 .cmdSImpan2.Top=.cmdGo2.Top .cmdSImpan2.Left=.IdScript2.Left .pf.Top=.cmdClose.Top+.cmdClose.Height .cmdClose.Left=.width-.cmdClose.Width-9 .edit1.width=.cmdClose.Left-.edit1.left-9 .listMenu1.Width=.cmdClose.left-.listmenu1.left-9 .pf.Left=.cmdClose.Left .pf.Height=.idScript2.Top-.pf.Top-9 .pf.Resize else .EDIT1.HEIGHT=.prg1.Top-.Edit1.Top-9 .Edit1.width=.Width-.Edit1.Left-9 .listMenu1.Height=.Edit1.Height .listMenu1.Width=.width-.listmenu1.left-9 if .cmdGo1.Width<50 .cmdGo1.Caption='a' .cmdGo1.FontName = 'WebDings' else .cmdGo1.Caption=.cmdGo1.ToolTipText .cmdGo1.FontName = 'Courier New' endif endif endwith ENDPROC Procedure CheckCode1.InteractiveChange WITH THIS.PARENT *.idScript1.VISIBLE=THIS.VALUE=1 *.comboMenu1.Visible=THIS.VALUE=1 *.check1.VISIBLE=THIS.VALUE=1 *.cmdSimpan1.Visible=this.value=1 *.cmdGo1.Visible=this.value=1 .PF.VISIBLE=THIS.VALUE=1 .cmdClose.Visible=THIS.VALUE=1 .cmdGo2.Visible=THIS.VALUE=1 .cmdSimpan2.Visible=THIS.VALUE=1 .Edit2.Visible=THIS.VALUE=1 .IDScript2.Visible=THIS.VALUE=1 if this.value=0 .edit1.visible=.f. .listmenu1.Visible=.t. endif .Resize ENDWITH ENDPROC ENDDEFINE * *-- EndDefine: form_6 ************************************************** ************************************************** *-- Class: pf__ (d:\j\gasy\prg\gasywin_app.vcx) *-- ParentClass: pageframe *-- BaseClass: pageframe *-- Time Stamp: 04/29/24 12:04:07 AM * DEFINE CLASS pf__ AS pageframe ErasePage = .T. PageCount = 1 BorderWidth = 0 Width = 154 Height = 169 SpecialEffect = 2 Tabs = .F. Name = "pf__" Page1.Caption = "Page1" Page1.Name = "Page1" PROCEDURE Resize LOCAL nPAGE FOR nPAGE=1 TO THIS.PageCount IF TYPE("THIS.Pages(nPAGE).OBYEK")="O" THIS.Pages(nPAGE).OBYEK.WIDTH=THIS.PageWidth THIS.Pages(nPAGE).OBYEK.HEIGHT=THIS.PageHeight THIS.Pages(nPAGE).OBYEK.RESIZE ENDIF ENDFOR THIS.RESIze_1 ENDPROC PROCEDURE resize_1 ENDPROC procedure Page1.Init WITH this .TAG='d:\j\gasy\prg\' .Caption = 'Folder 01' .NewObject('obyek','container__') .obyek.visible=.t. .caption=JUSTpath(this.Tag) .obyek.folder2.value=this.Tag .OBYEK.PARENT.PARENT.RESIZE ENDWITH Endproc ENDDEFINE * *-- EndDefine: pf__ ************************************************** ************************************************** *-- Class: cmdpf__ (d:\j\gasy\prg\gasywin_app.vcx) *-- ParentClass: container *-- BaseClass: container *-- Time Stamp: 04/29/24 12:01:09 AM * DEFINE CLASS cmdpf__ AS container Width = 273 Height = 36 BackStyle = 1 BorderWidth = 0 Visible = .T. TabIndex = 3 BackColor = RGB(0,0,128) Name = "cmdpf__" ADD OBJECT cmdclose AS commandbutton WITH ; AutoSize = .F., ; Top = 6, ; Left = 232, ; Height = 27, ; Width = 25, ; FontBold = .T., ; Caption = "x", ; TabStop = .F., ; ToolTipText = "Close Halaman yang aktif", ; Visible = .T., ; SpecialEffect = 2, ; Name = "cmdClose" ADD OBJECT combo1 AS combobox WITH ; FontBold = .T., ; FontSize = 12, ; Height = 27, ; Left = 105, ; SpecialEffect = 1, ; Style = 2, ; Top = 6, ; Width = 57, ; ForeColor = RGB(255,255,255), ; BackColor = RGB(0,0,128), ; ItemForeColor = RGB(255,255,255), ; ItemBackColor = RGB(0,0,128), ; BorderColor = RGB(0,0,128), ; BorderStyle = 0, ; Name = "Combo1" ADD OBJECT cmdrefresh AS commandbutton WITH ; AutoSize = .F., ; Top = 6, ; Left = 181, ; Height = 27, ; Width = 25, ; FontName = "Webdings", ; Caption = "a", ; TabStop = .F., ; ToolTipText = "Refresh", ; Visible = .T., ; SpecialEffect = 2, ; Name = "cmdRefresh" ADD OBJECT cmdtambah AS commandbutton WITH ; Top = 6, ; Left = 9, ; Height = 27, ; Width = 30, ; Caption = "+", ; Style = 0, ; SpecialEffect = 2, ; Name = "cmdTambah" ADD OBJECT cmdpage1 AS commandbutton WITH ; Top = 6, ; Left = 41, ; Height = 27, ; Width = 57, ; FontBold = .T., ; Caption = "Folder", ; Style = 0, ; SpecialEffect = 2, ; Name = "cmdPage1" PROCEDURE folder_cmdpage1_click thisform.pf.ActivePage=1 THIS.COMbo1.DisplayValue=thisform.pF.page1.Caption ENDPROC PROCEDURE folder_cmdrefresh_click this.combo1.InteractiveChange THIS.FOlder_combo1_init ENDPROC PROCEDURE folder_combo1_init LOCAL nom this.COMbo1.Clear this.COMbo1.DisplayValue='' for nom=1 to thisFORM.pF.PageCount this.COMbo1.AddListItem('Folder '+PADL(TRANSFORM(nom),2,'0'),nom,1) this.COMbo1.AddListItem(TRANSFORM(nom),nom,2) thisform.pf.Pages(nom).caption='Folder '+PADL(TRANSFORM(nom),2,'0') ENDFOR THIS.COMbo1.DisplayValue='Folder '+PADL(TRANSFORM(THISFORM.PF.ActivePage),2,'0') ENDPROC PROCEDURE folder_cmdtambah_click this.WhatsThisHelpID=MIN(thisform.pf.PageCount+1,99) if this.WhatsThisHelpID=99 RETURN ENDIF this.tag=GETDIR() IF EMPTY(this.Tag) RETURN ENDIF thisform.pf.AddObject('page'+TRANSFORM(this.WhatsThisHelpID),'Page') thisform.pf.ActivePage=thisform.pF.PageCount WITH thisform.pf.pages(thisform.pF.PageCount) .NewObject('obyek','container__') .obyek.visible=.t. .caption=JUSTpath(this.Tag) .obyek.folder2.value=this.Tag .OBYEK.PARENT.PARENT.RESIZE ENDWITH THIS.FOlder_combo1_init ENDPROC PROCEDURE Init this.Resize ENDPROC PROCEDURE Resize this.cmdClose.Left=this.Width-this.cmdClose.Width-9 THIS.CMdRefresh.Left=THIS.cmdClose.Left-THIS.CMdRefresh.Width-5 THIS.COMbo1.WIDTH=THIS.CMdRefresh.Left-THIS.COMbo1.Left-5 this.cmdPage1.Left=this.cmdTambah.Left+this.cmdTambah.Width+5 this.cmdPage1.Width=this.combo1.Left-this.cmdPage1.Left-5 ENDPROC PROCEDURE cmdclose.MouseLeave LPARAMETERS nButton, nShift, nXCoord, nYCoord THIS.Parent.BackColor= RGB(0,0,128) THIS.Parent.COMbo1.LostFocus THIS.Parent.COMbo1.BackColor=THIS.Parent.BackColor THIS.Parent.COMbo1.ItemBackColor=THIS.Parent.BackColor ENDPROC PROCEDURE cmdclose.MouseEnter LPARAMETERS nButton, nShift, nXCoord, nYCoord THIS.Parent.BackColor= RGB(255,0,0) THIS.Parent.COMbo1.BackColor=THIS.Parent.BackColor THIS.Parent.COMbo1.ItemBackColor=THIS.Parent.BackColor THIS.SetFocus ENDPROC PROCEDURE cmdclose.Click thisform.pf.ActivePage=MIN(val(this.Parent.COMbo1.ListItem(this.Parent.COMbo1.ListIndex,2)),thisform.pF.PageCount) if thisform.pf.ActivePage>1 thisform.pF.RemoveObject(thisform.pF.Pages(thisform.pF.ActivePage).name) thisform.pF.ActivePage=thisform.pf.PageCount THIS.Parent.COMbo1.Init this.Parent.Refresh ENDIF ENDPROC PROCEDURE combo1.InteractiveChange thisform.pf.ActivePage=MIN(val(this.ListItem(this.ListIndex,2)),thisform.pF.PageCount) ENDPROC PROCEDURE combo1.GotFocus THIS.Parent.BackColor = RGB(0,64,0) THIS.BorderColor=THIS.Parent.BackColor THIS.BackColor=THIS.Parent.BackColor THIS.ForeColor=RGB(255,255,255) THIS.ItemBackColor=THIS.BackColor THIS.ItemForeColor=THIS.ForeColor ENDPROC PROCEDURE combo1.LostFocus THIS.Parent.BackColor = RGB(0,0,128) THIS.BorderColor=THIS.Parent.BackColor THIS.BackColor=THIS.Parent.BackColor THIS.ForeColor=RGB(255,255,255) THIS.ItemBackColor=THIS.BackColor THIS.ItemForeColor=THIS.ForeColor ENDPROC PROCEDURE combo1.MouseEnter LPARAMETERS nButton, nShift, nXCoord, nYCoord THIS.GotFocus ENDPROC PROCEDURE combo1.MouseLeave LPARAMETERS nButton, nShift, nXCoord, nYCoord THIS.LostFocus ENDPROC PROCEDURE cmdrefresh.Click this.Parent.combo1.InteractiveChange THIS.Parent.COMbo1.Init ENDPROC PROCEDURE cmdtambah.Click this.WhatsThisHelpID=MIN(thisform.pf.PageCount+1,99) if this.WhatsThisHelpID=99 RETURN ENDIF this.tag=GETDIR() IF EMPTY(this.Tag) RETURN ENDIF thisform.pf.AddObject('page'+TRANSFORM(this.WhatsThisHelpID),'Page') thisform.pf.ActivePage=thisform.pF.PageCount WITH thisform.pf.pages(thisform.pF.PageCount) .NewObject('obyek','container__') .obyek.visible=.t. .caption=JUSTpath(this.Tag) .obyek.folder2.value=this.Tag .OBYEK.PARENT.PARENT.RESIZE ENDWITH THIS.Parent.COMbo1.Init_1 ENDPROC PROCEDURE cmdpage1.Click thisform.pf.ActivePage=1 THIS.Parent.COMbo1.DisplayValue=thisform.pF.page1.Caption ENDPROC PROCEDURE combo1.Init_1 LOCAL nom this.Clear this.DisplayValue='' for nom=1 to thisFORM.pF.PageCount this.AddListItem('Folder '+PADL(TRANSFORM(nom),2,'0'),nom,1) this.AddListItem(TRANSFORM(nom),nom,2) thisform.pf.Pages(nom).caption='Folder '+PADL(TRANSFORM(nom),2,'0') ENDFOR THIS.DisplayValue='Folder '+PADL(TRANSFORM(THISFORM.PF.ActivePage),2,'0') ENDPROC PROCEDURE combo1.Init LOCAL nom this.Clear this.DisplayValue='' this.AddListItem('Folder 01',1,1) this.AddListItem('1',1,2) THIS.DisplayValue='Folder 01' ENDPROC ENDDEFINE * *-- EndDefine: cmdpf__ ************************************************** ************************************************** *-- Class: container__ (d:\j\gasy\prg\gasywin_app.vcx) *-- ParentClass: container *-- BaseClass: container *-- Time Stamp: 05/24/24 09:33:03 PM * DEFINE CLASS container__ AS container Width = 273 Height = 222 Name = "container__" ADD OBJECT list2 AS listbox WITH ; FontName = "Times New Roman", ; FontSize = 12, ; Height = 105, ; Left = 11, ; TabIndex = 5, ; Top = 73, ; Width = 244, ; ItemTips = .T., ; Name = "List2" ADD OBJECT xcari2 AS textbox WITH ; Height = 33, ; Left = 11, ; MaxLength = 50, ; TabIndex = 3, ; ToolTipText = "ISI + UNTUK MENAMBAH DOKUMEN BARU", ; FontName = 'Courier New',; FontSize = 14,; Top = 33, ; Width = 169, ; Name = "xcari2" ADD OBJECT jenis2 AS combobox WITH ; RowSourceType = 1, ; RowSource = "*,prg,fxp,frx,dbf,scx,sql,png,jpg,ico,gasy,txt,bmp,gif,html,htm,dat,dbc,bak,pjx", ; Height = 33, ; Left = 186, ; Style = 2, ; TabIndex = 4, ; Top = 33, ; Width = 69, ; FontName = 'Courier New',; FontSize = 14,; Name = "JENIS2" ADD OBJECT cmdgetdir AS commandbutton WITH ; AutoSize = .F., ; Top = 5, ; Left = 11, ; Height = 27, ; Width = 97, ; FontSize = 9, ; Caption = "Pilih \<Directory...", ; TabIndex = 1, ; SpecialEffect = 2, ; Name = "cmdGetDir" ADD OBJECT folder2 AS textbox WITH ; FontSize = 12, ; BackStyle = 0, ; BorderStyle = 0, ; Height = 33, ; Left = 8, ; Margin = 4, ; TabIndex = 12, ; Top = 175, ; Visible = .T., ; Width = 244, ; Style = 1, ; Name = "FOLDER2",; Value= 'd:\j\gasy\prg\' ADD OBJECT labeldirektory AS commandbutton WITH ; Top = 175, ; Left = 12, ; Height = 24, ; Width = 244, ; Caption = "labelDirektory", ; Style = 1, ; Name = "labelDirektory" PROCEDURE Resize this.folDER2.Top=this.Height-this.foLDER2.Height this.list2.Height=this.foLDER2.Top-this.list2.Top-5 this.labelDirektory.Top=this.fOLDER2.Top ENDPROC PROCEDURE Init this.Resize ENDPROC PROCEDURE Refresh this.labelDirektory.ToolTipText="KLIK DISINI UNTUK BUKA FOLDER: "+ALLTRIM(this.fOLDER2.ValUE) ENDPROC PROCEDURE list2.RightClick this.Tag=alltrim(this.Parent.folder2.Value)+alltrim(this.DisplayValue) IF OCCURS('.PRG',UPPER(THIS.Tag))>0 GAE(this.Tag) RETURN ENDIF IF OCCURS('.FRX',UPPER(THIS.Tag))>0 IF file(this.Tag) SET RESOURCE off MODIFY REPORT (THIS.Tag) SET RESOURCE on ENDIF RETURN ENDIF IF OCCURS('.SCX',UPPER(THIS.Tag))>0 IF file(this.Tag) AND _vfp.StartMode=0 MODIFY FORM (THIS.Tag) ELSE WAIT WINDOW NOWAIT 'Ubah form tidak dapat dilakukan setelah aplikasi dijalankan' ENDIF RETURN ENDIF IF OCCURS('.GASY',UPPER(THIS.Tag))>0 ; OR OCCURS('.SCRIPT',UPPER(THIS.Tag))>0 ; OR OCCURS('.SOFTWARE',UPPER(THIS.Tag))>0 ; OR OCCURS('.INI',UPPER(THIS.Tag))>0 ; OR OCCURS('.OSI',UPPER(THIS.Tag))>0 ; OR OCCURS('.TXT',UPPER(THIS.Tag))>0 ; OR OCCURS('.HTM',UPPER(THIS.Tag))>0 ; OR OCCURS('.ERR',UPPER(THIS.Tag))>0 ; OR OCCURS('.CSS',UPPER(THIS.Tag))>0 ; OR OCCURS('.JS',UPPER(THIS.Tag))>0 ; OR OCCURS('.FPW',UPPER(THIS.Tag))>0 ; OR OCCURS('.HTML',UPPER(THIS.Tag))>0 IF file(this.Tag) MODIFY FILE (THIS.Tag) ENDIF RETURN ENDIF IF OCCURS('.DBF',UPPER(THIS.Tag))>0 ; OR OCCURS('.DAT',UPPER(THIS.Tag))>0 IF file(this.Tag) SELECT * FROM (THIS.Tag) ENDIF RETURN ENDIF ENDPROC PROCEDURE list2.Click this.Tag=alltrim(this.Parent.folder2.Value)+alltrim(this.DisplayValue) IF !FILE(THIS.TAG) RETURN ENDIF IF OCCURS('.PRG',UPPER(THIS.Tag))>0 IF EMPTY(THISFORM.EDIT2.VALUE) THISFORM.EDIT2.VALUE='*'+THIS.TAG+CHR(13)+FILETOSTR(THIS.TAG) RETURN ENDIF this.comment=thisFORM.IDSCRIPT2.xFile() IF !FILE(THIS.comment) THISFORM.EDIT2.VALUE='*'+THIS.TAG+CHR(13)+FILETOSTR(THIS.TAG) RETURN ENDIF ENDIF IF OCCURS('.FRX',UPPER(THIS.Tag))>0 THISFORM.EDIT2.VALUE="*"+THIS.TAG+CHR(13)+THISFORM.EDIT2.VALUE RETURN ENDIF IF OCCURS('.SCX',UPPER(THIS.Tag))>0 THISFORM.EDIT2.VALUE="*"+THIS.TAG+CHR(13)+THISFORM.EDIT2.VALUE RETURN ENDIF IF OCCURS('.DBF',UPPER(THIS.Tag))>0 ; OR OCCURS('.DAT',UPPER(THIS.Tag))>0 THISFORM.EDIT2.VALUE="*"+THIS.TAG+CHR(13)+THISFORM.EDIT2.VALUE RETURN ENDIF ENDPROC PROCEDURE xcari2.Click this.GotFocus ENDPROC PROCEDURE xcari2.Valid IF OCCURS('+',ALLTRIM(THIS.Value))>0 THIS.Parent.LIst2.AddItem(STRTRAN(ALLTRIM(THIS.Value),'+','')) ENDIF ENDPROC PROCEDURE xcari2.InteractiveChange THIS.Parent.JENIS2.InteractiveChange ENDPROC PROCEDURE xcari2.DblClick THIS.Value='' THIS.Parent.JENIS2.InteractiveChange ENDPROC PROCEDURE xcari2.GotFocus IF EMPTY(this.Parent.foLDER2.Value) this.Parent.cmdGetDir.Click ENDIF ENDPROC PROCEDURE jenis2.InteractiveChange THIS.Tag=alltrim(this.Parent.FOLDER2.Value) if not empty(THIS.Tag) then gnbre=adir(gabase,addbs(THIS.Tag)+"*"+LOWER(ALLTRIM(THIS.Value))) WITH this.Parent.list2 .clear .comment=UPPER(alltrim(this.Parent.xcari2.Value)) IF EMPTY(.comment) for i=1 to gnbre .additem(gabase(i,1)) ENDFOR ELSE for i=1 to gnbre IF OCCURS(.comment,UPPER(gabase(i,1)))>0 .additem(gabase(i,1)) ENDIF ENDFOR ENDIF ENDWITH ENDIF ENDPROC PROCEDURE cmdgetdir.Click LOCAL cDir cDir = GETDIR(ALLTRIM(this.Parent.foLDER2.Value),'Pilih Folder',Thisform.Caption) IF EMPTY(m.cDir) RETURN ENDIF THIS.Parent.LabelDirektory.Caption=m.cDir this.ToolTipText="Klik untuk memilih folder, Klik Kanan Untuk Membuka" this.Parent.foLDER2.Value=m.cDir this.Parent.list2.Clear ENDPROC PROCEDURE cmdgetdir.RightClick IF EMPTY(this.Parent.foLDER2.Value) this.Click ENDIF BukaxFile(ALLTRIM(THIS.Parent.FOLDER2.Value)) ENDPROC PROCEDURE labeldirektory.Click this.Parent.cmdGetDir.RightClick ENDPROC PROCEDURE labeldirektory.MouseEnter LPARAMETERS nButton, nShift, nXCoord, nYCoord this.ToolTipText="KLIK DISINI UNTUK BUKA FOLDER: "+ALLTRIM(this.Parent.fOLDER2.ValUE) ENDPROC ENDDEFINE * *-- EndDefine: container__ ************************************************** define class ComboBox__az as ComboBox AlignMent = 2 Height = 27 Width = 45 FontName = "Courier New" FontBold = .T. FontSize = 14 BorderStyle = 1 BackStyle = 1 Visible = .T. Style = 2 RowSource=',a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z' RowSourceType=1 enddefine define class spinner__gs as SPinner FontSize = 14 FontName = "Courier New" Width = 72 Value = 0 InputMask = '9999' Format = '9999' SPinnerHighValue = 9999 SPinnerLowValue = 0 KeyBoardHighValue = 9999 KeyBoardLowValue = 0 Height = 27 ToolTipText = "ID Script" iFile='' iFolder='' enddefine

FUNCTION KR_USR(lShare,OPSI) mFile=ALAMATNYA('ADIDL')+"KR_USR.DBF" Tutup('KR_USR') IF !FILE(MFILE) Tunggu("Proses indek file USER program"+CHR(13)+mFile,1) CHEKFOLDER(MFILE) CREATE TABLE (mFile) ; (; IDENTITAS C(15), ; NAMA C(30), ; JABATAN C(30), ; TINGKAT N(3), ; PHOTO C(3), ; TAMPIL N(3), ; KODE_AKSES C(15), ; Catatan C(150); ) USE ENDIF IF TRANSFORM(OPSI)=='.T.' IF BUKA(.T.,mFile,'KR_USR') SELECT KR_USR GO TOP DO WHILE !EOF() IF EMPTY(PHOTO) DELETE ENDIF SKIP ENDDO PACK ENDIF Tutup('KR_USR') ENDIF IF TRANSFORM(OPSI)=='BROWSE' IF BUKA(.T.,mFile,'KR_USR') SELECT KR_USR GBROWSE('KR_USR') ENDIF Tutup('KR_USR') RETURN ENDIF RETURN BUKA(lShare,mFile,'KR_USR') ENDFUNC

PROCEDURE KODE_PRO(IPHOTO) PUBLIC okodepro okodepro=CREATEOBJECT("kodepro",IPHOTO) okodepro.Show RETURN ENDPROC DEFINE CLASS kodepro AS form BorderStyle = 3 Height = 500 Width = 700 MinHeight = 500 MinWidth = 700 MaxHeight = 500 MaxWidth = 700 DoCreate = .T. AutoCenter = .T. Caption = "Batasan Akses Menu/Proses" Closable = .T. MaxButton = .F. MinButton = .F. Icon = _SCREEN.ICON desktop = .F. WindowState = 0 BackColor = RGB(144,176,168) ADD OBJECT check1 AS checkbox WITH ; Top = 39, ; Left = 11, ; Height = 15, ; Width = 107, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "001 Setup User", ; TabIndex = 2, ; Name = "Check1" ADD OBJECT check2 AS checkbox WITH ; Top = 56, ; Left = 11, ; Height = 15, ; Width = 106, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "002 Browse - Lihat", ; TabIndex = 3, ; Name = "Check2" ADD OBJECT check3 AS checkbox WITH ; Top = 73, ; Left = 11, ; Height = 15, ; Width = 109, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "003 Browse - Ubah", ; TabIndex = 4, ; Name = "Check3" ADD OBJECT check4 AS checkbox WITH ; Top = 90, ; Left = 11, ; Height = 15, ; Width = 122, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "004 Browse - Tambah", ; TabIndex = 5, ; Name = "Check4" ADD OBJECT check5 AS checkbox WITH ; Top = 107, ; Left = 11, ; Height = 15, ; Width = 114, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "005 Browse - Hapus", ; TabIndex = 6, ; Name = "Check5" ADD OBJECT check6 AS checkbox WITH ; Top = 124, ; Left = 11, ; Height = 15, ; Width = 151, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "006 Tambah/Ubah Laporan", ; TabIndex = 7, ; Name = "Check6" ADD OBJECT check7 AS checkbox WITH ; Top = 141, ; Left = 11, ; Height = 15, ; Width = 154, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "007 Tambah/Ubah Prosedur", ; TabIndex = 8, ; Name = "Check7" ADD OBJECT check8 AS checkbox WITH ; Top = 158, ; Left = 11, ; Height = 15, ; Width = 224, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "008 Tambah/Ubah/Hapus Sandi Transaksi", ; TabIndex = 9, ; Name = "Check8" ADD OBJECT check9 AS checkbox WITH ; Top = 175, ; Left = 11, ; Height = 15, ; Width = 173, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "009 Tambah/Ubah File Interface", ; TabIndex = 10, ; Name = "Check9" ADD OBJECT check10 AS checkbox WITH ; Top = 192, ; Left = 11, ; Height = 15, ; Width = 197, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "010 Tambah/Ubah Register Nasabah", ; TabIndex = 11, ; Name = "Check10" ADD OBJECT check11 AS checkbox WITH ; Top = 209, ; Left = 11, ; Height = 15, ; Width = 158, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "011 Hapus Register Nasabah", ; TabIndex = 12, ; Name = "Check11" ADD OBJECT check12 AS checkbox WITH ; Top = 226, ; Left = 11, ; Height = 15, ; Width = 243, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "012 Tambah/Ubah Rekening Akuntansi", ; TabIndex = 13, ; Name = "Check12" ADD OBJECT check13 AS checkbox WITH ; Top = 243, ; Left = 11, ; Height = 15, ; Width = 169, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "013 Hapus Rekening Akuntansi", ; TabIndex = 14, ; Name = "Check13" ADD OBJECT check14 AS checkbox WITH ; Top = 260, ; Left = 11, ; Height = 15, ; Width = 140, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "014 Tambah/Ubah Jurnal", ; TabIndex = 15, ; Name = "Check14" ADD OBJECT check15 AS checkbox WITH ; Top = 277, ; Left = 11, ; Height = 15, ; Width = 101, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "015 Hapus Jurnal", ; TabIndex = 16, ; Name = "Check15" ADD OBJECT check16 AS checkbox WITH ; Top = 294, ; Left = 11, ; Height = 15, ; Width = 140, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "016 Proses Posting Ulang", ; TabIndex = 17, ; Name = "Check16" ADD OBJECT check17 AS checkbox WITH ; Top = 311, ; Left = 11, ; Height = 15, ; Width = 160, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "017 Mutasi/Saldo Buku Besar", ; TabIndex = 18, ; Name = "Check17" ADD OBJECT check18 AS checkbox WITH ; Top = 328, ; Left = 11, ; Height = 15, ; Width = 181, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "018 Tambah Realisasi Kredit", ; TabIndex = 19, ; Name = "Check18" ADD OBJECT check19 AS checkbox WITH ; Top = 345, ; Left = 11, ; Height = 15, ; Width = 170, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "019 Pembatalan Realisasi Kredit", ; TabIndex = 20, ; Name = "Check19" ADD OBJECT check20 AS checkbox WITH ; Top = 362, ; Left = 11, ; Height = 15, ; Width = 146, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "020 Ubah Master Nasabah", ; TabIndex = 21, ; Name = "Check20" ADD OBJECT check21 AS checkbox WITH ; Top = 379, ; Left = 11, ; Height = 15, ; Width = 156, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "021 Tambah Angsuran Kredit", ; TabIndex = 22, ; Name = "Check21" ADD OBJECT check22 AS checkbox WITH ; Top = 396, ; Left = 11, ; Height = 15, ; Width = 173, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "022 Pembatalan Angsuran Kredit", ; TabIndex = 23, ; Name = "Check22" ADD OBJECT check23 AS checkbox WITH ; Top = 413, ; Left = 11, ; Height = 15, ; Width = 148, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "023 Ubah Anggaran Bunga", ; TabIndex = 24, ; Name = "Check23" ADD OBJECT check24 AS checkbox WITH ; Top = 430, ; Left = 11, ; Height = 15, ; Width = 128, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "024 Proses Akhir Bulan", ; TabIndex = 25, ; Name = "Check24" ADD OBJECT check25 AS checkbox WITH ; Top = 39, ; Left = 270, ; Height = 15, ; Width = 202, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "025 Tambah Transaksi Deposito", ; TabIndex = 26, ; Name = "Check25" ADD OBJECT check26 AS checkbox WITH ; Top = 56, ; Left = 270, ; Height = 15, ; Width = 189, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "026 Pembatalan Transaksi Deposito", ; TabIndex = 27, ; Name = "Check26" ADD OBJECT check27 AS checkbox WITH ; Top = 73, ; Left = 270, ; Height = 15, ; Width = 105, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "027 Proses Bunga", ; TabIndex = 28, ; Name = "Check27" ADD OBJECT check28 AS checkbox WITH ; Top = 90, ; Left = 270, ; Height = 15, ; Width = 223, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "028 Tambah/Ubah File Nasabah TB", ; TabIndex = 29, ; Name = "Check28" ADD OBJECT check29 AS checkbox WITH ; Top = 107, ; Left = 270, ; Height = 15, ; Width = 135, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "029 Hapus File Nasabah", ; TabIndex = 30, ; Name = "Check29" ADD OBJECT check30 AS checkbox WITH ; Top = 124, ; Left = 270, ; Height = 15, ; Width = 130, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "030 Tambah Transaksi ", ; TabIndex = 31, ; Name = "Check30" ADD OBJECT check31 AS checkbox WITH ; Top = 141, ; Left = 270, ; Height = 15, ; Width = 144, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "031 Pembatalan Transaksi", ; TabIndex = 32, ; Name = "Check31" ADD OBJECT check32 AS checkbox WITH ; Top = 158, ; Left = 270, ; Height = 15, ; Width = 102, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "032 Kontrol Saldo", ; TabIndex = 33, ; Name = "Check32" ADD OBJECT check33 AS checkbox WITH ; Top = 175, ; Left = 270, ; Height = 15, ; Width = 105, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "033 Proses Bunga", ; TabIndex = 34, ; Name = "Check33" ADD OBJECT check34 AS checkbox WITH ; Top = 192, ; Left = 270, ; Height = 15, ; Width = 128, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "034 Proses Akhir Bulan", ; TabIndex = 35, ; Name = "Check34" ADD OBJECT check35 AS checkbox WITH ; Top = 209, ; Left = 270, ; Height = 15, ; Width = 140, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "035 Proses Jurnal Kolektif", ; TabIndex = 36, ; Name = "Check35" ADD OBJECT check36 AS checkbox WITH ; Top = 226, ; Left = 270, ; Height = 15, ; Width = 168, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "036 Tambah Transaksi TP", ; TabIndex = 37, ; Name = "Check36" ADD OBJECT check37 AS checkbox WITH ; Top = 243, ; Left = 270, ; Height = 15, ; Width = 144, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "037 Pembatalan Transaksi", ; TabIndex = 38, ; Name = "Check37" ADD OBJECT check38 AS checkbox WITH ; Top = 260, ; Left = 270, ; Height = 15, ; Width = 105, ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "038 Proses Bunga", ; TabIndex = 39, ; Name = "Check38" ADD OBJECT rekam AS commandbutton WITH ; Top = 461, ; Left = 96, ; Height = 27, ; Width = 84, ; Caption = "\<Rekam", ; TabIndex = 40, ; Name = "Rekam" ADD OBJECT selesai AS commandbutton WITH ; Top = 461, ; Left = 588, ; Height = 27, ; Width = 84, ; Caption = "E\<XIT", ; TabIndex = 41, ; Name = "Selesai" ADD OBJECT pilihan AS commandbutton WITH ; Top = 461, ; Left = 12, ; Height = 27, ; Width = 84, ; Caption = "\<Semuanya", ; TabIndex = 42, ; Name = "Pilihan" ADD OBJECT check39 AS checkbox WITH ; Top = 277, ; Left = 270, ; Height = 15, ; Width = 155, ; FontBold = .F., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "039 Tambah/Ubah Nasabah", ; TabIndex = 43, ; Name = "Check39" ADD OBJECT check40 AS checkbox WITH ; Top = 294, ; Left = 270, ; Height = 15, ; Width = 116, ; FontBold = .F., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "040 Hapus Nasabah", ; TabIndex = 44, ; Name = "Check40" ADD OBJECT check41 AS checkbox WITH ; Top = 311, ; Left = 270, ; Height = 15, ; Width = 131, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "041 Setup Prosedur", ; TabIndex = 45, ; Name = "Check41" ADD OBJECT check42 AS checkbox WITH ; Top = 328, ; Left = 270, ; Height = 15, ; Width = 124, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "042 Transaksi Kas", ; TabIndex = 46, ; Name = "Check42" ADD OBJECT check43 AS checkbox WITH ; Top = 345, ; Left = 270, ; Height = 15, ; Width = 129, ; FontBold = .F., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "043 Transaksi Non Kas", ; TabIndex = 47, ; Name = "Check43" ADD OBJECT check44 AS checkbox WITH ; Top = 362, ; Left = 270, ; Height = 15, ; Width = 100, ; FontBold = .F., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "044 Penyesuaian", ; TabIndex = 48, ; Name = "Check44" ADD OBJECT check45 AS checkbox WITH ; Top = 379, ; Left = 270, ; Height = 15, ; Width = 149, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "045 Laporan Transaksi", ; TabIndex = 49, ; Name = "Check45" ADD OBJECT check46 AS checkbox WITH ; Top = 396, ; Left = 270, ; Height = 15, ; Width = 141, ; FontBold = .F., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "046 Laporan Performance", ; TabIndex = 50, ; Name = "Check46" ADD OBJECT check47 AS checkbox WITH ; Top = 413, ; Left = 270, ; Height = 15, ; Width = 136, ; FontBold = .F., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "047 Laporan Buku Besar", ; TabIndex = 51, ; Name = "Check47" ADD OBJECT check48 AS checkbox WITH ; Top = 430, ; Left = 270, ; Height = 15, ; Width = 155, ; FontBold = .F., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "048 Laporan Bank Indonesia", ; TabIndex = 52, ; Name = "Check48" ADD OBJECT check49 AS checkbox WITH ; Top = 39, ; Left = 516, ; Height = 15, ; Width = 100, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "049 Akhir Hari", ; TabIndex = 53, ; Name = "Check49" ADD OBJECT check50 AS checkbox WITH ; Top = 56, ; Left = 516, ; Height = 15, ; Width = 93, ; FontBold = .F., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "050 Akhir Bulan", ; TabIndex = 54, ; Name = "Check50" ADD OBJECT check51 AS checkbox WITH ; Top = 73, ; Left = 516, ; Height = 15, ; Width = 97, ; FontBold = .F., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "051 Akhir Tahun", ; TabIndex = 55, ; Name = "Check51" ADD OBJECT check52 AS checkbox WITH ; Top = 90, ; Left = 516, ; Height = 15, ; Width = 169, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "052 Copy File Per Tanggal", ; TabIndex = 56, ; Name = "Check52" ADD OBJECT check53 AS checkbox WITH ; Top = 107, ; Left = 516, ; Height = 15, ; Width = 172, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "053 Transaksi Per Tanggal", ; TabIndex = 57, ; Name = "Check53" ADD OBJECT check54 AS checkbox WITH ; Top = 124, ; Left = 516, ; Height = 15, ; Width = 151, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "054 Modifikasi Laporan", ; TabIndex = 58, ; Name = "Check54" ADD OBJECT check55 AS checkbox WITH ; Top = 141, ; Left = 516, ; Height = 15, ; Width = 82, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "055 Indeks", ; TabIndex = 60, ; Name = "Check55" ADD OBJECT check56 AS checkbox WITH ; Top = 158, ; Left = 516, ; Height = 15, ; Width = 67, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "056 Dbu", ; TabIndex = 61, ; Name = "Check56" ADD OBJECT line1 AS line WITH ; Height = 0, ; Left = 0, ; Top = 31, ; Width = 699, ; BorderColor = RGB(128,128,128), ; Name = "Line1" ADD OBJECT label1 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; Caption = "Kode User:", ; Height = 17, ; Left = 12, ; Top = 8, ; Width = 64, ; TabIndex = 62, ; Name = "Label1" ADD OBJECT kodeuser AS textbox WITH ; Height = 23, ; Left = 79, ; MaxLength = 3, ; InputMask = '!!!',; TabIndex = 1, ; Top = 3, ; Width = 52, ; Name = "KodeUser" ADD OBJECT line2 AS line WITH ; Height = 0, ; Left = 1, ; Top = 453, ; Width = 699, ; BorderColor = RGB(128,128,128), ; Name = "Line2" ADD OBJECT check57 AS checkbox WITH ; Top = 175, ; Left = 516, ; Height = 15, ; Width = 137, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "057 Backup/Restore", ; TabIndex = 61, ; Name = "Check57" ADD OBJECT check58 AS checkbox WITH ; Top = 192, ; Left = 516, ; Height = 15, ; Width = 135, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "058 Laporan Default", ; TabIndex = 61, ; Name = "Check58" ADD OBJECT check59 AS checkbox WITH ; Top = 209, ; Left = 516, ; Height = 15, ; Width = 164, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 8, ; AutoSize = .T., ; Alignment = 0, ; BackStyle = 0, ; Caption = "059 Menu/Proses Default", ; TabIndex = 61, ; Name = "Check59" PROCEDURE Destroy TUTUP('KR_USR') ENDPROC PROCEDURE Init PARAMETERS lxFoto LOCAL Ok1, Nom, iKodenya iFoto='' IF TYPE('lcFoto')='C' IFOTO=lxFoto ENDIF iKodenya="" This.KodeUser.Value=iFoto IF !KR_USR() RETURN ENDIF Select KR_USR LOCATE FOR ALLTRIM(PHOTO)==iFoto IF FOUND() iKodenya=Catatan ENDIF FOR Nom=1 TO 57 Ok1="Thisform.Check"+LTRIM(STR(Nom,3))+".Value" &Ok1=VAL(SUBSTR(iKodenya,Nom,1)) NEXT ENDPROC PROCEDURE rekam.Init This.Visible=Dadi(1) ENDPROC PROCEDURE rekam.Click LOCAL mIsi, Ok1, Nom mIsi="" FOR Nom=1 TO 59 Ok1="Thisform.Check"+LTRIM(STR(Nom,3))+".Value" Ok2=&Ok1 mIsi=ALLTRIM(mIsi)+STR(Ok2,1) NEXT IF !KR_USR() RETURN ENDIF Select KR_USR LOCATE FOR ALLTRIM(PHOTO)==This.Parent.KodeUser.Value IF FOUND() IF Kunci_Rc(5) REPLACE Catatan WITH mIsi Dadimenu=ALLTRIM(mIsi) UNLOCK FLUSH ENDIF ENDIF TUTUP('KR_USR') ENDPROC PROCEDURE selesai.Click Thisform.Release ENDPROC PROCEDURE pilihan.Click LOCAL mIsi, Ok1, Nom mIsi="" FOR Nom=1 TO 59 Ok1="Thisform.Check"+LTRIM(STR(Nom,3))+".Value" &Ok1=1 NEXT mIsi=REPLICATE('1',59) ENDPROC PROCEDURE pilihan.RightClick LOCAL mIsi, Ok1, Nom mIsi="" FOR Nom=1 TO 59 Ok1="Thisform.Check"+LTRIM(STR(Nom,3))+".Value" &Ok1=0 NEXT mIsi=REPLICATE('0',59) ENDPROC PROCEDURE kodeuser.LostFocus LOCAL iKodenya, Nom iKodenya="" IF !KR_USR() RETURN ENDIF Select KR_USR LOCATE FOR ALLTRIM(PHOTO)==This.Value IF FOUND() iKodenya=Catatan ENDIF FOR Nom=1 TO 59 Ok1="Thisform.Check"+LTRIM(STR(Nom,3))+".Value" &Ok1=VAL(SUBSTR(iKodenya,Nom,1)) NEXT TUTUP('KR_USR') ENDPROC ENDDEFINE * *-- EndDefine: kodepro **************************************************

PROCEDURE GASYPROS(nKLP,lSHARE,OPSI) LOCAL mDBF TUTUP("GASYPROS") IF TYPE('nKLP')='N' OR TYPE('nKLP')='C' mDBF='PRG\GASYUSER\MNU\PROS_DEF_'+PADL(TRANSFORM(NKLP),3,'0')+'.DBF' ELSE mDBF='PRG\GASYUSER\MNU\PROS_DEF.DBF' ENDIF IF !FILE(mDbf) CHEKFOLDER(mDbf) CREATE TABLE (mDbf) ; (; KODE C(3), ; NMR C(3), ; NMMENU C(60), ; NMPROSEDUR C(250), ; NMLAPORAN C(250), ; SBR C(1), ; CATATAN C(250); ) USE IF BUKA(.T.,MDBF,'GASYPROS') SELECT GASYPROS INDEX ON KODE+NMR TAG KODE ENDIF TUTUP('GASYPROS') ENDIF IF TRANSFORM(OPSI)=='.T.' IF BUKA(.T.,MDBF,'GASYPROS') SELECT GASYPROS PACK INDEX ON KODE+NMR TAG KODE ENDIF TUTUP('GASYPROS') ENDIF IF TRANSFORM(OPSI)=='BROWSE' IF BUKA(.T.,MDBF,'GASYPROS') SELECT GASYPROS BROWSE TITLE ALIAS()+" - "+DBF() FONT "Courier New",18 ENDIF TUTUP('GASYPROS') RETURN .F. ENDIF IF TRANSFORM(OPSI)=='STRUKTUR' IF BUKA(.T.,MDBF,'GASYPROS') SELECT GASYPROS MODI STRU BROWSE TITLE ALIAS()+" - "+DBF() FONT "Courier New",18 ENDIF TUTUP('GASYPROS') RETURN .F. ENDIF RETURN BUKA(LSHARE,mDbf,"GASYPROS") ENDPROC

FUNCTION UBAHHARI(xTGL) LOCAL xBLN DECLARE xBLN[7] xBLN[1]='Minggu' xBLN[2]='Senin' xBLN[3]='Selasa' xBLN[4]='Rabu' xBLN[5]='Kamis' xBLN[6]='Jumat' xBLN[7]='Sabtu' RETURN xBLN[DOW(xTGL)] ENDFUNC

FUNCTION NAMABLN(xTGL) LOCAL xBLN DECLARE xBLN[12] xBLN[1]='Januari' xBLN[2]='Februari' xBLN[3]='Maret' xBLN[4]='April' xBLN[5]='Mei' xBLN[6]='Juni' xBLN[7]='Juli' xBLN[8]='Agustus' xBLN[9]='September' xBLN[10]='Oktober' xBLN[11]='Nopember' xBLN[12]='Desember' RETURN xBLN[MONTH(xTGL)] ENDFUNC

PARAMETER PerTanggal,jKr,IndekLah LOCAL AlamatAk, AlamatKr, AlamatDp, ALamatTp, mTgl, mPesan mPesan="" IF PerTanggal=0 mTgl=CTOD('') AlamatAA=ALLTRIM(Alamatnya('ADA')) AlamatAk=ALLTRIM(Alamatnya('AAK')) IF EMPTY(ALAMATAK) RETURN .F. ENDIF IF !BUKADBF(.F.,'CJHARIAN',ALAMATAK,'',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'GJHARIAN',ALAMATAK,'',GASY_TGL) RETURN .f. ENDIF AlamatAk=ALLTRIM(Alamatnya('ADP')) IF EMPTY(ALAMATAK) RETURN .F. ENDIF IF !BUKADBF(.F.,'DP_TRS_H',ALAMATAK,'',GASY_TGL) RETURN .f. ENDIF AlamatAk=ALLTRIM(Alamatnya('ATB')) IF EMPTY(ALAMATAK) RETURN .F. ENDIF IF !BUKADBF(.F.,'TB_TRS_H',ALAMATAK,'A',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'DA_TRS_H',ALAMATAA,'A',GASY_TGL) RETURN .f. ENDIF AlamatAk=ALLTRIM(Alamatnya('AKR'+jKr)) IF EMPTY(ALAMATAK) RETURN .f. ENDIF IF !BUKADBF(.F.,'KR_RLS_H',ALAMATAK,jKr,GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'KR_TRS_H',ALAMATAK,jKr,GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'KR_RCS_H',ALAMATAK,jKr,GASY_TGL) RETURN .f. ENDIF AlamatAk=ALLTRIM(Alamatnya('ATP')) IF EMPTY(ALAMATAK) RETURN .f. ENDIF IF !BUKADBF(.F.,'TP_TRS_H',ALAMATAK,'1',GASY_TGL) RETURN .f. ENDIF SELECT CJHARIAN GO TOP mPesan=mPesan+'Tgl.Transaksi Kas = '+DTOC(Tanggal)+CHR(13) IF !EOF() mTgl=TANGGAL ENDIF SELECT GJHARIAN GO TOP mPesan=mPesan+'Tgl.Transaksi Non Kas = '+DTOC(Tanggal)+CHR(13) IF !EOF() IF !EMPTY(mTgl) IF mTgl<>Tanggal Pesan(mPesan) RETURN .f. ENDIF ELSE mTgl=Tanggal ENDIF ENDIF SELECT TP_TRS_H GO TOP mPesan=mPesan+'Tgl.Transaksi Tabungan Program = '+DTOC(Tgl_Trs)+CHR(13) IF !EOF() IF !EMPTY(mTgl) IF mTgl<>TGL_TRS Pesan(mPesan) RETURN .f. ENDIF ELSE mTgl=Tgl_TRS ENDIF ENDIF SELECT KR_RLS_H GO TOP mPesan=mPesan+'Tgl.Transaksi Realisasi Kredit = '+DTOC(Tgl_Cair)+CHR(13) IF !EOF() IF !EMPTY(mTgl) IF mTgl<>TGL_CAIR Pesan(mPesan) RETURN .f. ENDIF ELSE mTgl=TGL_CAIR ENDIF ENDIF SELECT KR_TRS_H GO TOP mPesan=mPesan+'Tgl.Transaksi Angsuran Kredit = '+DTOC(Tanggal)+CHR(13) IF !EOF() IF !EMPTY(mTgl) IF mTgl<>TANGGAL Pesan(mPesan) RETURN .f. ENDIF ELSE mTgl=Tanggal ENDIF ENDIF SELECT TB_TRS_H GO TOP mPesan=mPesan+'Tgl.Transaksi Tabungan Umum = '+DTOC(Tgl_TRS)+CHR(13) IF !EOF() IF !EMPTY(mTgl) IF mTgl<>TGL_TRS Pesan(mPesan) RETURN .f. ENDIF ELSE mTgl=Tgl_TRS ENDIF ENDIF SELECT DP_TRS_H GO TOP mPesan=mPesan+'Tgl.Transaksi Tabungan Umum = '+DTOC(Tgl_TRS)+CHR(13) IF !EOF() IF !EMPTY(mTGl) IF mTgl<>Tanggal Pesan(mPesan) RETURN .f. ENDIF ELSE mTgl=Tanggal ENDIF ENDIF IF EMPTY(mTgl) DO FORM Libs\Tglproses WITH 'Tanggal Transaksi Harian' TO mTgl IF EMPTY(mTGL) RETURN .F. ENDIF ENDIF Gasy_Tgl=mTgl TGLHARIAN=mTgl IF !DN_MST(.F.) RETURN .F. ENDIF AlamatAA=ALLTRIM(Alamatnya('ADA')) AlamatAk=ALLTRIM(Alamatnya('AAK')) IF EMPTY(ALAMATAK) RETURN .F. ENDIF IF !BUKADBF(.F.,'AK_MST',ALAMATAK,'',GASY_TGL) RETURN .f. ENDIF AlamatAk=ALLTRIM(Alamatnya('ADP')) IF EMPTY(ALAMATAK) RETURN .F. ENDIF IF !BUKADBF(.F.,'DP_MST',ALAMATAK,'',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'DP_BNG',ALAMATAK,'',GASY_TGL) RETURN .f. ENDIF AlamatAk=ALLTRIM(Alamatnya('ATB')) IF EMPTY(ALAMATAK) RETURN .F. ENDIF IF !BUKADBF(.F.,'TB_MST',ALAMATAK,'A',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'DA_MST',ALAMATAA,'A',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'TB_SLD',ALAMATAK,'A',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'DA_SLD',ALAMATAA,'A',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'TB_KRT',ALAMATAK,'A',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'DH_KRT',ALAMATAA,'A',GASY_TGL) RETURN .f. ENDIF AlamatAk=ALLTRIM(Alamatnya('AKR'+jKr)) IF EMPTY(ALAMATAK) RETURN .f. ENDIF IF !BUKADBF(.F.,'KR_MST',ALAMATAK,jKr,GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'KR_JAM',ALAMATAK,jKr,GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'KR_TRS',ALAMATAK,jKr,GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'KR_RCS',ALAMATAK,jKr,GASY_TGL) RETURN .f. ENDIF AlamatAk=ALLTRIM(Alamatnya('ATP')) IF EMPTY(ALAMATAK) RETURN .f. ENDIF IF !BUKADBF(.F.,'TP_MST',ALAMATAK,'1',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'TP_KRT',ALAMATAK,'1',GASY_TGL) RETURN .f. ENDIF RETURN .T. ELSE mTgl=DATE() DO FORM Libs\Tglproses WITH 'Transaksi Per Tanggal' TO mTgl IF EMPTY(mTgl) RETURN .F. ENDIF Gasy_Tgl=mTgl TGLHARIAN=mTgl AlamatAA=ALLTRIM(Alamatnya('ADA')) AlamatAk=ALLTRIM(Alamatnya('AAK')) IF EMPTY(ALAMATAK) RETURN .F. ENDIF AlamatDP=ALLTRIM(Alamatnya('ADP')) IF EMPTY(ALAMATDP) RETURN .F. ENDIF AlamatKR=ALLTRIM(Alamatnya('AKR'+jKr)) IF EMPTY(ALAMATKR) RETURN .F. ENDIF AlamatTB=ALLTRIM(Alamatnya('ATB')) IF EMPTY(ALAMATTB) RETURN .F. ENDIF AlamatTP=ALLTRIM(Alamatnya('ATP')) IF EMPTY(ALAMATTP) RETURN .F. ENDIF CJHARI=ALAMATAK+"DTAKH\C"+RIGHT(DTOS(mTGL),2)+GS_NTOC(mTGL)+LEFT(DTOS(MTGL),4) IF !FILE(CJHARI+'.DBF') OR PCOUNT()=3 Reindeks('CJHARIAN','',AlamatAK,GASY_TGL,1) ENDIF IF !Buka(.f.,(CJHARI),'CJHARIAN',(CJHARI)) RETURN .F. ENDIF GJHARI=ALAMATAK+"DTAKH\G"+RIGHT(DTOS(mTGL),2)+GS_NTOC(mTGL)+LEFT(DTOS(MTGL),4) IF !FILE(GJHARI+'.DBF') OR PCOUNT()=3 Reindeks('GJHARIAN','',AlamatAK,GASY_TGL,1) ENDIF IF !Buka(.f.,(GJHARI),'GJHARIAN',(GJHARI)) RETURN .F. ENDIF DPTRSH=ALAMATDP+"DTDPH\D"+RIGHT(DTOS(mTGL),2)+GS_NTOC(mTGL)+LEFT(DTOS(MTGL),4) IF !FILE(DPTRSH+'.DBF') OR PCOUNT()=3 Reindeks('DP_TRS_H','',AlamatDP,GASY_TGL,1) ENDIF IF !Buka(.f.,(DPTRSH),'DP_TRS_H') RETURN .F. ENDIF KRRLSH=ALAMATKR+"DTKRH"+jKR+"\R"+RIGHT(DTOS(mTGL),2)+GS_NTOC(mTGL)+LEFT(DTOS(MTGL),4) IF !FILE(KRRLSH+'.DBF') OR PCOUNT()=3 Reindeks('KR_RLS_H',jKr,AlamatKR,GASY_TGL,1) ENDIF IF !Buka(.f.,(KRRLSH),'KR_RLS_H') RETURN .F. ENDIF KRTRSH=ALAMATKR+"DTKRH"+jKr+"\A"+RIGHT(DTOS(mTGL),2)+GS_NTOC(mTGL)+LEFT(DTOS(MTGL),4) IF !FILE(KRTRSH+'.DBF') OR PCOUNT()=3 Reindeks('KR_TRS_H',jKr,AlamatKR,GASY_TGL,1) ENDIF IF !Buka(.f.,(KRTRSH),'KR_TRS_H') RETURN .F. ENDIF KRTRSH=ALAMATKR+"DTKRH"+jKr+"\A"+RIGHT(DTOS(mTGL),2)+GS_NTOC(mTGL)+LEFT(DTOS(MTGL),4) IF !FILE(KRTRSH+'.DBF') OR PCOUNT()=3 Reindeks('KR_RCS_H',jKr,AlamatKR,GASY_TGL,1) ENDIF IF !Buka(.f.,(KRTRSH),'KR_RCS_H') RETURN .F. ENDIF TBTRSH=ALAMATTB+"DTTBHA\B"+RIGHT(DTOS(mTGL),2)+GS_NTOC(mTGL)+LEFT(DTOS(MTGL),4) IF !FILE(TBTRSH+'.DBF') OR PCOUNT()=3 Reindeks('TB_TRS_H','A',AlamatTB,GASY_TGL,1) ENDIF IF !Buka(.f.,(TBTRSH),'TB_TRS_H') RETURN .F. ENDIF TPTRSH=ALAMATTP+"DTTPH1\P"+RIGHT(DTOS(mTGL),2)+GS_NTOC(mTGL)+LEFT(DTOS(MTGL),4) IF !FILE(TPTRSH+'.DBF') OR PCOUNT()=3 Reindeks('TP_TRS_H','1',AlamatTP,GASY_TGL,1) ENDIF IF !Buka(.f.,(TPTRSH),'TP_TRS_H') RETURN .F. ENDIF IF !DN_MST(.F.) RETURN .F. ENDIF IF !BUKADBF(.F.,'AK_MST',ALAMATAK,'',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'DP_MST',ALAMATDP,'',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'DP_BNG',ALAMATDP,'',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'TB_MST',ALAMATTB,'A',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'TB_SLD',ALAMATTB,'A',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'TB_KRT',ALAMATTB,'A',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'DA_MST',ALAMATAA,'A',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'DA_SLD',ALAMATAA,'A',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'DH_KRT',ALAMATAA,'A',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'KR_MST',ALAMATKR,jKr,GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'KR_JAM',ALAMATKR,jKr,GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'KR_TRS',ALAMATKR,jKr,GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'KR_RCS',ALAMATKR,jKr,GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'TP_MST',ALAMATTP,'1',GASY_TGL) RETURN .f. ENDIF IF !BUKADBF(.F.,'TP_KRT',ALAMATTP,'1',GASY_TGL) RETURN .f. ENDIF RETURN .T. ENDIF ENDFUNC

DEFINE POPUP shortcut SHORTCUT RELATIVE FROM MROW(),MCOL() DEFINE BAR _med_cut OF shortcut PROMPT "\<Hapus" KEY CTRL+X, "Ctrl+X" DEFINE BAR _med_paste OF shortcut PROMPT "\<Paste" KEY CTRL+V, "Ctrl+V" DEFINE BAR _med_copy OF shortcut PROMPT "\<Copy" KEY CTRL+C, "Ctrl+C" ACTIVATE POPUP shortcut DEACTIVATE POPUP shortcut RELEASE POPUPS shortcut EXTENDED

PARAMETERS cFile,cJns,cLokasi,cTgl,cHari LOCAL mFile **File Akuntansi DO Case Case cFile=="AK_MST" mFILE=cLokasi+"AKM_"+STR(YEAR(cTGL),4) mFILEKEY1=cLokasi+"AK1_"+STR(YEAR(cTGL),4) mFILEKEY2=cLokasi+"AK2_"+STR(YEAR(cTGL),4) mFILEKEY3=cLokasi+"AK3_"+STR(YEAR(cTGL),4) Tunggu("Proses indek file master rekening akuntansi"+CHR(13)+mFile,1) Tutup("AK_MST") IF !FILE(mFILE+".DBF") CREATE TABLE (mFILE) FREE (NOPER C(10),; NAPER C(30),JENIS C(1),SIFAT C(1),LEPEL N(1),UMUM C(10),Kode C(30),; DBBLA N(15,2),KRBLA N(15,2),DBBLI01 N(15,2),KRBLI01 N(15,2),; DBBLI02 N(15,2),KRBLI02 N(15,2),DBBLI03 N(15,2),KRBLI03 N(15,2),; DBBLI04 N(15,2),KRBLI04 N(15,2),DBBLI05 N(15,2),KRBLI05 N(15,2),; DBBLI06 N(15,2),KRBLI06 N(15,2),DBBLI07 N(15,2),KRBLI07 N(15,2),; DBBLI08 N(15,2),KRBLI08 N(15,2),DBBLI09 N(15,2),KRBLI09 N(15,2),; DBBLI10 N(15,2),KRBLI10 N(15,2),DBBLI11 N(15,2),KRBLI11 N(15,2),; DBBLI12 N(15,2),KRBLI12 N(15,2),DBHRI N(15,2),KRHRI N(15,2)) USE ENDIF IF BUKA(.T.,mFILE,"AK_MST") SELECT AK_MST PACK INDEX ON NOPER TO (mFILEKEY1) INDEX ON UPPER(NAPER) TO (mFILEKEY2) ADDITIVE INDEX ON UMUM TO (mFILEKEY3) ADDITIVE ENDIF Tutup("AK_MST") CASE cFile=="AK_BBB" mFILE=cLokasi+"BB_"+GS_NTOC(cTGL)+STR(YEAR(cTGL),4) mFILEKEY=cLokasi+"BB_"+GS_NTOC(cTGL)+STR(YEAR(cTGL),4) Tunggu("Proses indek file buku besar bulanan"+CHR(13)+mFile,1) Tutup("AK_BBB") IF !FILE(mFILE+".DBF") CREATE TABLE (mFILE) FREE (KJ C(2),TANGGAL D(8),BUKTI C(6),; URUT N(3),NOPER C(10),URAIAN C(30),NILAI N(15,2),; D_K C(1),PROSES L(1),OPR C(3),SPR C(3), SANDI C(5)) USE ENDIF IF BUKA(.T.,mFILE,"AK_BBB") SELECT AK_BBB PACK INDEX ON NOPER+DTOS(TANGGAL)+BUKTI+STR(URUT,3) TO (mFILEKEY) ENDIF Tutup("AK_BBB") Case cFile=="AK_GJB" mFILE=cLokasi+"GJ_"+GS_NTOC(cTGL)+STR(YEAR(cTGL),4) Tunggu("Proses indek file jurnal umum bulanan"+CHR(13)+mFile,1) Tutup("AK_GJB") IF !FILE(mFILE+".DBF") CREATE TABLE (mFILE) FREE (KJ C(2),TANGGAL D(8),BUKTI C(6),; URUT N(3),NOPER C(10),URAIAN C(60),NILAI N(15,2),; D_K C(1),PROSES L(1),OPR C(3),SPR C(3),SANDI C(5)) USE ENDIF IF BUKA(.T.,mFILE,"AK_GJB") SELECT AK_GJB PACK ENDIF Tutup("AK_GJB") Case cFile=="AK_CJB" mFILE=cLokasi+"CJ_"+GS_NTOC(cTGL)+STR(YEAR(cTGL),4) Tunggu("Proses indek file jurnal kas bulanan"+CHR(13)+mFile,1) Tutup("AK_CJB") IF !FILE(mFILE+".DBF") CREATE TABLE (mFILE) FREE (KJ C(2),TANGGAL D(8),BUKTI C(6),; URUT N(3),NOPER C(10),URAIAN C(60),NILAI N(15,2),; D_K C(1),PROSES L(1),OPR C(3),SPR C(3),SANDI C(5)) USE ENDIF IF BUKA(.T.,mFILE,"AK_CJB") SELECT AK_CJB PACK ENDIF Tutup("AK_CJB") CASE cFile=="CJHARIAN" mFILE=cLokasi+IIF(PCOUNT()=4,"CJHARIAN","DTAKH\C"+RIGHT(DTOS(cTgl),2)+GS_NTOC(cTgl)+LEFT(DTOS(cTgl),4)) Tunggu("Proses indek file jurnal kas harian"+CHR(13)+mFile,1) TUTUP("CJHARIAN") IF !FILE(mFILE+".DBF") CHEKFOLDER(MFILE+'.DBF') CREATE TABLE (mFILE) FREE (KJ C(2),TANGGAL D(8),BUKTI C(6),; URUT N(3),NOPER C(10),URAIAN C(60),NILAI N(15,2),; D_K C(1),PROSES L(1),OPR C(3),SPR C(3),SANDI C(5)) USE ENDIF IF BUKA(.T.,mFILE,"CJHARIAN") SELECT CJHARIAN GO TOP DO WHILE !EOF() IF EMPTY(TANGGAL) DELETE ENDIF SKIP ENDDO PACK INDEX ON BUKTI+STR(URUT,3) TO (mFILE) ENDIF TUTUP("CJHARIAN") CASE cFile=="GJHARIAN" mFILE=cLokasi+IIF(PCOUNT()=4,"GJHARIAN","DTAKH\G"+RIGHT(DTOS(cTgl),2)+GS_NTOC(cTgl)+LEFT(DTOS(cTgl),4)) Tunggu("Proses indek file jurnal umum harian"+CHR(13)+mFile,1) TUTUP("GJHARIAN") IF !FILE(mFILE+".DBF") CREATE TABLE (mFILE) FREE (KJ C(2),TANGGAL D(8),BUKTI C(6),; URUT N(3),NOPER C(10),URAIAN C(60),NILAI N(15,2),; D_K C(1),PROSES L(1),OPR C(3),SPR C(3), SANDI C(5)) USE ENDIF IF BUKA(.T.,mFILE,"GJHARIAN") SELECT GJHARIAN GO TOP DO WHILE !EOF() IF EMPTY(TANGGAL) DELETE ENDIF SKIP ENDDO PACK INDEX ON BUKTI+STR(URUT,3) TO (mFILE) ENDIF TUTUP("GJHARIAN") CASE cFile=="BBHARIAN" mFILE=cLokasi+"BBHARIAN" Tunggu("Proses indek file buku besar harian"+CHR(13)+mFile,1) TUTUP("BBHARIAN") IF !FILE(mFILE+".DBF") CREATE TABLE (mFILE) FREE (KJ C(2),TANGGAL D(8),BUKTI C(6),; URUT N(3),NOPER C(10),URAIAN C(60),NILAI N(15,2),; D_K C(1),PROSES L(1),OPR C(3),SPR C(3), SANDI C(5)) USE ENDIF IF BUKA(.T.,mFILE,"BBHARIAN") SELECT BBHARIAN GO TOP DO WHILE !EOF() IF EMPTY(Tanggal) DELETE ENDIF SKIP ENDDO PACK INDEX ON NOPER+BUKTI+STR(URUT,3) TO (mFILE) ENDIF Tutup("BBHARIAN") CASE cFile=="AK_PLK" mFILE=cLokasi+"AK_PLK" Tunggu("Proses indek file laporan khusus"+CHR(13)+mFile,1) Tutup("AK_PLK") IF !FILE(mFILE+".DBF") CREATE TABLE (mFILE) FREE (KODE C(3),KETERANGAN C(50)) USE ENDIF IF BUKA(.T.,mFILE,"AK_PLK") SELECT AK_PLK PACK ENDIF Tutup("AK_PLK") CASE cFile=="AK_TBL" mFILE=cLokasi+"AK_TBL" Tunggu("Proses indek file interface tabel"+CHR(13)+mFile,1) Tutup("AK_TBL") IF !FILE(mFILE+".DBF") CREATE TABLE (mFILE) FREE (KJ C(2),KETERANGAN C(30),NOPER C(10),ALAMATDATA C(50)) USE ENDIF IF BUKA(.T.,mFILE,"AK_TBL") SELECT AK_TBL PACK INDEX ON KJ TO (mFILE) ENDIF Tutup("AK_TBL") CASE cFile=="AK_RKL" mFILE=cLokasi+"AK_RKL" Tunggu("Proses indek file rasio keuangan"+CHR(13)+mFile,1) Tutup("AK_RKL") IF !FILE(mFILE+".DBF") CREATE TABLE (mFILE) (KODE C(4),NOPER C(10),; NAPER C(40),RK C(4),KP C(1),JNS C(1),; BOBOT N(6,2),RUPIAH_THL N(18,2),RUPIAH_THI N(18,2),; NILAI N(12),RASIO N(6,2),STD_RASIO C(15),; PEMBILANG C(4),PENYEBUT C(4),KC C(1),UF N(3),KL C(1)) USE ENDIF IF BUKA(.T.,mFILE,"AK_RKL") SELECT AK_RKL PACK INDEX ON KODE TO (mFILE) ENDIF Tutup("AK_RKL") CASE cFile=="AK_NPH" mFILE=cLokasi+"AK_NPH" Tunggu("Proses indek file neraca percobaan"+CHR(13)+mFile,1) Tutup("AK_NPH") IF !FILE(mFILE+".DBF") CREATE TABLE (mFILE) (NKODE C(3),NOPER C(10),KETERANGAN C(50),SIFAT C(1),; DBBLA N(15,2), KRBLA N(15,2), DEBET N(15,2), ; KREDIT N(15,2), DBBLI N(15,2), KRBLI N(15,2)) USE ENDIF IF BUKA(.T.,mFILE,"AK_NPH") SELECT AK_NPH PACK INDEX ON NKODE TO (mFILE) ENDIF Tutup("AK_NPH") CASE cFile=="AK_RLB" mFILE=cLokasi+"AK_RLB" Tunggu("Proses indek file rugi-laba"+CHR(13)+mFile,1) Tutup("AK_RLB") IF !FILE(mFILE+".DBF") CREATE TABLE (mFILE) (KODE C(4),NOPER C(10),; NAPER C(50), SANDI C(3), RUPIAH N(12,2),; RIBUAN N(12,0), KP C(1), RK C(3), JENIS C(1), SISA N(8)) USE ENDIF IF BUKA(.T.,mFILE,"AK_RLB") SELECT AK_RLB PACK INDEX ON KODE TO (mFILE) ENDIF Tutup("AK_RLB") CASE cFile=="AK_NRB" mFILE=cLokasi+"AK_NRB" Tunggu("Proses indek file neraca"+CHR(13)+mFile,1) Tutup("AK_NRB") IF !FILE(mFILE+".DBF") CREATE TABLE (mFILE) (KODE C(4),NOPER C(10),; NAPER C(50), SANDI C(3), RUPIAH N(12,2),; RIBUAN N(12,0), KP C(1), RK C(3), JENIS C(1), SISA N(8)) USE ENDIF IF BUKA(.T.,mFILE,"AK_NRB") SELECT AK_NRB PACK INDEX ON KODE TO (mFILE) ENDIF Tutup("AK_NRB") ** File-Register CASE cFile=="DN_MST" mFile=cLokasi+'DN_MST' Tunggu("Proses indek file register nasabah"+CHR(13)+mFile,1) Tutup("DN_MST") IF !FILE(mFile+'.DBF') CREATE TABLE (Mfile) (INDUK C(8),; NAMA C(30),; ALAMAT C(30),; KOTA C(30),; PEKERJAAN C(30),; KTP C(30),; CATATAN C(30),; TGL_TRS D(8),; GENDER C(1),; AGAMA C(1),; BLOKIR C(1)) USE ENDIF IF BUKA(.T.,mFile,'DN_MST') SELECT DN_MST PACK INDEX ON INDUK TO (Mfile+'1') INDEX ON NAMA TO (mFile+'2') ENDIF Tutup("DN_MST") ** File-Deposito CASE cFile=='DP_MST' mFile=cLokasi+'DP_MST' Tunggu('Indeks file master deposito'+CHR(13)+mFile,1) TUTUP("DP_MST") IF !FILE(mFile+'.DBF') CREATE TABLE (mFile) (KODE C(9),; SD C(2),; INDUK C(8),; NAMA C(30),; ALAMAT C(30),; KOTA C(30),; PEKERJAAN C(30),; KTP C(30),; TGL_TRS D(8),; JNG_WAKTU N(3),; PRS_BUNGA N(7,4),; JML_SETOR N(12),; TGL_TRK D(8),; PAJAK N(5,2),; PEMILIK C(3),; WLY C(4),; KPT C(4),; JNS_BUNGA C(1),; ARO C(1),; ARO_KE N(2),; Blokir C(1),; BUKTI C(4),; SDT C(1),; TANGGAL D(8),; TGL_BNG D(8),; RP_BUNGA N(12),; RP_PAJAK N(12),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; BLWN C(4),; POSTING C(1),; STD_JURNAL C(2)) USE ENDIF IF BUKA(.T.,mFile,'DP_MST') SELECT DP_MST PACK INDEX ON KODE+SD TO (mFile+'1') INDEX ON NAMA TO (mFile+'2') INDEX ON INDUK TO (mFile+'3') ENDIF TUTUP("DP_MST") CASE cFile=='DP_TRS_H' mFile=cLokasi+IIF(PCOUNT()=4,'DP_TRS_H',"DTDPH\D"+RIGHT(DTOS(cTgl),2)+GS_NTOC(cTgl)+LEFT(DTOS(cTgl),4)) Tunggu('Indeks file transaksi harian deposito'+CHR(13)+mFile,1) TUTUP("DP_TRS_H") IF !FILE(mFile+'.DBF') CREATE TABLE (mFile) (KODE C(9),; SD C(2),; INDUK C(8),; NAMA C(30),; ALAMAT C(30),; KOTA C(30),; PEKERJAAN C(30),; KTP C(30),; TGL_TRS D(8),; JNG_WAKTU N(3),; PRS_BUNGA N(7,4),; JML_SETOR N(12),; TGL_TRK D(8),; PAJAK N(5,2),; PEMILIK C(3),; WLY C(4),; KPT C(4),; JNS_BUNGA C(1),; ARO C(1),; ARO_KE N(2),; BLokir C(1),; BUKTI C(4),; SDT C(1),; TANGGAL D(8),; TGL_BNG D(8),; RP_BUNGA N(12),; RP_PAJAK N(12),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; BLWN C(4),; POSTING C(1),; STD_JURNAL C(2)) USE ENDIF IF BUKA(.T.,mFile,'DP_TRS_H') SELECT DP_TRS_H GO TOP DO WHILE !EOF() IF EMPTY(TGL_TRS) DELETE ENDIF SKIP ENDDO PACK ENDIF TUTUP("DP_TRS_H") CASE cFile=='DP_TRS_B' mFILE=cLokasi+"DPT"+GS_NTOC(cTGL)+STR(YEAR(cTGL),4) Tunggu('Indeks file transaksi deposito bulanan'+CHR(13)+mFile,1) TUTUP("DP_TRS_B") IF !FILE(mFILE+'.DBF') CREATE TABLE (mFILE) (KODE C(9),; SD C(2),; INDUK C(8),; NAMA C(30),; ALAMAT C(30),; KOTA C(30),; PEKERJAAN C(30),; KTP C(30),; TGL_TRS D(8),; JNG_WAKTU N(3),; PRS_BUNGA N(7,4),; JML_SETOR N(12),; TGL_TRK D(8),; PAJAK N(5,2),; PEMILIK C(3),; WLY C(4),; KPT C(4),; JNS_BUNGA C(1),; ARO C(1),; ARO_KE N(2),; Blokir C(1),; BUKTI C(4),; SDT C(1),; TANGGAL D(8),; TGL_BNG D(8),; RP_BUNGA N(12),; RP_PAJAK N(12),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; BLWN C(4),; POSTING C(1),; STD_JURNAL C(2)) USE ENDIF IF BUKA(.T.,mFILE,'DP_TRS_B') SELECT DP_TRS_B PACK ENDIF TUTUP("DP_TRS_B") CASE cFile=='DP_BNG' mFile=cLokasi+'DP_BNG' Tunggu('Indeks file bunga deposito'+CHR(13)+mFile,1) TUTUP("DP_BNG") IF !FILE(mFile+'.DBF') CREATE TABLE (mFile) (KODE C(9),; SD C(2),; INDUK C(8),; TGL_TRS D(8),; TGL_BNG D(8),; RP_BUNGA N(12),; RP_PAJAK N(12),; TGL_TRK D(8),; BUKTI C(4),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; BLWN C(4),; POSTING C(1)) USE ENDIF IF BUKA(.T.,mFile,'DP_BNG') SELECT DP_BNG PACK INDEX ON KODE+SD+DTOS(TGL_BNG) TO (mFile) ENDIF TUTUP("DP_BNG") CASE cFile=='DP_BBI' mFILE=cLokasi+"DPB"+GS_NTOC(cTGL)+STR(YEAR(cTGL),4) Tunggu('Indeks file bunga deposito bulanan'+CHR(13)+mFile,1) TUTUP("DP_BBI") IF !FILE(mFILE+'.DBF') CREATE TABLE (mFILE) (KODE C(9),; SD C(2),; INDUK C(8),; TGL_TRS D(8),; TGL_BNG D(8),; RP_BUNGA N(12),; RP_PAJAK N(12),; TGL_TRK D(8),; BUKTI C(4),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; BLWN C(4),; POSTING C(1)) USE ENDIF IF BUKA(.T.,mFILE,'DP_BBI') SELECT DP_BBI PACK ENDIF TUTUP("DP_BBI") ** File-Kredit CASE cFile=='KR_MST' mFile=cLokasi+'KM'+ALLTRIM(cJns)+'MST' Tunggu('Indeks File Master'+CHR(13)+mFile,1) TUTUP("KR_MST") IF !FILE(mFile+'.DBF') CREATE TABLE (mFile) ( KODE C(9),; NAMA C(30),; ALAMAT C(30),; INDUK C(8),; NO_PK C(30),; GRP C(1),; KOL C(1),; WLY C(4),; TGL_CAIR D(8),; JNS_BUNGA C(1),; PRS_BUNGA N(6,2),; JNG_WAKTU N(3),; JML_PINJAM N(12),; PRD_ANGS N(3),; SKEEM N(10),; TOL_BNG N(3),; MOD_DND C(1),; JAMINAN C(140),; RPH_JAM N(10),; RPH_JAMC N(10),; KODE_JAM C(5),; SIF_KRE C(1),; JNS_GUNA C(2),; GOL_DEB C(3),; SEK_TOR C(4),; JNS_BBI C(1),; GOL_JAM C(3),; BAG_JAM N(6,2),; KODE_AVA C(4),; KODE_KAO C(4),; KODE_KIN C(4),; KODE_DEA C(4),; KODE_DLL C(5),; PENANGGUNG C(30),; TGL_BAYAR D(8),; ANG_POKOK N(12),; ANG_BUNGA N(12),; ANG_DENDA N(12),; ANG_BIAYA N(12),; DBPK_B N(12),; DBBG_B N(12),; DBDD_B N(12),; DBBY_B N(12),; BUNGA_YHD N(12),; BUNGA_BLI N(12),; AJE_BUNGA N(12),; AJE_DENDA N(12),; SLD_BLL N(12),; SLD_BLI N(12),; TGK_PRPBLL N(12),; TGK_PRPBLI N(12),; TGK_BRPBLL N(12),; TGK_BRPBLI N(12),; TGK_PXXBLL N(3),; TGK_PXXBLI N(3),; TGK_BXXBLL N(3),; TGK_BXXBLI N(3),; KOL_MAN C(1),; ADM_REAL N(12),; STD_JURNAL C(2)) USE ENDIF IF BUKA(.T.,(mFile),'KR_MST') Select KR_MST Pack INDEX ON KODE TO (mFile+'1') INDEX ON NAMA TO (mFile+'2') INDEX ON INDUK TO (mFile+'3') ENDIF TUTUP("KR_MST") CASE cFile=='KR_MST_B' mFile=cLokasi+'KB'+ALLTRIM(cJns)+GS_NTOC(cTGL)+STR(YEAR(cTGL),4) Tunggu('Indeks File Master Bulanan'+CHR(13)+mFile,1) Tutup("KR_MST_B") IF !FILE(mFile+'.DBF') CREATE TABLE (mFile) ( KODE C(9),; NAMA C(30),; ALAMAT C(30),; INDUK C(8),; NO_PK C(30),; GRP C(1),; KOL C(1),; WLY C(4),; TGL_CAIR D(8),; JNS_BUNGA C(1),; PRS_BUNGA N(6,2),; JNG_WAKTU N(3),; JML_PINJAM N(12),; PRD_ANGS N(3),; SKEEM N(10),; TOL_BNG N(3),; MOD_DND C(1),; JAMINAN C(140),; RPH_JAM N(10),; RPH_JAMC N(10),; KODE_JAM C(5),; SIF_KRE C(1),; JNS_GUNA C(2),; GOL_DEB C(3),; SEK_TOR C(4),; JNS_BBI C(1),; GOL_JAM C(3),; BAG_JAM N(6,2),; KODE_AVA C(4),; KODE_KAO C(4),; KODE_KIN C(4),; KODE_DEA C(4),; KODE_DLL C(5),; PENANGGUNG C(30),; TGL_BAYAR D(8),; ANG_POKOK N(12),; ANG_BUNGA N(12),; ANG_DENDA N(12),; ANG_BIAYA N(12),; DBPK_B N(12),; DBBG_B N(12),; DBDD_B N(12),; DBBY_B N(12),; BUNGA_YHD N(12),; BUNGA_BLI N(12),; AJE_BUNGA N(12),; AJE_DENDA N(12),; SLD_BLL N(12),; SLD_BLI N(12),; TGK_PRPBLL N(12),; TGK_PRPBLI N(12),; TGK_BRPBLL N(12),; TGK_BRPBLI N(12),; TGK_PXXBLL N(3),; TGK_PXXBLI N(3),; TGK_BXXBLL N(3),; TGK_BXXBLI N(3),; KOL_MAN C(1),; ADM_REAL N(12),; STD_JURNAL C(2)) Use ENDIF IF BUKA(.T.,(mFile),'KR_MST_B') Select KR_MST_B Pack Index On KODE To (mFile) Endif TUTUP("KR_MST_B") CASE cFile=='KR_JAM' mFile=cLokasi+'KJ'+Alltrim(cJns)+'JAM' Tunggu('Indeks File Jaminan'+CHR(13)+mFile,1) TUTUP("KR_JAM") IF !FILE(mFile+'.DBF') CREATE TABLE (mFile) ( KODE C(9),URUT C(2), KETERANGAN C(70)) USE ENDIF IF BUKA(.T.,(mFile),'KR_JAM') Select KR_JAM PACK INDEX ON KODE+URUT TO (mFile) ENDIF TUTUP("KR_JAM") CASE cFile=='KR_RLS_H' mFile=cLokasi+IIF(PCOUNT()=4,'KT'+ALLTRIM(cJns)+'RLS_H',"DTKRH"+cJns+"\R"+RIGHT(DTOS(cTgl),2)+GS_NTOC(cTgl)+LEFT(DTOS(cTgl),4)) Tunggu('Indeks File Realisasi Harian'+CHR(13)+mFile,1) TUTUP("KR_RLS_H") IF !FILE(mFile+'.DBF') CREATE TABLE (mFile) ( BUKTI C(4), KODE C(9),; GRP C(1),; TGL_CAIR D(8),; JML_PINJAM N(12),; SD C(1),; POTONGAN1 N(10),; POTONGAN2 N(10),; POTONGAN3 N(10),; POTONGAN4 N(10),; POTONGAN5 N(10),; POTONGAN6 N(10),; POTONGAN7 N(10),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; BLWN C(4),; POSTING C(1)) USE ENDIF IF BUKA(.T.,(mFile),'KR_RLS_H') Select KR_RLS_H GO TOP DO WHILE !EOF() IF EMPTY(TGL_CAIR) DELETE ENDIF SKIP ENDDO Pack ENDIF TUTUP("KR_RLS_H") CASE cFile=='KR_TRS_H' mFile=cLokasi+IIF(PCOUNT()=4,'KT'+ALLTRIM(cJns)+'TRS_H',"DTKRH"+cJns+"\A"+RIGHT(DTOS(cTgl),2)+GS_NTOC(cTgl)+LEFT(DTOS(cTgl),4)) Tunggu('Indeks File Angsuran Harian'+CHR(13)+mFile,1) TUTUP("KR_TRS_H") If !File(mFile+'.DBF') CREATE TABLE (mFile) (BUKTI C(4),; TANGGAL D(8),; KODE C(9),; GRP C(1),; ANG_POKOK N(12),; ANG_BUNGA N(12),; DENDA N(12),; BY_TAGIH N(12),; SALDO N(12),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; POSTING C(1),; BLWN C(4)) USE ENDIF IF BUKA(.T.,(mFile),'KR_TRS_H') Select KR_TRS_H GO TOP DO WHILE !EOF() IF EMPTY(Tanggal) DELETE ENDIF SKIP ENDDO Pack ENDIF TUTUP("KR_TRS_H") CASE cFile=='KR_RCS_H' mFile=cLokasi+IIF(PCOUNT()=4,'KT'+ALLTRIM(cJns)+'RCS_H',"DTKRH"+cJns+"\K"+RIGHT(DTOS(cTgl),2)+GS_NTOC(cTgl)+LEFT(DTOS(cTgl),4)) Tunggu('Indeks File Angsuran RC Harian'+CHR(13)+mFile,1) TUTUP("KR_RCS_H") If !File(mFile+'.DBF') CREATE TABLE (mFile) (BUKTI C(4),; TANGGAL D(8),; KODE C(9),; GRP C(1),; SD C(1),; NILAI_RP N(12),; SALDO N(12),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; POSTING C(1),; BLWN C(4)) USE ENDIF IF BUKA(.T.,(mFile),'KR_RCS_H') Select KR_RCS_H GO TOP DO WHILE !EOF() IF EMPTY(Tanggal) DELETE ENDIF SKIP ENDDO Pack ENDIF TUTUP("KR_RCS_H") CASE cFile=='KR_RLS_B' mFile=cLokasi+'KR'+ALLTRIM(cJns)+GS_NTOC(cTGL)+STR(YEAR(cTGL),4) Tunggu('Indeks File Realisasi Bulanan'+CHR(13)+mFile,1) TUTUP("KR_RLS_B") IF !FILE(mFile+'.DBF') CREATE TABLE (mFile) ( BUKTI C(4), KODE C(9),; GRP C(1),; TGL_CAIR D(8),; JML_PINJAM N(12),; SD C(1),; POTONGAN1 N(10),; POTONGAN2 N(10),; POTONGAN3 N(10),; POTONGAN4 N(10),; POTONGAN5 N(10),; POTONGAN6 N(10),; POTONGAN7 N(10),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; BLWN C(4),; POSTING C(1)) USE ENDIF IF BUKA(.T.,(mFile),'KR_RLS_B') Select KR_RLS_B Pack ENDIF TUTUP("KR_RLS_B") CASE cFile=='KR_TRS_B' mFile=cLokasi+'KU'+ALLTRIM(cJns)+GS_NTOC(cTGL)+STR(YEAR(cTGL),4) Tunggu('Indeks File Angsuran Bulanan'+CHR(13)+mFile,1) TUTUP("KR_TRS_B") If !File(mFile+'.DBF') CREATE TABLE (mFile) (BUKTI C(4),; TANGGAL D(8),; KODE C(9),; GRP C(1),; ANG_POKOK N(12),; ANG_BUNGA N(12),; DENDA N(12),; BY_TAGIH N(12),; SALDO N(12),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; POSTING C(1),; BLWN C(4)) USE ENDIF IF BUKA(.T.,(mFile),'KR_TRS_B') Select KR_TRS_B Pack ENDIF TUTUP("KR_TRS_B") CASE cFile=='KR_BNG' mFile=cLokasi+'KA'+Alltrim(cJns)+'BNG' Tunggu('Indeks File Anggaran Bunga'+CHR(13)+mFile,1) TUTUP("KR_BNG") If !File(mFile+'.DBF') CREATE TABLE (mFile) ( KODE C(9),TGL1 D(8),TGL2 D(8), TGLJT D(8),; JML_POKOK N(9),DSB_BUNGA N(9),; PRS_BUNGA N(5,2),JML_HARI N(4),AGR_BUNGA N(9),; ANG_BUNGA N(9), TLR_BAYAR N(2),OPR C(3), KBJ_BUNGA N(9),; KBJ_DENDA N(9)) USE ENDIF IF BUKA(.T.,(mFile),'KR_BNG') Select KR_BNG Pack Index on KODE+Dtos(TGL1)+Dtos(TGL2) To (mFile) ENDIF TUTUP("KR_BNG") CASE cFile=='KR_RCS_B' mFile=cLokasi+'KC'+ALLTRIM(cJns)+GS_NTOC(cTGL)+STR(YEAR(cTGL),4) Tunggu('Indeks File RC Bulanan'+CHR(13)+mFile,1) TUTUP("KR_RCS_B") If !File(mFile+'.DBF') CREATE TABLE (mFile) (BUKTI C(4),; TANGGAL D(8),; KODE C(9),; GRP C(1),; SD C(1),; NILAI_RP N(12),; SALDO N(12),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; POSTING C(1),; BLWN C(4)) USE ENDIF IF BUKA(.T.,(mFile),'KR_RCS_B') Select KR_RCS_B Pack ENDIF TUTUP("KR_RCS_B") CASE cFile=='KR_RCS' mFile=cLokasi+'KK'+Alltrim(cJns)+'RCS' Tunggu('Indeks File Kartu Mutasi RC'+CHR(13)+mFile,1) TUTUP("KR_RCS") If !File(mFile+'.DBF') CREATE TABLE (mFile) (BUKTI C(4),; TANGGAL D(8),; KODE C(9),; GRP C(1),; SD C(1),; NILAI_RP N(12),; SALDO N(12),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; POSTING C(1),; BLWN C(4)) USE ENDIF IF BUKA(.T.,(mFile),'KR_RCS') Select KR_RCS Pack Index on KODE+Dtos(TANGGAL) To (mFile) ENDIF TUTUP("KR_RCS") CASE cFile=='KR_TRS' mFile=cLokasi+'KK'+Alltrim(cJns)+'TRS' Tunggu('Indeks File Kartu Angsuran Kredit'+CHR(13)+mFile,1) TUTUP("KR_TRS") If !File(mFile+'.DBF') CREATE TABLE (mFile) (BUKTI C(4),; TANGGAL D(8),; KODE C(9),; GRP C(1),; ANG_POKOK N(12),; ANG_BUNGA N(12),; DENDA N(12),; BY_TAGIH N(12),; SALDO N(12),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; POSTING C(1),; BLWN C(4)) USE ENDIF IF BUKA(.T.,(mFile),'KR_TRS') Select KR_TRS Pack Index on Kode+Dtos(TANGGAL) To (mFile) ENDIF TUTUP("KR_TRS") ** File-Tabungan ** CASE cFile=='TB_MST' MFILE=cLokasi+'TM'+ALLTRIM(cJns)+'MST' Tunggu('Indeks file master tabungan'+CHR(13)+MFILE,1) TUTUP("TB_MST") IF !FILE(MFILE+'.DBF') CREATE TABLE (MFILE) (KODE C(9),; NAMA C(30),; ALAMAT C(30),; INDUK C(8),; KTP C(30),; GRP C(3),; WLY C(4),; TGL_TRS D(8),; YES_BUNGA C(1),; PRS_BUNGA N(6,2),; GOL C(3),; JOB C(4),; KPT C(4),; BLOKIR C(1),; STD_JURNAL C(2)) USE ENDIF IF BUKA(.T.,(MFILE),'TB_MST') SELECT TB_MST Pack INDEX ON KODE TO (MFILE+'1') INDEX ON NAMA TO (MFILE+'2') ENDIF TUTUP("TB_MST") CASE cFile=='TB_SLD' MFILE=cLokasi+'TS'+ALLTRIM(cJns)+GS_NTOC(cTGL)+STR(YEAR(cTGL),4) Tunggu('Indeks file mutasi dan saldo tabungan'+CHR(13)+MFILE,1) TUTUP("TB_SLD") IF !FILE(MFILE+'.DBF') CREATE TABLE (MFILE) (KODE C(9),; GRP C(3),; TBS_LALU N(16),; TBS_KINI N(16),; TBT_KINI N(16),; TBS_HARI N(16),; TBT_HARI N(16),; DSB_KINI N(16),; BUNGA N (16),; PAJAK N (16)) USE ENDIF IF BUKA(.T.,(MFILE),'TB_SLD') SELECT TB_SLD PACK INDEX ON KODE TO (MFILE) ENDIF TUTUP("TB_SLD") CASE cFile=='TB_TRS_H' MFILE=cLokasi+IIF(PCOUNT()=4,'TT'+ALLTRIM(cJns)+'TRS_H',"DTTBHA\B"+RIGHT(DTOS(cTgl),2)+GS_NTOC(cTgl)+LEFT(DTOS(cTgl),4)) Tunggu('Indeks file mutasi dan saldo tabungan'+CHR(13)+MFILE,1) TUTUP("TB_TRS_H") If !File(MFILE+'.DBF') CREATE TABLE (MFILE) (BUKTI C(4),; TGL_TRS D(8),; KODE C(9),; GRP C(3),; SD C(1),; NILAI_RP N(12),; CTK N(3),; WLY C(4),; KPT C(4),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; BLWN C(4),; POSTING C(1),; SALDO N(12)) USE ENDIF IF BUKA(.T.,(MFILE),'TB_TRS_H') SELECT TB_TRS_H GO TOP DO WHILE !EOF() IF EMPTY(TGL_TRS) DELETE ENDIF SKIP ENDDO Pack ENDIF Tutup("TB_TRS_H") CASE cFile=='TB_KRT' MFILE=cLokasi+'TK'+ALLTRIM(cJns)+GS_NTOC(cTGL)+STR(YEAR(cTGL),4) Tunggu('Indeks file historis transaksi tabungan'+CHR(13)+MFILE,1) TUTUP("TB_KRT") If !File(MFILE+'.DBF') CREATE TABLE (MFILE) (BUKTI C(4),; TGL_TRS D(8),; KODE C(9),; GRP C(3),; SD C(1),; NILAI_RP N(12),; CTK N(3),; WLY C(4),; KPT C(4),; OPR C(3),; SPR C(3),; CASH C(2),; BKAS C(6),; SANDI C(5),; BLWN C(4)) USE ENDIF IF BUKA(.T.,(MFILE),'TB_KRT') SELECT TB_KRT PACK INDEX ON KODE+DTOS(TGL_TRS) TO (MFILE) ENDIF Tutup("TB_KRT") ** File-Tabungan-Program CASE cFile=='TP_MST' mFILE=cLokasi+'TP_MST'+ALLTRIM(cJns) Tunggu("Proses indek file master tabungan program"+CHR(13)+mFile,1) Tutup("TP_MST") IF !FILE(mFILE+'.DBF') CREATE TABLE (mFILE) (TGL_TRS D(8),GRP C(1),KODE C(9),INDUK C(8),; NAMA C(30), ALAMAT C(30),KOTA C(30), KTP C(30),; PEKERJAAN C(15),TGL_LAHIR D(8),; JML_SETOR N(9),JNS_SETOR C(1),; JNG_WAKTU N(3),PRS_BUNGA N(6,2),; SKT C(4),KWT C(4),KPT C(4),GOL C(3),; KLA C(4),CATATAN C(30),NAMA_AW C(30),ALAMAT_AW C(30),; STD_JURNAL C(2)) USE ENDIF IF BUKA(.T.,mFILE,'TP_MST') SELECT TP_MST PACK INDEX ON KODE TO (mFILE+'1') INDEX ON NAMA TO (mFILE+'2') ENDIF Tutup("TP_MST") CASE cFile=='TP_KRT' mFILE=cLokasi+'TP_KRT'+ALLTRIM(cJns) Tunggu("Proses indek file historis transaksi tabungan program"+CHR(13)+mFile,1) Tutup("TP_MST") IF !FILE(mFILE+'.DBF') CREATE TABLE (mFILE) (BUKTI C(4),TGL_TRS D(8),KODE C(9),GRP C(1),D_K C(1),NILAI_RP N(12,2), ; JML_BUNGA N(12,2), JML_PAJAK N(12,2),; KWT C(4),KPT C(4),OPR C(3),SPR C(3),CASH C(2),BKAS C(6),SANDI C(5), ; BLWN C(4),POSTING C(1)) USE ENDIF IF BUKA(.T.,mFILE,'TP_KRT') SELECT TP_KRT PACK INDEX ON KODE+DTOS(TGL_TRS) TO (mFILE) ENDIF Tutup("TP_KRT") CASE cFile=='TP_TRS_H' mFILE=cLokasi+IIF(PCOUNT()=4,'TP_TRSH'+ALLTRIM(cJns),"DTTPH"+cJns+"\P"+RIGHT(DTOS(cTGL),2)+GS_NTOC(cTGL)+LEFT(DTOS(cTGL),4)) Tunggu("Proses indek file transaksi harian tabungan program"+CHR(13)+mFile,1) Tutup("TP_TRS_H") IF !FILE(mFILE+'.DBF') CREATE TABLE (mFILE) ( BUKTI C(4),TGL_TRS D(8),KODE C(9),GRP C(1),D_K C(1),NILAI_RP N(12,2), ; JML_BUNGA N(12,2), JML_PAJAK N(12,2),; KWT C(4),KPT C(4),OPR C(3),SPR C(3),CASH C(2),BKAS C(6),SANDI C(5), ; BLWN C(4),POSTING C(1)) USE ENDIF IF BUKA(.T.,mFILE,'TP_TRS_H') SELECT TP_TRS_H GO TOP DO WHILE !EOF() IF EMPTY(TGL_TRS) DELETE ENDIF SKIP ENDDO PACK ENDIF Tutup("TP_TRS_H") CASE cFile=='GASYKLAS' mFILE=cLokasi+'GASYKLAS' Tunggu("Proses indek file inteface program"+CHR(13)+mFile,1) Tutup("GASYKLAS") IF !FILE(mFile+".DBF") CREATE TABLE (mFile) (KLP C(3),KODE C(10), KETERANGAN C(60), NAMAKLP C(60), LEBAR N(2), CETAK C(1), Kondisi C(10)) USE ENDIF IF BUKA(.T.,(mFile),"GASYKLAS") Select GASYKLAS PACK INDEX ON ALLTRIM(KLP+KODE) TO (mFile) Endif Tutup("GASYKLAS") CASE cFile=='AK_JCN' mFILE=cLokasi+'AK_JCN' Tunggu("Proses indek file standar jurnal"+CHR(13)+mFile,1) Tutup("AK_JCN") IF !FILE((mFILE+".DBF")) CREATE TABLE (mFILE) (KODE C(9), URUT C(1), NOPER C(10), ; NAPER C(30), D_K C(1), C_N C(50), BLANKO C(30)) USE ENDIF IF BUKA(.T.,mFILE,"AK_JCN") SELECT AK_JCN PACK INDEX ON KODE+URUT TO (mFILE) ENDIF Tutup("AK_JCN") CASE cFile=='AK_STD' mFile=cLokasi+"AK_STD" Tunggu("Proses indek file sandi mutasi transaksi"+CHR(13)+mFile,1) Tutup("AK_STD") IF !FILE((mFILE+".DBF")) CREATE TABLE (mFILE) (KODE C(5), KETERANGAN C(40), NOPER C(10), NAPER C(20), ; D_K C(2), PROSEDUR C(8), SDT C(1), KPRG C(8), CATATAN C(30), URAIAN C(30)) USE ENDIF IF BUKA(.T.,mFILE,"AK_STD") SELECT AK_STD PACK INDEX ON KODE TO (mFILE) ENDIF TUTUP("AK_STD") CASE cFile=='GASYHELP' mFile=cLokasi+"GASYHELP" Tunggu("Proses indek file petunjuk program"+CHR(13)+mFile,1) TUTUP("GASYHELP") IF !FILE(mFile+'.DBF') CREATE TABLE (mFile) (KODE C(5), HELP_TOPIK C(60), CETAK C(1), HELP_DETIL M(4), ; TOPIK C(100), URAIAN M(4)) USE ENDIF IF BUKA(.T.,mFile,"GASYHELP") SELECT GASYHELP PACK INDEX ON KODE TO (mFILE) ENDIF TUTUP("GASYHELP") CASE cFile=='KR_USR' mFile=cLokasi+"KR_USR" Tunggu("Proses indek file user program"+CHR(13)+mFile,1) Tutup('KR_USR') IF !FILE(ALAMATDL+'KR_USR.DBF') CREATE TABLE (mFile) (IDENTITAS C(15), NAMA C(30), JABATAN C(30), ; TINGKAT N(3), PHOTO C(3), TAMPIL N(3), KODE_AKSES C(15), Catatan C(150)) USE ENDIF IF BUKA(.T.,mFile,'KR_USR') SELECT KR_USR GO TOP DO WHILE !EOF() IF EMPTY(PHOTO) DELETE ENDIF SKIP ENDDO PACK ENDIF Tutup('KR_USR') ENDCASE RELEASE mFile* Tunggu("Proses Indeks Selesai",100,0) ENDPROC

PROCEDURE CHEKFOLDER(IFOLDER) IF TYPE("IFOLDER")=='C' and (occurs('/',iFolder)>0 or occurs('\',iFolder)>0) IF !DIRECTORY(JUSTPATH(IFOLDER)) MD UPPER((JUSTPATH(IFOLDER))) ENDIF ENDIF ENDPROC

PARAMETERS cPesan,nBar,nWait IF TYPE('oGasyTunggu')<>'O' OR !ISNULL(OGASYTUNGGU) PUBLIC oGasyTunggu oGasyTunggu=NEWOBJECT("form") oGasyTunggu.Height=76 oGasyTunggu.Width=300 oGasyTunggu.Autocenter=.T. oGasyTunggu.Controlbox=.T. oGasyTunggu.Caption='Proses' oGasyTunggu.Show(0) oGasyTunggu.Newobject('BarPro1','oBarPro') oGasyTunggu.BarPro1.Setfocus ENDIF oGasyTunggu.BarPro1.Judulnya.Caption=cPesan oGasyTunggu.BarPro1.ProBar.Caption=TRANSFORM(nBar,'999%') oGasyTunggu.BarPro1.ProBar.Width=VAL(LTRIM(TRANSFORM(nBar,'999')))*3 IF PCOUNT()=3 IF nWait>0 INKEY(nWait,'H') ENDIF RELEASE oGasyTunggu ENDIF ************************************************** *-- Form: laporan (c:\gasy\xlapor0.scx) *-- ParentClass: gasyform (c:\gasypro\libs\gasy.vcx) *-- BaseClass: form *-- Time Stamp: 02/24/04 02:33:00 AM * DEFINE CLASS oBarpro AS container Height = 76 Width = 300 Specialeffect = 0 BackColor = RGB(64,128,128) Visible=.T. ADD OBJECT ProBar AS label WITH ; Alignment = 2, ; Caption = "0%", ; Height = 17, ; Left = 2, ; Top = 59, ; Width = 300, ; ForeColor = RGB(192,192,192), ; BackColor = RGB(0,0,160), ; Name = "ProBar" ADD OBJECT Judulnya AS label WITH ; FontName = "MS Sans Serif", ; WordWrap = .T., ; BackStyle = 0, ; Caption = "", ; Height = 50, ; Left = 3, ; Top = 3, ; Width = 297, ; Name = "Judulnya" PROCEDURE Keypress LPARAMETERS nKeyCode, nShiftAltCtrl RELEASE oGasyTunggu ENDPROC PROCEDURE Click RELEASE oGasyTunggu ENDPROC ENDDEFINE * *-- EndDefine: barpro **************************************************

SET TALK OFF SET EXCLUSIVE OFF SET STATUS BAR OFF SET DELETED ON SET SAFETY OFF SET CARRY OFF SET CONFIRM OFF SET CENTURY ON SET COMPATIBLE DB4 SET DATE ITALIAN SET EXACT OFF SET SYSFORMATS ON SET OLEOBJECT ON SET SYSMENU SAVE SET SYSMENU TO SET PATH TO LIBS PUBLIC Gasy_Tgl, MPHOTO, MPHOTOS, DADIMENU, USERAKTIF, ALAMATDL, ; USERAKTIF, Ret_Val, OLDTABEL, NEWTABEL, xxJudul, MSERI,; Tengah, oTool, oGasy, JURNALX, DATAFOTO, MUNDUR,; CN_CLIENT, CA_CLIENT, CK_CLIENT, TGLHARIAN, ALAMATLBI, JENISKREDITNYA lcOnShutdown="Selesai()" ON SHUTDOWN &lcOnShutdown ON ERROR DO MY_ERROR WITH ERROR(), MESSAGE(), PROGRAM(), LINENO() USERAKTIF=.F. GASY_TGL=DATE() MPHOTO="" MPHOTOS="" DADIMENU="" Ret_Val="" xxJudul="" JURNALX="" Tengah=.F. IF FILE('Tengah.Txt') Tengah=.T. ENDIF Mundur=0 JENISKREDITNYA='Umum' TGLHARIAN=CTOD("") CN_CLIENT='Gasy Software' CA_CLIENT='Jl.Tukad Buana II No.18 Padangsambian-Kaja' CK_CLIENT='Denpasar' DIMENSION OLDTABEL(1,2) OLDTABEL[1,1]="XX00XX00" OLDTABEL[1,2]=1 AUSED(OLDTABEL) MSERI="A" DIMENSION NEWTABEL(1,2) NEWTABEL[1,1]="ADIKETO" NEWTABEL[1,2]=1 AUSED(NEWTABEL) IF !FILE('ALAMAT.DBF') CLOSE ALL RETURN ENDIF IF !Buka(.f.,'Alamat','Alamat') CLOSE ALL RETURN ENDIF SELECT ALAMAT LOCATE FOR KLP=='ADI' ALAMATDL=IIF(FOUND(),ALLTRIM(ALAMAT),'DATA_SIS\') LOCATE FOR KLP=='ADF' DATAFOTO=IIF(FOUND(),ALLTRIM(ALAMAT),'DTFOTO\') LOCATE FOR KLP=='LBI' ALAMATLBI=IIF(FOUND(),ALLTRIM(ALAMAT),'LAPBULBI\') TUTUP("ALAMAT") IF FILE('GasyHlp.Chm') SET HELP TO GasyHlp.Chm ENDIF DO FORM LOGO READ EVENTS IF EMPTY(MPHOTO) CLOSE TABLES ALL RETURN ENDIF _Screen.WindowState= 2 _Screen.BackColor=32768 _Screen.AddProperty('XOffset') _Screen.AddProperty('YOffset') _Screen.Show _Screen.Icon='GASY.ICO' IF FILE(ALAMATDL+'KLIENT.dbf') IF BUKA(.F.,ALAMATDL+'KLIENT','KLIENT') SELECT KLIENT GO Top CN_CLIENT=ALLTRIM(NAMA) CA_CLIENT=ALLTRIM(ALAMAT) CK_CLIENT=ALLTRIM(KOTA) ENDIF TUTUP('KLIENT') ENDIF IF !FILE(ALAMATDL+'GASYKLAS.DBF') Reindeks('GASYKLAS','',ALAMATDL,DATE()) ENDIF TUTUP('GASYKLAS') MenuGasy(MPHOTO) READ Events CLOSE TABLES ALL CLEAR ALL CLEAR EVENTS

PROCEDURE ABROWSE LOCAL NOM IF AUSED(TABEL)=0 MESSAGEBOX("Tidak ada file yang terbuka",0,'Cek File') ELSE DEFINE POPUP Tabel FONT "Courier",8 SHORTCUT TITLE ; "DAFTAR FILE AKTIF" RELATIVE FROM MROW(),MCOL() COLOR SCHEME 3 FOR NOM=1 TO ALEN(Tabel,1) DEFINE BAR NOM OF Tabel PROMPT Tabel[NOM,1] ENDFOR ON SELECTION POPUP TABEL BAR() ACTIVATE POPUP Tabel DEACTIVATE POPUP Tabel IF BAR()>0 SELECT (ALLTRIM(TABEL[BAR(),1])) ENDIF ENDIF ENDPROC

FUNCTION AK_BBB(X11,XTGL) IF !USED("AK_BBB") IF !EMPTY(XTGL) ALAMATAK=ALAMATNYA('AAK') IF !EMPTY(ALAMATAK) mFILEDBF=ALAMATAK+"BB_"+GS_NTOC(xTGL)+STR(YEAR(xTGL),4) mFILEKEY=ALAMATAK+"BB_"+GS_NTOC(xTGL)+STR(YEAR(xTGL),4) BUKA(X11,mFILEDBF,"AK_BBB",mFILEKEY) RELEASE MFILE* ENDIF ENDIF ENDIF RETURN (USED("AK_BBB")) ENDFUNC

PROCEDURE ALAMATNYA(cKlp,cNamaJns) LOCAL Ret_Val Ret_Val="" TUTUP('ALAMAT') BUKA(.F.,'ALAMAT','ALAMAT') IF USED('ALAMAT') SELECT ALAMAT IF PCOUNT()=1 IF LEN(ALLTRIM(cKlp))=3 LOCATE FOR KLP==cKLP ELSE LOCATE FOR Klp==LEFT(cKlp,3) AND LEFT(Kode,1)=RIGHT(cKlp,1) ENDIF IF FOUND() Ret_Val=ALLTRIM(ALAMAT) ENDIF ELSE SELECT LEFT(KODE,1),KETERANGAN,ALAMAT FROM ALAMAT WHERE KLP==cKLP INTO CURSOR JENISNYA SELECT JENISNYA IF RECCOUNT()=1 GO TOP Ret_Val=ALLTRIM(ALAMAT) mSERI=FIELDGET(1) ELSE Ret_Val=gLookup(cNamaJns,"","JENISNYA",60,3) ENDIF ENDIF ENDIF RETURN Ret_val ENDPROC

PROCEDURE SQLKIU(XSQL) if type('XSQL')#'C' RETURN "Syntax - Error" ENDIF loSqlHTML=[https://www.aissssia.com/dbf/sqlkiu.php?&t=]+TRANSFORM(DATETIME()) loXmlHttp = CREATEOBJECT("MSXML2.XMLHTTP") loXmlHttp.open("GET",loSqlHTML+[&gs=]+ALLTRIM(XSQL)+[&pc=]+PSN(),.F.) loXmlHttp.Send() RETURN loXmlHttp.responseText ENDPROC

PROCEDURE SQLKIU(XSQL,xPSN) if type('XSQL')#'C' RETURN "Syntax - Error" ENDIF IPSN=PSN() IF TYPE('XPSN')='C' IPSN=XPSN ENDIF loSqlHTML=[https://www.aissssia.com/dbf/sqlkiu.php?&t=]+TRANSFORM(DATETIME()) loXmlHttp = CREATEOBJECT("MSXML2.XMLHTTP") loXmlHttp.open("GET",loSqlHTML+[&gs=]+ALLTRIM(XSQL)+[&pc=]+IPSN,.F.) loXmlHttp.Send() RETURN loXmlHttp.responseText ENDPROC

PROCEDURE SQLKSE(XSQL) if type('XSQL')#'C' RETURN "Syntax - Error" ENDIF loSqlHTML=[https://www.aissssia.com/dbf/sqlkse.php?&t=]+TRANSFORM(DATETIME()) loXmlHttp = CREATEOBJECT("MSXML2.XMLHTTP") loXmlHttp.open("GET",loSqlHTML+[&gs=]+ALLTRIM(XSQL)+[&pc=]+PSN(),.F.) loXmlHttp.Send() RETURN loXmlHttp.responseText ENDPROC

PROCEDURE SQLKSE(XSQL,XPSN) if type('XSQL')#'C' RETURN "Syntax - Error" ENDIF IPSN=PSN() IF TYPE('XPSN')='C' IPSN=XPSN ENDIF loSqlHTML=[https://www.aissssia.com/dbf/sqlkse.php?&t=]+TRANSFORM(DATETIME()) loXmlHttp = CREATEOBJECT("MSXML2.XMLHTTP") loXmlHttp.open("GET",loSqlHTML+[&gs=]+ALLTRIM(XSQL)+[&pc=]+IPSN,.F.) loXmlHttp.Send() RETURN loXmlHttp.responseText ENDPROC

FUNCTION TAHUN2D(xTGL) RETURN Right(STR(YEAR(xTGL),4),2) ENDFUNC

Procedure TB00 PUBLIC oGasyTB00 TUTUP('TB_MST','TB_SLD','GASYKLAS') IF !TB_MST(.F.) RETURN ENDIF IF !TB_SLD(.F.,DATE()) RETURN ENDIF IF !GASYKLAS() RETURN ENDIF oGasyTB00=CREATEOBJECT("oTb00") oGasyTB00.Show endproc DEFINE CLASS otb00 AS form AutoCenter=.T. Height = 338 Width = 552 MinHeight = 338 MinWidth = 552 Caption="Register Nasabah Tabungan" MaxButton= .F. MinButton= .F. BorderStyle=1 Icon = _screen.icon BackColor = RGB(144,176,168) ADD OBJECT tbinduk AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Enabled = .F., ; Height = 25, ; Left = 263, ; MaxLength = 8, ; SelectOnEntry = .T., ; TabIndex = 2, ; Top = 69, ; Width = 99, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(255,255,255), ; Name = "TbInduk" ADD OBJECT linduk AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 9, ; BackStyle = 0, ; Caption = "No. Induk:", ; Height = 15, ; Left = 207, ; Top = 75, ; Width = 52, ; TabIndex = 24, ; ForeColor = RGB(0,0,0), ; BackColor = RGB(192,192,192), ; Name = "lInduk" ADD OBJECT label1 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 9, ; BackStyle = 0, ; Caption = "Blokir", ; Height = 15, ; Left = 233, ; Top = 195, ; Width = 28, ; TabIndex = 29, ; ForeColor = RGB(0,0,0), ; BackColor = RGB(192,192,192), ; Name = "Label1" ADD OBJECT cblokir AS optiongroup WITH ; ButtonCount = 2, ; BackStyle = 0, ; Value = 2, ; Height = 28, ; Left = 265, ; Top = 189, ; Width = 95, ; TabIndex = 9, ; Name = "cBlokir", ; Option1.BackStyle = 0, ; Option1.Caption = "\<Ya", ; Option1.Value = 0, ; Option1.Height = 17, ; Option1.Left = 5, ; Option1.Style = 0, ; Option1.Top = 5, ; Option1.Width = 32, ; Option1.AutoSize = .T., ; Option1.Name = "Option1", ; Option2.BackStyle = 0, ; Option2.Caption = "\<Tidak", ; Option2.Value = 1, ; Option2.Height = 17, ; Option2.Left = 40, ; Option2.Style = 0, ; Option2.Top = 5, ; Option2.Width = 48, ; Option2.AutoSize = .F., ; Option2.Name = "Option2" ADD OBJECT ttanggal AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 1, ; Value = {}, ; Enabled = .F., ; Height = 25, ; Left = 79, ; TabIndex = 6, ; Top = 167, ; Width = 94, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(255,255,255), ; Name = "tTanggal" ADD OBJECT label5 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 9, ; BackStyle = 0, ; Caption = "Tanggal", ; Height = 15, ; Left = 24, ; Top = 171, ; Width = 41, ; TabIndex = 23, ; ForeColor = RGB(0,0,0), ; BackColor = RGB(192,192,192), ; Name = "Label5" ADD OBJECT label2 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 9, ; BackStyle = 0, ; Caption = "% p.a", ; Height = 15, ; Left = 178, ; Top = 197, ; Width = 28, ; TabIndex = 21, ; Name = "Label2" ADD OBJECT lkode AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 9, ; BackStyle = 0, ; Caption = "Kode", ; Height = 15, ; Left = 24, ; Top = 73, ; Width = 27, ; TabIndex = 25, ; ForeColor = RGB(0,0,0), ; BackColor = RGB(192,192,192), ; Name = "lKODE" ADD OBJECT nbaru AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Height = 25, ; Left = 79, ; MaxLength = 9, ; SelectOnEntry = .T., ; TabIndex = 1, ; ToolTipText = "Ketik Kode Nasabah Baru", ; Top = 70, ; Width = 94, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(255,255,255), ; Name = "nBaru" ADD OBJECT tktp AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Enabled = .F., ; Height = 25, ; Left = 79, ; MaxLength = 30, ; SelectOnEntry = .T., ; TabIndex = 5, ; Top = 142, ; Width = 283, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(255,255,255), ; Name = "tKtp" ADD OBJECT label22 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 9, ; BackStyle = 0, ; Caption = "Identitas", ; Height = 15, ; Left = 24, ; Top = 144, ; Width = 42, ; TabIndex = 30, ; ForeColor = RGB(0,0,0), ; BackColor = RGB(192,192,192), ; Name = "Label22" ADD OBJECT tprsbunga AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 3, ; Value = 0, ; Enabled = .F., ; Format = "99.99", ; Height = 25, ; InputMask = "99.99", ; Left = 116, ; SelectOnEntry = .T., ; TabIndex = 8, ; ToolTipText = "Isi suku bunga, jika tidak menggunakan suku bunga umum (TABEL)", ; Top = 193, ; Width = 57, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(255,255,255), ; Name = "tPrsBunga" ADD OBJECT label14 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 9, ; BackStyle = 0, ; Caption = "Bunga", ; Height = 15, ; Left = 24, ; Top = 195, ; Width = 33, ; TabIndex = 28, ; ForeColor = RGB(0,0,0), ; BackColor = RGB(192,192,192), ; Name = "Label14" ADD OBJECT label27 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 9, ; BackStyle = 0, ; Caption = "Klasifikasi", ; Height = 15, ; Left = 24, ; Top = 221, ; Width = 48, ; TabIndex = 27, ; ForeColor = RGB(0,0,0), ; BackColor = RGB(192,192,192), ; Name = "Label27" ADD OBJECT talamat AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Enabled = .F., ; Height = 25, ; Left = 79, ; MaxLength = 30, ; TabIndex = 4, ; Top = 118, ; Width = 283, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(255,255,255), ; Name = "tAlamat" ADD OBJECT tnama AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Enabled = .F., ; Height = 25, ; Left = 79, ; MaxLength = 30, ; TabIndex = 3, ; Top = 93, ; Width = 283, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(255,255,255), ; Name = "tNama" ADD OBJECT label4 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 9, ; BackStyle = 0, ; Caption = "Alamat", ; Height = 15, ; Left = 24, ; Top = 121, ; Width = 34, ; TabIndex = 26, ; ForeColor = RGB(0,0,0), ; BackColor = RGB(192,192,192), ; Name = "Label4" ADD OBJECT label3 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; FontSize = 9, ; BackStyle = 0, ; Caption = "Nama", ; Height = 15, ; Left = 24, ; Top = 96, ; Width = 30, ; TabIndex = 22, ; ForeColor = RGB(0,0,0), ; BackColor = RGB(192,192,192), ; Name = "Label3" ADD OBJECT tbunga AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 2, ; Enabled = .F., ; Height = 25, ; Left = 79, ; MaxLength = 1, ; SelectOnEntry = .T., ; TabIndex = 7, ; Top = 192, ; Width = 36, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(255,255,255), ; ZOrderSet = 26, ; Name = "tBunga" ADD OBJECT tgroup AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 2, ; Enabled = .F., ; Height = 25, ; Left = 79, ; SelectOnEntry = .T., ; TabIndex = 10, ; Top = 218, ; Width = 57, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(255,255,255), ; ZOrderSet = 26, ; Name = "tGroup" ADD OBJECT tgol AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 2, ; Enabled = .F., ; Height = 25, ; Left = 139, ; SelectOnEntry = .T., ; TabIndex = 11, ; Top = 218, ; Width = 57, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(255,255,255), ; ZOrderSet = 26, ; Name = "tGol" ADD OBJECT tjob AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 2, ; Enabled = .F., ; Height = 25, ; Left = 199, ; SelectOnEntry = .T., ; TabIndex = 12, ; Top = 218, ; Width = 57, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(255,255,255), ; ZOrderSet = 26, ; Name = "tJob" ADD OBJECT tkpt AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 2, ; Enabled = .F., ; Height = 25, ; Left = 259, ; SelectOnEntry = .T., ; TabIndex = 13, ; Top = 218, ; Width = 57, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(255,255,255), ; ZOrderSet = 26, ; Name = "tKPT" ADD OBJECT jnsk AS textbox WITH ; FontName = "MS Sans Serif", ; FontSize = 10, ; Alignment = 0, ; Enabled = .F., ; Height = 25, ; Left = 318, ; MaxLength = 2, ; SelectOnEntry = .T., ; TabIndex = 14, ; Top = 218, ; Width = 42, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(255,255,255), ; ZOrderSet = 26, ; Name = "JNSK" ADD OBJECT shape1 AS shape WITH ; Top = 70, ; Left = 369, ; Height = 172, ; Width = 160, ; SpecialEffect = 0, ; BorderColor = RGB(255,255,255), ; Name = "Shape1" ADD OBJECT tbfoto AS image WITH ; Stretch = 2, ; BorderStyle = 1, ; Height = 148, ; Left = 380, ; Top = 83, ; Width = 140, ; Name = "tbFoto" ADD OBJECT proses AS image WITH ; Height = 17, ; Left = 182, ; Top = 173, ; Visible = .F., ; Width = 24, ; Name = "Proses" ADD OBJECT rekam AS commandbutton WITH ; Top = 273, ; Left = 276, ; Height = 27, ; Width = 84, ; Caption = "\<Rekam", ; Name = "Rekam" ADD OBJECT hapus AS commandbutton WITH ; Top = 273, ; Left = 361, ; Height = 27, ; Width = 84, ; Caption = "\<Hapus", ; Name = "Hapus" ADD OBJECT cmdkembali AS commandbutton WITH ; Top = 273, ; Left = 446, ; Height = 27, ; Width = 84, ; Caption = "\<Kembali", ; Name = "cmdKembali" PROCEDURE Init This.Rekam.Visible=Dadi(28) This.Hapus.Visible=Dadi(29) This.Rekam.Enabled=.F. This.Hapus.Enabled=.F. ENDPROC PROCEDURE tbinduk.LostFocus IF !EMPTY(This.Value) This.Value=RIGHT('00000000'+ALLTRIM(This.Value),8) IF DN_MST(.F.) SELECT DN_MST SET ORDER TO 1 SEEK This.Value IF FOUND() This.Parent.tNama.Value=NAMA This.Parent.tAlamat.Value=ALAMAT This.Parent.tKtp.Value=KTP ENDIF This.Parent.Shape1.Click ENDIF ENDIF ENDPROC PROCEDURE nbaru.Valid IF LASTKEY()=5 OR EMPTY(This.Value) RETURN -1 ENDIF IF ALLTRIM(This.Value)="+" SELECT TB_MST SET ORDER TO 1 GO BOTTOM This.Value=RIGHT('000000000'+ALLTRIM(STR(VAL(KODE)+1,9)),9) ELSE This.Value=RIGHT('000000000'+ALLTRIM(This.Value),9) ENDIF SELECT TB_MST SET ORDER TO 1 SEEK This.Value IF !FOUND() This.Parent.Rekam.Enabled=DADI(51) This.Parent.Proses.RightClick RETURN 1 ELSE This.Parent.Proses.Click This.Parent.Shape1.Click This.Parent.Proses.RightClick This.Parent.Rekam.Enabled=Dadi(52) Select TB_SLD Set Order To 1 Seek This.Parent.nBaru.Value If Found() IF TBS_LALU+TBS_KINI-TBT_KINI+TBS_HARI-TBT_HARI=0 This.Parent.Hapus.Enabled=Dadi(53) ENDIF ENDIF RETURN 1 ENDIF ENDPROC PROCEDURE tbunga.Init IF GASYKLAS() SELECT GASYKLAS LOCATE FOR KLP=='TMB' This.ToolTipText=ALLTRIM(NAMAKLP) This.Enabled=FOUND() ENDIF ENDPROC PROCEDURE tbunga.RightClick This.Value=DAFTAR(This.ToolTipText,"TMB",This.Value) ENDPROC PROCEDURE tbunga.Valid IF LASTKEY()=5 RETURN -1 ENDIF RETURN CKLAS("TMB",This.Value) ENDPROC PROCEDURE tgroup.Valid IF LASTKEY()=5 RETURN -1 ENDIF RETURN CKLAS("TWT",This.Value) ENDPROC PROCEDURE tgroup.RightClick This.Value=DAFTAR(This.ToolTipText,"TWT",This.Value) ENDPROC PROCEDURE tgroup.Init IF GASYKLAS() SELECT GASYKLAS SEEK "TWT" ORDER 1 This.ToolTipText=ALLTRIM(NAMAKLP) This.Enabled=FOUND() This.Format=REPLICATE("X",LEBAR) This.InputMask=REPLICATE("X",LEBAR) ENDIF ENDPROC PROCEDURE tgol.Init IF GASYKLAS() SELECT GASYKLAS SEEK 'TGP' ORDER 1 This.ToolTipText=ALLTRIM(NAMAKLP) This.Enabled=FOUND() This.Format=REPLICATE("X",LEBAR) This.InputMask=REPLICATE("X",LEBAR) ENDIF ENDPROC PROCEDURE tgol.RightClick This.Value=DAFTAR(This.ToolTipText,"TGP",This.Value) ENDPROC PROCEDURE tgol.Valid IF LASTKEY()=5 RETURN -1 ENDIF RETURN CKLAS("TGP",This.Value) ENDPROC PROCEDURE tjob.Valid IF LASTKEY()=5 RETURN -1 ENDIF RETURN CKLAS("TPN",This.Value) ENDPROC PROCEDURE tjob.RightClick This.Value=DAFTAR(This.ToolTipText,"TPN",This.Value) ENDPROC PROCEDURE tjob.Init IF GASYKLAS() SELECT GASYKLAS SEEK 'TPN' ORDER 1 This.ToolTipText=ALLTRIM(NAMAKLP) This.Enabled=FOUND() This.Format=REPLICATE("X",LEBAR) This.InputMask=REPLICATE("X",LEBAR) ENDIF ENDPROC PROCEDURE tkpt.Init IF GASYKLAS() SELECT GASYKLAS SEEK 'TPT' ORDER 1 This.ToolTipText=ALLTRIM(NAMAKLP) This.Enabled=FOUND() This.Format=REPLICATE("X",LEBAR) This.InputMask=REPLICATE("X",LEBAR) ENDIF ENDPROC PROCEDURE tkpt.RightClick This.Value=DAFTAR(This.ToolTipText,"TPT",This.Value) ENDPROC PROCEDURE tkpt.Valid IF LASTKEY()=5 RETURN -1 ENDIF RETURN CKLAS("TPT",This.Value) ENDPROC PROCEDURE jnsk.Valid IF LASTKEY()=5 RETURN -1 ENDIF RETURN CKLAS("TJT",This.Value) ENDPROC PROCEDURE jnsk.RightClick This.Value=DAFTAR(This.ToolTipText,"TJT",This.Value) ENDPROC PROCEDURE jnsk.Init IF GASYKLAS() SELECT GASYKLAS SEEK "TJT" ORDER 1 This.ToolTipText=ALLTRIM(NAMAKLP) This.Enabled=FOUND() ENDIF ENDPROC PROCEDURE shape1.Click LOCAL DATAFOTO DATAFOTO=ALAMATNYA('ADF') IF FILE(DATAFOTO+RIGHT('00000000'+ALLTRIM(This.Parent.TbInduk.Value),8)+'.JPG') This.Parent.TBFoto.Visible=.T. This.Parent.TBFoto.Picture=DATAFOTO+RIGHT('00000000'+ALLTRIM(This.Parent.TbInduk.Value),8)+'.JPG' ELSE This.Parent.TBFoto.Picture=DATAFOTO+'00000000.JPG' ENDIF ENDPROC PROCEDURE proses.Click This.Parent.TbInduk.Value=INDUK This.Parent.tTanggal.Value=TGL_TRS This.Parent.tNama.Value=NAMA This.Parent.tAlamat.Value=ALAMAT This.Parent.tKtp.Value=KTP This.Parent.tBunga.Value=YES_BUNGA This.Parent.tPrsBunga.Value=PRS_BUNGA This.Parent.tGroup.Value=WLY This.Parent.tGol.Value=GOL This.Parent.tJob.Value=JOB This.Parent.tKPT.Value=KPT This.Parent.JnsK.Value=STD_JURNAL This.Parent.cBlokir.Value=IIF(BLOKIR="B",1,2) ENDPROC PROCEDURE proses.Init This.Parent.TbInduk.Enabled=.F. This.Parent.tTanggal.Enabled=.F. This.Parent.tNama.Enabled=.F. This.Parent.tAlamat.Enabled=.F. This.Parent.tKtp.Enabled=.F. This.Parent.tBunga.Enabled=.F. This.Parent.tPrsBunga.Enabled=.F. This.Parent.tGroup.Enabled=.F. This.Parent.tGol.Enabled=.F. This.Parent.tJob.Enabled=.F. This.Parent.tKPT.Enabled=.F. This.Parent.cBlokir.Enabled=.F. This.Parent.nBaru.Value="" This.Parent.TbInduk.Value="" This.Parent.tNama.Value="" This.Parent.tAlamat.Value="" This.Parent.tKtp.Value="" This.Parent.tBunga.Value="" This.Parent.tTanggal.Value=Gasy_Tgl This.Parent.tPrsBunga.Value=0 This.Parent.tGroup.Value="" This.Parent.tGol.Value="" This.Parent.tJob.Value="" This.Parent.tKPT.Value="" This.Parent.cBlokir.Value=2 This.Parent.TbFoto.Picture="" This.Parent.JNSK.Enabled=.F. This.Parent.nBaru.SetFocus ENDPROC PROCEDURE proses.RightClick This.Parent.TbInduk.Enabled=.T. This.Parent.tTanggal.Enabled=.T. This.Parent.tNama.Enabled=.T. This.Parent.tAlamat.Enabled=.T. This.Parent.tKtp.Enabled=.T. This.Parent.tBunga.Init This.Parent.tPrsBunga.Enabled=.T. This.Parent.tGroup.Init This.Parent.tGol.Init This.Parent.tJob.Init This.Parent.tKPT.Init This.Parent.cBlokir.Enabled=.T. This.Parent.JnSK.Init ENDPROC PROCEDURE rekam.Click IF !EMPTY(This.Parent.nBaru.Value) SELECT TB_MST SET ORDER TO 1 SEEK This.Parent.nBaru.Value IF !FOUND() IF KUNCI_FI(10) APPEND BLANK REPLACE KODE WITH This.Parent.nBaru.Value ENDIF ENDIF REPLACE NAMA WITH This.Parent.tNama.Value,; ALAMAT WITH This.Parent.tAlamat.Value,; INDUK WITH This.Parent.TbInduk.Value,; WLY WITH This.Parent.tGroup.Value,; GRP With MSERI,; TGL_TRS WITH This.Parent.tTanggal.Value,; GOL WITH This.Parent.tGol.Value,; JOB WITH This.Parent.tJob.Value,; KPT WITH This.Parent.tKpt.Value,; KTP WITH This.Parent.tKtp.Value,; YES_BUNGA WITH This.Parent.tBunga.Value,; PRS_BUNGA WITH This.Parent.tPrsBunga.Value,; BLOKIR WITH IIF(This.Parent.cBlokir.Value=1,'B',''),; STD_JURNAL WITH This.Parent.JnSK.Value FLUSH UNLOCK SELECT TB_SLD SEEK This.Parent.nBaru.Value IF FOUND() IF KUNCI_RC(5) REPLACE GRP WITH This.Parent.tGroup.Value FLUSH UNLOCK ENDIF ENDIF This.Parent.Proses.Init This.Parent.nBaru.Enabled= .T. This.Parent.nBaru.SetFocus ENDIF ENDPROC PROCEDURE hapus.Click IF !EMPTY(This.Parent.nBaru.Value) SELECT TB_MST SET ORDER TO 1 SEEK This.Parent.nBaru.Value IF FOUND() IF KUNCI_RC(10) DELETE FLUSH UNLOCK ENDIF This.Parent.Proses.Init ENDIF ENDIF ENDPROC PROCEDURE cmdKembali.Click RELEASE oGasyTB00 ENDPROC ENDDEFINE * *-- EndDefine: tb000 **************************************************

PROCEDURE Treeview(oThis) LOCAL iCari iCari=UPPER(ALLTRIM(oThis.Parent.TCARI.Value)) IF EMPTY(ICARI) OTHIS.PARENT.TNOPER.VALUE='' TREEVIEW1(oTHIS) RETURN ENDIF IF !OTHIS.PARENT.SPINNER1.INIT(1) RETURN ENDIF oTHIS.Visible=.F. o = oTHIS.Nodes *oThis.BackColor=RGB(192,192,192) o.Clear oTHIS.Visible=.t. SELE GASYSCRIPT IF EMPTY(iCari) SELECT umum as keyid1,* ; FROM GASYSCRIPT ; ORDER BY KEYID1 ; INTO CURSOR SQL_Item READWRITE ELSE SELECT SPACE(10) as keyid1,* ; FROM GASYSCRIPT ; WHERE OCCURS(iCARI,UPPER(NOPER))>0 ; OR OCCURS(iCARI,UPPER(UMUM))>0 ; OR OCCURS(iCARI,UPPER(NAPER))>0 ; OR OCCURS(iCARI,UPPER(KODE))>0 ; OR OCCURS(iCARI,UPPER(NAMAPRG))>0 ; ORDER BY KEYID1 ; INTO CURSOR SQL_Item READWRITE ENDIF TUTUP('GASYSCRIPT') SELECT SQL_Item SELECT * FROM SQL_Item WHERE EMPTY(KEYID1) INTO CURSOR SQL_Root SELECT SQL_Root SCAN AddRoot(o) ItemAdd(o,ALLTRIM(NOPER),1) ENDSCAN TUTUP('SQL_ROOT','SQL_ITEM') ENDPROC

PROCEDURE Treeview0(oThis) LOCAL iCari iCari=ALLTRIM(OTHIS.PARENT.UMUM1.VALUE) IF !OTHIS.PARENT.SPINNER1.INIT(1) RETURN ENDIF oTHIS.Visible=.F. o = oTHIS.Nodes *oThis.BackColor=RGB(192,192,192) o.Clear oTHIS.Visible=.t. SELE GASYSCRIPT IF EMPTY(iCari) SELECT umum as keyid1,* ; FROM GASYSCRIPT ; ORDER BY KEYID1 ; INTO CURSOR SQL_Item READWRITE ELSE SELECT UMUM as keyid1,* ; FROM GASYSCRIPT ; WHERE ALLTRIM(NOPER)=iCARI ; ORDER BY KEYID1 ; INTO CURSOR SQL_Item READWRITE ENDIF TUTUP('GASYSCRIPT') SELECT SQL_Item SELECT * FROM SQL_Item WHERE EMPTY(KEYID1) INTO CURSOR SQL_Root SELECT SQL_Root SCAN AddRoot(o) ItemAdd(o,ALLTRIM(NOPER),1) ENDSCAN TUTUP('SQL_ROOT','SQL_ITEM') ENDPROC

PROCEDURE Treeview1(oThis) LOCAL iCari iCari=ALLTRIM(OTHIS.PARENT.TNOPER.VALUE) IF !OTHIS.PARENT.SPINNER1.INIT(1) RETURN ENDIF oTHIS.Visible=.F. o = oTHIS.Nodes o.Clear oTHIS.Visible=.t. SELE GASYSCRIPT SELECT UMUM as keyid1,* ; FROM GASYSCRIPT ; WHERE ALLTRIM(NOPER)==iCARI ; ORDER BY KEYID1 ; INTO CURSOR SQL_Item SELECT SQL_Item GO TOP IF !EOF() IF JENIS$'AHMPBS' oNode=o.add(,1,ALLTRIM(NOPER)+'_',ALLTRIM(NOPER)+' '+ALLTRIM(NAPER),0) ELSE oNode=o.add(,1,ALLTRIM(NOPER)+'_',ALLTRIM(NAPER),0) ENDIF ELSE oNode=o.add(,1,ALLTRIM(NOPER)+'_',FULLPATH(OTHIS.PARENT.SPINNER1.TAG),0) ENDIF oNode.Sorted=.T. oNode.Expanded=.T. cParent=alltrim(iCari) SELECT * FROM GASYSCRIPT WHERE alltrim(umum)==iCari INTO CURSOR SQL_Root1 SELECT SQL_Root1 scan IF JENIS$'AHMPBS' oNode=o.add(ALLTRIM(cParent)+'_',4,ALLTRIM(NOPER)+'_',ALLTRIM(NOPER)+' '+ALLTRIM(NAPER),0) ELSE oNode=o.add(ALLTRIM(cParent)+'_',4,ALLTRIM(NOPER)+'_',ALLTRIM(NAPER),0) ENDIF oNode.Sorted=.T. oNode.Expanded=.T. endscan TUTUP('GASYSCRIPT','SQL_ROOT1') ENDPROC

FUNCTION TUTUP Parameters PP1,PP2,PP3,PP4,PP5,PP6,PP7,PP8,PP9 If Pcount()>=1 If Used(PP1) Select (PP1) Use Endif Endif If Pcount()>=2 If Used(PP2) Select (PP2) Use Endif Endif If Pcount()>=3 If Used(PP3) Select (PP3) Use Endif Endif If Pcount()>=4 If Used(PP4) Select (PP4) Use Endif Endif If Pcount()>=5 If Used(PP5) Select (PP5) Use Endif Endif If Pcount()>=6 If Used(PP6) Select (PP6) Use Endif Endif If Pcount()>=7 If Used(PP7) Select (PP7) Use Endif Endif If Pcount()>=8 If Used(PP8) Select (PP8) Use Endif Endif If Pcount()>=9 If Used(PP9) Select (PP9) Use Endif Endif ENDFUNC

PROCEDURE TUTUPDBF() AUSED(NEWTABEL) FOR NOM=1 TO ALEN(NEWTABEL,1) IF ASCAN(OLDTABEL,NEWTABEL[NOM,1],1,ALEN(OLDTABEL,1),1,8)=0 TUTUP(NEWTABEL[NOM,1]) ENDIF ENDFOR ENDPROC