ShiftOS/ShiftOS/Snakey.vb
2015-03-08 09:18:40 -07:00

707 lines
No EOL
29 KiB
VB.net

Imports System.Drawing.Drawing2D
Public Class Snakey
Public rolldownsize As Integer
Public oldbordersize As Integer
Public oldtitlebarheight As Integer
Public justopened As Boolean = False
Public needtorollback As Boolean = False
Public minimumsizewidth As Integer = 673 'replace with minimum size
Public minimumsizeheight As Integer = 507 'replace with minimum size
#Region "Template Code"
Private Sub Template_Load(sender As Object, e As EventArgs) Handles MyBase.Load
justopened = True
Me.Left = (Screen.PrimaryScreen.Bounds.Width - Me.Width) / 2
Me.Top = (Screen.PrimaryScreen.Bounds.Height - Me.Height) / 2
setupall()
ShiftOSDesktop.pnlpanelbuttondodge.SendToBack() 'CHANGE NAME
ShiftOSDesktop.setuppanelbuttons()
ShiftOSDesktop.setpanelbuttonappearnce(ShiftOSDesktop.pnlpanelbuttondodge, ShiftOSDesktop.tbdodgeicon, ShiftOSDesktop.tbdodgetext, True) 'modify to proper name
ShiftOSDesktop.programsopen = ShiftOSDesktop.programsopen + 1
End Sub
Public Sub setupall()
setuptitlebar()
setupborders()
setskin()
End Sub
Private Sub ShiftOSDesktop_keydown(sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
'Make terminal appear
If e.KeyCode = Keys.T AndAlso e.Control Then
Terminal.Show()
Terminal.Visible = True
Terminal.BringToFront()
End If
'Movable Windows
If ShiftOSDesktop.boughtmovablewindows = True Then
If e.KeyCode = Keys.A AndAlso e.Control Then
e.Handled = True
Me.Location = New Point(Me.Location.X - ShiftOSDesktop.movablewindownumber, Me.Location.Y)
End If
If e.KeyCode = Keys.D AndAlso e.Control Then
e.Handled = True
Me.Location = New Point(Me.Location.X + ShiftOSDesktop.movablewindownumber, Me.Location.Y)
End If
If e.KeyCode = Keys.W AndAlso e.Control Then
e.Handled = True
Me.Location = New Point(Me.Location.X, Me.Location.Y - ShiftOSDesktop.movablewindownumber)
End If
If e.KeyCode = Keys.S AndAlso e.Control Then
e.Handled = True
Me.Location = New Point(Me.Location.X, Me.Location.Y + ShiftOSDesktop.movablewindownumber)
End If
ShiftOSDesktop.log = ShiftOSDesktop.log & My.Computer.Clock.LocalTime & " User moved " & Me.Name & " to " & Me.Location.ToString & " with " & e.KeyCode.ToString & Environment.NewLine
End If
End Sub
Private Sub titlebar_MouseDown(sender As Object, e As MouseEventArgs) Handles titlebar.MouseDown, lbtitletext.MouseDown, pnlicon.MouseDown, pgtoplcorner.MouseDown, pgtoprcorner.MouseDown
' Handle Draggable Windows
If ShiftOSDesktop.boughtdraggablewindows = True Then
If e.Button = MouseButtons.Left Then
titlebar.Capture = False
lbtitletext.Capture = False
pnlicon.Capture = False
pgtoplcorner.Capture = False
pgtoprcorner.Capture = False
Const WM_NCLBUTTONDOWN As Integer = &HA1S
Const HTCAPTION As Integer = 2
Dim msg As Message = _
Message.Create(Me.Handle, WM_NCLBUTTONDOWN, _
New IntPtr(HTCAPTION), IntPtr.Zero)
Me.DefWndProc(msg)
End If
ShiftOSDesktop.log = ShiftOSDesktop.log & My.Computer.Clock.LocalTime & " User dragged " & Me.Name & " to " & Me.Location.ToString & Environment.NewLine
End If
End Sub
Public Sub setupborders()
If ShiftOSDesktop.boughtwindowborders = False Then
pgleft.Hide()
pgbottom.Hide()
pgright.Hide()
Me.Size = New Size(Me.Width - pgleft.Width - pgright.Width, Me.Height - pgbottom.Height)
End If
End Sub
Private Sub closebutton_Click(sender As Object, e As EventArgs) Handles closebutton.Click
Me.Close()
End Sub
Private Sub closebutton_MouseEnter(sender As Object, e As EventArgs) Handles closebutton.MouseEnter, closebutton.MouseUp
closebutton.BackgroundImage = Skins.closebtnhover
End Sub
Private Sub closebutton_MouseLeave(sender As Object, e As EventArgs) Handles closebutton.MouseLeave
closebutton.BackgroundImage = Skins.closebtn
End Sub
Private Sub closebutton_MouseDown(sender As Object, e As EventArgs) Handles closebutton.MouseDown
closebutton.BackgroundImage = Skins.closebtnclick
End Sub
Private Sub minimizebutton_Click(sender As Object, e As EventArgs) Handles minimizebutton.Click
ShiftOSDesktop.minimizeprogram(Me, False)
End Sub
'Old skinning system - No idea what this does
''Private Sub titlebar_MouseEnter(sender As Object, e As EventArgs) Handles titlebar.MouseEnter, titlebar.MouseUp, lbtitletext.MouseEnter, pnlicon.MouseEnter, closebutton.MouseEnter, rollupbutton.MouseEnter
'' If ShiftOSDesktop.skinimages(3) = ShiftOSDesktop.skinimages(4) Then Else titlebar.BackgroundImage = ShiftOSDesktop.skintitlebar(1)
''End Sub
'Private Sub titlebar_MouseLeave(sender As Object, e As EventArgs) Handles titlebar.MouseLeave, lbtitletext.MouseLeave, pnlicon.MouseLeave, closebutton.MouseLeave, rollupbutton.MouseLeave
' If ShiftOSDesktop.skinimages(3) = ShiftOSDesktop.skinimages(4) Then Else titlebar.BackgroundImage = ShiftOSDesktop.skintitlebar(0)
'End Sub
Private Sub rollupbutton_Click(sender As Object, e As EventArgs) Handles rollupbutton.Click
rollupanddown()
End Sub
Private Sub rollupbutton_MouseEnter(sender As Object, e As EventArgs) Handles rollupbutton.MouseEnter, rollupbutton.MouseUp
rollupbutton.BackgroundImage = Skins.rollbtnhover
End Sub
Private Sub rollupbutton_MouseLeave(sender As Object, e As EventArgs) Handles rollupbutton.MouseLeave
rollupbutton.BackgroundImage = Skins.rollbtn
End Sub
Private Sub rollupbutton_MouseDown(sender As Object, e As EventArgs) Handles rollupbutton.MouseDown
rollupbutton.BackgroundImage = Skins.rollbtnclick
End Sub
Public Sub setuptitlebar()
setupborders()
If Me.Height = Me.titlebar.Height Then pgleft.Show() : pgbottom.Show() : pgright.Show() : Me.Height = rolldownsize : needtorollback = True
pgleft.Width = Skins.borderwidth
pgright.Width = Skins.borderwidth
pgbottom.Height = Skins.borderwidth
titlebar.Height = Skins.titlebarheight
' fixes growing issue
If justopened = False Then
Me.Size = New Size(Me.Width, Me.Height - (Skins.titlebarheight / 2))
End If
If justopened = True Then
Me.Size = New Size(673, 507) 'put the default size of your window here
Me.Size = New Size(Me.Width, Me.Height + Skins.titlebarheight - 30)
Me.Size = New Size(Me.Width + Skins.borderwidth + Skins.borderwidth, Me.Height + Skins.borderwidth)
oldbordersize = Skins.borderwidth
oldtitlebarheight = Skins.titlebarheight
justopened = False
Else
If Me.Visible = True Then
'Me.Hide()
Me.Size = New Size(Me.Width - (2 * oldbordersize) + (2 * Skins.borderwidth), (Me.Height - oldtitlebarheight - oldbordersize) + Skins.titlebarheight + Skins.borderwidth)
'Me.Size = New Size(Me.Width - oldbordersize - oldbordersize, Me.Height - oldbordersize) 'Just put a little algebra in the first size setting and comment out the mess
oldbordersize = Skins.borderwidth
oldtitlebarheight = Skins.titlebarheight
'Me.Size = New Size(Me.Width, Me.Height + Skins.titlebarheight - 30)
'Me.Size = New Size(Me.Width + Skins. borderwidth + Skins. borderwidth, Me.Height + Skins. borderwidth)
'rolldownsize = Me.Height
If needtorollback = True Then Me.Height = titlebar.Height : pgleft.Hide() : pgbottom.Hide() : pgright.Hide()
'Me.Show()
End If
End If
If Skins.enablecorners = True Then
pgtoplcorner.Show()
pgtoprcorner.Show()
pgtoprcorner.Width = Skins.titlebarcornerwidth
pgtoplcorner.Width = Skins.titlebarcornerwidth
Else
pgtoplcorner.Hide()
pgtoprcorner.Hide()
End If
If ShiftOSDesktop.boughttitlebar = False Then
titlebar.Hide()
Me.Size = New Size(Me.Width, Me.Size.Height - titlebar.Height)
End If
If ShiftOSDesktop.boughttitletext = False Then
lbtitletext.Hide()
Else
lbtitletext.Font = New Font(Skins.titletextfontfamily, Skins.titletextfontsize, Skins.titletextfontstyle, GraphicsUnit.Point)
lbtitletext.Text = ShiftOSDesktop.snakeyname 'Remember to change to name of program!!!!
lbtitletext.Show()
End If
If ShiftOSDesktop.boughtclosebutton = False Then
closebutton.Hide()
Else
closebutton.BackColor = Skins.closebtncolour
closebutton.Size = Skins.closebtnsize
closebutton.Show()
End If
If ShiftOSDesktop.boughtrollupbutton = False Then
rollupbutton.Hide()
Else
rollupbutton.BackColor = Skins.rollbtncolour
rollupbutton.Size = Skins.rollbtnsize
rollupbutton.Show()
End If
If ShiftOSDesktop.boughtminimizebutton = False Then
minimizebutton.Hide()
Else
minimizebutton.BackColor = Skins.minbtncolour
minimizebutton.Size = Skins.minbtnsize
minimizebutton.Show()
End If
If ShiftOSDesktop.boughtwindowborders = True Then
closebutton.Location = New Point(titlebar.Size.Width - Skins.closebtnfromside - closebutton.Size.Width, Skins.closebtnfromtop)
rollupbutton.Location = New Point(titlebar.Size.Width - Skins.rollbtnfromside - rollupbutton.Size.Width, Skins.rollbtnfromtop)
minimizebutton.Location = New Point(titlebar.Size.Width - Skins.minbtnfromside - minimizebutton.Size.Width, Skins.minbtnfromtop)
Select Case Skins.titletextpos
Case "Left"
lbtitletext.Location = New Point(Skins.titletextfromside, Skins.titletextfromtop)
Case "Centre"
lbtitletext.Location = New Point((titlebar.Width / 2) - lbtitletext.Width / 2, Skins.titletextfromtop)
End Select
lbtitletext.ForeColor = Skins.titletextcolour
Else
closebutton.Location = New Point(titlebar.Size.Width - Skins.closebtnfromside - pgtoplcorner.Width - pgtoprcorner.Width - closebutton.Size.Width, Skins.closebtnfromtop)
rollupbutton.Location = New Point(titlebar.Size.Width - Skins.rollbtnfromside - pgtoplcorner.Width - pgtoprcorner.Width - rollupbutton.Size.Width, Skins.rollbtnfromtop)
minimizebutton.Location = New Point(titlebar.Size.Width - Skins.minbtnfromside - pgtoplcorner.Width - pgtoprcorner.Width - minimizebutton.Size.Width, Skins.minbtnfromtop)
Select Case Skins.titletextpos
Case "Left"
lbtitletext.Location = New Point(Skins.titletextfromside + pgtoplcorner.Width, Skins.titletextfromtop)
Case "Centre"
lbtitletext.Location = New Point((titlebar.Width / 2) - lbtitletext.Width / 2, Skins.titletextfromtop)
End Select
lbtitletext.ForeColor = Skins.titletextcolour
End If
'Change when Icon skinning complete
If ShiftOSDesktop.boughtknowledgeinputicon = True Then ' Change to program's icon
pnlicon.Visible = True
pnlicon.Location = New Point(Skins.titleiconfromside, Skins.titleiconfromtop)
pnlicon.Size = New Size(ShiftOSDesktop.titlebariconsize, ShiftOSDesktop.titlebariconsize)
pnlicon.Image = ShiftOSDesktop.snakeyicontitlebar 'Replace with the correct icon for the program.
End If
End Sub
Public Sub rollupanddown()
If Me.Height = Me.titlebar.Height Then
pgleft.Show()
pgbottom.Show()
pgright.Show()
Me.Height = rolldownsize
Me.MinimumSize = New Size(minimumsizewidth, minimumsizeheight)
Else
Me.MinimumSize = New Size(0, 0)
pgleft.Hide()
pgbottom.Hide()
pgright.Hide()
rolldownsize = Me.Height
Me.Height = Me.titlebar.Height
End If
End Sub
Public Sub resettitlebar()
If ShiftOSDesktop.boughtwindowborders = True Then
closebutton.Location = New Point(titlebar.Size.Width - Skins.closebtnfromside - closebutton.Size.Width, Skins.closebtnfromtop)
rollupbutton.Location = New Point(titlebar.Size.Width - Skins.rollbtnfromside - rollupbutton.Size.Width, Skins.rollbtnfromtop)
minimizebutton.Location = New Point(titlebar.Size.Width - Skins.minbtnfromside - minimizebutton.Size.Width, Skins.minbtnfromtop)
Select Case Skins.titletextpos
Case "Left"
lbtitletext.Location = New Point(Skins.titletextfromside, Skins.titletextfromtop)
Case "Centre"
lbtitletext.Location = New Point((titlebar.Width / 2) - lbtitletext.Width / 2, Skins.titletextfromtop)
End Select
lbtitletext.ForeColor = Skins.titletextcolour
Else
closebutton.Location = New Point(titlebar.Size.Width - Skins.closebtnfromside - pgtoplcorner.Width - pgtoprcorner.Width - closebutton.Size.Width, Skins.closebtnfromtop)
rollupbutton.Location = New Point(titlebar.Size.Width - Skins.rollbtnfromside - pgtoplcorner.Width - pgtoprcorner.Width - rollupbutton.Size.Width, Skins.rollbtnfromtop)
minimizebutton.Location = New Point(titlebar.Size.Width - Skins.minbtnfromside - pgtoplcorner.Width - pgtoprcorner.Width - minimizebutton.Size.Width, Skins.minbtnfromtop)
Select Case Skins.titletextpos
Case "Left"
lbtitletext.Location = New Point(Skins.titletextfromside + pgtoplcorner.Width, Skins.titletextfromtop)
Case "Centre"
lbtitletext.Location = New Point((titlebar.Width / 2) - lbtitletext.Width / 2, Skins.titletextfromtop)
End Select
lbtitletext.ForeColor = Skins.titletextcolour
End If
End Sub
Private Sub pullside_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles pullside.Tick
Me.Width = Cursor.Position.X - Me.Location.X
resettitlebar()
End Sub
Private Sub pullbottom_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles pullbottom.Tick
Me.Height = Cursor.Position.Y - Me.Location.Y
resettitlebar()
End Sub
Private Sub pullbs_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles pullbs.Tick
Me.Width = Cursor.Position.X - Me.Location.X
Me.Height = Cursor.Position.Y - Me.Location.Y
resettitlebar()
End Sub
'delete this for non-resizable windows
Private Sub Rightpull_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pgright.MouseDown
If ShiftOSDesktop.boughtresizablewindows = True Then
pullside.Start()
End If
End Sub
Private Sub RightCursorOn_MouseDown(ByVal sender As Object, ByVal e As System.EventArgs) Handles pgright.MouseEnter
If ShiftOSDesktop.boughtresizablewindows = True Then
Cursor = Cursors.SizeWE
End If
End Sub
Private Sub bottomCursorOn_MouseDown(ByVal sender As Object, ByVal e As System.EventArgs) Handles pgbottom.MouseEnter
If ShiftOSDesktop.boughtresizablewindows = True Then
Cursor = Cursors.SizeNS
End If
End Sub
Private Sub CornerCursorOn_MouseDown(ByVal sender As Object, ByVal e As System.EventArgs) Handles pgbottomrcorner.MouseEnter
If ShiftOSDesktop.boughtresizablewindows = True Then
Cursor = Cursors.SizeNWSE
End If
End Sub
Private Sub SizeCursoroff_MouseDown(ByVal sender As Object, ByVal e As System.EventArgs) Handles pgright.MouseLeave, pgbottom.MouseLeave, pgbottomrcorner.MouseLeave
If ShiftOSDesktop.boughtresizablewindows = True Then
Cursor = Cursors.Default
End If
End Sub
Private Sub rightpull_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pgright.MouseUp
If ShiftOSDesktop.boughtresizablewindows = True Then
pullside.Stop()
End If
End Sub
Private Sub bottompull_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pgbottom.MouseDown
If ShiftOSDesktop.boughtresizablewindows = True Then
pullbottom.Start()
End If
End Sub
Private Sub buttompull_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pgbottom.MouseUp
If ShiftOSDesktop.boughtresizablewindows = True Then
pullbottom.Stop()
End If
End Sub
Private Sub bspull_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pgbottomrcorner.MouseDown
If ShiftOSDesktop.boughtresizablewindows = True Then
pullbs.Start()
End If
End Sub
Private Sub bspull_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pgbottomrcorner.MouseUp
If ShiftOSDesktop.boughtresizablewindows = True Then
pullbs.Stop()
End If
End Sub
Public Sub setskin()
'disposals
closebutton.BackgroundImage = Nothing
titlebar.BackgroundImage = Nothing
rollupbutton.BackgroundImage = Nothing
pgtoplcorner.BackgroundImage = Nothing
pgtoprcorner.BackgroundImage = Nothing
minimizebutton.BackgroundImage = Nothing
'apply new skin
If Skins.closebtn Is Nothing Then closebutton.BackColor = Skins.closebtncolour Else closebutton.BackgroundImage = Skins.closebtn
closebutton.BackgroundImageLayout = Skins.closebtnlayout
If Skins.titlebar Is Nothing Then titlebar.BackColor = Skins.titlebarcolour Else titlebar.BackgroundImage = Skins.titlebar
titlebar.BackgroundImageLayout = Skins.titlebarlayout
If Skins.rollbtn Is Nothing Then rollupbutton.BackColor = Skins.rollbtncolour Else rollupbutton.BackgroundImage = Skins.rollbtn
rollupbutton.BackgroundImageLayout = Skins.rollbtnlayout
If Skins.leftcorner Is Nothing Then pgtoplcorner.BackColor = Skins.leftcornercolour Else pgtoplcorner.BackgroundImage = Skins.leftcorner
pgtoplcorner.BackgroundImageLayout = Skins.leftcornerlayout
If Skins.rightcorner Is Nothing Then pgtoprcorner.BackColor = Skins.rightcornercolour Else pgtoprcorner.BackgroundImage = Skins.rightcorner
pgtoprcorner.BackgroundImageLayout = Skins.rightcornerlayout
If Skins.minbtn Is Nothing Then minimizebutton.BackColor = Skins.minbtncolour Else minimizebutton.BackgroundImage = Skins.minbtn
minimizebutton.BackgroundImageLayout = Skins.minbtnlayout
If Skins.borderleft Is Nothing Then pgleft.BackColor = Skins.borderleftcolour Else pgleft.BackgroundImage = Skins.borderleft
pgleft.BackgroundImageLayout = Skins.borderleftlayout
If Skins.borderright Is Nothing Then pgright.BackColor = Skins.borderrightcolour Else pgright.BackgroundImage = Skins.borderright
pgleft.BackgroundImageLayout = Skins.borderrightlayout
If Skins.borderbottom Is Nothing Then pgbottom.BackColor = Skins.borderbottomcolour Else pgbottom.BackgroundImage = Skins.borderbottom
pgbottom.BackgroundImageLayout = Skins.borderbottomlayout
If Skins.bottomleftcorner Is Nothing Then pgbottomlcorner.BackColor = Skins.bottomleftcornercolour Else pgbottomlcorner.BackgroundImage = Skins.bottomleftcorner
pgbottomlcorner.BackgroundImageLayout = Skins.bottomleftcornerlayout
If Skins.bottomrightcorner Is Nothing Then pgbottomrcorner.BackColor = Skins.bottomrightcornercolour Else pgbottomrcorner.BackgroundImage = Skins.bottomrightcorner
pgbottomrcorner.BackgroundImageLayout = Skins.bottomrightcornerlayout
Me.TransparencyKey = ShiftOSDesktop.globaltransparencycolour
End Sub
Private Sub Clock_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
ShiftOSDesktop.programsopen = ShiftOSDesktop.programsopen - 1
Me.Hide()
ShiftOSDesktop.setuppanelbuttons()
End Sub
'end of general setup
#End Region
Private Structure structSnake
Dim rect As Rectangle
Dim x As Integer
Dim y As Integer
End Structure
Private Enum Direction
Rightward
Downward
Leftward
Upward
End Enum
Private Const INITIAL_SNAKE_RECT_COUNT As Integer = 5
Private Const COLUMN_COUNT As Integer = 65
Private Const ROW_COUNT As Integer = 47
Private curRecCount As Integer
Private rects(,) As Rectangle
Private isSnakePart(,) As Boolean
Private snake As Collection
Private snakeBrush As Brush = New SolidBrush(Color.FromArgb(255, 255, 255))
Private backBrush As Brush = New SolidBrush(Color.FromArgb(1, 1, 1))
Private tokenBrush As Brush = New SolidBrush(Color.FromArgb(255, 255, 255))
Private curDirection As Direction
Private buffer As Bitmap
Private columnCount As Integer
Private rowCount As Integer
Private snakePoints As Integer
Private snakeSpeed As Double
Private snakeLength As Integer
Private token As Rectangle
Private Function xyToRectIndex(ByVal X As Integer, ByVal Y As Integer) As Integer
Return (Y * (columnCount)) + X
End Function
Private Sub rectIndexToXY(ByVal Index As Integer, ByRef X As Integer, ByRef Y As Integer)
X = Index Mod (columnCount)
Y = Index \ (columnCount)
End Sub
Private Sub initSnake()
Dim x As Integer
Dim y As Integer
Dim i As Integer
Dim index As Integer
Dim sSnake As structSnake
snake = New Collection
x = ((columnCount) - 10) \ 2
y = ((rowCount) - 6) \ 2
Dim snakePosition As Point = New Point(x, y)
index = xyToRectIndex(x, y)
For i = 1 To INITIAL_SNAKE_RECT_COUNT
rectIndexToXY(index + (i - 1), x, y)
sSnake.rect = rects(x, y)
sSnake.x = x
sSnake.y = y
snake.Add(sSnake)
Next
snakeLength = INITIAL_SNAKE_RECT_COUNT
snakeSpeed = 1
length.Text = "Length: " & CStr(snakeLength)
speed.Text = "Speed: " & CStr(snakeSpeed)
End Sub
Private Sub selectRectangles()
Dim g As Graphics = Graphics.FromImage(My.Resources.snakeyback)
Dim i As Integer
Dim sSnake As structSnake
For i = 1 To INITIAL_SNAKE_RECT_COUNT
sSnake = snake(i)
g.FillRectangle(snakeBrush, sSnake.rect)
isSnakePart(sSnake.x, sSnake.y) = True
Next
buffer = New Bitmap(My.Resources.snakeyback)
g.Dispose()
Refresh()
End Sub
Private Sub initRectangles()
Dim i As Integer
Dim j As Integer
columnCount = COLUMN_COUNT
rowCount = ROW_COUNT
ReDim rects(columnCount, rowCount)
ReDim isSnakePart(columnCount, rowCount)
For j = 0 To rowCount
For i = 0 To columnCount
rects(i, j) = New Rectangle((i * 10) + 1, (j * 10) + 1, 9, 9)
isSnakePart(i, j) = False
Next
Next
End Sub
Private Sub initialize()
curRecCount = INITIAL_SNAKE_RECT_COUNT
curDirection = Direction.Leftward
snakePoints = 0
initRectangles()
initSnake()
selectRectangles()
setToken()
setPoints()
tmr.Interval = 50
tmr.Enabled = True
End Sub
Private Sub setPoints()
score.Text = "Total Points: " & CStr(snakePoints)
End Sub
Private Sub setToken()
Randomize()
Dim x As Integer
Dim y As Integer
Dim g As Graphics = Graphics.FromImage(buffer)
x = CInt(Rnd() * columnCount)
Do While x > columnCount Or isSnakePart(x, y) = True
x = CInt(Rnd() * columnCount)
Loop
y = CInt(Rnd() * rowCount)
Do While y > rowCount Or isSnakePart(x, y) = True
y = CInt(Rnd() * rowCount)
Loop
token = rects(x, y)
g.FillEllipse(tokenBrush, token)
Refresh()
g.Dispose()
End Sub
Private Sub main_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
initialize()
End Sub
Private Sub main_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
Select Case e.KeyCode
Case Keys.Down
If Not (curDirection = Direction.Downward Or curDirection = Direction.Upward) Then
curDirection = Direction.Downward
End If
Case Keys.Left
If Not (curDirection = Direction.Leftward Or curDirection = Direction.Rightward) Then
curDirection = Direction.Leftward
End If
Case Keys.Right
If Not (curDirection = Direction.Rightward Or curDirection = Direction.Leftward) Then
curDirection = Direction.Rightward
End If
Case Keys.Up
If Not (curDirection = Direction.Upward Or curDirection = Direction.Downward) Then
curDirection = Direction.Upward
End If
End Select
End Sub
Private Sub moveSnake()
Dim sSnake As structSnake
Dim x As Integer
Dim y As Integer
Dim rect As Rectangle = New Rectangle()
Dim g As Graphics = Graphics.FromImage(buffer)
tmr.Enabled = False
sSnake = snake(snake.Count)
g.FillRectangle(backBrush, sSnake.rect)
snake.Remove(snake.Count)
isSnakePart(sSnake.x, sSnake.y) = False
sSnake = snake.Item(1)
x = sSnake.x
y = sSnake.y
Select Case curDirection
Case Direction.Downward
y = y + 1
If y > rowCount Then y = 0
Case Direction.Leftward
x = x - 1
If x < 0 Then x = columnCount
Case Direction.Rightward
x = x + 1
If x > columnCount Then x = 0
Case Direction.Upward
y = y - 1
If y < 0 Then y = rowCount
End Select
If isSnakePart(x, y) = True Then
tmr.Enabled = False
If MessageBox.Show("You lost! You got a total of " & snakePoints & " codepoints. ", "Snake", MessageBoxButtons.OK, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1) = Windows.Forms.DialogResult.Yes Then
initialize()
Exit Sub
Else
End
End If
End If
rect = rects(x, y)
sSnake.x = x
sSnake.y = y
sSnake.rect = rect
isSnakePart(x, y) = True
g.FillRectangle(snakeBrush, sSnake.rect)
Me.BackgroundImage = buffer
snake.Add(sSnake, , 1)
If rects(x, y).Equals(CObj(token)) Then
snakePoints += 1
setPoints()
If snakePoints Mod 5 = 0 Then
sSnake = snake.Item(snake.Count)
Select Case curDirection
Case Direction.Downward
sSnake.y -= 1
Case (Direction.Leftward)
sSnake.x += 1
Case Direction.Rightward
sSnake.x -= 1
Case Direction.Upward
sSnake.y += 1
End Select
sSnake.rect = rects(sSnake.x, sSnake.y)
g.FillRectangle(snakeBrush, sSnake.rect)
Me.BackgroundImage = buffer
snake.Add(sSnake, , , snake.Count)
snakeLength = snake.Count
tmr.Interval -= 1
If tmr.Interval < 0 Then tmr.Interval = 1
snakeSpeed = 1 + (50 - tmr.Interval)
length.Text = "Length: " & CStr(snakeLength)
speed.Text = "Speed: " & CStr(snakeSpeed)
End If
setToken()
End If
Refresh()
tmr.Enabled = True
End Sub
Private Sub tmr_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs)
moveSnake()
Application.DoEvents()
End Sub
End Class