VB Golf

Option Explicit
 
Dim Ar(15) As Long
 
Private Sub Form_Load()
  ScaleMode = vbPixels
  AutoRedraw = True
  FontSize = 15
  Caption = 15
  Move Left, Top, Width - Screen.TwipsPerPixelX * (ScaleWidth - 256), Height - Screen.TwipsPerPixelY * (ScaleHeight - 256)
  Randomize Timer
  NewGame
End Sub
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  MoveBrick (x \ 64) + (y \ 64) * 4
  ShowField
  If Victory Then
    MsgBox "Victory!", vbOKOnly, "15"
    NewGame
  End If
End Sub
 
Private Sub ShowField()
  Dim i As Long
  Dim x As Long, y As Long
 
  Line (0, 0)-(255, 255), &H507050, BF
  For i = 0 To 15
    x = (i And 3) * 64
    y = (i \ 4) * 64
    If Ar(i) > 0 Then
      Line (x + 2, y + 2)-(x + 61, y + 61), 0, B
      Line (x + 3, y + 3)-(x + 60, y + 60), &HA0A0A0, BF
      CurrentX = x + 16 - (Ar(i) < 10) * 7: CurrentY = y + 22
      ForeColor = &H0: Print Ar(i);
      CurrentX = x + 14 - (Ar(i) < 10) * 7: CurrentY = y + 20
      ForeColor = &HE0FFA0: Print Ar(i);
    End If
  Next i
End Sub
 
Private Sub NewGame()
  Dim i As Long
 
  For i = 0 To 15
    Ar(i) = (i + 1) And 15
  Next i
  For i = 0 To 1023
    MoveBrick Int(Rnd * 16)
  Next i
  ShowField
End Sub
 
Private Function Victory() As Boolean
  Dim i As Long
 
  For i = 0 To 15
    If Ar(i) <> ((i + 1) And 15) Then Exit Function
  Next i
  Victory = True
End Function
 
Private Sub MoveBrick(ByVal i As Long)
  If (i And 3) > 0 Then If Ar(i - 1) = 0 Then Swap i, i - 1
  If (i And 3) < 3 Then If Ar(i + 1) = 0 Then Swap i, i + 1
  If (i And 12) > 0 Then If Ar(i - 4) = 0 Then Swap i, i - 4
  If (i And 12) < 12 Then If Ar(i + 4) = 0 Then Swap i, i + 4
End Sub
 
Private Sub Swap(ByVal i1 As Long, ByVal i2 As Long)
  Ar(i1) = Ar(i1) Xor Ar(i2)
  Ar(i2) = Ar(i1) Xor Ar(i2)
  Ar(i1) = Ar(i1) Xor Ar(i2)
End Sub

Option Explicit
 
Dim Ar(15, 15) As Integer, bX As Long, bY As Long, dX As Long, dY As Long, L As Long
 
Private Sub Form_Activate()
  Dim T As Single
 
  BackColor = &H509950
  Move Left, Top, Width - ScaleWidth + 7000, Height - ScaleHeight + 7000
  Scale (-0.5, -0.5)-(15.5, 15.5)
  DrawWidth = 6500 / (Screen.TwipsPerPixelX * 16)
  Randomize Timer
  Ar(1, 0) = -1
  dX = 1
  While DoEvents
    If T < Timer Then
      T = Timer + 0.2
      Tick
    End If
  Wend
End Sub
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  Select Case KeyCode
    Case vbKeyLeft: dX = -1: dY = 0
    Case vbKeyUp: dX = 0: dY = -1
    Case vbKeyRight: dX = 1: dY = 0
    Case vbKeyDown: dX = 0: dY = 1
  End Select
End Sub
 
Private Sub Tick()
  Dim x As Long, y As Long
 
  bX = (bX + dX) And 15
  bY = (bY + dY) And 15
  If Ar(bX, bY) = -1 Then
    L = L + 1
    Caption = L
    Do
      x = Int(Rnd * 16)
      y = Int(Rnd * 16)
    Loop While Ar(x, y) > 0
    Ar(x, y) = -1
    PSet (x, y), &H205099
  ElseIf Ar(bX, bY) > 0 Then MsgBox L, , "Snake": End
  Else
    For y = 0 To 15
      For x = 0 To 15
        If Ar(x, y) = 1 Then Ar(x, y) = 0: PSet (x, y), BackColor
        If Ar(x, y) > 1 Then Ar(x, y) = Ar(x, y) - 1
      Next x
    Next y
  End If
  Ar(bX, bY) = L
  PSet (bX, bY), &HFFFFFF
End Sub

Private Sub Swap(ByVal i1 As Long, ByVal i2 As Long)
  Ar(i1) = Ar(i1) Xor Ar(i2)
  Ar(i2) = Ar(i1) Xor Ar(i2)
  Ar(i1) = Ar(i1) Xor Ar(i2)
End Sub

Move Left, Top, Width - Screen.TwipsPerPixelX * (ScaleWidth - 256), Height - Screen.TwipsPerPixelY * (ScaleHeight - 256)

Option Explicit
 
Dim XX As Long, pY As Single, sY As Single, KK As Boolean, Wall(3) As Long, Sc As Long, t As Single
 
Private Sub Form_KeyDown(Key As Integer, Shift As Integer)
  KK = True
End Sub
 
Private Sub Form_KeyUp(Key As Integer, Shift As Integer)
  KK = False
End Sub
 
Sub Form_Load()
  ScaleMode = vbPixels
  Move Left, Top, Width - Screen.TwipsPerPixelX * (ScaleWidth - 512), Height - Screen.TwipsPerPixelY * (ScaleHeight - 384)
  Show
  t = Timer + 0.03
  pY = 32
  While DoEvents
    While t > Timer: Wend: t = t + 0.03
    Tick
  Wend
End Sub
 
Private Sub Tick()
  Dim x As Long, y As Long, d As Single
 
  Line (0, 0)-(512, 384), &HAA7755, BF
  For x = -3 To 512 Step 4
    If (x + XX) And 192 Then
    Else
      y = Wall((x + XX) \ 256 And 3)
      Line (x, 0)-(x, y), ((x + XX) And 63) * &H20402
      Line (x, y + 128)-(x, 384), ((x + XX) And 63) * &H20402
    End If
  Next x
 
  DrawWidth = 5
  d = Sin(Timer * 25)
  Line (74, pY - d * 2)-(84, pY + d * 5), &HAAAAAA
  Line (69, pY + 1 - d * 2)-(79, pY + 3 - d * 2), &HFFFFFF
  Line (74, pY - d * 2)-(64, pY + d * 5), &HCCCCCC
 
  DrawWidth = 12
  If (XX Mod 256) > 160 Then
    y = Wall(XX \ 256 + 1 And 3)
    If pY < y + 12 Or pY > y + 112 Then
      t = Timer + 1
      Circle (74, pY), 32, &HFF
      pY = y + 64: sY = 0: Sc = 0
    End If
  End If
  XX = (XX + 4) And 1023
  If (XX And 255) = 0 Then
    Wall((XX \ 256) + 3 And 3) = Rnd * 256
    Sc = Sc + 1: Caption = Sc
  End If
  If KK Then sY = sY - 0.8 Else sY = sY + 0.3
  pY = pY + sY
End Sub

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_THICKFRAME = &H40000
 
Private Sub Form_Load()
    SetWindowLong hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) And Not WS_THICKFRAME
End Sub

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_THICKFRAME = &H40000
Private Const WS_MAXIMIZEBOX = &H10000
 
Private Sub Form_Load()
    SetWindowLong hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) And Not (WS_THICKFRAME Or WS_MAXIMIZEBOX)
End Sub