Изобразить шахматную доску и случайным образом расставленные на ней шашки

@konispat · Регистрация: 25.12.2011

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

задание: изобразить шахматную доску и случайным образом расставленные на ней шашки.

есть часть программы которая рисует доску:

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
uses graphabc, crt;
Var x,y,c,n,k,t:integer;
begin
setwindowsize (500,500);
 
rectangle(49,49,451,451);
y:=50;
for k:=1 to 8 do
 begin x:=50;
 
 for n:=1 to 8 do
 begin
 if (n+k) mod 2=0 then
 c:=clwhite else c:=clblack;
 setpencolor(c);
 rectangle(x,y,x+50,y+50);
 FloodFill(x+1,y+1,c);
 
 x:=x+50;
 end;
 y:=y+50;
 
 end
 
end.

как сделать так чтобы шашки каждый раз стояли в разных местах? сколько голову не ломал не додумался, единственное что смог просто расставить шашки в начальном их положении:

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
uses graphabc, crt;
Var x,y,c,n,k,t:integer;
begin
setwindowsize (500,500);
rectangle(49,49,451,451);
y:=50;
for k:=1 to 8 do
 begin x:=50;
 
 for n:=1 to 8 do
 begin
 if (n+k) mod 2=0 then
 c:=clwhite else c:=clblack;
 setpencolor(c);
 rectangle(x,y,x+50,y+50);
 FloodFill(x+1,y+1,c);
 if (k<4) then
 begin
 if (c=clwhite) then
 begin
 c:=clblack;
 setpencolor(c);
 Circle(x+25,y+25, 20);
 end
 end;
 if (k>5) then
 begin
 if (c=clwhite) then
 begin
 c:=clblack;
 SetBrushColor(c);
 Circle(x+25,y+25, 20);
 end
 end;
 x:=x+50;
 end;
 y:=y+50;
 end
end.

очень надеюсь на вашу помощь!

@КонецСвета · 25.12.2011, 14:52

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
uses graphabc;
Var x,y,c,n,k,t,ys,xs:integer;
begin
setwindowsize (500,500);
rectangle(49,49,451,451);
y:=50;
 
for k:=1 to 8 do
 begin x:=50;
 
 for n:=1 to 8 do
 begin
 if (n+k) mod 2=0 then
 c:=clwhite else c:=clblack;
 setpencolor(c);
 rectangle(x,y,x+50,y+50);
 FloodFill(x+1,y+1,c);
 x:=x+50;
 end;
 y:=y+50;
 end;
 
 for n:=1 to 24 do
     begin
     x:=25;y:=25;
     xs:=random(8)+1;
     ys:=random(8)+1;
     x:=x+(50*xs);
     y:=y+(50*ys);
     c:=GetPixel(x,y);
     if c=clblack then c:=clwhite
        else c:=clblack;
     setbrushcolor(c);
     setpencolor(c);
     circle(x,y,20);
     end;
end.

с возможностью того, что часть шашек уже съедена...
и, если честно, не знаю, могут ли стоять белые на белом, а черные на черном, поэтому у меня пока только ч на б и б на ч, если надо - поправлю...
ой, могут, сейчас поправлю...

@konispat · 25.12.2011, 14:55 **[ТС]**

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

@КонецСвета · 25.12.2011, 15:04

konispat, я в шашках.... хм
вот правильный вариант

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
uses graphabc;
Var x,y,c,n,k,t,ys,xs,w,z:integer;
begin
setwindowsize (500,500);
rectangle(49,49,451,451);
y:=50;
 
for k:=1 to 8 do
 begin x:=50;
 
 for n:=1 to 8 do
 begin
 if (n+k) mod 2=0 then
 c:=clwhite else c:=clblack;
 setpencolor(c);
 rectangle(x,y,x+50,y+50);
 FloodFill(x+1,y+1,c);
 x:=x+50;
 end;
 y:=y+50;
 end;
 
 for n:=1 to 24 do
     begin
     x:=25;y:=25;
     xs:=random(8)+1;
     ys:=random(8)+1;
     x:=x+(50*xs);
     y:=y+(50*ys);
     z:=GetPixel(x,y);
     if z=clblack then dec(n) else
        begin
        w:=random(2);
        if w=0 then
           begin
           c:=clwhite;
           k:=clblack;
           end else
           begin
           c:=clblack;
           k:=clblack;
           end;
        setbrushcolor(c);
        setpencolor(k);
        circle(x,y,20);
        end;
     end;
end.

@konispat · 25.12.2011, 15:06 **[ТС]**

КонецСвета, спасибо огромное! есть один нюанс, но надеюсь не заметит препод) хотя если это не сложно поправить.. иногда шашек на поле становится больше чем 12 одного цвета

@КонецСвета · 25.12.2011, 15:26

вот так пропробуй (у меня в 10 прогонах не превысило 12...)

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
uses graphabc;
Var x,y,c,n,k,t,ys,xs,w,z,kb,kc:integer;
begin
setwindowsize (500,500);
rectangle(49,49,451,451);
y:=50;
 
for k:=1 to 8 do
 begin x:=50;
 
 for n:=1 to 8 do
 begin
 if (n+k) mod 2=0 then
 c:=clwhite else c:=clblack;
 setpencolor(c);
 rectangle(x,y,x+50,y+50);
 FloodFill(x+1,y+1,c);
 x:=x+50;
 end;
 y:=y+50;
 end;
 
 for n:=1 to 24 do
     begin
     x:=25;y:=25;
     xs:=random(8)+1;
     ys:=random(8)+1;
     x:=x+(50*xs);
     y:=y+(50*ys);
     z:=GetPixel(x,y);
     if z=clblack then dec(n) else
        begin
        w:=random(2);
        if w=0 then
           begin
           inc(kb);
           if kb<=12 then
              begin
              c:=clwhite;
              k:=clblack;
              end else
              begin
              c:=clblack;
              k:=clblack;
              end;
           end else
           begin
           inc(kc);
           if kc<=12 then
              begin
              c:=clblack;
              k:=clblack;
              end else
              begin
           c:=clwhite;
           k:=clblack;
              end;
           end;
        setbrushcolor(c);
        setpencolor(k);
        circle(x,y,20);
        end;
     end;
end.

правда, код громоздкий и черные всегда побеждают...

@konispat · 25.12.2011, 15:53 **[ТС]**

огромное вам человеческое спасибо! код и вправду громоздкий, если спросят как я это сделал врятли смогу защитить)

@КонецСвета · 25.12.2011, 16:15

сейчас поясню вкратце....

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

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
uses graphabc;
Var x,y,c,n,k,t,ys,xs,w,z,kb,kc:integer;
begin
setwindowsize (500,500);
rectangle(49,49,451,451);
y:=50;
 
for k:=1 to 8 do
 begin x:=50;
 
 for n:=1 to 8 do
 begin
 if (n+k) mod 2=0 then
 c:=clwhite else c:=clblack;
 setpencolor(c);
 rectangle(x,y,x+50,y+50);
 FloodFill(x+1,y+1,c);
 x:=x+50;
 end;
 y:=y+50;
 end;
 
 for n:=1 to 24 do
     begin
     x:=25;y:=25;
     xs:=random(8)+1;       //выбираем случайное поле по х (одно из восьми)
     ys:=random(8)+1;       //выбираем случайное поле по у (одно из восьми)
     x:=x+(50*xs);          //вычисляем центр шашки для выбранного поля
     y:=y+(50*ys);          //вычисляем центр шашки для выбранного поля
     z:=GetPixel(x,y);      //запрашиваем цвет поля
     if z=clblack then dec(n) else  //если поле черное (а мы работаем только на белом), то делаем шаг назад
        begin
        w:=random(2);     //здесь генерируем либо 0 либо 1 - определяем цвет  шашки
        if w=0 then       //если выпал 0 (белый)
           begin
           inc(kb);       //увеличиваем на 1 количество белых
           if kb<=12 then   //если это количество меньше 12, то будем делать шашку белой, цвет назначаем белый
              c:=clwhite else  c:=clblack;  //иначе (если уже 12 белых есть) - цвет назначаем черный
           end else  //иначе (если выпала 1, то есть черный)
           begin
           inc(kc);        //увеличиваем на 1 количество черных
           if kc<=12 then   //если это количество меньше 12, то будем делать шашку черной, цвет назначаем черный
              c:=clblack else c:=clwhite; //иначе (если уже 12 черных есть) - цвет назначаем белый
           end;
        setbrushcolor(c);  //задаем цвет заливки
        setpencolor(clblack); //задаем цвет контура
        circle(x,y,20);     //рисуем круг с центром по вычисленным координатам
        end;
     end;
end.

правда, черные опять побеждают....

@konispat · 25.12.2011, 16:42 **[ТС]**

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

Новые блоги и статьи Все статьи Все блоги /
Первый деплой lagorue 16.01.2026 Не спеша развернул своё 1ое приложение в kubernetes. А дальше мне интересно создать 1фронтэнд приложения и 2 бэкэнд приложения развернуть 2 деплоя в кубере получится 2 сервиса и что-бы они. . .	Расчёт переходных процессов в цепи постоянного тока igorrr37 16.01.2026 / * Дана цепь постоянного тока с R, L, C, k(ключ), U, E, J. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа, решает её и находит токи на L и напряжения на C в установ. режимах до и. . .	Восстановить юзерскрипты Greasemonkey из бэкапа браузера damix 15.01.2026 Если восстановить из бэкапа профиль Firefox после переустановки винды, то список юзерскриптов в Greasemonkey будет пустым. Но восстановить их можно так. Для этого понадобится консольная утилита. . .	Изучаю kubernetes lagorue 13.01.2026 А пригодятся-ли мне знания kubernetes в России?
Сукцессия микоризы: основная теория в виде двух уравнений. anaschu 11.01.2026 https:/ / rutube. ru/ video/ 7a537f578d808e67a3c6fd818a44a5c4/	WordPad для Windows 11 Jel 10.01.2026 WordPad для Windows 11 — это приложение, которое восстанавливает классический текстовый редактор WordPad в операционной системе Windows 11. После того как Microsoft исключила WordPad из. . .	Classic Notepad for Windows 11 Jel 10.01.2026 Old Classic Notepad for Windows 11 Приложение для Windows 11, позволяющее пользователям вернуть классическую версию текстового редактора «Блокнот» из Windows 10. Программа предоставляет более. . .	Почему дизайн решает? Neotwalker 09.01.2026 В современном мире, где конкуренция за внимание потребителя достигла пика, дизайн становится мощным инструментом для успеха бренда. Это не просто красивый внешний вид продукта или сайта — это. . .

@konispat 2 / 2 / 2 Регистрация: 25.12.2011 Сообщений: 55
	25.12.2011, 14:55 [ТС]
	КонецСвета, спасибо за активность, но это немного не логично со стороны самой игры, ведь шашки могут стоять либо только на белых полях, либо только черных, иначе как они друг друга есть будут?) это усложняет задачу? 0

@konispat 2 / 2 / 2 Регистрация: 25.12.2011 Сообщений: 55
	25.12.2011, 15:06 [ТС]
	КонецСвета, спасибо огромное! есть один нюанс, но надеюсь не заметит препод) хотя если это не сложно поправить.. иногда шашек на поле становится больше чем 12 одного цвета 0

@konispat 2 / 2 / 2 Регистрация: 25.12.2011 Сообщений: 55
	25.12.2011, 15:53 [ТС]
	огромное вам человеческое спасибо! код и вправду громоздкий, если спросят как я это сделал врятли смогу защитить) 0

@konispat 2 / 2 / 2 Регистрация: 25.12.2011 Сообщений: 55
	25.12.2011, 16:42 [ТС]
	блин спасибо огромное.. есть же еще отзывчивые люди готовые помочь.. судьба значит такая у белых, что черные выигрывают) 0