Source Code Game Puzzle Visual Basic

Berikut ini akan saya bagikan kepada Anda source code game puzzle sederhana menggunakan level yang ditulis dengan bahasa Visual Basic VB.NET. Source code beserta projectnya dapat anda download melalui link dibawah.

Kode Koneksi:


Imports System.Data.OleDb
Public Class koneksidata
    Dim conect As New OleDbConnection("provider = Microsoft.ACE.OLEDB.12.0;Data Source=" & Application.StartupPath.ToString & "soni.mdb")
    Public Function open() As OleDbConnection
        Try
            conect.Open()
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        Return conect
    End Function
    Public Function close() As OleDbConnection
        Try
            conect.Close()
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        Return conect
    End Function
End Class

Kode mnfrm:


Imports System.Data.OleDb
Namespace slidePuzzle
    Structure Block
        Public Row, Col As Integer
        Public Sub New(ByVal row As Integer, ByVal col As Integer)
            Me.Row = row
            Me.Col = col
        End Sub
    End Structure
    Public Class mnfrm
        Inherits System.Windows.Forms.Form
        Dim myconnection As New koneksidata
#Region "Kode Private"
        Const tSquare As Integer = 64
        Const tImageW As Integer = 62
        'Ukuran default
        Dim nRows As Integer = 2
        Dim nCols As Integer = 2
        Dim rand As Random
        Dim blankTile As Block
        Dim PictureLoaded As Boolean = False

        Dim timerCountdown As Integer
        Friend WithEvents tmplasttile As ctlTile
        Private tile(,) As ctlTile
        Friend WithEvents DariDataBase As MenuItem
        Friend WithEvents DariKomputer As MenuItem
        Friend WithEvents menuLoad As MenuItem
        Friend WithEvents menuShuffle As MenuItem
        Friend WithEvents menu2X2 As MenuItem
        Friend WithEvents menu3X3 As MenuItem
        Friend WithEvents menu4X4 As MenuItem
        Friend WithEvents menu5X5 As MenuItem
        Friend WithEvents menu6X6 As MenuItem
        Friend WithEvents menu7X7 As MenuItem
        Friend WithEvents menu8X8 As MenuItem
        Friend WithEvents menu9X9 As MenuItem
        Friend WithEvents menu10X10 As MenuItem
        Friend WithEvents menuSize As MenuItem
        Friend WithEvents MenuItem1 As MenuItem
        Friend WithEvents menuWhite As MenuItem
        Friend WithEvents menuGreen As MenuItem
        Friend WithEvents menuBlue As MenuItem
        Friend WithEvents menuRed As MenuItem
        Friend WithEvents menuSilver As MenuItem
        Friend WithEvents menuGridColor As MenuItem
        Friend WithEvents MenuItem2 As MenuItem
        Friend WithEvents mainMenu1 As MainMenu
        Friend WithEvents Konfigurasi As MenuItem
        Friend WithEvents openFile As System.Windows.Forms.OpenFileDialog
#End Region

#Region "Kode WinFormnya"
        Public Sub New()
            MyBase.New()
            InitializeComponent()
        End Sub
        Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
            If disposing Then
                If Not (components Is Nothing) Then
                    components.Dispose()
                End If
            End If
            MyBase.Dispose(disposing)
        End Sub

        Private components As System.ComponentModel.IContainer
        Friend WithEvents tRandom As System.Windows.Forms.Timer
        Private WithEvents tilesPanel As System.Windows.Forms.Panel
         Private Sub InitializeComponent()
            Me.components = New System.ComponentModel.Container()
            Me.tilesPanel = New System.Windows.Forms.Panel()
            Me.openFile = New System.Windows.Forms.OpenFileDialog()
            Me.tRandom = New System.Windows.Forms.Timer(Me.components)
            Me.DariDataBase = New System.Windows.Forms.MenuItem()
            Me.DariKomputer = New System.Windows.Forms.MenuItem()
            Me.menuLoad = New System.Windows.Forms.MenuItem()
            Me.Konfigurasi = New System.Windows.Forms.MenuItem()
            Me.menuShuffle = New System.Windows.Forms.MenuItem()
            Me.menu2X2 = New System.Windows.Forms.MenuItem()
            Me.menu3X3 = New System.Windows.Forms.MenuItem()
            Me.menu4X4 = New System.Windows.Forms.MenuItem()
            Me.menu5X5 = New System.Windows.Forms.MenuItem()
            Me.menu6X6 = New System.Windows.Forms.MenuItem()
            Me.menu7X7 = New System.Windows.Forms.MenuItem()
            Me.menu8X8 = New System.Windows.Forms.MenuItem()
            Me.menu9X9 = New System.Windows.Forms.MenuItem()
            Me.menu10X10 = New System.Windows.Forms.MenuItem()
            Me.menuSize = New System.Windows.Forms.MenuItem()
            Me.MenuItem1 = New System.Windows.Forms.MenuItem()
            Me.menuWhite = New System.Windows.Forms.MenuItem()
            Me.menuGreen = New System.Windows.Forms.MenuItem()
            Me.menuBlue = New System.Windows.Forms.MenuItem()
            Me.menuRed = New System.Windows.Forms.MenuItem()
            Me.menuSilver = New System.Windows.Forms.MenuItem()
            Me.menuGridColor = New System.Windows.Forms.MenuItem()
            Me.MenuItem2 = New System.Windows.Forms.MenuItem()
            Me.mainMenu1 = New System.Windows.Forms.MainMenu(Me.components)
            Me.SuspendLayout()
            '
            'tilesPanel
            '
            Me.tilesPanel.BackColor = System.Drawing.Color.PaleGreen
            Me.tilesPanel.BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D
            Me.tilesPanel.Location = New System.Drawing.Point(8, 12)
            Me.tilesPanel.Name = "tilesPanel"
            Me.tilesPanel.Size = New System.Drawing.Size(272, 224)
            Me.tilesPanel.TabIndex = 0
            '
            'tRandom
            '
            '
            'DariDataBase
            '
            Me.DariDataBase.Index = 0
            Me.DariDataBase.Text = "Dari Database (Otomatis)"
            '
            'DariKomputer
            '
            Me.DariKomputer.Index = 1
            Me.DariKomputer.Text = "Dari Komputer (Manual)"
            '
            'menuLoad
            '
            Me.menuLoad.Index = 0
            Me.menuLoad.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.DariDataBase, Me.DariKomputer, Me.Konfigurasi})
            Me.menuLoad.Text = "Gambar"
            '
            'Konfigurasi
            '
            Me.Konfigurasi.Index = 2
            Me.Konfigurasi.Text = "Konfigurasi"
            '
            'menuShuffle
            '
            Me.menuShuffle.Enabled = False
            Me.menuShuffle.Index = 1
            Me.menuShuffle.Text = "Acak"
            '
            'menu2X2
            '
            Me.menu2X2.DefaultItem = True
            Me.menu2X2.Index = 0
            Me.menu2X2.Text = "2 x 2"
            '
            'menu3X3
            '
            Me.menu3X3.Index = 1
            Me.menu3X3.RadioCheck = True
            Me.menu3X3.Text = "3 x 3"
            '
            'menu4X4
            '
            Me.menu4X4.Index = 2
            Me.menu4X4.RadioCheck = True
            Me.menu4X4.Text = "4 x 4"
            '
            'menu5X5
            '
            Me.menu5X5.Index = 3
            Me.menu5X5.RadioCheck = True
            Me.menu5X5.Text = "5 x 5"
            '
            'menu6X6
            '
            Me.menu6X6.Index = 4
            Me.menu6X6.Text = "6 x 6"
            '
            'menu7X7
            '
            Me.menu7X7.Index = 5
            Me.menu7X7.Text = "7 x 7"
            '
            'menu8X8
            '
            Me.menu8X8.Index = 6
            Me.menu8X8.Text = "8 x 8"
            '
            'menu9X9
            '
            Me.menu9X9.Index = 7
            Me.menu9X9.Text = "9 x 9"
            '
            'menu10X10
            '
            Me.menu10X10.Index = 8
            Me.menu10X10.Text = "10 x 10"
            '
            'menuSize
            '
            Me.menuSize.Index = 2
            Me.menuSize.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.menu2X2, Me.menu3X3, Me.menu4X4, Me.menu5X5, Me.menu6X6, Me.menu7X7, Me.menu8X8, Me.menu9X9, Me.menu10X10})
            Me.menuSize.RadioCheck = True
            Me.menuSize.Text = "Ukuran"
            '
            'MenuItem1
            '
            Me.MenuItem1.Index = 4
            Me.MenuItem1.Text = ""
            '
            'menuWhite
            '
            Me.menuWhite.Index = 0
            Me.menuWhite.Text = "White"
            '
            'menuGreen
            '
            Me.menuGreen.Checked = True
            Me.menuGreen.DefaultItem = True
            Me.menuGreen.Index = 1
            Me.menuGreen.Text = "Green"
            '
            'menuBlue
            '
            Me.menuBlue.Index = 2
            Me.menuBlue.Text = "Blue"
            '
            'menuRed
            '
            Me.menuRed.Index = 3
            Me.menuRed.Text = "Red"
            '
            'menuSilver
            '
            Me.menuSilver.Index = 4
            Me.menuSilver.Text = "Silver"
            '
            'menuGridColor
            '
            Me.menuGridColor.Index = 3
            Me.menuGridColor.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.menuWhite, Me.menuGreen, Me.menuBlue, Me.menuRed, Me.menuSilver})
            Me.menuGridColor.Text = "Warna"
            '
            'MenuItem2
            '
            Me.MenuItem2.Index = 5
            Me.MenuItem2.Text = ""
            '
            'mainMenu1
            '
            Me.mainMenu1.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.menuLoad, Me.menuShuffle, Me.menuSize, Me.menuGridColor, Me.MenuItem1, Me.MenuItem2})
            '
            'mnfrm
            '
            Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
            Me.ClientSize = New System.Drawing.Size(288, 401)
            Me.Controls.Add(Me.tilesPanel)
            Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.Fixed3D
            Me.Icon = Global.slidePuzzle.My.Resources.Resources.ikonku
            Me.MaximizeBox = False
            Me.Menu = Me.mainMenu1
            Me.Name = "mnfrm"
            Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
            Me.Text = "D'Puzzle www.skyars.com"
            Me.ResumeLayout(False)

        End Sub
#End Region

#Region "Muat Form"
        Private Sub mnfrm_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
            MakeTiles(nRows, nCols)
            menuSize.Enabled = False
            menuGridColor.Enabled = False
        End Sub
#End Region

#Region "Acak dengan Waktu"
        Protected Sub Randomize()
            rand = New Random()
            timerCountdown = 64 * nRows * nCols
            tRandom.Interval = 1
            tRandom.Enabled = True
        End Sub
        Private Sub TimerOnTick(ByVal obj As Object, ByVal ea As EventArgs) Handles tRandom.Tick
            Dim col As Integer = blankTile.Col
            Dim row As Integer = blankTile.Row

            Select Case (rand.Next(4))
                Case 0 : col += 1
                Case 1 : col -= 1
                Case 2 : row += 1
                Case 3 : row -= 1
            End Select

            If (col >= 0 And col < nCols And row >= 0 And row < nRows) Then
                MoveTile(col, row)
            End If

            timerCountdown = timerCountdown - 1
            If (timerCountdown = 0) Then
                tRandom.Stop()
            End If
        End Sub
#End Region

#Region "Pindahkan Tiles (int Col, Int Row)"
        Private Sub MoveTile(ByVal Col As Integer, ByVal Row As Integer)
            tile(Row, Col).Location = New Point(blankTile.Col * tSquare,
                       blankTile.Row * tSquare)

            tile(blankTile.Row, blankTile.Col) = tile(Row, Col)
            tile(Row, Col) = Nothing
            blankTile = New Block(Row, Col)
        End Sub
#End Region

#Region "Pindahkan Tiles (int Rows, int Cols)"
        Public Sub MakeTiles(ByVal Rows As Integer, ByVal Cols As Integer)
            Dim index As Integer = 0

            ReDim tile(Rows, Cols)
            tilesPanel.Size = New Size(tSquare * Rows + 4, tSquare * Cols + 4)
            tilesPanel.Location = New Point(4, 4)
            Me.ClientSize = New Size(tilesPanel.Size.Width + 6, tilesPanel.Size.Height + 6)

            Dim Row, Col As Integer
            For Row = 0 To Rows - 1
                For Col = 0 To Cols - 1
                    tile(Row, Col) = New ctlTile(tSquare, tSquare, index)
                    tile(Row, Col).Parent = Me.tilesPanel
                    tile(Row, Col).Location = New Point(Col * tSquare, Row * tSquare)
                    index += 1
                Next
            Next
        End Sub
#End Region

#Region "Keyboard dan Mouse"
        Private Sub mnfrm_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
            ' Cek puzzle sudah diacak atau belum
            If ((menuShuffle.Enabled) Or (PictureLoaded = False)) Then Return

            ' Arrow Keys Left
            If (e.KeyCode = Keys.Left And blankTile.Col < nCols - 1) Then
                MoveTile(blankTile.Col + 1, blankTile.Row)

                ' Arrow Keys Right
            ElseIf (e.KeyCode = Keys.Right And blankTile.Col > 0) Then
                MoveTile(blankTile.Col - 1, blankTile.Row)

                ' Arrow Keys Up
            ElseIf (e.KeyCode = Keys.Up And blankTile.Row < nRows - 1) Then
                MoveTile(blankTile.Col, blankTile.Row + 1)

                ' Arrow Keys Down
            ElseIf (e.KeyCode = Keys.Down And blankTile.Row > 0) Then
                MoveTile(blankTile.Col, blankTile.Row - 1)

            End If

            e.Handled = True
            CheckFinish()     'Cek jika puzzle dipecahkan.
        End Sub

        Private Sub tilesPanel_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles tilesPanel.MouseDown
            ' Cek puzzle sudah diacak atau belum
            If ((menuShuffle.Enabled) Or (PictureLoaded = False)) Then Return

            Dim Col As Integer = e.X  tSquare  'pembagi integer
            Dim Row As Integer = e.Y  tSquare  'pembagi integer

            If (Col = blankTile.Col) Then
                If (Row < blankTile.Row) Then
                    Dim Row2 As Integer
                    For Row2 = blankTile.Row - 1 To Row Step -1
                        MoveTile(Col, Row2)
                    Next

                ElseIf (Row > blankTile.Row) Then
                    Dim Row2 As Integer
                    For Row2 = blankTile.Row + 1 To Row
                        MoveTile(Col, Row2)
                    Next
                End If

            ElseIf (Row = blankTile.Row) Then
                If (Col < blankTile.Col) Then
                    Dim Col2 As Integer
                    For Col2 = blankTile.Col - 1 To Col Step -1
                        MoveTile(Col2, Row)
                    Next

                ElseIf (Col > blankTile.Col) Then
                    Dim Col2 As Integer
                    For Col2 = blankTile.Col + 1 To Col
                        MoveTile(Col2, Row)
                    Next
                End If
            End If

            CheckFinish() 'Cek jika puzzle benar :)
        End Sub
#End Region

#Region "Kode jika susunan benar dan menang"
        Private Sub CheckFinish()
            Dim Finished As Boolean = True

            Dim index As Integer = 0
            Dim Row, Col As Integer

            For Row = 0 To nRows - 1
                For Col = 0 To nCols - 1
                    If ((index <> nRows * nCols) And Not (tile(Row, Col) Is Nothing)) Then
                        Finished = Finished And (tile(Row, Col).tIndex = index)
                    End If
                    index += 1
                    If Not (Finished) Then Return
                Next
            Next

            If (Finished) Then
                tile(nRows - 1, nCols - 1) = tmplasttile
                tile(nRows - 1, nCols - 1).Visible = True
                Dim result As Integer = MessageBox.Show("Anda berhasil menyusunnya!!, Lanjut level selanjutnya?", "Selamat :)", MessageBoxButtons.YesNo)
                If result = DialogResult.No Then
                    blankTile = New Block(nRows - 1, nCols - 1)
                    clearItems()
                    MakeTiles(nRows, nCols)
                ElseIf result = DialogResult.Yes Then
                    If My.Settings.SLEVEL <= 9 Then
                        My.Settings.SLEVEL += 1
                        My.Settings.Save()
                        MessageBox.Show("Level, '" & My.Settings.SLEVEL & "'", "[Konfirmasi]")
                        blankTile = New Block(nRows - 1, nCols - 1)
                        clearItems()
                        Dim sonisitez As Integer = My.Settings.SLEVEL + 1
                        nRows = sonisitez
                        nCols = sonisitez
                        MakeTiles(nRows, nCols)
                        muat_dari_db()
                    Else
                        MsgBox("Anda sudah menyelesaikan seluruh level hehe :-D", MsgBoxStyle.Information, "Selamat :)")
                        blankTile = New Block(nRows - 1, nCols - 1)
                    End If

                End If
            End If
        End Sub
#End Region

#Region "Menunya"
        Private Sub menuShuffle_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles menuShuffle.Click
            menuShuffle.Enabled = False
            menuGridColor.Enabled = True
            tmplasttile = tile(nRows - 1, nCols - 1)
            tmplasttile.Visible = False
            tile(nRows - 1, nCols - 1).Visible = False
            Randomize()
        End Sub
#End Region

#Region "Ukuran Menu"
        Private Sub menu2X2_Click(sender As Object, e As EventArgs) Handles menu2X2.Click
            If (menu2X2.Checked) Then Return
            clearItems()
            menu2X2.Checked = True
            nRows = 2
            nCols = 2
            MakeTiles(nRows, nCols)
        End Sub
        Private Sub menu3X3_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles menu3X3.Click
            If (menu3X3.Checked) Then Return
            clearItems()
            menu3X3.Checked = True
            nRows = 3
            nCols = 3
            MakeTiles(nRows, nCols)
        End Sub
        Private Sub menu4X4_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles menu4X4.Click
            If (menu4X4.Checked) Then Return
            clearItems()
            menu4X4.Checked = True
            nRows = 4
            nCols = 4
            MakeTiles(nRows, nCols)
        End Sub
        Private Sub menu5X5_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles menu5X5.Click
            If (menu5X5.Checked) Then Return
            clearItems()
            menu5X5.Checked = True
            nRows = 5
            nCols = 5
            MakeTiles(nRows, nCols)
        End Sub

        Private Sub menu6X6_Click(sender As Object, e As EventArgs) Handles menu6X6.Click
            If (menu6X6.Checked) Then Return
            clearItems()
            menu6X6.Checked = True
            nRows = 6
            nCols = 6
            MakeTiles(nRows, nCols)
        End Sub

        Private Sub menu7X7_Click(sender As Object, e As EventArgs) Handles menu7X7.Click
            If (menu7X7.Checked) Then Return
            clearItems()
            menu7X7.Checked = True
            nRows = 7
            nCols = 7
            MakeTiles(nRows, nCols)
        End Sub

        Private Sub menu8X8_Click(sender As Object, e As EventArgs) Handles menu8X8.Click
            If (menu8X8.Checked) Then Return
            clearItems()
            menu8X8.Checked = True
            nRows = 8
            nCols = 8
            MakeTiles(nRows, nCols)
        End Sub

        Private Sub menu9X9_Click(sender As Object, e As EventArgs) Handles menu9X9.Click
            If (menu9X9.Checked) Then Return
            clearItems()
            menu9X9.Checked = True
            nRows = 9
            nCols = 9
            MakeTiles(nRows, nCols)
        End Sub

        Private Sub menu10X10_Click(sender As Object, e As EventArgs) Handles menu10X10.Click
            If (menu10X10.Checked) Then Return
            clearItems()
            menu10X10.Checked = True
            nRows = 10
            nCols = 10
            MakeTiles(nRows, nCols)
        End Sub
        Private Sub clearItems()
            menu2X2.Checked = False
            menu3X3.Checked = False
            menu4X4.Checked = False
            menu5X5.Checked = False
            menu6X6.Checked = False
            menu7X7.Checked = False
            menu8X8.Checked = False
            menu9X9.Checked = False
            menu10X10.Checked = False
            Dim Row, Col As Integer
            For Row = 0 To nRows - 1
                For Col = 0 To nCols - 1
                    Try
                        tile(Row, Col).Dispose()
                    Catch
                        '
                    End Try
                Next
            Next
            menuShuffle.Enabled = False
            menuGridColor.Enabled = True
            PictureLoaded = False
        End Sub

#End Region

#Region "Warna Grid"
        Private Sub ClearColors()
            menuWhite.Checked = False
            menuGreen.Checked = False
            menuBlue.Checked = False
            menuRed.Checked = False
            menuSilver.Checked = False
        End Sub

        Private Sub menuWhite_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles menuWhite.Click
            ClearColors()
            menuWhite.Checked = True
            Me.tilesPanel.BackColor = Color.LightYellow
        End Sub

        Private Sub menuGreen_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles menuGreen.Click
            ClearColors()
            menuGreen.Checked = True
            Me.tilesPanel.BackColor = Color.PaleGreen
        End Sub

        Private Sub menuBlue_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles menuBlue.Click
            ClearColors()
            menuBlue.Checked = True
            Me.tilesPanel.BackColor = Color.LightBlue
        End Sub

        Private Sub menuRed_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles menuRed.Click
            ClearColors()
            menuRed.Checked = True
            Me.tilesPanel.BackColor = Color.LightCoral
        End Sub

        Private Sub menuSilver_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles menuSilver.Click
            ClearColors()
            menuSilver.Checked = True
            Me.tilesPanel.BackColor = Color.Silver
        End Sub
#End Region
        Private Sub DariKomputer_Click(sender As Object, e As EventArgs) Handles DariKomputer.Click
            openFile.FileName = ""
            openFile.Filter = "Gambar (*.jpg,*.jpeg,*.png,*.bmp,*.gif,*.tiff)|*.jpg;*.jpeg;*.png;*.bmp;*.gif;*.tiff"
            openFile.ShowDialog()
            If (openFile.FileName = "") Then
                menuShuffle.Enabled = False
                menuGridColor.Enabled = True
                Return
            End If

            Dim Row, Col As Integer
            For Row = 0 To nRows - 1
                For Col = 0 To nCols - 1
                    Try
                        tile(Row, Col).Dispose()
                    Catch
                    End Try
                Next
            Next

            MakeTiles(nRows, nCols)

            Dim cxThumbnail As Integer = tImageW * nRows
            Dim cyThumbnail As Integer = tImageW * nRows

            Dim Pic As Image = Image.FromFile(openFile.FileName)
            Pic = Pic.GetThumbnailImage(cxThumbnail, cyThumbnail, Nothing, System.IntPtr.Zero)

            Console.WriteLine(tile(0, 0).Location)
            For Row = 0 To nRows - 1
                For Col = 0 To nCols - 1
                    tile(Row, Col).tilePicture(Pic, New Point(Col * tImageW, Row * tImageW))
                Next
            Next

            blankTile = New Block(nRows - 1, nCols - 1)
            menuShuffle.Enabled = True
            PictureLoaded = True
            If menuSize.Enabled = False Then
                menuSize.Enabled = True
            End If
            If menuGridColor.Enabled = False Then
                menuGridColor.Enabled = True
            End If
        End Sub
        Sub muat_dari_db()
            Try
                Using sql As New OleDbCommand("select gambar from tbsoni where level='" & Replace(My.Settings.SLEVEL, "'", "''") & "'", myconnection.open)
                    Using dr As OleDbDataReader = sql.ExecuteReader()
                        Using dt As New DataTable
                            dt.Load(dr)
                            If dt.Rows.Count <> 1 Then
                            Else
                                Dim rowsoni As DataRow = dt.Rows(0)
                                Using ms As New IO.MemoryStream(CType(rowsoni(0), Byte()))
                                    Dim Row, Col As Integer
                                    For Row = 0 To nRows - 1
                                        For Col = 0 To nCols - 1
                                            Try
                                                tile(Row, Col).Dispose()
                                            Catch
                                            End Try
                                        Next
                                    Next
                                    MakeTiles(nRows, nCols)
                                    Dim cxThumbnail As Integer = tImageW * nRows
                                    Dim cyThumbnail As Integer = tImageW * nRows
                                    'Dim Pic As Image = Image.FromFile(openFile.FileName)
                                    Dim Pic As Image = Image.FromStream(ms)
                                    Pic = Pic.GetThumbnailImage(cxThumbnail, cyThumbnail, Nothing, System.IntPtr.Zero)
                                    Console.WriteLine(tile(0, 0).Location)
                                    For Row = 0 To nRows - 1
                                        For Col = 0 To nCols - 1
                                            tile(Row, Col).tilePicture(Pic, New Point(Col * tImageW, Row * tImageW))
                                        Next
                                    Next
                                    blankTile = New Block(nRows - 1, nCols - 1)
                                    ''If My.Settings.LEVELSONI <= 1 Then
                                    ''Else
                                    ''    clearItems()
                                    ''    Dim sonisitez As Integer = My.Settings.LEVELSONI
                                    ''    nRows = sonisitez
                                    ''    nCols = sonisitez
                                    ''    MakeTiles(nRows, nCols)
                                    ''End If
                                    menuShuffle.Enabled = True
                                    If menuGridColor.Enabled = False Then
                                        menuGridColor.Enabled = True
                                    End If
                                    If menuSize.Enabled = True Then
                                        menuSize.Enabled = False
                                    End If
                                    PictureLoaded = True
                                End Using
                            End If
                        End Using
                    End Using
                End Using
            Catch ex As Exception
                MsgBox(ex.Message)
            End Try
            myconnection.close()
        End Sub
        Private Sub DariDataBase_Click(sender As Object, e As EventArgs) Handles DariDataBase.Click
            muat_dari_db()
        End Sub
        Private Sub Konfigurasi_Click(sender As Object, e As EventArgs) Handles Konfigurasi.Click
            FormKonfigurasi.Show()
        End Sub
        Private Sub mnfrm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
            My.Settings.LEVELSONI = My.Settings.SLEVEL
            My.Settings.Save()
        End Sub
    End Class
End Namespace

Kode Tile:


Namespace slidePuzzle
    Public Class ctlTile
        Inherits System.Windows.Forms.UserControl

#Region "Private filds"
        Private imagePoint As Point
        Friend WithEvents imageBase As System.Windows.Forms.Button
        Friend WithEvents tilePic As System.Windows.Forms.PictureBox
        Private t_index As Integer
#End Region

#Region "Public Properties"
        Public ReadOnly Property tIndex() As Integer
            Get
                Return t_index
            End Get
        End Property

        Public ReadOnly Property tImageSize() As Size
            Get
                Return Me.tilePic.Size
            End Get
        End Property
#End Region

        Private components As System.ComponentModel.Container = Nothing

#Region "Contructor and Dispose"
        Public Sub New(ByVal tWidth As Integer, ByVal tHeight As Integer, ByVal index As Integer)

            MyBase.New()
            'Tile's Index
            t_index = index

            'Disable control so parent form cann handle its key and mouse
            'events
            Enabled = False

            ' This call is required by the Windows.Forms Form Designer.
            InitializeComponent()

            'Image Base and Imgae Fixation Here
            If ((tWidth < 32 Or tWidth > 96) Or (tHeight < 32 Or tHeight > 96)) Then
                Me.Size = New Size(64, 64)
                tWidth = 64
                tHeight = 64
            Else
                Me.Size = New Size(tWidth, tHeight)
            End If

            imageBase.Location = New Point(0, 0)
            imageBase.Size = New Size(tWidth, tHeight)
            tilePic.Location = New Point(1, 1)
            tilePic.Size = New Size(tWidth - 2, tHeight - 2)
            tilePic.Image = Nothing
        End Sub

        ' Clean up any resources being used.
        Protected Overloads Sub Dispose(ByVal disposing As Boolean)
            If disposing Then
                If Not (components Is Nothing) Then
                    components.Dispose()
                End If
            End If
            MyBase.Dispose(disposing)
        End Sub

#End Region

#Region "Component Designer generated code"
        ' Required method for Designer support - do not modify 
        ' the contents of this method with the code editor.
         Private Sub InitializeComponent()
            Me.imageBase = New System.Windows.Forms.Button()
            Me.tilePic = New System.Windows.Forms.PictureBox()
            CType(Me.tilePic, System.ComponentModel.ISupportInitialize).BeginInit()
            Me.SuspendLayout()
            '
            'imageBase
            '
            Me.imageBase.BackColor = System.Drawing.Color.DarkOliveGreen
            Me.imageBase.Enabled = False
            Me.imageBase.FlatStyle = System.Windows.Forms.FlatStyle.System
            Me.imageBase.Location = New System.Drawing.Point(1, 1)
            Me.imageBase.Name = "imageBase"
            Me.imageBase.Size = New System.Drawing.Size(62, 62)
            Me.imageBase.TabIndex = 0
            Me.imageBase.UseVisualStyleBackColor = False
            '
            'tilePic
            '
            Me.tilePic.BackColor = System.Drawing.Color.OliveDrab
            Me.tilePic.Location = New System.Drawing.Point(2, 2)
            Me.tilePic.Name = "tilePic"
            Me.tilePic.Size = New System.Drawing.Size(60, 60)
            Me.tilePic.TabIndex = 1
            Me.tilePic.TabStop = False
            '
            'ctlTile
            '
            Me.Controls.Add(Me.tilePic)
            Me.Controls.Add(Me.imageBase)
            Me.Name = "ctlTile"
            Me.Size = New System.Drawing.Size(64, 64)
            CType(Me.tilePic, System.ComponentModel.ISupportInitialize).EndInit()
            Me.ResumeLayout(False)

        End Sub
#End Region

#Region "Tile Picture"
        Public Sub tilePicture(ByVal tImage As Image, ByVal StartPt As Point)
            tilePic.Image = tImage
            imagePoint = StartPt
        End Sub
#End Region

#Region "Repaint Tile"
        Private Sub TilePic_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles tilePic.Paint
            If Not (tilePic.Image Is Nothing) Then
                Dim g As Graphics = e.Graphics
                g.DrawImage(tilePic.Image, New Rectangle(New Point(0, 0), New Size(tilePic.Width, tilePic.Height)),
                 New Rectangle(imagePoint, New Size(tilePic.Width, tilePic.Height)), GraphicsUnit.Pixel)
            End If
        End Sub

        Private Sub tilePic_Click(sender As Object, e As EventArgs) Handles tilePic.Click

        End Sub
#End Region
    End Class
End Namespace

Kode Konfigurasi:


Imports System.Data.OleDb
Public Class FormKonfigurasi
    Dim myconnection As New koneksidata
    Dim mycmd As New OleDbCommand
    Dim objadapter As OleDbDataAdapter
    Dim objreader As OleDbDataReader
    Dim dtable As New DataTable
#Region "konfigurasi"
    Dim a As New OpenFileDialog
    Sub bukadialogfoto()
        Dim PictureLocation As String
        a.Filter = "Gambar (*.jpg,*.jpeg,*.png,*.bmp,*.gif,*.tiff)|*.jpg;*.jpeg;*.png;*.bmp;*.gif;*.tiff"
        PictureLocation = a.FileName
        Try
            If a.ShowDialog = Windows.Forms.DialogResult.OK Then
                PictureBox1.Image = New Bitmap(a.FileName)
                PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage
            End If
        Catch ex As Exception
            Exit Sub
        End Try
    End Sub
    Sub simpanfoto()
        Try
            myconnection.close()
            Using sql As New OleDbCommand("insert into tbsoni values('" & CLEVEL.Text & "',@gambar)", myconnection.open)
                If a.FileName = Nothing Then
                    'sql.Parameters.Add(New OleDbParameter("@FOTO", OleDbType.Binary)).Value = IO.File.ReadAllBytes("kosong.jpg")
                    MsgBox("Anda belum memilih gambar !!", MsgBoxStyle.Information, "Pemberitahuan !!")
                Else
                    sql.Parameters.Add(New OleDbParameter("@gambar", OleDbType.Binary)).Value = IO.File.ReadAllBytes(a.FileName)
                    MsgBox("Gambar level:  '" & CLEVEL.Text & "'  berhasil disimpan !!", MsgBoxStyle.Information, "Pemberitahuan !!")
                End If
                sql.ExecuteNonQuery()
            End Using
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        myconnection.close()
    End Sub
    Sub ubahfoto()
        Try
            myconnection.close()
            Using sql As New OleDbCommand("update tbsoni set [email protected] where level='" & CLEVEL.Text & "'", myconnection.open)
                If a.FileName = Nothing Then
                    'sql.Parameters.Add(New OleDbParameter("@FOTO", OleDbType.Binary)).Value = IO.File.ReadAllBytes("kosong.jpg")
                    MsgBox("Anda belum memilih gambar !!", MsgBoxStyle.Information, "Pemberitahuan !!")
                Else
                    sql.Parameters.Add(New OleDbParameter("@gambar", OleDbType.Binary)).Value = IO.File.ReadAllBytes(a.FileName)
                    MsgBox("Gambar level:  '" & CLEVEL.Text & "'  berhasil dirubah !!", MsgBoxStyle.Information, "Pemberitahuan !!")
                End If
                sql.ExecuteNonQuery()
            End Using
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        myconnection.close()
    End Sub
#End Region
    Private Sub BTSIMPAN_Click(sender As Object, e As EventArgs) Handles BTSIMPAN.Click
        Try
            Using sql As New OleDbCommand("select gambar from tbsoni where level = '" & Replace(CLEVEL.Text, "'", "''") & "'", myconnection.open)
                Using dr As OleDbDataReader = sql.ExecuteReader()
                    Using dt As New DataTable
                        dt.Load(dr)
                        If CLEVEL.Text = "" Then
                            MsgBox("Anda belum memilih level !!", MsgBoxStyle.Exclamation, "Pemberitahuan !!")
                        ElseIf dt.Rows.Count <> 1 Then
                            simpanfoto()
                        Else
                            ubahfoto()
                        End If
                    End Using
                End Using
            End Using
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        myconnection.close()
    End Sub
    Private Sub PictureBox1_Click(sender As Object, e As EventArgs) Handles PictureBox1.Click
        bukadialogfoto()
    End Sub
    Private Sub CLEVEL_KeyPress(sender As Object, e As KeyPressEventArgs) Handles CLEVEL.KeyPress
        e.KeyChar = Chr(0)
    End Sub

    Private Sub BTRESETLEVEL_Click(sender As Object, e As EventArgs) Handles BTRESETLEVEL.Click
        My.Settings.SLEVEL = 1
        My.Settings.Save()
    End Sub
    Private Sub CLEVEL_SelectedIndexChanged(sender As Object, e As EventArgs) Handles CLEVEL.SelectedIndexChanged
        Try
            Using sql As New OleDbCommand("select gambar from tbsoni where level='" & Replace(CLEVEL.Text, "'", "''") & "'", myconnection.open)
                Using dr As OleDbDataReader = sql.ExecuteReader()
                    Using dt As New DataTable
                        dt.Load(dr)
                        If dt.Rows.Count <> 1 Then
                            PictureBox1.Image = Nothing
                        Else
                            Dim rowsoni As DataRow = dt.Rows(0)
                            Using ms As New IO.MemoryStream(CType(rowsoni(0), Byte()))
                                'Dim Pic As Image = Image.FromFile(openFile.FileName)
                                Dim Pic As Image = Image.FromStream(ms)
                                PictureBox1.Image = New Bitmap(Pic)
                                PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage
                            End Using
                        End If
                    End Using
                End Using
            End Using
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        myconnection.close()
    End Sub
End Class

Download Project:

Download Project
Lihat Video:

Leave a Reply

Your email address will not be published. Required fields are marked *