Форум программистов, компьютерный форум, киберфорум
Наши страницы
Бета-тестирование
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.79/24: Рейтинг темы: голосов - 24, средняя оценка - 4.79
KoGG
5288 / 1361 / 322
Регистрация: 23.12.2010
Сообщений: 2,019
Записей в блоге: 1
1

Шахматы на VBA.

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

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

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

Шахматы в с++
Даны фигуры: Пешка, слон, король.(цвет фигуры не зависит). Суть задачи состоит...

Шахматы
День добрый, хочу написать шахматы на java, но не знаю с чего начать,...

Шахматы
Нужен исходный код шахмат, для игры ИИ + человек зачем нужен: пишу программу...

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

Шахматы.
Доброго времени суток. Пишу курсовую работу. В общем нужно реализовать игру в...

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
5288 / 1361 / 322
Регистрация: 23.12.2010
Сообщений: 2,019
Записей в блоге: 1
27.12.2011, 22:10  [ТС] 4
Версия 1.068.
Для совместимости с Офисом 97-XP заменены цветовые константы.
DebugFlag установлен 0 для игры в графическом режиме.
1
Вложения
Тип файла: rar Chess_Ko.rar (216.9 Кб, 212 просмотров)
KoGG
5288 / 1361 / 322
Регистрация: 23.12.2010
Сообщений: 2,019
Записей в блоге: 1
30.04.2013, 11:07  [ТС] 5
Версия 1.069.
Без шрифтов ISChess, отладочный режим на стандартных шахматных символах из Unicode.
3
Вложения
Тип файла: zip Chess_Ko.zip (231.1 Кб, 238 просмотров)
Новичок
Модератор
1524 / 993 / 468
Регистрация: 17.07.2012
Сообщений: 5,016
Завершенные тесты: 3
26.07.2014, 17:08 6
Не думал, что в Excel такое реально! А я белыми выиграл...
Название: шахматы.jpg
Просмотров: 477

Размер: 37.5 Кб
0
Новичок
Модератор
1524 / 993 / 468
Регистрация: 17.07.2012
Сообщений: 5,016
Завершенные тесты: 3
26.07.2014, 17:12 7
Жаль, что движок не сильный. Но все-равно круто!
0
SonicQ
283 / 183 / 18
Регистрация: 20.02.2012
Сообщений: 918
14.08.2014, 12:09 8
KoGG, просто обалдеть!
0
bedvit
606 / 168 / 18
Регистрация: 20.05.2016
Сообщений: 671
Записей в блоге: 7
03.02.2017, 15:09 9
Неплохо, выиграл с первого раза (не профи). За идею и реализацию респект.
0
Pilarentes
8 / 8 / 7
Регистрация: 06.03.2017
Сообщений: 48
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
5288 / 1361 / 322
Регистрация: 23.12.2010
Сообщений: 2,019
Записей в блоге: 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
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
05.09.2017, 20:00

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

Шахматы
как сделать шахматы? сама система родов Добавлено через 1 час 14 минут я...

Шахматы.
Поле шахматной доски определяется парой чисел, каждое из которых не превосходит...


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

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

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