Fungsi-Fungsi Matematika
3 posters
Halaman 1 dari 1
Fungsi-Fungsi Matematika
Deklarasikan di module Class!
- Code:
Option Explicit
Private i As Integer
Private mValue As Double
'Fungsi Penjumlahan
Function Sum(ParamArray Angka()) As Double
mValue = 0
For i = 0 To UBound(Angka)
mValue = mValue + Angka(i)
Next
Sum = mValue
End Function
'Fungsi Rata-rata
Function Average(ParamArray Angka()) As Double
mValue = 0
For i = 0 To UBound(Angka)
mValue = mValue + Angka(i)
Next
Average = mValue / i
End Function
'Funsi Perkalian
Function Multiply(ParamArray Angka()) As Double
mValue = 1
For i = 0 To UBound(Angka)
mValue = mValue * Angka(i)
Next
Multiply = mValue
End Function
'Konversi Binear ke Desimal
Function BinearToDecimal(Nilai) As Long
Dim intLen As Integer
mValue = 0
intLen = Len(CStr(Nilai))
For i = 1 To intLen
mValue = mValue + CLng(Mid(Nilai, i, 1)) * _
(2 ^ (intLen - i))
Next
'
BinearToDecimal = mValue
End Function
'Konversi Desimal ke Basis
Function Basis(IntAngka%, intBasis%) As String
Dim intNilai&
Dim intLen%
Dim strHasil$, strHexa$, strEnd$, strSub$
Do
intNilai = IntAngka Mod intBasis
IntAngka = IntAngka \ intBasis
Select Case intNilai
Case 10: strHexa = "A"
Case 11: strHexa = "B"
Case 12: strHexa = "C"
Case 13: strHexa = "D"
Case 14: strHexa = "E"
Case 15: strHexa = "F"
Case Else:
strHexa = CStr(intNilai)
End Select
strHasil = strHasil + strHexa
Loop Until IntAngka < intBasis
intLen = Len(strHasil)
strEnd = CStr(IntAngka)
For i = intLen To 1 Step -1
strSub = strSub + Mid(strHasil, i, 1)
Next
If (Mid(strEnd + strSub, 1, 1)) = "0" Then
Basis = Mid(strEnd + strSub, _
2, Len(strEnd + strSub) - 1)
Else
Basis = strEnd + strSub
End If
End Function
'Konversi Desimal ke Romawi
Function Roman(IntAngka As Integer) As String
Dim IntSeribu%, IntLimaRatus%
Dim IntSeratus%, IntLimaPuluh%
Dim IntSepuluh%, IntLima%, IntSatu%
Dim StrSeribu$, StrLimaRatus$
Dim StrSeratus$, StrLimaPuluh$
Dim StrSepuluh$, StrLima$, StrSatu$
Dim StrRomawi$
IntSatu = IntAngka
IntSeribu = IntAngka \ 1000
IntSatu = IntAngka Mod 1000
IntLimaRatus = IntSatu \ 500
IntSatu = IntAngka Mod 500
IntSeratus = IntSatu \ 100
IntSatu = IntAngka Mod 100
IntLimaPuluh = IntSatu \ 50
IntSatu = IntAngka Mod 50
IntSepuluh = IntSatu \ 10
IntSatu = IntAngka Mod 10
IntLima = IntSatu \ 5
IntSatu = IntAngka Mod 5
For i = 0 To IntSeribu - 1
StrSeribu = StrSeribu + "M"
Next
If IntSeratus <> 4 Then
For i = 0 To IntLimaRatus - 1
StrLimaRatus = StrLimaRatus + "D"
Next
End If
For i = 0 To IntSeratus - 1
StrSeratus = StrSeratus + "C"
Next
If IntSeratus = 4 Then
If IntLimaRatus = 1 Then
StrSeratus = StrRomawi + "CM"
Else
StrSeratus = StrRomawi + "CD"
End If
End If
If IntSepuluh <> 4 Then
For i = 0 To IntLimaPuluh - 1
StrLimaPuluh = StrLimaPuluh + "L"
Next
End If
For i = 0 To IntSepuluh - 1
StrSepuluh = StrSepuluh + "X"
Next
If IntSepuluh = 4 Then
If IntLimaPuluh = 1 Then
StrSepuluh = StrRomawi + "XC"
Else
StrSepuluh = StrRomawi + "XL"
End If
End If
If IntSatu <> 4 Then
For i = 0 To IntLima - 1
StrLima = StrLima + "V"
Next
End If
For i = 0 To IntSatu - 1
StrSatu = StrSatu + "I"
Next
If IntSatu = 4 Then
If IntLima = 1 Then
StrSatu = StrRomawi + "IX"
Else
StrSatu = StrRomawi + "IV"
End If
End If
StrRomawi = StrSeribu + StrLimaRatus _
+ StrSeratus + StrLimaPuluh _
+ StrSepuluh + StrLima + StrSatu
Roman = StrRomawi
End Function
'Fungsi mencari nilai maksimum dengan
'menggunakan parameter input berupa array
Function NilaiMax1(ParamArray Nilai()) As Double
Dim i As Long
Dim nMax As Double
Dim nTemp As Double
For i = LBound(Nilai) To UBound(Nilai)
nMax = Nilai(i)
If nTemp > nMax Then
nMax = nTemp
End If
nTemp = nMax
Next
NilaiMax1 = nMax
End Function
'Fungsi mencari nilai maksimum dengan
'menggunakan parameter input berupa daftar deret
Function NilaiMax2(DeretAngka$) As Double
Dim i As Long
Dim nMax As Double
Dim nTemp As Double
Dim Pisah() As String
Pisah = Split(DeretAngka$, ";")
For i = LBound(Pisah) To UBound(Pisah)
nMax = Val(Pisah(i))
If nTemp > nMax Then
nMax = nTemp
End If
nTemp = nMax
Next
NilaiMax2 = nMax
End Function
'Fungsi mencari nilai minimum dengan
'menggunakan parameter input berupa array
Function NilaiMin1(ParamArray Nilai()) As Double
Dim i As Long
Dim nMin As Double
Dim nTemp As Double
nTemp = 1
For i = LBound(Nilai) To UBound(Nilai)
nMin = Nilai(i)
If nTemp < nMin Then
nMin = nTemp
End If
nTemp = nMin
Next
NilaiMin1 = nMin
End Function
'Fungsi mencari nilai minimum dengan
'menggunakan parameter input berupa daftar deret
Function NilaiMin2(DeretAngka$) As Double
Dim i As Long
Dim nMin As Double
Dim nTemp As Double
Dim Pisah() As String
Pisah = Split(DeretAngka$, ";")
nTemp = 1
For i = LBound(Pisah) To UBound(Pisah)
nMin = Val(Pisah(i))
If nTemp < nMin Then
nMin = nTemp
End If
nTemp = nMin
Next
NilaiMin2 = nMin
End Function
Private Sub Class_Initialize()
mValue = 0
End Sub
Re: Fungsi-Fungsi Matematika
Keren...
flack- Lahir
- Jumlah posting : 5
Join date : 27.10.08
Age : 34
Lokasi : Sidoarjo
Re: Fungsi-Fungsi Matematika
flack wrote:Keren...
Siapa nih???? jangan2 Kloningnya yang di Forum sebelah...
Re: Fungsi-Fungsi Matematika
Sebelum ada yang minta, saya kasih tau duluan ya....
"Untuk saat ini forum sudah menutup pendaftaran sebagai moderator"
"Untuk saat ini forum sudah menutup pendaftaran sebagai moderator"
Re: Fungsi-Fungsi Matematika
moderator itu apa ya om.. ?
flack- Lahir
- Jumlah posting : 5
Join date : 27.10.08
Age : 34
Lokasi : Sidoarjo
Similar topics
» Fungsi-Fungsi pada Pemograman Pascal
» Prosedur dan Fungsi General pada Pascal
» Fungsi "Terbilang" dengan VB dan Pascal
» Prosedur dan Fungsi General pada Pascal
» Fungsi "Terbilang" dengan VB dan Pascal
Halaman 1 dari 1
Permissions in this forum:
Anda tidak dapat menjawab topik
|
|