Source Code Game Tic Tac Toe Pada VB.Net

Selamat siang ,hari ini saya akan mengposting tentang cara membuat game tic tac toe di VB.Net
Kali ini saya menggunakan button create on the fly
Berikut Codingannya :
Public Class Form1
    'true -> giliran player 1 X
    'false -> giliran player 2 O
    Dim flag As Boolean = True
    Function cekbutton(btna As Button, btnb As Button, btnc As Button) As Integer
        Dim menang As Integer = 0
        If (btna.Text = btnb.Text) And (btnb.Text = btnc.Text) Then
            If btna.Text = "X" Then
                menang = 1
            ElseIf btna.Text = "O" Then
                menang = 2
            End If
        End If
        Return menang
    End Function
    Sub cekmenang()
        '0 -> blm ad yang menang
        '1 -> player 1 yg menang
        '2 -> player 2 yang menang
        Dim menang As Integer = 0
        Dim temp As Integer
        'Horizontal

        'temp = cekbutton(Button1, Button2, Button3)
        'If temp = 1 Then
        '    menang = 1
        'ElseIf temp = 2 Then
        '    menang = 2
        'End If
       
        If (Button1.Text = Button2.Text) And (Button2.Text = Button3.Text) Then
            If Button1.Text = "X" Then
                menang = 1
            ElseIf Button1.Text = "O" Then
                menang = 2
            End If
        End If

        If (Button4.Text = Button5.Text) And (Button5.Text = Button6.Text) Then
            If Button4.Text = "X" Then
                menang = 1
            ElseIf Button4.Text = "O" Then
                menang = 2
            End If
        End If

        If (Button7.Text = Button8.Text) And (Button8.Text = Button9.Text) Then
            If Button7.Text = "X" Then
                menang = 1
            ElseIf Button7.Text = "O" Then
                menang = 2
            End If
        End If
        'Vertikal
        If (Button1.Text = Button4.Text) And (Button4.Text = Button7.Text) Then
            If Button1.Text = "X" Then
                menang = 1
            ElseIf Button1.Text = "O" Then
                menang = 2
            End If
        End If

        If (Button2.Text = Button5.Text) And (Button5.Text = Button8.Text) Then
            If Button2.Text = "X" Then
                menang = 1
            ElseIf Button2.Text = "O" Then
                menang = 2
            End If
        End If
        If (Button3.Text = Button6.Text) And (Button6.Text = Button9.Text) Then
            If Button3.Text = "X" Then
                menang = 1
            ElseIf Button3.Text = "O" Then
                menang = 2
            End If
        End If
        'Diagonal
        If (Button1.Text = Button5.Text) And (Button5.Text = Button9.Text) Then
            If Button1.Text = "X" Then
                menang = 1
            ElseIf Button1.Text = "O" Then
                menang = 2
            End If
        End If
        If (Button3.Text = Button5.Text) And (Button5.Text = Button7.Text) Then
            If Button3.Text = "X" Then
                menang = 1
            ElseIf Button3.Text = "O" Then
                menang = 2
            End If
        End If
        If menang = 1 Then
            Label1.Text = "Player 1 Menang"
        ElseIf menang = 2 Then
            Label1.Text = "Player 2 Menang"
        End If
    End Sub
    Sub cekdraw()
        'memeriksa apakah draw/stalemate
        Dim temp As Boolean = True 'draw
        If Button1.Text = "" Then
            temp = False
        End If
        If Button2.Text = "" Then
            temp = False
        End If
        If Button3.Text = "" Then
            temp = False
        End If
        If Button4.Text = "" Then
            temp = False
        End If
        If Button5.Text = "" Then
            temp = False
        End If
        If Button6.Text = "" Then
            temp = False
        End If
        If Button7.Text = "" Then
            temp = False
        End If
        If Button8.Text = "" Then
            temp = False
        End If
        If Button9.Text = "" Then
            temp = False
        End If
        If temp Then
            Label1.Text = "Game Over"
        End If


    End Sub
    Private Sub Cekflag()
        If flag = True Then
            Label1.Text = "Player 1 Turn"
        Else
            Label1.Text = "Player 2 Turn"
        End If
    End Sub
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        flag = True
        Call Cekflag()
    End Sub
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click, Button9.Click, Button8.Click, Button7.Click, Button6.Click, Button5.Click, Button4.Click, Button3.Click, Button2.Click
        Dim a As Button = CType(sender, Button)
        If a.Text = "" Then
            'masih kosong
            'if flag = true then
            If flag Then 'artinya turn player 1
                a.Text = "X"
            Else 'artinya turn player 2
                a.Text = "O"
            End If
            flag = Not flag
            Call Cekflag()
            Call cekdraw()
            Call cekmenang()

        Else
            MsgBox("Kotak Sdh Ad Isinya !!!")
        End If
    End Sub
End Class

Screenshot :



 

Source Code Program Untuk Menyimpan Data Mahasiswa Utk VBScript

Berikut Source Codenya : 
<HTML>
<meta http-equiv="x-ua-compatible" content="IE=10">
<body>
<H3>
<HR>
<script language = "vbs">
    indeks_x = 0
   
    do until pilih = 8
        pilih = cint(inputbox("1. Input Nilai" & vbcrlf & "2. Hapus Nilai"_
        & vbcrlf & "3. Tampilkan Nilai" & vbcrlf & "4. Geser Nilai" &_
        vbcrlf & "5. Palindrom" & vbcrlf & "6. Pengelompokkan Nilai" &_
        vbcrlf & "7. Acak Nilai" & vbcrlf & "8. Exit"))
       
        if pilih = 1 then
            indeks_x = indeks_x + 1
            redim preserve x(indeks_x)
            x(indeks_x) = cint(inputbox("Nilai Mahasiswa : "))
        elseif pilih = 2 then
            indeks_y = 0
            indeks_hapus = cint(inputbox("Indeks Angka Yang Dihapus : "))
            redim y(indeks_x-1)
            for i = 1 to indeks_x
                if i <> indeks_hapus then
                    indeks_y = indeks_y + 1
                    y(indeks_y) = x(i)
                end if
            next
            indeks_x = indeks_x - 1
            redim x(indeks_x)
            for i = 1 to indeks_x
                x(i) = y(i)
            next
        elseif pilih = 3 then
            for i = 1 to indeks_x
                document.write x(i) & "<br>"
            next
            document.write "----------------<br>"
        elseif pilih = 4 then
            geser = cint(inputbox("Index Pergeseran : "))
            redim y(indeks_x)
            if geser > 0 then
                do while geser > 0
                    indeks = 2
                    y(1) = x(indeks_x)
                    for i = 1 to indeks_x-1
                        y(indeks) = x(i)
                        indeks = indeks + 1
                    next
                    for i = 1 to indeks_x
                        x(i) = y(i)
                    next
                    geser = geser - 1
                loop
            else
                geserplus = abs(geser)
                do while geserplus > 0
                    indeks = 1
                    for i = 2 to indeks_x
                        y(indeks) = x(i)
                        indeks = indeks + 1
                    next
                    y(indeks_x) = x(1)
                    for i = 1 to indeks_x
                        x(i) = y(i)
                    next
                    geserplus = geserplus - 1
                loop
            end if
        elseif pilih = 5 then
            sama = 0
            indeks = indeks_x
            for i = 1 to indeks_x
                if x(i) = x(indeks) then
                    sama = sama + 1
                end if
                indeks = indeks - 1
            next
            if sama = indeks_x then
                document.write "Palindrom<br>"
            else
                document.write "Bukan Palindrom<br>"
            end if
        elseif pilih = 6 then
            redim y(indeks_x)
            indeks = 1
            minimum = 0
            'PROSES SORTING !!!!!!!!!!
            for i = 1 to indeks_x
                minimum = i
                for j = i+1 to indeks_x
                    if x(j) < x(minimum) then
                        minimum = j
                    end if
                next
               
                if minimum <> i then
                    temp = x(minimum)
                    x(minimum) = x(i)
                    x(i) = temp
                end if
            next
            'PROSES GANJIL GENAP
            for i = 1 to indeks_x
                if x(i) mod 2 = 0 then
                    y(indeks) = x(i)
                    indeks = indeks + 1
                end if
            next
            for i = 1 to indeks_x
                if x(i) mod 2 = 1 then
                    y(indeks) = x(i)
                    indeks = indeks + 1
                end if
            next
            for i = 1 to indeks_x
                x(i) = y(i)
            next
        elseif pilih = 7 then
           
        end if
    loop
</script>
<HR>
</body>
</HTML>

Screenshot :

METODE SORTING MODIFIED BUBBLE VB.NET

Public Class Form1

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim i, j, temp As Long
        Dim n As Integer = CInt(TextBox1.Text)
        Dim x(500000) As Long
        Dim flag As Boolean


        TextBox2.Text = ("Start Time " & Hour(Now) & " " & Minute(Now) & " " & Second(Now))
        Dim start As Integer = Minute(Now)
        Dim start2 As Integer = Second(Now)

        ListBox1.Items.Clear()
        For i = 0 To CInt(TextBox1.Text) - 1
            Randomize()
            x(i) = CInt(Math.Ceiling(Rnd() * 500000)) + 1
            ListBox1.Items.Add(x(i))
        Next

        ListBox2.Items.Clear()
        For i = 0 To n - 1
            flag = True
            For j = 0 To n - i - 1
                If x(j) > x(j + 1) Then
                    temp = x(j)
                    x(j) = x(j + 1)
                    x(j + 1) = temp
                    flag = False
                End If
            Next

            If flag = True Then Exit For
        Next

        For i = 0 To n - 1
            ListBox2.Items.Add(x(i))
        Next

        TextBox3.Text = ("End Time " & Hour(Now) & " " & Minute(Now) & " " & Second(Now))
        Dim end2 As Integer = Minute(Now)
        Dim end3 As Integer = Second(Now)
        Dim interval As Integer = end2 - start
        Dim interval2 As Integer = end3 - start2
        If interval > 0 Then
            interval2 = 60 - interval2
        End If

        TextBox4.Text = ("interval " & interval & " menit dan " & interval2 & " detik")
    End Sub


End Class