Форум программистов, компьютерный форум, киберфорум
Бета-тестирование
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/28: Рейтинг темы: голосов - 28, средняя оценка - 5.00
KoGG
5330 / 1396 / 330
Регистрация: 23.12.2010
Сообщений: 2,072
Записей в блоге: 1
1

Шахматы на VBA.

12.12.2011, 15:54. Просмотров 5615. Ответов 12
Метки нет (Все метки)

Шахматы на VBA в Excel.
В отлиичии от Chess_64
https://www.cyberforum.ru/vba/thread...ead346543.html
код открыт.
Графическая система оттуда позаимствована, но программа может работать и без нее на шрифтах ISChess.
В коде сохранены отладочные блоки - так как нет предела для совершенствования.

Ближайший предок - на Qbasic
http://www.ocf.berkeley.edu/~horie/lordx1b.bas
12
Миниатюры
Шахматы на VBA.  
Вложения
Тип файла: zip Chess_Ko.zip (200.8 Кб, 294 просмотров)
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
12.12.2011, 15:54
Ответы с готовыми решениями:

Шахматы
По умолчанию Ферзь, ладья и конь Ферзь, ладья и конь На шахматной доске 8х8 расположены три...

C++ и шахматы.
Дали такое задание по курсовой, не могу понять как написать программу. Помогите пожалуйста. Даны...

Шахматы
Ход шахматной фигуры задан в виде: XY-XY, где X - буква (A,B,C,D,E,F,G,H), а Y - цифра...

Шахматы
Помогите пожалуйста решить прогу, так как я абсолютно не шарю, что здесь делать. Вот в чём она...

12
Artemo
20 / 6 / 1
Регистрация: 06.03.2010
Сообщений: 74
16.12.2011, 15:27 2
Пришлось все константы rgbЦвет сменить на vbЦвет,иначе ошибку выдавало. Здорово!сразу проиграл))))).
1
HarkBack
17 / 17 / 1
Регистрация: 14.11.2011
Сообщений: 94
27.12.2011, 19:45 3
А я знал что в Excel'е можно создать какую нить игру
0
KoGG
5330 / 1396 / 330
Регистрация: 23.12.2010
Сообщений: 2,072
Записей в блоге: 1
27.12.2011, 22:10  [ТС] 4
Версия 1.068.
Для совместимости с Офисом 97-XP заменены цветовые константы.
DebugFlag установлен 0 для игры в графическом режиме.
1
Вложения
Тип файла: rar Chess_Ko.rar (216.9 Кб, 226 просмотров)
KoGG
5330 / 1396 / 330
Регистрация: 23.12.2010
Сообщений: 2,072
Записей в блоге: 1
30.04.2013, 11:07  [ТС] 5
Версия 1.069.
Без шрифтов ISChess, отладочный режим на стандартных шахматных символах из Unicode.
3
Вложения
Тип файла: zip Chess_Ko.zip (231.1 Кб, 261 просмотров)
Новичок
Модератор
1586 / 1046 / 480
Регистрация: 17.07.2012
Сообщений: 5,218
Завершенные тесты: 3
26.07.2014, 17:08 6
Не думал, что в Excel такое реально! А я белыми выиграл...
Название: шахматы.jpg
Просмотров: 516

Размер: 37.5 Кб
0
Новичок
Модератор
1586 / 1046 / 480
Регистрация: 17.07.2012
Сообщений: 5,218
Завершенные тесты: 3
26.07.2014, 17:12 7
Жаль, что движок не сильный. Но все-равно круто!
0
SonicQ
284 / 184 / 18
Регистрация: 20.02.2012
Сообщений: 925
14.08.2014, 12:09 8
KoGG, просто обалдеть!
0
bedvit
630 / 190 / 20
Регистрация: 20.05.2016
Сообщений: 755
Записей в блоге: 11
03.02.2017, 15:09 9
Неплохо, выиграл с первого раза (не профи). За идею и реализацию респект.
0
Pilarentes
137 / 98 / 34
Регистрация: 06.03.2017
Сообщений: 424
06.03.2017, 10:43 10
Шикарно! В принципе компьютер играет на уровне среднестатистического неподготовленного пользователя, так что шахматы самое то. Остается допиливать мелочи вроде двойного щелчка, убрать неудобство с установкой шрифта, ну и навести эстетику во внешнем виде.
0
alexminin007
9 / 9 / 4
Регистрация: 22.10.2012
Сообщений: 120
19.05.2017, 18:18 11
у меня ферзь срубил туру и исчез(
0
Владимир_Сар
58 / 57 / 13
Регистрация: 10.09.2009
Сообщений: 255
05.09.2017, 17:19 12
А как эти шахматы прокачивать, где зашита библиотека (дебюты) или алгоритм, а то некоторые дебюты неправильно разыгрывает.
Я б их прокачал до гроса
0
KoGG
5330 / 1396 / 330
Регистрация: 23.12.2010
Сообщений: 2,072
Записей в блоге: 1
05.09.2017, 20:00  [ТС] 13
Дебюты зашиты в процедуре Books

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
Sub Books()
' Sub make first moves from book  DataW()
' Процедура делает ходы из предзаписанной книги DataW()
    '--------- Opening Book -----------------------------------------------
    If BookFlag = False Then Exit Sub            'if no more books skip
    Const BookLimit = 17
    Dim i, j, k, RndNumber, BlankSpaceCount    ', SumBookPercent
    Dim DataW(BookLimit) As String, BookMove(BookLimit, 2) As String
    Dim Prioritet1(BookLimit) As Single
    Dim BookStr As String, CurBook As String, CurBookMove As String
    Dim X1w$, X2w$, Y1w$, Y2w$
    Dim X1, X2, Y1, Y2
    Dim Condition1 As Boolean
    i = 0
    '-------------------
    i = i + 1
    DataW(i) = "RNBQKBNRPPPPPPPP32pppppppprnbqkbnr*1"
    BookMove(i, 1) = "E2E4": BookMove(i, 2) = "D2D4"
    Prioritet1(i) = 0.75
    i = i + 1
    DataW(i) = "RNBQKBNRPPPP1PPP12P19pppppppprnbqkbnr*1"
    BookMove(i, 1) = "E7E5": BookMove(i, 2) = "E7E5"
    Prioritet1(i) = 0.5
    i = i + 1
    DataW(i) = "RNBQKBNRPPPP1PPP12P7p11pppp1ppprnbqkbnr*2"
    BookMove(i, 1) = "G1F3": BookMove(i, 2) = "B1C3"
    Prioritet1(i) = 0.5
    i = i + 1
    DataW(i) = "RNBQKB1RPPPP1PPP5N6P7p11pppp1ppprnbqkbnr*2"
    BookMove(i, 1) = "B8C6": BookMove(i, 2) = "D7D6"
    Prioritet1(i) = 0.5
    i = i + 1
    DataW(i) = "RNBQKBNRPPPP2PP5P6P7p11pppp1ppprnbqkbnr*2"
    BookMove(i, 1) = "D7D6": BookMove(i, 2) = "D7D6"
    Prioritet1(i) = 0.5
    i = i + 1
    DataW(i) = "R1BQKBNRPPPP1PPP2N9P7p11pppp1ppprnbqkbnr*2"
    BookMove(i, 1) = "G8F6": BookMove(i, 2) = "F8C5"
    Prioritet1(i) = 0.5
    
    i = i + 1
    DataW(i) = "RNBQKBNRPPPP1PPP12P5p13pp1ppppprnbqkbnr*2"
    BookMove(i, 1) = "G1F3": BookMove(i, 2) = "G1F3"
    Prioritet1(i) = 0.5
    
    i = i + 1
    DataW(i) = "RNBQKB1RPPPP1PPP5N6P5p13pp1ppppprnbqkbnr*2"
    BookMove(i, 1) = "D7D6": BookMove(i, 2) = "D7D6"
    Prioritet1(i) = 0.5
    
    i = i + 1
    DataW(i) = "RNBQKBNRPPPP1PPP12P15p3pppp1ppprnbqkbnr*2"
    BookMove(i, 1) = "D2D3": BookMove(i, 2) = "D2D4"
    Prioritet1(i) = 0.5
    
    
    i = i + 1
    DataW(i) = "RNBQKBNRPPP2PPP3P8P15p3pppp1ppprnbqkbnr*2"
    BookMove(i, 1) = "D7D5": BookMove(i, 2) = "D7D5"
    Prioritet1(i) = 0.5
    
    i = i + 1
    DataW(i) = "RNBQKBNRPPP2PPP11PP15p3pppp1ppprnbqkbnr*2"
    BookMove(i, 1) = "D7D5": BookMove(i, 2) = "D7D5"
    Prioritet1(i) = 0.5
    
    i = i + 1
    DataW(i) = "RNBQKB1RPPPP1PPP5N5P7p9n2pppp1pppr1bqkbnr*3"
    BookMove(i, 1) = "B1F3": BookMove(i, 2) = "B1F3"
    Prioritet1(i) = 0.5
    i = i + 1
    DataW(i) = "R1BQKB1RPPPP1PPP2N2N6P7p5n5pppp1pppr1bqkbnr*3"
    BookMove(i, 1) = "G8F6": BookMove(i, 2) = "G8F6"
    Prioritet1(i) = 0.5
    i = i + 1
    DataW(i) = "R1BQKBNRPPPP1PPP2N9P7p8n2pppp1ppprnbqkb1r*3"
    BookMove(i, 1) = "G1F3": BookMove(i, 2) = "G1F3"
    Prioritet1(i) = 0.5
    i = i + 1
    DataW(i) = "R1BQKB1RPPPP1PPP2N2N6P7p8n2pppp1ppprnbqkb1r*3"
    BookMove(i, 1) = "B8C6": BookMove(i, 2) = "B8C6"
    Prioritet1(i) = 0.5
   
    i = i + 1
    DataW(i) = "RNBQKB1RPPPP1PPP5N6P5p8p4pp2pppprnbqkbnr*3"
    BookMove(i, 1) = "D2D4": BookMove(i, 2) = "D2D4"
    Prioritet1(i) = 0.5
    
    i = i + 1
    DataW(i) = "R1BQK2RPPPP1PPP2N2N4B1P7p5n2n2pppp1pppr1bqkb1r*4"
    BookMove(i, 1) = "F8C5": BookMove(i, 2) = "F8C5"
    Prioritet1(i) = 0.5
    
    '---------
    BookStr = ""                           'set start flag for book moves
    BlankSpaceCount = 0                     'set blank space counter
    For k = 10 To 80 Step 10                'scan chess board
        For j = 1 To 8                      'scan chess board
          If ChessBoard(k + j) = 0 Then     'is square empty ?
            BlankSpaceCount = BlankSpaceCount + 1        'count space
          Else
            If BlankSpaceCount > 0 Then                     'this means we found a man
                BookStr = BookStr & Format(BlankSpaceCount)  'put results in book string
                BlankSpaceCount = 0                          'reset space counter
            End If
            i = ChessBoard(k + j)           'get contents of square
            BookStr = BookStr & Boo(i)   'store white man in book string
          End If
        Next j                              'next Column
    Next k                                  'next Row
    BookStr = BookStr & "*" & Format(MoveNum) 'set end flag & store move number
    '======= Debug block == блок отладки ==========
    'Debug.Print "BookStr "
    'Debug.Print BookStr
    '======== END of Debug block == конец блока отладки =========
    Do
        BookIndex = BookIndex + 1
        If BookIndex > BookLimit Then             'if we are at the end
          BookFlag = False                  'the set books to No more
          Exit Sub
        ElseIf BookIndex = BookLimit Then             'if we are at the end
          BookFlag = False                  'the set books to No more
        End If
        CurBook = DataW(BookIndex)          'read book data
    Loop While (BookStr <> CurBook)         'our books start with a "*" compare with boardscan
    If Rnd() < Prioritet1(BookIndex) Then
        CurBookMove = BookMove(BookIndex, 1)
    Else
        CurBookMove = BookMove(BookIndex, 2)
    End If
    X1w$ = Mid$(CurBookMove, 1, 1)           'used to convert to numbers that
    X1 = Asc(X1w$) - 64                     'the computer can use to make
    Y1w$ = Mid$(CurBookMove, 2, 1)             'the required move indicated by
    Y1 = Val(Y1w$)                             'our opening book data
    X2w$ = Mid$(CurBookMove, 3, 1)
    X2 = Asc(X2w$) - 64
    Y2w$ = Mid$(CurBookMove, 4, 1)
    Y2 = Val(Y2w$)
    FromPos = 10 * Y1 + X1                      'convert to "from-to" format
    ToPos = 10 * Y2 + X2
    For i = 1 To MoveIteration
        BestFromPs(i) = FromPos
        BestToPs(i) = ToPos
        Best(i) = 500
    Next
End Sub
Позиция на доске к которой применяется ход "RNBQKBNRPPPPPPPP32pppppppprnbqkbnr*1"
0
05.09.2017, 20:00
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
05.09.2017, 20:00

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Шахматы
не могу понять задачи .. помогите Класс &quot;фигура&quot;: координаты на шахматной доске, цвет. Метод -...

Шахматы
Всем доброго вечера. Слив компьютеру десятую партию в шахматы, мне стало интересно, как же он...

Шахматы
ВЕТВЛЕНИЕ! Поле шахматной доски определяется парой натуральных чисел, каждое из которых не...

Шахматы
Разработать симулятор стандартной шахматной игры с возможностью перемещать фигуры и пешки «мышкой»...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
13
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.