Function Week Of Month

Function Week Of Month

  00.00    Prometheus

---

&& FUNCTION WeekOfMonth
&& PARAMETERS _Date,_Mode
&& Nilai RETURN tergantung PARAMETER _Mode 
&& jika _Mode=0 Nilai RETURN Numerik, yaitu : -1,1,2,3,4,5
&& jika _Mode=1 Nilai RETURN karakter, yaitu :
&& "" jika error atau 
&& "1'st of MonthName" atau "2'nd of MonthName" dst s/d "5'th of MonthName"
&& jika _Mode= 2 dst Nilai RETURN karakter seperti pada _Mode=1 tapi ada tambahan bulan/tahun

FUNCTION WeekOfMonth
PARAMETERS _Date,_Mode
PRIVATE _Date,_Hr,_Bl,_Th,_DateTest,_MingguKe,_Balik,_Mode
IF VARTYPE(_Mode)<>"N"
_Mode=0
ENDIF
IF VARTYPE(_Date)<>"D"
RETURN IIF(_Mode=0,-1,"")
ENDIF
_SetDate=SET("Date")
_SetCentury=SET("CENTURY")
SET DATE ITALIAN 
SET CENTURY ON 
_Hr=DAY(_Date)
_Bl=MONTH(_Date)
_Th=YEAR(_Date)
_DateTest=CTOD("01"+"-"+PADL(_Bl,2,"0")+"-"+PADL(_Th,4,"0"))
_MingguKe=1
DO WHILE _DateTest<_Date
_DateTest=_DateTest+1
IF DOW(_DateTest)=1
_MingguKe=_MingguKe+1
ENDIF 
ENDDO 
IF !EMPTY(_SetDate)
SET DATE &_SetDate
ENDIF 
IF !EMPTY(_SetCentury)
SET CENTURY &_SetCentury
ENDIF 
_Balik=-1
DO CASE 
CASE _Mode=1
DO CASE 
CASE _MingguKe=1
_Balik="1'st of "+CMONTH(_Date)
CASE _MingguKe=2
_Balik="2'nd of "+CMONTH(_Date)
CASE _MingguKe=3
_Balik="3'th of "+CMONTH(_Date)
CASE _MingguKe=4
_Balik="4'th of "+CMONTH(_Date)
OTHERWISE 
_Balik="5'th of "+CMONTH(_Date)
ENDCASE 
CASE _Mode=2
DO CASE 
CASE _MingguKe=1
_Balik=CMONTH(_Date)+" 1'st"
CASE _MingguKe=2
_Balik=CMONTH(_Date)+" 2'nd"
CASE _MingguKe=3
_Balik=CMONTH(_Date)+" 3'th"
CASE _MingguKe=4
_Balik=CMONTH(_Date)+" 4'th"
OTHERWISE 
_Balik=CMONTH(_Date)+" 5'th"
ENDCASE 
CASE _Mode=3
DO CASE 
CASE _MingguKe=1
_Balik=PADL(_Th,4,"0")+" "+CMONTH(_Date)+" 1'st"
CASE _MingguKe=2
_Balik=PADL(_Th,4,"0")+" "+CMONTH(_Date)+" 2'nd"
CASE _MingguKe=3
_Balik=PADL(_Th,4,"0")+" "+CMONTH(_Date)+" 3'th"
CASE _MingguKe=4
_Balik=PADL(_Th,4,"0")+" "+CMONTH(_Date)+" 4'th"
OTHERWISE 
_Balik=PADL(_Th,4,"0")+" "+CMONTH(_Date)+" 5'th"
ENDCASE 
OTHERWISE 
_Balik=_MingguKe
ENDCASE 
RETURN _Balik

Read More

Menterjemahkan Angka Romawi dengan Visual Foxpro

Menterjemahkan Angka Romawi dengan Visual Foxpro

  11.19    Prometheus

---

&& FUNCTION Rom2Lat
&& PARAMETERS _cBil,_Mode

&& Function Rom2Lat

&& Untuk merubah angka romawi menjadi bilBulPos Latin
&& Parameter _cBil,_Mode
&&  _cBil Angka Romawi
&&  _Mode untuk menentuka Nlai Return, _Mode berupa 0 atau 1
&& Return : Jika _Mode=0, BilBulPos, -1 jika tak dapat diterjemahkan
&&               Jika _Mode=1, Expresi String dari Bil
&& Contoh :
&& Rom3Lat(XII) ==> 12
&& Rom2Lat("YZ") ==> -1
&& Rom2Lat("XII",1) ==>  "10+1+1"
&& Catatan : Function BacaDrKanan()

FUNCTION Rom2Lat
PARAMETERS _cBil,_Mode
IF VARTYPE(_cBil)<>"C"
        RETURN -1
ENDIF
IF LEN(_cBil)>99
        RETURN -1
ENDIF
IF VARTYPE(_Mode)="C"
        _Mode=VAL(_Mode)
ENDIF
IF VARTYPE(_Mode)<>"N"
        _Mode=0
ENDIF
IF _Mode<=0 .or. _Mode>1
        _Mode=0
ENDIF
_cBil=BacaDrKanan(HapusBlank(_cBil))
_ncBil=LEN(_cBil)
_BalikRom=""
FOR _kesekian=1 TO _ncBil
        _CharKei=SUBSTR(_cBil,_kesekian,1)
        _vKei=CharRom2Lat(_CharKei)
        IF _kesekian<_ncBil
                _NexChar=SUBSTR(_cBil,_kesekian+1,1)
                _vNexChar=CharRom2Lat(_NexChar)
                IF _vNexChar<_vKei
                        _BalikRom=_BalikRom+ALLTRIM(STR(_vKei))+"-"
                ELSE
                        _BalikRom=_BalikRom+ALLTRIM(STR(_vKei))+"+"
                ENDIF
        ELSE
                _BalikRom=_BalikRom+ALLTRIM(STR(_vKei))
        ENDIF
NEXT
IF _Mode=1
        RETURN _BalikRom
ENDIF
RETURN INT(Trump(_BalikRom))

&& FUNCTION Trump
&& Ini merupakan subfunction untuk function Rom2Lat
&& Untuk memnterjenahkan String berisi + dan - menjadi operasi &
&& Contoh :
&& Trump("11+10+2-2") ===> 21
&& Sama atrinya jika kita pakai & sbb :
&& xx="11+10+2-2"
&& ? &xx  ===> 21
&& Trump tidak dapat dipergunakan untuk string dengan operasi perkalian atau pembagian

FUNCTION Trump
PARAMETERS _BalikRom
_Kali=1000
_nBalik=0
_BalikRom=_BalikRom
DO WHILE _Kali>1
        _PosPlus=RAT("+",_BalikRom)
        _PosMin=RAT("-",_BalikRom)
        DO CASE
                CASE _PosPlus>_PosMin && Tanda + ada di belakang
                        _StringNBuncit=VAL(SUBSTR(_BalikRom,_PosPlus+1))
                        _nBalik=_nBalik+_StringNBuncit
                        _BalikRom=LEFT(_BalikRom,_PosPlus-1)
                CASE _PosPlus<_PosMin
                        _StringNBuncit=VAL(SUBSTR(_BalikRom,_PosMin+1))
                        _nBalik=_nBalik-_StringNBuncit
                        _BalikRom=LEFT(_BalikRom,_PosMin-1)
                CASE _PosPlus=0 .and. _PosMin=0
                        _StringNBuncit=VAL(_BalikRom)
                        _nBalik=_nBalik+_StringNBuncit
                        _BalikRom=""
                        EXIT
        ENDCASE
        _Kali=_Kali-1
ENDDO
RETURN _nBalik

&& Function CharRom2Lat
&& Untuk merubah 1 digit angka dasar romawi menjadi bilBulPos Latin
&& Parameter _cBil Angka Dasar Romawi (I,V,X, L,C,D,M)
&& Return : BilBulPos, 1 atau 5 atau 10, 50 atau 100 atau 500 atau 1000
&& Contoh :
&& Rom3Lat("C") ==> 100
&& Rom2Lat("c") ==> 100

FUNCTION CharRom2Lat
PARAMETERS _cBil
IF VARTYPE(_cBil)<>"C"
        RETURN -1
ENDIF
_cBil=UPPER(HapusBlank(_cBil))
DO CASE
        CASE _cBil="V"
                _Balik=5
        CASE _cBil="X"
                _Balik=10
        CASE _cBil="L"
                _Balik=50
        CASE _cBil="C"
                _Balik=100
        CASE _cBil="D"
                _Balik=500
        CASE _cBil="M"
                _Balik=1000
        OTHERWISE
                _Balik=1
ENDCASE
RETURN _Balik

Read More

Konversi Desimal ke Hexadesimal dalam Visual Foxpro

Konversi Desimal ke Hexadesimal dalam Visual Foxpro

  19.59    Prometheus

---

&& FUNCTION Dec2Hex 
&& Untuk mengubah bilangan bulat tak negatif menjadi bilangan hexadesimal
&& PARAMETERS _DecNum merupakan bilangan bulat tak negatif
&& RETURN : Bilangan Hexadesimal

FUNCTION Dec2Hex
PARAMETERS _DecNum
IF VARTYPE(_DecNum)="C"
        _DecNum=VAL(_DecNum)
ENDIF 
IF VARTYPE(_DecNum)<>"N"
        _DecNum=0
ENDIF 
_DecAwal=_DecNum
_balik=""
_Sisa=0
DO WHILE _DecAwal>15
        _Int=INT(_DecAwal/16)
        _Sisa=_DecAwal-_Int*16
        _balik=Dec2HexTbl(_sisa)+_Balik
        _DecAwal=_Int
ENDDO 
_Balik=Dec2HexTbl(_DecAwal)+_Balik
RETURN _Balik 

&& FUNCTION Dec2HexTbl
&& Merupakan fungsi bantu untuk menterjemahkan satu digit bilangan bulat 
&& tak negatif menjadi satu digit bilangan hexadesimal
&& PARAMETERS __DecNum satu digit bilangan bulat tak negatif 
&& RETURN __Balik satu digit bilangan hexadesimal

FUNCTION Dec2HexTbl
PARAMETERS __DecNum
IF VARTYPE(__DecNum)="C"
        __DecNum=VAL(__DecNum)
ENDIF 
IF VARTYPE(__DecNum)<>"N"
        __DecNum=0
ENDIF 
DO CASE 
        CASE __DecNum=0
                __Balik="0"
        CASE __DecNum=1
                __Balik="1"
        CASE __DecNum=2
                __Balik="2"
        CASE __DecNum=3
                __Balik="3"
        CASE __DecNum=4
                __Balik="4"
        CASE __DecNum=5
            __Balik="5"
        CASE __DecNum=6
            __Balik="6"
        CASE __DecNum=7
            __Balik="7"
        CASE __DecNum=8
            __Balik="8"
        CASE __DecNum=9
            __Balik="9"
        CASE __DecNum=10
            __Balik="A"
        CASE __DecNum=11
            __Balik="B"
        CASE __DecNum=12
            __Balik="C"
        CASE __DecNum=13
            __Balik="D"
        CASE __DecNum=14
            __Balik="E"
        CASE __DecNum=15
            __Balik="F"
ENDCASE 
RETURN __Balik

Read More

Menulis Angka Romawi dengan Visual Foxpro

Menulis Angka Romawi dengan Visual Foxpro

  10.05    Prometheus

---

&& FUNCTION Lat2Rom  && Max 999999
&& Mengubah bilangan bulat positif menjadi angka Romawi
&& PARAMETERS _nLat ; Bilangan bulat positif
&& Contoh :
&& Lat2Rom(2) ===> "II"
&& Lat2Rom("2") ===> "II"
&& Lat2Rom(0) ===> ""

FUNCTION Lat2Rom
PARAMETERS _nLat
IF VARTYPE(_nLat)="C"
        _nLat=INT(VAL(_nLat))
ENDIF
IF _nLat<=0  && Tak ada angka Romawi NOL atau Negaatif
        RETURN ""
ENDIF
IF _nLat>999999  && Sebagai pembatas Bilbul Pos yang akan diromawikan
        RETURN ""
ENDIF
_Balik=""
_nSisa=_nLat
DO WHILE _nSisa>0
        DO CASE
                CASE _nSisa>=1000
                        _Jum1000=INT(_nSisa/1000)
                        _nSisa=_nSisa-_Jum1000*1000
                        _Balik=_Balik+REPLICATE("M",_Jum1000)
                CASE _nSisa>=900
                        _Balik=_Balik+"CM"
                        _nSisa=_nSisa-900
                CASE _nSisa>=800
                        _Balik=_Balik+"DCCC"
                        _nSisa=_nSisa-800
                CASE _nSisa>=700
                        _Balik=_Balik+"DCC"
                        _nSisa=_nSisa-700
                CASE _nSisa>=600
                        _Balik=_Balik+"DC"
                        _nSisa=_nSisa-600
                CASE _nSisa>=500
                        _Balik=_Balik+"D"
                        _nSisa=_nSisa-500
                CASE _nSisa>=400
                        _Balik=_Balik+"CD"
                        _nSisa=_nSisa-400
                CASE _nSisa>=300
                        _Balik=_Balik+"CCC"
                        _nSisa=_nSisa-300
                CASE _nSisa>=200
                        _Balik=_Balik+"CC"
                        _nSisa=_nSisa-200
                CASE _nSisa>=100
                        _Balik=_Balik+"C"
                        _nSisa=_nSisa-100
                CASE _nSisa>=90
                        _Balik=_Balik+"XC"
                        _nSisa=_nSisa-90
                CASE _nSisa>=80
                        _Balik=_Balik+"LXXX"
                        _nSisa=_nSisa-80
                CASE _nSisa>=70
                        _Balik=_Balik+"LXX"
                        _nSisa=_nSisa-70
                CASE _nSisa>=60
                        _Balik=_Balik+"LX"
                        _nSisa=_nSisa-60
                CASE _nSisa>=50
                        _Balik=_Balik+"L"
                        _nSisa=_nSisa-50
                CASE _nSisa>=40
                        _Balik=_Balik+"XL"
                        _nSisa=_nSisa-40
                CASE _nSisa>=30
                        _Balik=_Balik+"XXX"
                        _nSisa=_nSisa-30
                CASE _nSisa>=20
                        _Balik=_Balik+"XX"
                        _nSisa=_nSisa-20
                CASE _nSisa>=10
                        _Balik=_Balik+"X"
                        _nSisa=_nSisa-10
                OTHERWISE
                        DO CASE
                                CASE _nSisa=9
                                        _Balik=_Balik+"IX"
                                        _nSisa=0
                                CASE _nSisa=8
                                        _Balik=_Balik+"VIII"
                                        _nSisa=0
                                CASE _nSisa=7
                                        _Balik=_Balik+"VII"
                                        _nSisa=0
                                CASE _nSisa=6
                                        _Balik=_Balik+"VI"
                                        _nSisa=0
                                CASE _nSisa=5
                                        _Balik=_Balik+"V"
                                        _nSisa=0
                                CASE _nSisa=4
                                        _Balik=_Balik+"IV"
                                        _nSisa=0
                                CASE _nSisa=3
                                        _Balik=_Balik+"III"
                                        _nSisa=0
                                CASE _nSisa=2
                                        _Balik=_Balik+"II"
                                        _nSisa=0
                                CASE _nSisa=1
                                        _Balik=_Balik+"I"
                                        _nSisa=0
                        ENDCASE
        ENDCASE
ENDDO
RETURN _Balik

Read More

Menentukan Tanggal Awal Minggu dengan Visual Foxpro

Menentukan Tanggal Awal Minggu dengan Visual Foxpro

  05.11    Prometheus

---

&& FUNCTION FirstDateW
&& PARAMETERS _Date,_nDayW
&& _Date adalah tanggal atau string tanggal
&& _nDayW adalah numerik 1'st Day Of Week yang bernilai SET("FDOW")
&& RETURN : Tanggal Awal dari Minggu dimana _Date berada
&& ? FirstDateW()  ===> 17-12-2016 jika sekarang tanggal 17 s/d 24 Desember 2016
&& ? FirstDateW("21-12-2016",0) ===> 17-12-2016
&& ? FirstDateW("21-12-2016",1) ===> 17-12-2016
&& ? FirstDateW("21-12-2016",2) ===> 18-12-2016
&& ? FirstDateW("21-12-2016",2.01) ===> 18-12-2016
&& ? FirstDateW(1,2.01) ===> 18-12-2016 jika sekarang tanggal 17 s/d 24 Desember 2016


FUNCTION FirstDateW
PARAMETERS _Date,_nDayW
IF VARTYPE(_Date)="C"
        _Date=CTOD(_Date)
ENDIF
IF VARTYPE(_Date)<>"C"
        _Date=DATE()
ENDIF
IF VARTYPE(_nDayW)="C"
        _nDayW=VAL(_nDayW)
ENDIF
IF VARTYPE(_nDayW)<>"N" .or. !(_nDayW>=1 .and. _nDayW<=7)
        && Ini terjadi jika _nDayW tak diberikan atau _nDayW<1 atau _nDayW>7
        _nDayW=SET("FDOW")
ENDIF
_nDayW=INT(_nDayW)  && Antisipasi jika PARAMETER _nDayW diberikan pecahan
RETURN _Date-DOW(_Date,_nDayW)

Read More

Memeriksa Kesamaan Struktur 2 File DBF dengan Visual Foxpro

Memeriksa Kesamaan Struktur 2 File DBF dengan Visual Foxpro

  09.29    Prometheus

---

&& FUNCTION ApadbfSama
&& untuk menguji kesamaan struktur 2 workarea
&& Parameter _alias1,_alias2 ==> Alias yang akan dibandingkan
&& Return
&& .T. jika kedua workarea sama strukturnya
&& .F. Jika :
&& - Parameter workarea tak diberikan
&& - kedua workarea tak sama

FUNCTION ApadbfSama
PARAMETERS _alias1,_alias2
IF VARTYPE(_alias1)<>"C" .or. VARTYPE(_alias2)<>"C"
        RETURN .F.
ENDIF
_lenar1=AFIELDS(_ar1,_alias1)
_lenar2=AFIELDS(_ar2,_alias2)
IF VARTYPE(_lenar1)<>"N" .or. VARTYPE(_lenar2)<>"N"
        RETURN .F.
ENDIF
IF _lenar1<>_lenar2
        RETURN .F.
ENDIF
_balik=.T.
FOR _kej=1 TO 18
        FOR _kei=1 TO _lenar1
                IF _ar1(_kei,_kej)<>_ar2(_kei,_kej)
                        _balik=.F.
                        EXIT
                ENDIF
                * ? _ar1(_kei,_kej)
        NEXT

NEXT
RETURN _balik

Read More

Membaca Bilangan Bulat dengan Visual Foxpro

Membaca Bilangan Bulat dengan Visual Foxpro

  10.13    Prometheus

---

&& FUNCTION BacaBilBul untuk membaca Bilangan Bulat tak negatif s/d 999,999,999,999,999
&& Contoh :
&& BacaBilbul(149)  == >  "SERATUS EMPAT PULUH SEMBILAN"
&& Fungsi Terkait : JumlahKata(), KataKeX(), Baca3Digit()

FUNCTION BacaBilBul
PARAMETERS _bil  && _bil wajib bilangan Bulat, MAX 999,999,999,999,999
IF VARTYPE(_bil)<>"N"
        _bil=0
ENDIF
_charbil=IdCur(_bil)
_charbil=STRTRAN(_charbil,"."," ")
xJumKelBil=Jumlahkata(_charbil)
_dibaca=""
DO CASE
        && 999,999,999,999,999
        CASE xJumKelBil=1
                _dibaca=Baca3Digit(_bil)
        CASE xJumKelBil=2
                _kel1=VAL(katakex(_charbil,1))
                _kel2=VAL(katakex(_charbil,2))
                _CikalR=Baca3Digit(_kel1)
                _CikalS=Baca3Digit(_kel2)
                IF _kel1>0
                        IF _kel1=1
                                _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+"SERIBU"
                        ELSE
                                _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+_CikalR+" RIBU"
                        ENDIF
                ENDIF
                IF _kel2>0
                        _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+_CikalS
                ENDIF
        CASE xJumKelBil=3
                _kel1=VAL(katakex(_charbil,1))
                _kel2=VAL(katakex(_charbil,2))
                _kel3=VAL(katakex(_charbil,3))
                _CikalJ=Baca3Digit(_kel1)
                _CikalR=Baca3Digit(_kel2)
                _CikalS=Baca3Digit(_kel3)
                IF _kel1>0
                        _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+_CikalJ+" JUTA"
                ENDIF
                IF _kel2>0
                        IF _kel2=1
                                _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+"SERIBU"
                        ELSE
                                _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+_CikalR+" RIBU"
                        ENDIF
                ENDIF
                IF _kel3>0
                        _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+_CikalS
                ENDIF
        CASE xJumKelBil=4
                _kel1=VAL(katakex(_charbil,1))
                _kel2=VAL(katakex(_charbil,2))
                _kel3=VAL(katakex(_charbil,3))
                _kel4=VAL(katakex(_charbil,4))
                _CikalM=Baca3Digit(_kel1)
                _CikalJ=Baca3Digit(_kel2)
                _CikalR=Baca3Digit(_kel3)
                _CikalS=Baca3Digit(_kel4)
                IF _kel1>0
                        _dibaca=_CikalM+" MILIAR"
                ENDIF
                IF _kel2>0
                        _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+_CikalJ+" JUTA"
                ENDIF
                IF _kel3>0
                        IF _kel3=1
                                _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+"SERIBU"
                        ELSE
                                _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+_CikalR+" RIBU"
                        ENDIF
                ENDIF
                IF _kel4>0
                        _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+_CikalS
                ENDIF
        CASE xJumKelBil=5
                _kel1=VAL(katakex(_charbil,1))
                _kel2=VAL(katakex(_charbil,2))
                _kel3=VAL(katakex(_charbil,3))
                _kel4=VAL(katakex(_charbil,4))
                _kel5=VAL(katakex(_charbil,5))
                _CikalT=Baca3Digit(_kel1)
                _CikalM=Baca3Digit(_kel2)
                _CikalJ=Baca3Digit(_kel3)
                _CikalR=Baca3Digit(_kel4)
                _CikalS=Baca3Digit(_kel5)
                IF _kel1>0
                        _dibaca=_CikalT+" TRILIUN"
                ENDIF
                IF _kel2>0
                        _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+_CikalM+" MILIAR"
                ENDIF
                IF _kel3>0
                        _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+_CikalJ+" JUTA"
                ENDIF
                IF _kel4>0
                        IF _kel4=1
                                _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+"SERIBU"
                        ELSE
                                _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+_CikalR+" RIBU"
                        ENDIF
                ENDIF
                IF _kel5>0
                        _dibaca=_dibaca+IIF(!EMPTY(_dibaca)," ","")+_CikalS
                ENDIF
ENDCASE
RETURN ALLTRIM(_dibaca)

Read More

Membaca 3 Angka dengan Visual Foxpro

Membaca 3 Angka dengan Visual Foxpro

  13.31    Prometheus

---

&& FUNCTION Baca3Digit
&& PARAMETERS _bil ; dimana _bil adalah bilangan bulat positif dari 0 s/d 999
&& Untuk membaca dalam bahasa indonesia dari suatu angka yang terdiri dari 3 digit
&& Contoh :
&& Baca3Digit(999) ===> SEMBILAN RATUS SEMBILAN PULUH SEMBILAN
&& Fungsi bantu : IdCurr(), AngkaDasar()

FUNCTION Baca3Digit
PARAMETERS _bil
IF VARTYPE(_bil)="C"
        _bil=INT(VAL(_bil))
ENDIF
IF VARTYPE(_bil)<"N"
        RETURN ""
ENDIF
_charbil=IdCur(_bil,3)
_Angkake1=SUBSTR(_charbil,1,1)
_Angkake2=SUBSTR(_charbil,2,1)
_Angkake3=SUBSTR(_charbil,3,1)
_Nil1=VAL(_Angkake1)
_Nil2=VAL(_Angkake2)
_Nil3=VAL(_Angkake3)
_balik=""
IF _Nil1>0
        IF _Nil1=1
                _balik="SERATUS"
        ELSE
                _balik=AngkaDasar(_Nil1)+" RATUS"
        ENDIF
ENDIF
DO CASE
        CASE _Nil2=1 .and. _Nil3=0
                _balik=IIF(!EMPTY(_balik),_balik+" SEPULUH","SEPULUH")
        CASE _Nil2=1 .and. _Nil3=1
                _balik=IIF(!EMPTY(_balik),_balik+" SEBELAS","SEBELAS")
        CASE _Nil2=1 .and. _Nil3>1
                _balik=IIF(!EMPTY(_balik),_balik+" "+AngkaDasar(_Nil3)+;

                            "BELAS",AngkaDasar(_Nil3)+" BELAS")
        CASE _Nil2>1 .and. _Nil3=0
                _balik=IIF(!EMPTY(_balik),_balik+" "+AngkaDasar(_Nil2)+" PULUH";

                            ,AngkaDasar(_Nil2)+" PULUH")
        CASE _Nil2>1 .and. _Nil3>0
                _balik=IIF(!EMPTY(_balik),_balik+" "+AngkaDasar(_Nil2)+;

                            " PULUH "+AngkaDasar(_Nil3),AngkaDasar(_Nil2)+;

                            " PULUH "+AngkaDasar(_Nil3))
        CASE _Nil2=0 .and. _Nil3>0
                _balik=IIF(!EMPTY(_balik),_balik+" "+AngkaDasar(_Nil3),AngkaDasar(_Nil3))
        CASE _Nil2=0 .and. _Nil3=0
                _balik=IIF(!EMPTY(_balik),_balik,"NOL")
ENDCASE
RETURN _balik

Read More

Pembulatan Angka ke Nilai Satuan Terkecil dengan Visual Foxpro

Pembulatan Angka ke Nilai Satuan Terkecil dengan Visual Foxpro

  14.55    Prometheus

---

&& FUNCTION RoundRp
&& PARAMETERS _Nilaim,_LeastBit
&& _Nilai adalah angka yang akan dibulatkan
&& _LeastBit adalah satuan terkecil yang ada
&& Pada tahun 2019, pecahan di bawah Rp. 500,- sangat sulit
&& Oleh karena itu disarankan dibulatkan ke 500 rupiah terdekat
&& Tanpa pembulatan semacam ini transaksi akan menjadi "Semu"
&& Contoh : Toko harus mengembalikan Rp. 200,- 
&& padahal uang ratusan dan duaratusan sudah tak ada
&& Contoh :
&& RoundRp(13.25,1) ==> 14
&& RoundRp(13.25) ==> 14
&& RoundRp(13.25,500) ==> 500
&& RoundRp("1300.57","1000") ==> 2000

FUNCTION RoundRp
PARAMETERS _Nilai,_LeastBit
IF VARTYPE(_LeastBit)="C"
_LeastBit=VAL(_LeastBit)
ENDIF
IF VARTYPE(_LeastBit)<>"N"
_LeastBit=1
ENDIF
IF VARTYPE(_Nilai)="C"
_Nilai=VAL(_Nilai)
ENDIF
IF VARTYPE(_Nilai)<>"N"
RETURN 0
ENDIF
IF _Nilai=0
RETURN 0
ENDIF
_revert=.F.
IF _Nilai<0
_Nilai=-1*_Nilai
_revert=.T.
ENDIF
_NonDec=INT(_Nilai/_LeastBit)*_LeastBit
_Dec=_Nilai-_NonDec
DO CASE
CASE _Nilai<_LeastBit
_Balik=_LeastBit
CASE _Dec*_LeastBit<=(0.5*_LeastBit)
_Balik=_NonDec
OTHERWISE
_Balik=_NonDec+_LeastBit
ENDCASE
RETURN IIF(_revert,-1*_Balik,_Balik)

Read More

Menampilkan Angka Dalam Format Rupiah dengan Visual Foxpro

Menampilkan Angka Dalam Format Rupiah dengan Visual Foxpro

  13.22    Prometheus

---

&& FUNCTION IdCur
&& PARAMETERS _Num,_Len,_Des
&& Fungsi untuk menampilkan angka dalam mata uang rupiah
&& _num adalah angka yang akan ditampilkan
&& _Len adalah panjang tampilan yang diinginkan
&& _Des adalah logika penampilan desimal, defaul False
&& Nilai return : String
&& Contoh :
&& ? IdCur(15000,11)
&& ? IdCur(15000,9,.t.) ==> 15.000,00
&& ? IdCur(15000,9,.f.) ==>    15.000
&& ? IdCur(15000,9) ==>    15.000
&& ? IdCur(15000,5) ==>  **.***
&& Hasil 15.000,00 sepanjang 11 karakter

FUNCTION IdCur
PARAMETERS _Num,_Len,_Des
IF VARTYPE(_Num)<>"N"
        _Num=0
ENDIF
IF VARTYPE(_Des)<>"L"
        _Des=.F.
ENDIF
_String=ALLTRIM(TRANSFORM(_Num,"999,999,999,999,999,999.99"))
_String1=LEFT(_String,AT(".",_String)-1)
_String2=substr(_String,AT(".",_String)+1)
IF AT(",",_String1)<=0
        _String1=_String1
ELSE
        _String1=STRTRAN(_String1,",",".")
ENDIF
_String=IIF(_Des,_String1+","+_String2,_String1)
IF VARTYPE(_Len)<>"N"
        _Len=LEN(_String)
ENDIF
IF _Len>=26
        _Len=26
ENDIF
IF _Len<LEN(_String)
        _String0=""
        FOR xkei=1 TO LEN(_String)
                IF SUBSTR(_String,xkei,1)="," .OR. SUBSTR(_String,xkei,1)="."
                        _String0=_String0+SUBSTR(_String,xkei,1)
                ELSE
                        _String0=_String0+"*"
                ENDIF
        NEXT
        _String=_String0
ELSE
        _String=PADL(_String,_len,CHR(32))
ENDIF
RETURN _String

Read More