Home
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
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
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
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 gambar=@gambar 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:
0 komentar:
Posting Komentar
Kita bukanlah apa-apa tanpaNya, jika ada pertanyaan mengenai artikel silakan tinggalkan komentar anda melalui form komentar :)