Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 26.01.2016, 12:48   #1
Stolenskiy
Новичок
Джуниор
 
Регистрация: 26.01.2016
Сообщений: 1
Лампочка Sudoku на Delphi

Помогите пожалуйсто исправить код

Код:
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
type mas=array[1..9,1..9] of 0..9;
vec=array[1..9] of 0..9;
trez=array[1..9,1..9] of vec;
var sud,a:mas;
rez:trez;
iv,jv,kv:array[1..81] of 0..9;
riad:vec;
i,j,o,k,l:integer;

function frez:trez;
 var i,j,o,k,ii,jj,zm:integer;
 rez2:trez;
 b:vec;
 begin
 for i:=1 to 9 do
 for j:=1 to 9 do
 if sud[i,j]=0 then begin
    o:=0;
   for  ii := 1 to 9 do
   b[ii]:=0;

  for k:=1 to 9 do begin
  zm:=0;

  for ii := 1 to 9 do
  if (a[i,ii]=k) or (a[ii,j]=k) then zm:=1;

  if (i=1) or (i=2) or (i=3)  then begin

  if (j=1) or (j=2) or (j=3) then
    for ii := 1 to 3 do
      for jj := 1 to 3 do
      if a[ii,jj]=k then zm:=1;

  if (j=4) or (j=5) or (j=6) then
    for ii := 1 to 3 do
      for jj := 4 to 6 do
      if a[ii,jj]=k then zm:=1;

  if (j=7) or (j=8) or (j=9) then
    for ii := 1 to 3 do
      for jj := 7 to 9 do
      if a[ii,jj]=k then zm:=1;
      end;


  if (i=4) or (i=5) or (i=6)  then begin

  if (j=1) or (j=2) or (j=3) then
    for ii := 4 to 6 do
      for jj := 1 to 3 do
      if a[ii,jj]=k then zm:=1;

  if (j=4) or (j=5) or (j=6) then
    for ii := 4 to 6 do
      for jj := 4 to 6 do
      if a[ii,jj]=k then zm:=1;

  if (j=7) or (j=8) or (j=9) then
    for ii := 4 to 6 do
      for jj := 7 to 9 do
      if a[ii,jj]=k then zm:=1;
      end;


  if (i=7) or (i=8) or (i=9)  then begin

  if (j=1) or (j=2) or (j=3) then
    for ii := 7 to 9 do
      for jj := 1 to 3 do
      if a[ii,jj]=k then zm:=1;

  if (j=4) or (j=5) or (j=6) then
    for ii := 7 to 9 do
      for jj := 4 to 6 do
      if a[ii,jj]=k then zm:=1;

  if (j=7) or (j=8) or (j=9) then
    for ii := 7 to 9 do
      for jj := 7 to 9 do
      if a[ii,jj]=k then zm:=1;
      end;

  if zm=0 then begin
    o:=o+1;
    b[o]:=k;
  end;
  end;
  rez2[i,j]:=b;
  end;
  frez:=rez2;
  end;

begin
sud[1,1]:=strtoint(edit1.Text);
sud[1,2]:=strtoint(edit2.Text);
sud[1,3]:=strtoint(edit3.Text);
sud[2,1]:=strtoint(edit4.Text);
sud[2,2]:=strtoint(edit5.Text);
sud[2,3]:=strtoint(edit6.Text);
sud[3,1]:=strtoint(edit7.Text);
sud[3,2]:=strtoint(edit8.Text);
sud[3,3]:=strtoint(edit9.Text);

sud[1,4]:=strtoint(edit10.Text);
sud[1,5]:=strtoint(edit11.Text);
sud[1,6]:=strtoint(edit12.Text);
sud[2,4]:=strtoint(edit13.Text);
sud[2,5]:=strtoint(edit14.Text);
sud[2,6]:=strtoint(edit15.Text);
sud[3,4]:=strtoint(edit16.Text);
sud[3,5]:=strtoint(edit17.Text);
sud[3,6]:=strtoint(edit18.Text);

sud[1,7]:=strtoint(edit19.Text);
sud[1,8]:=strtoint(edit20.Text);
sud[1,9]:=strtoint(edit21.Text);
sud[2,7]:=strtoint(edit22.Text);
sud[2,8]:=strtoint(edit23.Text);
sud[2,9]:=strtoint(edit24.Text);
sud[3,7]:=strtoint(edit25.Text);
sud[3,8]:=strtoint(edit26.Text);
sud[3,9]:=strtoint(edit27.Text);

//----------------------------------

sud[4,1]:=strtoint(edit28.Text);
sud[4,2]:=strtoint(edit29.Text);
sud[4,3]:=strtoint(edit30.Text);
sud[5,1]:=strtoint(edit31.Text);
sud[5,2]:=strtoint(edit32.Text);
sud[5,3]:=strtoint(edit33.Text);
sud[6,1]:=strtoint(edit34.Text);
sud[6,2]:=strtoint(edit35.Text);
sud[6,3]:=strtoint(edit36.Text);

sud[4,4]:=strtoint(edit37.Text);
sud[4,5]:=strtoint(edit38.Text);
sud[4,6]:=strtoint(edit39.Text);
sud[5,4]:=strtoint(edit40.Text);
sud[5,5]:=strtoint(edit41.Text);
sud[5,6]:=strtoint(edit42.Text);
sud[6,4]:=strtoint(edit43.Text);
sud[6,5]:=strtoint(edit44.Text);
sud[6,6]:=strtoint(edit45.Text);

sud[4,7]:=strtoint(edit46.Text);
sud[4,8]:=strtoint(edit47.Text);
sud[4,9]:=strtoint(edit48.Text);
sud[5,7]:=strtoint(edit49.Text);
sud[5,8]:=strtoint(edit50.Text);
sud[5,9]:=strtoint(edit51.Text);
sud[6,7]:=strtoint(edit52.Text);
sud[6,8]:=strtoint(edit53.Text);
sud[6,9]:=strtoint(edit54.Text);

//----------------------------------

sud[7,1]:=strtoint(edit55.Text);
sud[7,2]:=strtoint(edit56.Text);
sud[7,3]:=strtoint(edit57.Text);
sud[8,1]:=strtoint(edit58.Text);
sud[8,2]:=strtoint(edit59.Text);
sud[8,3]:=strtoint(edit60.Text);
sud[9,1]:=strtoint(edit61.Text);
sud[9,2]:=strtoint(edit62.Text);
sud[9,3]:=strtoint(edit63.Text);

sud[7,4]:=strtoint(edit64.Text);
sud[7,5]:=strtoint(edit65.Text);
sud[7,6]:=strtoint(edit66.Text);
sud[8,4]:=strtoint(edit67.Text);
sud[8,5]:=strtoint(edit68.Text);
sud[8,6]:=strtoint(edit69.Text);
sud[9,4]:=strtoint(edit70.Text);
sud[9,5]:=strtoint(edit71.Text);
sud[9,6]:=strtoint(edit72.Text);

sud[7,7]:=strtoint(edit73.Text);
sud[7,8]:=strtoint(edit74.Text);
sud[7,9]:=strtoint(edit75.Text);
sud[8,7]:=strtoint(edit76.Text);
sud[8,8]:=strtoint(edit77.Text);
sud[8,9]:=strtoint(edit78.Text);
sud[9,7]:=strtoint(edit79.Text);
sud[9,8]:=strtoint(edit80.Text);
sud[9,9]:=strtoint(edit81.Text);
{Зчитую з едіта в масив}

 for i := 1 to 9 do
  for j := 1 to 9 do
  a[i,j]:=sud[i,j];


  o:=0;
  for i := 1 to 9 do
  for j := 1 to 9 do
  if sud[i,j]=0 then begin
  o:=o+1;
  iv[o]:=i;
  jv[o]:=j;
  kv[o]:=1;
  end;

  l:=0;
  i:=0;
  repeat
    i:=i+1;
    rez:=frez;
    for j := 1 to 9 do
    riad[j]:=0;
    riad:=rez[iv[i],jv[i]];
    repeat
      if riad[kv[i]]=0 then begin
      if i>1 then begin i:=i-1;
      a[iv[i],jv[i]]:=0;
      rez:=frez;
      for j := 1 to 9 do
      riad[j]:=0;
      riad:=rez[iv[i],jv[i]];
      kv[i]:=kv[i]+1;

      if riad[kv[i]]=0 then kv[i]:=1;

      for j:=i+1 to o-1 do
        kv[j]:=1;
      end;
      end;

      until riad[kv[i]]<>0;
      a[iv[i],jv[i]]:=riad[kv[i]];
    //  showmessage(inttostr(a[iv[i],jv[i]]));

    until i=o ;



  for i := 1 to 9 do 
    for j := 1 to 9 do
      stringgrid1.cells[j,i]:=inttostr(a[i,j]);
      end;



end;

end.

Последний раз редактировалось Аватар; 26.01.2016 в 13:27.
Stolenskiy вне форума Ответить с цитированием
Старый 26.01.2016, 13:36   #2
Utkin
Старожил
 
Аватар для Utkin
 
Регистрация: 04.02.2009
Сообщений: 18,136
По умолчанию

Цитата:
Помогите пожалуйсто исправить код
А зачем? Красивый китайский код. Нафига его исправлять?
Маньяк-самоучка
Utkin появился в результате деления на нуль.
Осторожно! Альтернативная логика
Utkin вне форума Ответить с цитированием
Старый 26.01.2016, 13:45   #3
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Stolenskiy, а действительно, что Вас не устраивает?

и подобные проекты лучше выкладывать в виде архива с исходниками.
вряд ли кто-то будет больше 80 эдитов на форме размещать, чтобы ваш код посмотреть... И, кстати, непонятно, зачем их столько? чем StringGrid не устроил?!
Serge_Bliznykov вне форума Ответить с цитированием
Старый 26.01.2016, 15:23   #4
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

Цитата:
Помогите пожалуйсто исправить код
Исправил. Хрень какая-то получилася...
Чо это такое, ваще?



Беззастенчиво содрать и выдать за своё - БЕСЦЕННО!
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...

Последний раз редактировалось min@y™; 26.01.2016 в 15:57.
min@y™ вне форума Ответить с цитированием
Старый 26.01.2016, 17:32   #5
newerow1989
Я самый любопытный
Участник клуба
 
Аватар для newerow1989
 
Регистрация: 24.07.2012
Сообщений: 1,949
По умолчанию

Вот мой код. Он рабочий! Заложено здесь 3 способа!
Правда, если у этого судоку имеется несколько решений, то программа не в состоянии его решить!
Вложения
Тип файла: rar Судоку.rar (321.8 Кб, 23 просмотров)
С запрограммированным приветом, Неверов Евгений!
Сайт: http://newerow1989.ru
[Паскаль] [Delphi]
newerow1989 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Sudoku Zeraim Софт 11 15.07.2011 15:31
SUDOKU prouser Общие вопросы C/C++ 3 07.07.2010 13:12
Delphi. Как нарисовать в Delphi два движущиеся шара с определенной скоростью? redred Общие вопросы Delphi 10 11.12.2007 10:43
Как открыть БД, написанную в Delphi если нf другой машине Delphi нет? dagarik БД в Delphi 7 22.10.2007 17:54
Sudoku Xandr Gamedev - cоздание игр: Unity, OpenGL, DirectX 0 03.09.2007 16:48