Показать сообщение отдельно
  #7  
Старый 17.04.2009, 18:52
ciev ciev вне форума
Прохожий
 
Регистрация: 17.04.2009
Сообщения: 4
Репутация: 10
По умолчанию

Цитата:
Сообщение от Nyctos Kasignete
Уж простите, какой-то ужас... Зачем вложенные циклы?? Я так поняла, CEdits — двумерный массив объектов TEdit на форме. Ну назначьте им всем один и тот же обработчик события OnKeyPress. Типа такого...
Код:
procedure TForm1.AllEditsKeyPress(Sender: TObject; var Key: Char);
var
  ci: Integer;
begin
  if (Sender as TEdit) = CEdits[12,12] then Exit; // не поняла, зачем это...
  case Key of
    '0'..'9': if (StrToInt((Sender as TEdit).Text + Key) > 12) then
                Key := #0;
    #8: {};
  else Key := #0;
  end;
  ci := (Sender as TEdit).ComponentIndex

Код:
А вообще по приведенному вами куску кода довольно сложно что-либо понять...
Код:
unit umain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TSudoku = array[1..9,1..9] of 0..9;

type
  TForm1 = class(TForm)
    Button1: TButton;
    cmbMode: TComboBox;
    grpAns: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure EditKeyPress(Sender: TObject; var Key: Char);
    procedure ReadInSud;
    procedure Button1Click(Sender: TObject);
    procedure cmbModeChange(Sender: TObject);
    procedure sudFill(s:TSudoku);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Sud:TSudoku;
  Ans:array of TSudoku;
  CEdits:array[1..9,1..9] of TEdit;

var
  Form1: TForm1;
  cmbMode:TComboBox;
  mlen:integer; // необходимое количество решений

implementation

{$R *.dfm}

function sudInLine(s:TSudoku;p:TPoint;v:integer):boolean;
var
  i:1..9;
begin
  Result:=True;
  for i:=1 to 9 do
    if p.y<>i then
      if s[p.X,i]=v then Exit;
  Result:=False;
end;

function sudInRow(s:TSudoku;p:TPoint;v:integer):boolean;
var
  i:1..9;
begin
  Result:=True;
  for i:=1 to 9 do
    if p.x<>i then
      if s[i,p.Y]=v then Exit;
  Result:=False;
end;

function sudInSq(s:TSudoku;p:TPoint;v:integer):boolean;
var
  ix,iy:0..8;
  lx,ly:0..8;
begin
  lx:=0; ly:=0;
  if p.x in [1,2,3] then lx:=1;
  if p.x in [4,5,6] then lx:=4;
  if p.x in [7,8,9] then lx:=7;
  lx:=lx-1;
  if p.y in [1,2,3] then ly:=1;
  if p.y in [4,5,6] then ly:=4;
  if p.y in [7,8,9] then ly:=7;
  ly:=ly-1;
  Result:=True;
  for ix:=1 to 3 do
    for iy:=1 to 3 do
      if (p.x<>lx+ix) and (p.y<>ly+iy) then
        if s[lx+ix,ly+iy]=v then Exit;
  Result:=False;
end;

function sudInAny(s:TSudoku;p:TPoint;v:integer):boolean;
begin
  Result:=sudInLine(s,p,v) or sudInRow(s,p,v) or sudInSq(s,p,v);
end;

function IsNextUnknown(s:TSudoku;var p:TPoint):boolean;
var
  ix,iy:1..9;
begin
  Result:=False;
  for ix:=1 to 9 do
    for iy:=1 to 9 do
      if s[ix,iy]=0 then begin
        Result:=True;
        p.X:=ix;
        p.Y:=iy;
        Exit;
      end; // if
end;

function sudMod(s:TSudoku;p:TPoint;v:integer):TSudoku;
var
  st:TSudoku;
begin
  st:=s;
  st[p.x,p.y]:=v;
  Result:=st;
end;

procedure sudAddAns(s:TSudoku);
var
  l:integer;
begin
  l:=Length(ans);
  SetLength(ans,l+1);
  ans[l]:=s;
end;

function DoRec(s:TSudoku):boolean;
var
  i:integer;
  p:TPoint;
begin
  Result:=True;
  if IsNextUnknown(s,p) then begin // запуск рекурсий
    for i:=1 to 9 do
      if not sudInAny(s,p,i) then
        if DoRec(sudMod(s,p,i)) then
          Exit;
  end else begin // сохранение результата
    sudAddAns(s);
  end;
  if Length(ans)<mlen then // не хватает результатов
    Result:=False;
end; // DoRec

procedure TForm1.ReadInSud;
var
  ix,iy:integer;
  CEdit:TEdit;
begin
  for iy:=1 to 9 do
    for ix:=1 to 9 do begin
      CEdit:=CEdits[ix,iy];
      if CEdit.Text = '' then
        Sud[ix,iy]:= 0
      else
        Sud[ix,iy]:=StrToInt(CEdit.Text);
    end; // for
end;

function IsValidSudoku(s:TSudoku):boolean;
var
  ix,iy:integer;
  p:TPoint;
begin
  for ix:=1 to 9 do
    for iy:=1 to 9 do begin
      p.X:=ix;
      p.Y:=iy;
      if s[ix,iy] <> 0 then
        if sudInAny(s,p,s[ix,iy]) then begin
          Result:=False;
          Exit;
        end; // if
    end; // for
  Result:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  ix,iy:integer;
begin
  for iy:=1 to 9 do
    for ix:=1 to 9 do begin
      CEdits[ix,iy]:=TEdit.Create(self);
      with CEdits[ix,iy] do begin
        Parent:=self;
        Left:= (ix - 1) * 30 + 5;
        Top:= (iy - 1) * 30 + 5;
        Width:= 25;
        Color:= self.Color;
        MaxLength:= 1;
        Ctl3D:= False;
        OnKeyPress:=EditKeyPress;
      end; // with
    end; // for, ix
end;

procedure TForm1.EditKeyPress(Sender: TObject; var Key: Char);
var
  ci:integer;
  ix,iy:integer;
  CEdit:TEdit;
begin
  for iy:=1 to 9 do
    for ix:=1 to 9 do
      if Sender is TEdit then
        if (Sender as TEdit)=CEdits[ix,iy] then
          CEdit:=CEdits[ix,iy];
  if (Sender as TEdit)=CEdits[9,9] then
    Exit;
  if Pos(Key,'0123456789'#8) = 0 then
    Key:= #0;
  if Key <> #8 then begin
    ci:=CEdit.ComponentIndex;
    (self.Components[ci+1] as TEdit).SetFocus;
  end; // if 
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i:integer;
  l:integer;
begin
  ans:=nil;
  ReadInSud;
  if not IsValidSudoku(sud) then begin
    ShowMessage('повторение в исходном');
    Exit;
  end; // if

  if grpAns.ItemIndex = 0 then
    mlen:=1
  else
    mlen:=1000;

  DoRec(sud);

  l:=length(ans);
  showmessage('решений: '+IntToStr(l));
  cmbMode.Clear;
  cmbMode.Items.Add('исходное');
  for i:=1 to l do
    cmbMode.Items.Add('решение '+IntToStr(i));
  cmbMode.ItemIndex:=0;

end;

procedure TForm1.sudFill(s:TSudoku);
var
  ix,iy:integer;
begin
  for iy:=1 to 9 do
    for ix:=1 to 9 do
      CEdits[ix,iy].Text:=IntToStr(S[ix,iy]);
end;

procedure TForm1.cmbModeChange(Sender: TObject);
begin
  if cmbMode.ItemIndex = 0 then
    SudFill(sud)
  else
    SudFill(ans[cmbMode.ItemIndex-1]);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Pen.Width:=3;
  Canvas.MoveTo(2,2);
  Canvas.LineTo(272,2);
  Canvas.LineTo(272,266);
  Canvas.LineTo(2,266);
  Canvas.LineTo(2,2);
  Canvas.Pen.Width:=2;
  Canvas.MoveTo(2,88+2);
  Canvas.LineTo(272,88+2);
  Canvas.MoveTo(2,88*2+2);
  Canvas.LineTo(272,88*2+2);
  Canvas.MoveTo(90+2,2);
  Canvas.LineTo(90+2,266);
  Canvas.MoveTo(90*2+2,2);
  Canvas.LineTo(90*2+2,266);

end;

end.
Admin: Пользуемся тегами! Иначе последуют санкции!

это судоку из 9 цифр хочу переделать ее на 12.может поможешь?
Ответить с цитированием