數獨

新增一個TButton並點兩下加入事件
在Form的OnCreate, OnPaint點兩下加入事件
接著就加入程式碼囉~

unit Unit1;

interface

uses
  Windows, Graphics, Forms, Classes, Controls, StdCtrls, Dialogs, Grids;
  
type
  TByteSet = set of Byte;
  TBytes = array of Byte;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    Done: Boolean;
    ResultTable: array[0..8, 0..8] of Byte;    //最後產出之結果
  public
    function SetToBytes(ASet: TByteSet; Range: Integer): TBytes;
    function ColSet(Index: Integer): TByteSet;
    function RowSet(Index: Integer): TByteSet;
  end;

var
  Form1: TForm1;

implementation

uses SysUtils;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Sudos: TBytes;
  I, K, L, C, R: Byte;
  S: array[0..2] of TByteSet;
  AreaSet: array[0..8] of TByteSet;//作為比對
begin
  Sudos := nil;
  repeat
    Done := True;
    for I := 0 to 8 do AreaSet[I] := [];   //九個區域
    FillChar(ResultTable, SizeOf(ResultTable), $FF);
    for I := 0 to 80 do   //81個號碼
    begin
      C := I mod 9;    //C=除以9取黍數  Cols
      R := I div 9;    //R=除以9        Rows
      K := (R div 3) * 3 + (C div 3);  //K=列除3*3+行除3
      S[0] := [0..8] - ColSet(C);     //Column Available SudoSet
      S[1] := [0..8] - RowSet(R);     //Row Available SudoSet
      S[2] := [0..8] - AreaSet[K];   //Area Available SudoSet
      S[0] := S[0] * S[1] * S[2];     //Intersection: The Available SudoSet
      if S[0] = [] then   //空集合時就不做了
        Done := False
      else
      begin
        Sudos := SetToBytes(S[0], 9);     //Random Selection
        L := Sudos[Random(Length(Sudos))];
        AreaSet[K] := AreaSet[K] + [L]; 
        ResultTable[C, R] := L;
      end;
    end;
  until Done;

  Repaint;//繪出數讀表

end;

function TForm1.SetToBytes(ASet: TByteSet; Range: Integer): TBytes;
var
  I, J: Byte;
begin
  SetLength(Result, Range);
  J := 0;
  for I := 0 to Range-1 do
  begin
    if I in ASet then
    begin
      Result[J] := I;
      ASet := ASet - [I];
      Inc(J);
    end;
    if ASet = [] then Break;
  end;
  SetLength(Result, J);
end;

function TForm1.ColSet(Index: Integer): TByteSet;
var
  i: Integer;
begin
  Result := [];
  for i := 0 to 8 do
    if ResultTable[Index, i] <> $FF then
      Result := Result + [ResultTable[Index, i]];
end;

function TForm1.RowSet(Index: Integer): TByteSet;
var
  i: Integer;
begin
  Result := [];
  for i := 0 to 8 do
    if ResultTable[i, Index] <> $FF then
      Result := Result + [ResultTable[i, Index]];
end;

procedure TForm1.FormPaint(Sender: TObject);
const
  CW = 40;
  RH = 40;

  procedure SetPen(Color: TColor; Width: Integer; Style: TPenStyle; Mode: TPenMode);
  begin
    Canvas.Pen.Color := Color;
    Canvas.Pen.Width := Width;
    Canvas.Pen.Style := Style;
    Canvas.Pen.Mode := Mode;
  end;

  procedure SetBrush(Color: TColor; Style: TBrushStyle);
  begin
    Canvas.Brush.Color := Color;
    Canvas.Brush.Style := Style;
  end;

  procedure SetFont(Name: string; Height: Integer; Color: TColor; Style: TFontStyles);
  begin
    Canvas.Font.Name := Name;
    Canvas.Font.Height := Height;
    Canvas.Font.Color := Color;
    Canvas.Font.Style := Style;
  end;

  procedure Clear;
  var
    rt: TRect;
  begin
    SetPen(clGray, 1, psSolid, pmCopy); //設定邊寬
    SetBrush(clSilver, bsSolid); //設定背景
    rt := Rect(0, 0, CW*9-8, RH*9-8); //設定常數   //352 //352
    OffsetRect(rt, 10, 10);
    Canvas.Rectangle(rt); //畫被景圖
  end;

  procedure DrawColsRows;
  var
    i: Integer;
    rt: TRect;
  begin
    SetPen(clSilver, 1, psSolid, pmCopy); //銀色，固，1
    SetBrush(clGray, bsSolid); //灰，固
    rt := Rect(0, 0, CW, RH*9-8); //0,0,40,352

    OffsetRect(rt, 10, 10); //位於圖的初使位置
    for i := 0 to 7 do
    begin
      Canvas.FrameRect(rt);
      OffsetRect(rt, CW-1, 0); //偏移位置少一，才不會兩行寬
    end;

    rt := Rect(0, 0, CW*9-8, RH); //0,0,352,40
    OffsetRect(rt, 10, 10); //位於圖的初使位置
    for I := 0 to 8 do
    begin
      Canvas.FrameRect(rt);
      OffsetRect(rt, 0, RH-1);
    end;
  end;

  procedure DrawColsRows2;
  var
    i: Integer;
    rt: TRect;
  begin
    SetPen(clSilver, 1, psSolid, pmCopy);
    SetBrush(clRed, bsSolid);
    rt := Rect(0, 0, CW*9-8, RH*3-2);  //0, 0, 352, 118
    OffsetRect(rt, 10, 10);
    for i := 0 to 2 do
    begin
      Canvas.FrameRect(rt);     //畫直的矩形
      OffsetRect(rt, 0, (RH-1)*3);
    end;

    rt := Rect(0, 0, CW*3-2, RH*9-8);
    OffsetRect(rt, 10, 10);
    for i := 0 to 2 do
    begin
      Canvas.FrameRect(rt);     //畫橫的矩形
      OffsetRect(rt, (CW-1)*3, 0);
    end;
  end;

  procedure DrawContents;
  var
    i, j: Integer;
    rt: TRect;
    S: string;
  begin
    SetBrush(clGray, bsSolid);
    SetFont('ARIAL',36,clWhite,[fsBold]); //設定字型
    for i := 0 to 8 do
      for j := 0 to 8 do
      begin
        rt := Rect((CW-1)*i, (RH-1)*j, (CW-1)*(i+1), (RH-1)*(j+1)); //39*i, 39*j, 39*(i+1), 39*(j+1)
        OffsetRect(rt, 10, 10);
        InflateRect(rt, -2, -2);
        Inc(rt.Right);
        Inc(rt.Bottom);
        S := IntToStr(ResultTable[i, j]+1); //結果表加1，然後存到S字串
        Canvas.TextRect(Rt, Rt.Left+10, Rt.Top+2, S);
      end;
  end;

begin
  Clear;
  DrawColsRows;
  DrawColsRows2;

  if Done then  //如果做完就畫內容囉
    DrawContents;
end;

end.