Страницы: 1
RSS
Игра "ход конём"
 
Код
'Program Name:      horse
'Purpose:           Entertainment puzzle game
'Author:            
'Date:              01.12.2009
'Version:           ...
'File Size:         ...

Option Explicit

Dim n As Integer
Dim x As Integer
Dim i As Boolean
Dim TimeStart As Date
Dim timeFinish As Date
Dim TimeSolve As Date

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Cells.Select
    Selection.ClearContents
Rows("3:12").Select
    Selection.RowHeight = 30
Columns("C:L").Select
    Selection.ColumnWidth = 5
Range("C3:L12").Select
    With Selection
    .Borders.LineStyle = xlContinuous
    .Borders(xlEdgeLeft).Weight = xlMedium
    .Borders(xlEdgeTop).Weight = xlMedium
    .Borders(xlEdgeBottom).Weight = xlMedium
    .Borders(xlEdgeRight).Weight = xlMedium
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Font.Name = "Calibri"
    .Font.Size = 17
End With
Range("O1").Select
Cells(1, 15).Value = "ЗАНОВО"
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    End With
    
    Application.ScreenUpdating = True
    TimeStart = TimeValue(Now)
    x = 1
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Target.Cells.Value = Empty
n = n - 1
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Address = "$O$1" Then
    Range("C3:L13").Select
    Selection.ClearContents
    TimeStart = TimeValue(Now)
    i = True
    n = 0
End If

If Not Target.Address = "$O$1" Then
    If x = 1 Then
        n = n + 1
        Target.Cells.Value = n
        x = 2
        Exit Sub
    End If
End If

If Not Target.Address = "$O$1" Then
    If x = 2 Then
        If ActiveCell.Offset(2, 1).Value = n Or ActiveCell.Offset(2, -1).Value = n Or ActiveCell.Offset(1, -2).Value = n Or ActiveCell.Offset(-1, -2).Value = n Or ActiveCell.Offset(-2, -1).Value = n Or ActiveCell.Offset(-2, 1).Value = n Or ActiveCell.Offset(-1, 2).Value = n Or ActiveCell.Offset(1, 2).Value = n Then
            n = n + 1
            Target.Cells.Value = n
            Else: MsgBox "Конь ходит буквой 'Г'"
        End If
    End If
End If

If n = 100 And i = True Then
timeFinish = TimeValue(Now)
TimeSolve = timeFinish - TimeStart
Beep
Application.Speech.Speak ("Well Done!")
MsgBox "Отлично!" & vbCrLf & _
        "Время сборки: " & TimeSolve
i = False
n = 0
End If


End Sub
 
Программу можно обвести вокруг пальца ) Исправить - запретить выделение нескольких ячеек.
А еще можно ходить вне поля, можно удалять ходы. Нужно избавиться от Select'ов. А еще... простор для дорабток )
 
Это же не коммерческая версия, а просто так, для развлечения... Зато код не слишком длинный.
 
Еще одна некоммерческая для развлечения
Возможность задавать размер поля, начальную точку. ЛКМ - ход, ПКМ - удаление ходов (шаги назад). Собщение при ошибочном ходе.

Можно добавить:
- окончание игры при тупике;
- выбор маршрута (замкнутый, незамкнутый);
- расстановка на поле непроходимых клеток;
- чего-то еще )

Заполнение 8*8 за 41 сек. :)
Страницы: 1
Наверх