Форум программистов, компьютерный форум, киберфорум
Наши страницы
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/3: Рейтинг темы: голосов - 3, средняя оценка - 5.00
norka746
1 / 1 / 0
Регистрация: 25.09.2009
Сообщений: 15
1

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

28.12.2009, 21:50. Просмотров 609. Ответов 2
Метки нет (Все метки)

Delphi
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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
//const n=8;
var
  Form1: TForm1;
  x:array[1..100]of record x,y:byte; end;
   count:integer; //êîë-ГўГ® ГўГ*ðèГ*Г*òîâ
  t:integer; //ГЄГ*êîé ГўГ*ðèГ*Г*ГІ âûâîäèòü
  dk:array[1..100] of integer; //dk - êîë-ГўГ® êëåòîê êëåòîê äèГ*ГЈГ®Г*Г*ëè
  n:integer;
implementation
 
{$R *.dfm}
 
procedure Board;
   var i,j,d:integer;
begin
Form1.Canvas.Brush.Color:=form1.Color;
Form1.Canvas.Rectangle(0,0,Form1.ClientWidth,Form1.ClientHeight);
d:=65; //Г°Г*çìåð êëåòêè
form1.Canvas.Pen.Color:=clblack;
For i:=1 to n do
 For j:=1 to n do
 begin
 if (i+j) mod 2=0 then form1.Canvas.Brush.Color:=clOlive
 else form1.Canvas.Brush.Color:=clwhite ;
  form1.Canvas.Rectangle((j-1)*d,(i-1)*d,j*d,i*d);
 end;
end;
 
procedure Print1;
  var i,d:integer;
begin
Board;
form1.Canvas.Brush.Color:=clMaroon;
d:=65; //Г°Г*çìåð êëåòêè
For i:=1 to 2*n-1 do
  form1.Canvas.Ellipse((x[i].y-1)*d,(x[i].x-1)*d,x[i].y*d,x[i].x*d);
 
Form1.Label1.Caption:=inttostr(count);
form1.Label1.Repaint;
end;
 
 
function Kill(x1,y1,x2,y2:integer):boolean;
//ГЃГјГѕГІ ëè ôåðçè (x1,y1) ГЁ (x2,y2) äðóã äðóãГ*
begin
if (abs(x1-x2)=abs(y1-y2)) then Kill:=true
else Kill:=false;
end;
 
function Possible(k,x1,y1:integer):boolean;
{ÌîæГ*Г® ëè Г*Г* ГЄ âåðòèêГ*ëü ГЁ  y ãîðèçîГ*ГІГ*ëü ïîñòГ*ГўГЁГІГј ôåðçÿ}
 var i:integer;
begin
 i:=1;
 while (i<k) and not Kill(x[i].x,x[i].y,x1,y1) do i:=i+1;
 Possible:=(i=k);
end;
 
procedure    BackTracking(k:integer); //k Г*îìåð äèГ*ГЈГ®Г*Г*ëè
  var y:integer; // Г*îìåð êëåòêè Г*Г* k äèГ*ГЈГ®Г*Г*ëè
      x1,y1:integer; //êîîðäèГ*Г*ГІГ» ñëîГ*Г*
      k1:integer;
begin
  if k=2*n-1 then begin count:=count+1;  //Ñêîëüêî ГґГЁГЈ. Г°Г*Г±Г±ГІГ*âèëèè åñëè ГўГ±ГҐ ГІГ® îòâåò
    if  t=count then
     Print1;   end
  else
 
    for y:=1 to dk[k] do  //ÏåðèáåðГ*ГҐГ¬ êëåòêè Г*Г* ГЄ äèГ*ГЈГ®Г*Г*ëè
    begin
    if (k>=1)and(k<=n) then  // ÊîîðäèГ*Г*ГІГ» êëåòêè Г*Г* êîòîðóþ áóäåò Г±ГІГ*ГўГЁГІГј
      begin x1:=k-(y-1); y1:=1+(y-1); end
    else
      begin  k1:=k-n; x1:=n-(y-1); y1:=(k1+1)+(y-1); end;
 
    if Possible(k,x1,y1) then // Îïðåäèëÿåì åñëè ìû ìîæåì Г*Г* Г*ГҐВё ïîñòГ*ГўГЁГІГј ГІГ® èä¸ì Г¤Г*ëüøå
      begin
      x[k].x:=x1;
      x[k].y:=y1;
      BackTracking(k+1);
      end;
    end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
  var i:integer;
begin
n:=strtoint(Edit1.Text);
 count:=0;  //Êîë-ГўГ® ГўГ*Г°. Г*Г*éäåГ*Г*ûõ Г*ГҐ ГІГҐГЄ. ìîìåГ*ГІ
 t:=t+1; //Г‚Г*ðèГ*Г*ГІ êîòîðûé âûâîäèò
//t:=120;
for i:=1 to n do dk[i]:=i;   //Ñêîëüêî êëåòîê Г*Г* ГЄГ*æäîé äèîãГ*Г*Г*ëè
for i:=1 to n-1 do dk[n+i]:=n-i;
 
 BackTracking(1);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
t:=0;  // Ïðè ñîçäГ*Г*ГЁГЁ Г± 0
end;
 
procedure TForm1.Edit1Change(Sender: TObject);
  var i:integer;
begin
t:=0; // Ïðè èçìåГ*ГҐГ*ГЁГҐ Г± 0
For i:=1 to 100 do begin x[i].x:=0; x[i].y:=0; end;
end;
 
end.
0
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
28.12.2009, 21:50
Ответы с готовыми решениями:

Подскажите ошибку,не могу понять где что изменить чтобы прога работала
Подскажите ошибку,не могу понять где что изменить чтобы прога работала. Var...

Определить наименьшее количество ферзей, которые можно расставить так, чтобы они держали под боем все ее свободные поля
Ребята, помогите с такой проблемкой. Нужно написать программу, которая будет...

нужно чтобы ссылка открывалась не на новой странице, а в отдельном окне что нужно изменить?
&lt;subButton type=&quot;link&quot;&gt; &lt;label&gt;&lt;!]&gt;&lt;/label&gt; ...

что нужно изменить чтобы массив С состоял из повторяющихся элемонтов массива А которых нет в В?? срочно нужно(
using System; using System.Collections.Generic; using System.Linq; using...

Решить задачу так чтобы фиксировались клетки шахматной доски находящиеся под боем
Решить задачу так чтобы фиксировались клетки шахматной доски находящиеся под...

2
deathNC
1892 / 1005 / 123
Регистрация: 08.12.2009
Сообщений: 2,792
Записей в блоге: 2
28.12.2009, 22:00 2
Сложно разобраться в этом коде... можешь выложить архив с проектом?

тока в архив приложение не архивируй...
1
norka746
1 / 1 / 0
Регистрация: 25.09.2009
Сообщений: 15
28.12.2009, 22:13  [ТС] 3
Вот держите, если я правильно вас поняла...
0
Вложения
Тип файла: rar Слоны.rar (177.5 Кб, 22 просмотров)
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
28.12.2009, 22:13

Установить на шахматной доске минимум ферзей (первоначально 8), чтобы каждое поле было под боем
Доска (8*8). Требуется, чтобы программа выводила первоначально матрицу с 8-ью...

Расставить на стандартной 64-клеточной доске 8 ферзей так, чтобы ни один из них не находился под боем другого
Расставить на стандартной 64-клеточной доске 8 ферзей так, чтобы ни один из них...

Оцените подобранную конфигурацию, подскажите что нужно изменить.
Хочу взять комп: Процессор: AMD Phenom 9650 X4 Socket AM2 box Материнская...


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

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

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