Код |
---|
'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 |
Игра "ход конём"
12.07.2019 22:44:56
Программу можно обвести вокруг пальца ) Исправить - запретить выделение нескольких ячеек.
А еще можно ходить вне поля, можно удалять ходы. Нужно избавиться от Select'ов. А еще... простор для дорабток ) |
|
|
|
12.07.2019 22:56:28
Это же не коммерческая версия, а просто так, для развлечения... Зато код не слишком длинный.
|
|
|
|
13.07.2019 15:47:13
Еще одна некоммерческая для развлечения
Возможность задавать размер поля, начальную точку. ЛКМ - ход, ПКМ - удаление ходов (шаги назад). Собщение при ошибочном ходе. Можно добавить: - окончание игры при тупике; - выбор маршрута (замкнутый, незамкнутый); - расстановка на поле непроходимых клеток; - чего-то еще ) Заполнение 8*8 за 41 сек. |
||||
|
|
|||