Source Code VB6 Penerapan Algoritma Fuzzy C-Means - Hallo sahabat pemerogaman, Pada kesempatan kali ini admin pemerogaman akan sharing yang berjudul Source Code VB6 Penerapan Algoritma Fuzzy C-Means, saya telah menyediakan artikel yang cocok untuk belajar para progamer. mudah-mudahan isi postingan pemerogaman yang saya tulis ini dapat anda pahami. okelah, ini dia artikel pemerogamannya.

Judul Artikel : Source Code VB6 Penerapan Algoritma Fuzzy C-Means
Artikel : Source Code VB6 Penerapan Algoritma Fuzzy C-Means

Source Code VB6 Penerapan Algoritma Fuzzy C-Means

Source Code VB6 Penerapan Fuzzy C-Means - Hasil analisa penulis selaku pembuat skripsi mahasiswa menyatakan tidak ada yang berani memposting code program penerapan fuzzy c-means ke dalam artikel, hal demikian penulis tidak dapat mengetahui penyebabnya. Untuk itu pada artikel kali ini penulis ingin berbagi cara penerapan logika algoritma fuzzy c-means ke dalam code visual basic 6.0.

Sebelumnya berikut tampilan hasil yang penulis buat:

Tampilan Hasil

Dan Berikut Code Program yang ada pada form diatas:


'////   Pembentukan Fuzzy  C-means   /////
Sub FUZZYCMEANS()
Dim i As Integer
Dim baris As Integer
Call BukaDatabase
    tabel.Clear
    tabel.Rows = 2
    tabel.Cols = 13
    tabel.FixedRows = 1
    baris = 0
    tabel.TextMatrix(0, 0) = "Kode Calon"
    tabel.TextMatrix(0, 1) = "Nama"
    tabel.TextMatrix(0, 2) = "Jenis Kelamin"
    tabel.TextMatrix(0, 3) = "Tempat Lahir"
    tabel.TextMatrix(0, 4) = "Tanggal Lahir"
    tabel.TextMatrix(0, 5) = "Alamat"
    tabel.TextMatrix(0, 6) = "Pendidikan Akhir (K1)"
    tabel.TextMatrix(0, 7) = "Agama"
    tabel.TextMatrix(0, 8) = "NoTelepon"
    tabel.TextMatrix(0, 9) = "Pengalaman (K2)"
    tabel.TextMatrix(0, 10) = "Kesehatan (K3)"
    tabel.ColWidth(0) = 1000
    tabel.ColWidth(1) = 2000
    tabel.TextMatrix(0, 11) = "Warga Negara"
    tabel.TextMatrix(0, 12) = "Nilai Test (K4)"
    tabel.ColWidth(2) = 1500
    tabel.ColWidth(3) = 1500
    tabel.ColWidth(4) = 1500
    tabel.ColWidth(5) = 1500
    tabel.ColWidth(6) = 2000
    tabel.ColWidth(7) = 1500
    tabel.ColWidth(8) = 1800
    tabel.ColWidth(9) = 1800
    tabel.ColWidth(10) = 1800
    tabel.ColWidth(11) = 1800
    tabel.ColWidth(12) = 2000
For i = Val(NilaiTest.Text) To Val(TTOT.Text)
            Set RSREKAP = New ADODB.Recordset
            RSREKAP.Open " Select * from REKAP " & " Where NILTES='" _
            & i & "'" _
            , KONEKSI, adOpenDynamic, adLockBatchOptimistic
            Do While Not RSREKAP.EOF
            On Error Resume Next
                    baris = baris + 1
                    tabel.Rows = baris + 1
                    tabel.TextMatrix(baris, 0) = RSREKAP!KdCalon
                    tabel.TextMatrix(baris, 1) = RSREKAP!Nama
                    tabel.TextMatrix(baris, 2) = RSREKAP!JenisKelamin
                    tabel.TextMatrix(baris, 3) = RSREKAP!TempatLahir
                    tabel.TextMatrix(baris, 4) = RSREKAP!TanggalLahir
                    tabel.TextMatrix(baris, 5) = RSREKAP!Alamat
                    tabel.TextMatrix(baris, 6) = RSREKAP!PendidikanAkhir
                    tabel.TextMatrix(baris, 7) = RSREKAP!Agama
                    tabel.TextMatrix(baris, 8) = RSREKAP!NoTelepon
                    tabel.TextMatrix(baris, 9) = RSREKAP!Pengalaman
                    tabel.TextMatrix(baris, 10) = RSREKAP!Kesehatan
                    tabel.TextMatrix(baris, 11) = RSREKAP!WNI
                    tabel.TextMatrix(baris, 12) = RSREKAP!NILTES
                    RTBKET.SelRTF = tabel.TextMatrix(baris, 6) & vbTab & tabel.TextMatrix(baris, 9) & vbTab & vbTab & vbTab & tabel.TextMatrix(baris, 10) & vbTab & vbTab & tabel.TextMatrix(baris, 12) & vbCrLf
                    RSREKAP.MoveNext
            Loop
Next i
End Sub
' /// Menentukan nilai akir nilai tes   ///
Sub MKCalon()
Dim i As Integer
Dim vntgjl As Variant
Dim vnDummy As Variant
Call BukaDatabase
RSCalon.Requery
Set RSCalon = New ADODB.Recordset
RSCalon.Open "Select * From Calon order by NILTES", _
KONEKSI, adOpenDynamic, adLockBatchOptimistic
   Do While Not RSCalon.EOF
      vntgjl = RSCalon!NILTES
      If IsNull(vntgjl) Then vntgjl = ""
      TTOT.Text = CStr(vntgjl)
      RSCalon.MoveNext
   Loop
End Sub

Sub MKREKAP()
Dim i As Integer
Dim vntgjl As Variant
Dim vnDummy As Variant
Call BukaDatabase
List2.Clear
RSREKAP.Requery
Set RSREKAP = New ADODB.Recordset
RSREKAP.Open "Select * From REKAP order by NILTES", _
KONEKSI, adOpenDynamic, adLockBatchOptimistic
   Do While Not RSREKAP.EOF
      vntgjl = RSREKAP!NILTES
      If IsNull(vntgjl) Then vntgjl = ""
      List2.AddItem CStr(vntgjl)
      List2.Text = CStr(vntgjl)
      RSREKAP.MoveNext
   Loop
End Sub
'///    Membuat Keterangan Pada Form    ///
Sub KETERANGAN()
MGrs = String$(120, "-")
RTBKET.SelRTF = "Jumlah Cluster" & " = " & "4" & " : " & vbCrLf
RTBKET.SelRTF = "Jumlah Kebutuhan" & " = " & Val(Text2.Text) & vbCrLf
RTBKET.SelRTF = "Kategori Pengelompokan" & " :" & vbCrLf
RTBKET.SelRTF = "Cluster 1" & vbTab & " = " & "Pendidikan Terakhir" & vbCrLf
RTBKET.SelRTF = "Cluster 2" & vbTab & " = " & "Pengalaman" & vbCrLf
RTBKET.SelRTF = "Cluster 3" & vbTab & " = " & "Kesehatan" & vbCrLf
RTBKET.SelRTF = "Cluster 4" & vbTab & " = " & "Nlai Test" & vbCrLf
RTBKET.SelRTF = "Hasil Pengelompokan Berdasarkan Cluster 1 - 4" & vbTab & vbCrLf & MGrs & vbCrLf
RTBKET.SelRTF = "C1" & vbTab & "C2" & vbTab & vbTab & vbTab & "C3" & vbTab & vbTab & "C4" & vbTab & vbCrLf & MGrs & vbCrLf
End Sub

Sub SIMPANCMEANS()
        SqlInsert = "INSERT INTO CMeans " _
        & " (KdCalon,Nama,JenisKelamin,TempatLahir,TanggalLahir,Alamat,PendidikanAkhir,Agama,NoTelepon,Pengalaman,Kesehatan,WNI,NILTES)" _
        & " VALUES('" _
        & tabel.TextMatrix(baris, 0) & "','" _
        & tabel.TextMatrix(baris, 1) & "','" _
        & tabel.TextMatrix(baris, 2) & "','" _
        & tabel.TextMatrix(baris, 3) & "','" _
        & tabel.TextMatrix(baris, 4) & "','" _
        & tabel.TextMatrix(baris, 5) & "','" _
        & tabel.TextMatrix(baris, 6) & "','" _
        & tabel.TextMatrix(baris, 7) & "','" _
        & tabel.TextMatrix(baris, 8) & "','" _
        & tabel.TextMatrix(baris, 9) & "','" _
        & tabel.TextMatrix(baris, 10) & "','" _
        & tabel.TextMatrix(baris, 11) & "','" _
        & tabel.TextMatrix(baris, 12) & "')"
        KONEKSI.Execute SqlInsert, , adCmdText
        RSCMeans.Requery
End Sub
Private Sub CKeluar_Click()
Unload Me
End Sub
Sub HPSDATA()
SqlDelete = "DELETE FROM REKAP WHERE NILTES"
KONEKSI.Execute SqlDelete, , adCmdText
RSREKAP.Requery
End Sub

Sub PROSESPEMBATASANDATA()
Dim i As Integer
'List4.Clear
For i = 0 To LISTTDAKDIBUTUHKAN.ListCount - 1
Set RSREKAP = New ADODB.Recordset
RSREKAP.Open " Select * from REKAP " & " Where NILTES ='" _
& LISTTDAKDIBUTUHKAN.List(i) & "'" _
, KONEKSI, adOpenDynamic, adLockBatchOptimistic
Do While Not RSREKAP.EOF
On Error Resume Next
Text1.Text = RSREKAP!KdCalon
RSREKAP.MoveNext
Loop
    SqlDelete = "DELETE FROM REKAP WHERE  " _
    & " KdCalon='" & Text1.Text & "'"
    KONEKSI.Execute SqlDelete, , adCmdText
    RSREKAP.Requery
Next i
FUZZYCMEANS
End Sub

Sub TAHAPPERTAMA()
Dim i As Integer
On Error GoTo redam
LISTTDAKDIBUTUHKAN.Clear
ALLREKAPNILAI.Selected(i) = False
TSREKAP.Text = Val(TALLSREKAP.Text) - Val(Text2.Text)
For i = 0 To Val(TSREKAP.Text) - 1
        ALLREKAPNILAI.Selected(i) = True
        LISTTDAKDIBUTUHKAN.AddItem ALLREKAPNILAI.List(i)
        LISTTDAKDIBUTUHKAN.Selected(i) = True
Next i
PROSESPEMBATASANDATA
redam:
End Sub

Private Sub CProses_Click()
Dim i As Integer
Dim a As Integer
Dim K As Integer
Dim P As Integer
Dim baris As Integer
Me.MousePointer = vbHourglass
HPSDATA
RTBKET.TextRTF = ""
T1.Text = PendidikanAkhir.ListIndex
T2.Text = PendidikanAkhir.ListCount - 1
PI.Text = Pengalaman.ListIndex
PC.Text = Pengalaman.ListCount - 1
KK1.Text = Kesehatan.ListIndex
KK2.Text = Kesehatan.ListCount - 1
Call KETERANGAN
Call BukaDatabase
    tabel.Clear
    tabel.Rows = 2
    tabel.Cols = 13
    tabel.FixedRows = 1
    baris = 0
    tabel.TextMatrix(0, 0) = "Kode Calon"
    tabel.TextMatrix(0, 1) = "Nama"
    tabel.TextMatrix(0, 2) = "Jenis Kelamin"
    tabel.TextMatrix(0, 3) = "Tempat Lahir"
    tabel.TextMatrix(0, 4) = "Tanggal Lahir"
    tabel.TextMatrix(0, 5) = "Alamat"
    tabel.TextMatrix(0, 6) = "Pendidikan Akhir (K1)"
    tabel.TextMatrix(0, 7) = "Agama"
    tabel.TextMatrix(0, 8) = "NoTelepon"
    tabel.TextMatrix(0, 9) = "Pengalaman (K2)"
    tabel.TextMatrix(0, 10) = "Kesehatan (K3)"
    tabel.TextMatrix(0, 11) = "Warga Negara"
    tabel.TextMatrix(0, 12) = "Nilai Test (K4)"
    tabel.ColWidth(0) = 1000
    tabel.ColWidth(1) = 2000
    tabel.ColWidth(2) = 1500
    tabel.ColWidth(3) = 1500
    tabel.ColWidth(4) = 1500
    tabel.ColWidth(5) = 1500
    tabel.ColWidth(6) = 2000
    tabel.ColWidth(7) = 1500
    tabel.ColWidth(8) = 1800
    tabel.ColWidth(9) = 1800
    tabel.ColWidth(10) = 1800
    tabel.ColWidth(11) = 1800
    tabel.ColWidth(12) = 2000
ALLREKAPNILAI.Clear
For a = T1.Text To T2.Text
    For K = KK1.Text To KK2.Text
        For P = PI.Text To PC.Text
            For i = Val(NilaiTest.Text) To Val(TTOT.Text)
            Set RSCalon = New ADODB.Recordset
            RSCalon.Open " Select * from Calon " & " Where PendidikanAkhir  & Pengalaman & Kesehatan & NILTES='" _
            & PendidikanAkhir.List(a) & Pengalaman.List(P) & Kesehatan.List(K) & i & "'" _
            , KONEKSI, adOpenDynamic, adLockBatchOptimistic
                Do While Not RSCalon.EOF
                    On Error Resume Next
                    baris = baris + 1
                    tabel.Rows = baris + 1
                    tabel.TextMatrix(baris, 0) = RSCalon!KdCalon
                    tabel.TextMatrix(baris, 1) = RSCalon!Nama
                    tabel.TextMatrix(baris, 2) = RSCalon!JenisKelamin
                    tabel.TextMatrix(baris, 3) = RSCalon!TempatLahir
                    tabel.TextMatrix(baris, 4) = RSCalon!TanggalLahir
                    tabel.TextMatrix(baris, 5) = RSCalon!Alamat
                    tabel.TextMatrix(baris, 6) = RSCalon!PendidikanAkhir
                    tabel.TextMatrix(baris, 7) = RSCalon!Agama
                    tabel.TextMatrix(baris, 8) = RSCalon!NoTelepon
                    tabel.TextMatrix(baris, 9) = RSCalon!Pengalaman
                    tabel.TextMatrix(baris, 10) = RSCalon!Kesehatan
                    tabel.TextMatrix(baris, 11) = RSCalon!WNI
                    tabel.TextMatrix(baris, 12) = RSCalon!NILTES
                    ALLREKAPNILAI.AddItem RSCalon!NILTES
                    RSCalon.MoveNext
                        SqlInsert = "INSERT INTO REKAP " _
                        & " (KdCalon,Nama,JenisKelamin,TempatLahir,TanggalLahir,Alamat,PendidikanAkhir,Agama,NoTelepon,Pengalaman,Kesehatan,WNI,NILTES)" _
                        & " VALUES('" _
                        & tabel.TextMatrix(baris, 0) & "','" _
                        & tabel.TextMatrix(baris, 1) & "','" _
                        & tabel.TextMatrix(baris, 2) & "','" _
                        & tabel.TextMatrix(baris, 3) & "','" _
                        & tabel.TextMatrix(baris, 4) & "','" _
                        & tabel.TextMatrix(baris, 5) & "','" _
                        & tabel.TextMatrix(baris, 6) & "','" _
                        & tabel.TextMatrix(baris, 7) & "','" _
                        & tabel.TextMatrix(baris, 8) & "','" _
                        & tabel.TextMatrix(baris, 9) & "','" _
                        & tabel.TextMatrix(baris, 10) & "','" _
                        & tabel.TextMatrix(baris, 11) & "','" _
                        & tabel.TextMatrix(baris, 12) & "')"
                        KONEKSI.Execute SqlInsert, , adCmdText
                        RSREKAP.Requery
                        TALLSREKAP.Text = ALLREKAPNILAI.ListCount
                Loop
            Next i
        Next P
    Next K
Next a
Call MKCalon
Call TAHAPPERTAMA
Me.MousePointer = vbDefault
End Sub
Private Sub Form_Load()
MKCalon
FMU.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
FMU.Enabled = True
End Sub

Private Sub Text2_Change()
If Val(Text2.Text) <= 0 Then
Text2.Text = ""
End If
End Sub

Aplikasi ini berjalan jika dibatuh dengan database, artikel ini hanya berisi pada bagian fuzzy  c-means. jika anda seorang programer, tentu anda dapat menggunakan coding di atas, tapi jika anda belum paham, anda dapat menghubungi penulis. terima kasih.

Demikianlah Artikel Source Code VB6 Penerapan Algoritma Fuzzy C-Means

Sekian Artikel pemerogaman Source Code VB6 Penerapan Algoritma Fuzzy C-Means, mudah-mudahan bisa memberi manfaat untuk anda semua. baiklah, sekian postingan pemerogaman kali ini.

Anda sedang membaca artikel Source Code VB6 Penerapan Algoritma Fuzzy C-Means dan artikel ini url permalinknya adalah http://pemerogaman.blogspot.com/2016/09/source-code-vb6-penerapan-algoritma.html Semoga artikel ini bisa bermanfaat.

Tweet