Игра: Крестики-нолики

@just a dream · Регистрация: 10.08.2013

Студворк — интернет-сервис помощи студентам

Pascal
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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
program tictac;
 
uses
  GraphAbc, ABCobjects;
 
var
  mas: array[1..9] of rectangleABC;
  wx, wy, ww, wh, k, hod, c1, c2: integer;
  res: RectangleABC;
  finish: boolean;
 
procedure start;
begin
  finish := false;
  
  k := 0;
  ww := 80;
  wh := 80;
  wx := 0;
  wy := 0;
  res := new RectangleABC(0, 237, 238, 31, clsalmon);
  res.BorderWidth := 2;
  res.Text := IntToStr(c1) + '  -  Новая игра  -  ' + IntToStr(c2);
  for var i := 1 to 9 do 
  begin
    mas[i] := new RectangleABC(wx, wy, ww, wh, clLavender);
    mas[i].BorderWidth := 2;
    wx += 79;
    k += 1;
    if k mod 3 = 0 then begin wy += 79; wx := 0; end;
  end;
  
end;
 
procedure prov;
begin
  
  if (mas[1].Text = 'X') and (mas[2].Text = 'X') and (mas[3].Text = 'X') then begin
    mas[1].Color := clGreen;mas[2].Color := clGreen;mas[3].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(10, 38, 228, 38);c1 += 1;hod := 0;
  end;
  
  if (mas[4].Text = 'X') and (mas[5].Text = 'X') and (mas[6].Text = 'X') then begin
    mas[4].Color := clGreen;mas[5].Color := clGreen;mas[6].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(10, 38 + wh, 228, 38 + wh);c1 += 1;hod := 0;
  end;
  
  if (mas[7].Text = 'X') and (mas[8].Text = 'X') and (mas[9].Text = 'X') then begin
    mas[7].Color := clGreen;mas[8].Color := clGreen;mas[9].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(10, 38 + 2 * wh, 228, 38 + 2 * wh);c1 += 1;hod := 0;
  end;
  
  if (mas[1].Text = 'X') and (mas[4].Text = 'X') and (mas[7].Text = 'X') then begin
    mas[1].Color := clGreen;mas[4].Color := clGreen;mas[7].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(38, 10, 38, 3 * wh - 10);c1 += 1;hod := 0;
  end;
  
  if (mas[2].Text = 'X') and (mas[5].Text = 'X') and (mas[8].Text = 'X') then begin
    mas[2].Color := clGreen;mas[5].Color := clGreen;mas[8].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(38 + ww, 10, 38 + ww, 3 * wh - 10);c1 += 1;hod := 0;
  end;
  
  if (mas[3].Text = 'X') and (mas[6].Text = 'X') and (mas[9].Text = 'X') then begin
    mas[3].Color := clGreen;mas[6].Color := clGreen;mas[9].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(38 + 2 * ww, 10, 38 + 2 * ww, 3 * wh - 10);c1 += 1;hod := 0;
  end;
  
  if (mas[1].Text = 'X') and (mas[5].Text = 'X') and (mas[9].Text = 'X') then begin
    mas[1].Color := clGreen;mas[5].Color := clGreen;mas[9].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(18, 18, 2 * ww + 58, 2 * wh + 58);c1 += 1;hod := 0;
  end;
  
  if (mas[3].Text = 'X') and (mas[5].Text = 'X') and (mas[7].Text = 'X') then begin
    mas[3].Color := clGreen;mas[5].Color := clGreen;mas[7].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(18, 58 + wh * 2, 2 * ww + 58, 18);c1 += 1;hod := 0;
  end;
  //-------------------
  if (mas[1].Text = 'O') and (mas[2].Text = 'O') and (mas[3].Text = 'O') then begin
    mas[1].Color := clGreen;mas[2].Color := clGreen;mas[3].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(10, 38, 228, 38);c2 += 1;hod := 1;
  end;
  
  if (mas[4].Text = 'O') and (mas[5].Text = 'O') and (mas[6].Text = 'O') then begin
    mas[4].Color := clGreen;mas[5].Color := clGreen;mas[6].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(10, 38 + wh, 228, 38 + wh);c2 += 1;hod := 1;
  end;
  
  if (mas[7].Text = 'O') and (mas[8].Text = 'O') and (mas[9].Text = 'O') then begin
    mas[7].Color := clGreen;mas[8].Color := clGreen;mas[9].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(10, 38 + 2 * wh, 228, 38 + 2 * wh);c2 += 1;hod := 1;
  end;
  
  if (mas[1].Text = 'O') and (mas[4].Text = 'O') and (mas[7].Text = 'O') then begin
    mas[1].Color := clGreen;mas[4].Color := clGreen;mas[7].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(38, 10, 38, 3 * wh - 10);c2 += 1;hod := 1;
  end;
  
  if (mas[2].Text = 'O') and (mas[5].Text = 'O') and (mas[8].Text = 'O') then begin
    mas[2].Color := clGreen;mas[5].Color := clGreen;mas[8].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(38 + ww, 10, 38 + ww, 3 * wh - 10);c2 += 1;hod := 1;
  end;
  
  if (mas[3].Text = 'O') and (mas[6].Text = 'O') and (mas[9].Text = 'O') then begin
    mas[3].Color := clGreen;mas[6].Color := clGreen;mas[9].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(38 + 2 * ww, 10, 38 + 2 * ww, 3 * wh - 10);c2 += 1;hod := 1;
  end;
  
  if (mas[1].Text = 'O') and (mas[5].Text = 'O') and (mas[9].Text = 'O') then begin
    mas[1].Color := clGreen;mas[5].Color := clGreen;mas[9].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(18, 18, 2 * ww + 58, 2 * wh + 58);c2 += 1;hod := 1;
  end;
  
  if (mas[3].Text = 'O') and (mas[5].Text = 'O') and (mas[7].Text = 'O') then begin
    mas[3].Color := clGreen;mas[5].Color := clGreen;mas[7].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(18, 58 + wh * 2, 2 * ww + 58, 18);c2 += 1;hod := 1;
  end;
  
  
end;
 
procedure MouseDown(xm, ym, mb: integer);
begin
  if finish = false then begin
    if (mb = 1) then begin
      if (hod mod 2 = 0) and (mas[1].PtInside(xm, ym) = true)  and (mas[1].Text = '') then begin mas[1].Text := 'X';hod += 1; end;
      if (hod mod 2 = 0) and (mas[2].PtInside(xm, ym) = true)  and (mas[2].Text = '') then begin mas[2].Text := 'X';hod += 1; end;
      if (hod mod 2 = 0) and (mas[3].PtInside(xm, ym) = true)  and (mas[3].Text = '') then begin mas[3].Text := 'X';hod += 1; end;
      if (hod mod 2 = 0) and (mas[4].PtInside(xm, ym) = true)  and (mas[4].Text = '') then begin mas[4].Text := 'X';hod += 1; end;
      if (hod mod 2 = 0) and (mas[5].PtInside(xm, ym) = true)  and (mas[5].Text = '') then begin mas[5].Text := 'X';hod += 1; end;
      if (hod mod 2 = 0) and (mas[6].PtInside(xm, ym) = true)  and (mas[6].Text = '') then begin mas[6].Text := 'X';hod += 1; end;
      if (hod mod 2 = 0) and (mas[7].PtInside(xm, ym) = true)  and (mas[7].Text = '') then begin mas[7].Text := 'X';hod += 1; end;
      if (hod mod 2 = 0) and (mas[8].PtInside(xm, ym) = true)  and (mas[8].Text = '') then begin mas[8].Text := 'X';hod += 1; end;
      if (hod mod 2 = 0) and (mas[9].PtInside(xm, ym) = true)  and (mas[9].Text = '') then begin mas[9].Text := 'X';hod += 1; end;
      
      if (hod mod 2 <> 0) and (mas[1].PtInside(xm, ym) = true)  and (mas[1].Text = '') then begin mas[1].Text := 'O';hod += 1; end;
      if (hod mod 2 <> 0) and (mas[2].PtInside(xm, ym) = true)  and (mas[2].Text = '') then begin mas[2].Text := 'O';hod += 1; end;
      if (hod mod 2 <> 0) and (mas[3].PtInside(xm, ym) = true)  and (mas[3].Text = '') then begin mas[3].Text := 'O';hod += 1; end;
      if (hod mod 2 <> 0) and (mas[4].PtInside(xm, ym) = true)  and (mas[4].Text = '') then begin mas[4].Text := 'O';hod += 1; end;
      if (hod mod 2 <> 0) and (mas[5].PtInside(xm, ym) = true)  and (mas[5].Text = '') then begin mas[5].Text := 'O';hod += 1; end;
      if (hod mod 2 <> 0) and (mas[6].PtInside(xm, ym) = true)  and (mas[6].Text = '') then begin mas[6].Text := 'O';hod += 1; end;
      if (hod mod 2 <> 0) and (mas[7].PtInside(xm, ym) = true)  and (mas[7].Text = '') then begin mas[7].Text := 'O';hod += 1; end;
      if (hod mod 2 <> 0) and (mas[8].PtInside(xm, ym) = true)  and (mas[8].Text = '') then begin mas[8].Text := 'O';hod += 1; end;
      if (hod mod 2 <> 0) and (mas[9].PtInside(xm, ym) = true)  and (mas[9].Text = '') then begin mas[9].Text := 'O';hod += 1; end;
      
    end; 
    prov;
  end;
  if (mb = 1) and (res.PtInside(xm, ym) = true) then  start;
end;
 
 
begin
  SetWindowCaption('Крестики - Нолики');
  SetWindowSize(238, 268);
  hod := 0;
  
  start;
  OnMouseDown := MouseDown;
  
  
end.

@APALoff · 27.01.2014, 12:57

А когда ожидать, что компьютер начнет сам ходить?

@Kordn · 27.01.2014, 22:09

Ну что ж, неплохо

Немного "подшлифовал" твой код: извини, не удержался

Pascal
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
program tictac;
 
uses
  GraphAbc, ABCobjects;
 
var
  mas: array[1..9] of rectangleABC;
  wx, wy, ww, wh, hod, c1, c2: integer;
  res: RectangleABC;
  finish, x_won: boolean;
 
procedure Start;
begin
  finish := false;
  //Победили ли крестики
  x_won := false;
  //Крестики всегда ходят первыми! ;)
  hod := 0;
  SetWindowCaption('Ход: Крестики');
  ww := 80;
  wh := 80;
  wx := 0;
  wy := 0;
  res := new RectangleABC(0, 237, 238, 31, clSalmon);
  res.BorderWidth := 2;
  res.Text := IntToStr(c1) + '  -  Новая игра  -  ' + IntToStr(c2);
  for var i := 1 to 9 do 
  begin
    mas[i] := new RectangleABC(wx, wy, ww, wh, clLavender);
    mas[i].BorderWidth := 2;
    wx += 79;
    if i mod 3 = 0 then begin wy += 79; wx := 0; end;
  end;
  
end;
 
//Проверяем...
procedure Prov;
var
  i: integer;
begin
  //...горизонтали,
  i := 1;
  while (i <= 9) do
  begin
    if (mas[i].Text <> '') and (mas[i].Text = mas[i + 1].Text) and (mas[i + 1].Text = mas[i + 2].Text) then
    begin
      for var j := i to i + 2 do mas[j].Color := clGreen; finish := true;
      SetPenColor(clRed);
      Line(10, 38 + wh * (i div 3), 228, 38 + wh * (i div 3));
      if mas[i].Text = 'X' then begin x_won := true; c1 += 1; end
      else c2 += 1;
      break;
    end
    else 
      i += 3;
  end;
  
  //...вертикали,  
  i := 1;
  while (i <= 3) do
  begin
    if (mas[i].Text <> '') and (mas[i].Text = mas[i + 3].Text) and (mas[i + 3].Text = mas[i + 6].Text) then
    begin
      mas[i].Color := clGreen; mas[i + 3].Color := clGreen; mas[i + 6].Color := clGreen; finish := true;
      SetPenColor(clRed);
      Line(38 + (i - 1) * ww, 10, 38 + (i - 1) * ww, 3 * wh - 10);
      if mas[i].Text = 'X' then begin x_won := true; c1 += 1 end
      else c2 += 1;
      break;
    end
    else 
      i += 1;
  end;
  
  //...диагональ слева направо,  
  if (mas[1].Text <> '') and (mas[1].Text = mas[5].Text) and (mas[5].Text = mas[9].Text) then
  begin
    mas[1].Color := clGreen; mas[5].Color := clGreen; mas[9].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(18, 18, 2 * ww + 58, 2 * wh + 58);
    if mas[1].Text = 'X' then begin x_won := true; c1 += 1; end
    else  c2 += 1;
  end;
  //...диагональ справа налево. 
  if (mas[3].Text <> '') and (mas[3].Text = mas[5].Text) and (mas[5].Text = mas[7].Text) then
  begin
    mas[3].Color := clGreen; mas[5].Color := clGreen; mas[7].Color := clGreen; finish := true;
    SetPenColor(clRed);
    Line(18, 58 + wh * 2, 2 * ww + 58, 18);
    if mas[3].Text = 'X' then begin x_won := true; c1 += 1 end
    else c2 += 1; 
  end;
  //Если кто-то победил...  
  if finish then
  //...то нам же нужно определить победителя, не так ли? 
  begin
    if x_won then SetWindowCaption('Крестики победили!')
    else SetWindowCaption('Нолики победили!');
  end
  //А вдруг ничья?
  else
    for var j := 1 to 9 do
      if mas[j].Text <> '' then begin
        if j = 9 then begin finish := true; SetWindowCaption('Ничья!'); end;
      end
      else break;
end;
 
//Лаконично обрабатываем нажатие :)
procedure MouseDown(xm, ym, mb: integer);
begin
  if (mb = 1) then
  begin
    if finish = false then  begin
      for var i := 1 to 9 do 
        if (mas[i].PtInside(xm, ym) = true)  and (mas[i].Text = '') then
        begin
          if hod mod 2 = 0 then begin mas[i].Text := 'X'; SetWindowCaption('Ход: Нолики'); end
          else begin mas[i].Text := 'O'; SetWindowCaption('Ход: Крестики'); end;
          hod += 1;
        end;     
      Prov;
    end;
    if (res.PtInside(xm, ym) = true) then  Start;
  end;
end;
 
 
begin
  SetWindowSize(238, 268);
  //Фиксируем размер окна
  Window.IsFixedSize := true;  
  Start;
  OnMouseDown := MouseDown;    
end.

@just a dream · 28.01.2014, 20:46 **[ТС]**

Kordn, мне было так лень делать лаконичное обрабатывание клика) Ну чтож, спасибо!

Добавлено через 8 минут
И еще, в моей версии кто победил - тот ходит первым)

@Kordn · 29.01.2014, 07:32

just a dream, не за что)

Сообщение от just a dream

И еще, в моей версии кто победил - тот ходит первым)

Я так и понял, но решил, что правила есть правила, и...

Сообщение от Kordn

//Крестики всегда ходят первыми!

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

@just a dream · 29.01.2014, 18:35 **[ТС]**

Kordn, а еще есть выигрышная комбинация, когда дают сразу два очка! ты сбиваешь сразу два ряда, знаете ее?

@Kordn · 30.01.2014, 07:27

just a dream, да, я это учел

@Toooooooooooooo · 21.12.2014, 20:34

это на паскале точно?а не на делфи?

Добавлено через 4 минуты
ауууууууууууууууууууууууууууууууууу

Добавлено через 2 минуты
ответьте мне срочно((((((Добавлено через 23 минуты

Добавлено через 5 минут

Добавлено через 11 секунд

@keniseg · 21.12.2014, 20:50

точно

@Toooooooooooooo · 21.12.2014, 21:35

точно точно точно?

Добавлено через 21 минуту
опять

Добавлено через 4 минуты
он в консоле будет ж работать?

Добавлено через 12 минут

Новые блоги и статьи Все статьи Все блоги /
Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .
Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .	Фото: Daniel Greenwood kumehtar 13.11.2025	Расскажи мне о Мире, бродяга kumehtar 12.11.2025 — Расскажи мне о Мире, бродяга, Ты же видел моря и метели. Как сменялись короны и стяги, Как эпохи стрелою летели. - Этот мир — это крылья и горы, Снег и пламя, любовь и тревоги, И бескрайние. . .	PowerShell Snippets iNNOKENTIY21 11.11.2025 Модуль PowerShell 5. 1+ : Snippets. psm1 У меня модуль расположен в пользовательской папке модулей, по умолчанию: \Documents\WindowsPowerShell\Modules\Snippets\ А в самом низу файла-профиля. . .

@APALoff 1648 / 1077 / 1081 Регистрация: 03.07.2013 Сообщений: 4,507
	27.01.2014, 12:57
	А когда ожидать, что компьютер начнет сам ходить? 0

@just a dream 2 / 2 / 3 Регистрация: 10.08.2013 Сообщений: 30
	28.01.2014, 20:46 [ТС]
	Kordn, мне было так лень делать лаконичное обрабатывание клика) Ну чтож, спасибо! Добавлено через 8 минут И еще, в моей версии кто победил - тот ходит первым) 0

@just a dream 2 / 2 / 3 Регистрация: 10.08.2013 Сообщений: 30
	29.01.2014, 18:35 [ТС]
	Kordn, а еще есть выигрышная комбинация, когда дают сразу два очка! ты сбиваешь сразу два ряда, знаете ее? 0

@Kordn 158 / 137 / 106 Регистрация: 18.05.2013 Сообщений: 289
	30.01.2014, 07:27
	just a dream, да, я это учел 0

@Toooooooooooooo 0 / 0 / 0 Регистрация: 18.12.2014 Сообщений: 4
	21.12.2014, 20:34
	это на паскале точно?а не на делфи? Добавлено через 4 минуты ауууууууууууууууууууууууууууууууууу Добавлено через 2 минуты ответьте мне срочно((((((Добавлено через 23 минуты Добавлено через 5 минут Добавлено через 11 секунд 0

@keniseg 0 / 0 / 0 Регистрация: 21.12.2014 Сообщений: 5
	21.12.2014, 20:50
	точно 0

@Toooooooooooooo 0 / 0 / 0 Регистрация: 18.12.2014 Сообщений: 4
	21.12.2014, 21:35
	точно точно точно? Добавлено через 21 минуту опять Добавлено через 4 минуты он в консоле будет ж работать? Добавлено через 12 минут 0