Вверх ↑
Ответов: 1926
Рейтинг: 172
#1: 2009-11-28 22:22:44 ЛС | профиль | цитата
Знаю, что очень нерационально из-за edito'в, но, к сожалению, никогда не использовал функции рисования на картинке...
Надо просто нажимать кнопку, и будут перебираться варианты. Иногда это будет 7, иногда - заветные 8.


Add(Button,1048210,154,140)
{
Left=245
Top=20
link(onClick,15909764:GetFerz,[])
}
Add(InlineCode,15909764,224,140)
{
WorkPoints=#7:GetFerz|
Code=#15:unit HiAsmUnit;|0:|9:interface|0:|21:uses kol,Share,Debug;|0:|4:type|28: THiAsmClass = class(TDebug)|10: private|35: cells:array[1..8,1..8] of byte;|39: edits:array[1..8,1..8] of PControl;|30: function CheckArr:boolean;|9: public|17: //:THI_Event;|0:|23: constructor Create;|48: procedure GetFerz(var dt:TData; index:word);|0:|5: end;|0:|14:implementation|0:|31:constructor THiAsmClass.Create;|21:var i,i1,l,t:integer;|5:begin|18: inherited Create;|9: l := 20;|9: t := 20;|17: for i:=1 to 8 do|7: begin|20: for i1:=1 to 8 do|9: begin|54: edits[i,i1] := NewEditbox(Applet.Children[0],[]);|31: edits[i,i1].Ctl3D := true;|34: edits[i,i1].Color := clWhite;|39: edits[i,i1].Font.FontHeight := 18;|39: edits[i,i1].TextAlign := taCenter;|29: edits[i,i1].Width := 25;|30: edits[i,i1].Height := 25;|27: edits[i,i1].Left := l;|26: edits[i,i1].Top := t;|33: edits[i,i1].Visible := true;|17: t := t + 25;|8: end;|11: t := 20;|15: l := l + 25;|6: end;|4:end;|0:|30:procedure THiAsmClass.GetFerz;|25:var i,i1,n,xr,yr:integer;|5:begin|11: randomize;|8: //Сброс|35: for i:=1 to 8 do for i1:=1 to 8 do|7: begin|20: cells[i,i1] := 0;|32: edits[i,i1].Color := clWhite;|6: end;|16: //Поиск решения|7: repeat|8: repeat|27: xr := round(random*7+1);|27: yr := round(random*7+1);|25: until cells[xr,yr] = 0;|19: //Установка ферзя|20: cells[xr,yr] := 1;|19: //Установка угроз|60: for i:=1 to 8 do if cells[i,yr] = 0 then cells[i,yr] := 2;|60: for i:=1 to 8 do if cells[xr,i] = 0 then cells[xr,i] := 2;|9: n := 0;|21: for i:=yr+1 to 8 do|8: begin|11: inc(n);|59: if (xr+n <= 8) and (xr+n >= 1) then cells[xr+n,i] := 2;|59: if (xr-n <= 8) and (xr-n >= 1) then cells[xr-n,i] := 2;|7: end;|9: n := 0;|25: for i:=yr-1 downto 1 do|8: begin|11: inc(n);|59: if (xr+n <= 8) and (xr+n >= 1) then cells[xr+n,i] := 2;|59: if (xr-n <= 8) and (xr-n >= 1) then cells[xr-n,i] := 2;|7: end;|16: until CheckArr;|0:|35: for i:=1 to 8 do for i1:=1 to 8 do|21: case cells[i,i1] of|34: 1: edits[i,i1].Color := clBlack;|32: 2: edits[i,i1].Color := clRed;|6: end;|17: //_hi_OnEvent();|4:end;|0:|30:function THiAsmClass.CheckArr;|17:var i,i1:integer;|5:begin|16: Result := true;|76: for i:=1 to 8 do for i1:=1 to 8 do if cells[i,i1] = 0 then Result := false;|4:end;|0:|4:end.|
}
------------ Дoбавленo в 22.36:
А вот схема для тех, кому нужно получать только комбинации из 8 ферзей.


Add(Button,1048210,154,154)
{
Left=245
Top=20
link(onClick,15909764:GetFerz,[])
}
Add(InlineCode,15909764,224,154)
{
WorkPoints=#7:GetFerz|
Code=#15:unit HiAsmUnit;|0:|9:interface|0:|21:uses kol,Share,Debug;|0:|4:type|28: THiAsmClass = class(TDebug)|10: private|35: cells:array[1..8,1..8] of byte;|39: edits:array[1..8,1..8] of PControl;|30: function CheckArr:boolean;|30: function CheckAll:boolean;|9: public|17: //:THI_Event;|0:|23: constructor Create;|48: procedure GetFerz(var dt:TData; index:word);|0:|5: end;|0:|14:implementation|0:|31:constructor THiAsmClass.Create;|21:var i,i1,l,t:integer;|5:begin|18: inherited Create;|9: l := 20;|9: t := 20;|17: for i:=1 to 8 do|7: begin|20: for i1:=1 to 8 do|9: begin|54: edits[i,i1] := NewEditbox(Applet.Children[0],[]);|31: edits[i,i1].Ctl3D := true;|34: edits[i,i1].Color := clWhite;|39: edits[i,i1].Font.FontHeight := 18;|39: edits[i,i1].TextAlign := taCenter;|29: edits[i,i1].Width := 25;|30: edits[i,i1].Height := 25;|27: edits[i,i1].Left := l;|26: edits[i,i1].Top := t;|33: edits[i,i1].Visible := true;|17: t := t + 25;|8: end;|11: t := 20;|15: l := l + 25;|6: end;|4:end;|0:|30:procedure THiAsmClass.GetFerz;|25:var i,i1,n,xr,yr:integer;|5:begin|11: randomize;|6:repeat|8: //Сброс|35: for i:=1 to 8 do for i1:=1 to 8 do|7: begin|20: cells[i,i1] := 0;|32: edits[i,i1].Color := clWhite;|6: end;|16: //Поиск решения|7: repeat|8: repeat|27: xr := round(random*7+1);|27: yr := round(random*7+1);|25: until cells[xr,yr] = 0;|19: //Установка ферзя|20: cells[xr,yr] := 1;|19: //Установка угроз|60: for i:=1 to 8 do if cells[i,yr] = 0 then cells[i,yr] := 2;|60: for i:=1 to 8 do if cells[xr,i] = 0 then cells[xr,i] := 2;|9: n := 0;|21: for i:=yr+1 to 8 do|8: begin|11: inc(n);|59: if (xr+n <= 8) and (xr+n >= 1) then cells[xr+n,i] := 2;|59: if (xr-n <= 8) and (xr-n >= 1) then cells[xr-n,i] := 2;|7: end;|9: n := 0;|25: for i:=yr-1 downto 1 do|8: begin|11: inc(n);|59: if (xr+n <= 8) and (xr+n >= 1) then cells[xr+n,i] := 2;|59: if (xr-n <= 8) and (xr-n >= 1) then cells[xr-n,i] := 2;|7: end;|16: until CheckArr;|15:until CheckAll;|0:|35: for i:=1 to 8 do for i1:=1 to 8 do|21: case cells[i,i1] of|34: 1: edits[i,i1].Color := clBlack;|32: 2: edits[i,i1].Color := clRed;|6: end;|17: //_hi_OnEvent();|4:end;|0:|30:function THiAsmClass.CheckArr;|17:var i,i1:integer;|5:begin|16: Result := true;|76: for i:=1 to 8 do for i1:=1 to 8 do if cells[i,i1] = 0 then Result := false;|4:end;|0:|30:function THiAsmClass.CheckAll;|21:var i,i1,sum:integer;|5:begin|10: sum := 0;|17: Result := false;|69: for i:=1 to 8 do for i1:=1 to 8 do if cells[i,i1] = 1 then inc(sum);|32: if sum = 8 then Result := true;|4:end;|0:|0:|4:end.|
}

Я пробовал поискать комбинацию из 9 ферзей - виснет
карма: 9
3
Голосовали:filyaxxxcom, Pirr, Tad