Delphi 猜數字遊戲(電腦猜)

設定數字給電腦猜(難度較高)

unit GauessNumAI;

interface

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

type
  TForm1 = class(TForm)
    ediAns: TEdit;
    Label1: TLabel;
    btnStart: TButton;
    btnReset: TButton;
    btnClose: TButton;
    FinalLabel: TLabel;
    ansList: TMemo;
    procedure btnCloseClick(Sender: TObject);
    procedure btnResetClick(Sender: TObject);
    procedure btnStartClick(Sender: TObject);

  private
    { Private declarations }
    function AddZero(const Num : SmallInt):ShortString;//加0
    function DubCheck(const Num : ShortString):Boolean;//是否有重複
    function ABCheck(const Num,AnsNum : ShortString):ShortString;//算幾a幾b
    procedure FindAns(const Num : ShortString); //尋找可能答案
    procedure Start(); //開始動作
    procedure Reset(); //重置
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  PossibleArray :array[0..5040] of ShortString;   //解集合
  NowCount : Integer = 0;   //陣列長度
  TempCount : Integer = 0;  //暫時紀錄陣列長度
  Ans : ShortString = '0123'; //答案

implementation

{$R *.dfm}

function TForm1.AddZero(const Num : SmallInt):ShortString; //如果三位數前面就加0,小於三位數就回傳'0000'
 begin
   Result := IntToStr(Num);
    if Num <= 999 then
      Result := '0' + Result;
    if Num <= 99 then
      Result := '0000';
 end;

function TForm1.DubCheck(const Num : ShortString):Boolean; //如果四位數中有重複就不算(有就回傳true)
 var
  i,j : SmallInt;
 begin
  Result := False;
    for i := 1 to 3 do
     for j := i+1 to 4 do
       if Num[i] = Num[j] then //數字重複就繼續
         begin
           Result := True;
           break;
         end;
 end;

function TForm1.ABCheck(const Num,AnsNum : ShortString):ShortString; //算出AB數
 var
  A,B,i,j : SmallInt;
 begin
   A := 0;
   B := 0;
  for i := 1 to 4 do //猜測的數字位置
   for j := 1 to 4 do  //答案的數字位置
    if Num[i] = AnsNum[j] then  //數字相同繼續
      if i = j then
        Inc(A)        //位置相同加A
      else
        Inc(B);       //位置不同加B
  Result := IntToStr(A) + IntToStr(B);
 end;

procedure TForm1.FindAns(const Num : ShortString);
 var
  i : Integer;
 begin
  TempCount :=  NowCount;  //暫時紀錄原本陣列長度
  NowCount := 0;   //重計
  for i := 0 to TempCount do
   begin
     if ABCheck(Num,Ans) = ABCheck(Num,PossibleArray[i]) then //將有可能的解都重放入陣列中
       begin
         PossibleArray[NowCount] := PossibleArray[i];
         Inc(NowCount);
       end;
   end;
 end;

procedure TForm1.Start;
 var
  r,i,t : Integer;
  AB : ShortString;
 begin
  t := 0;
  while AB <> '40' do
   begin
    Randomize;
    r := Trunc(Random(NowCount)); //取亂數(陣列長度內)
    AB := ABCheck(PossibleArray[r],Ans); //取出比較AB
    ansList.Lines.Add(IntToStr(t+1) + '. ' + PossibleArray[r] + '　' + AB[1] + 'A' + AB[2] + 'B'); //印出
    FindAns(PossibleArray[r]); //呼叫程式開始尋找可能解
    Inc(t);
    if AB = '40' then
    begin
      FinalLabel.Caption := 'Total Guess Times : ' + IntToStr(t); //答案找出就印出總次數
      break;
    end;
   end;
 end;

procedure TForm1.ReSet;  //產生(重置)所有解集合
 var
  i : Integer;
  N : ShortString;
 begin
   NowCount := 0;
  for i := 0 to 9876 do
  begin
    N := AddZero(i);
    if Not(DubCheck(N)) then
    begin
      PossibleArray[NowCount] := N;
      Inc(NowCount);
    end;
  end;
 end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin
 Close();
end;

procedure TForm1.btnResetClick(Sender: TObject);
begin
 ediAns.Text := '';
 ansList.Lines.Clear;
end;

procedure TForm1.btnStartClick(Sender: TObject);   //Start按鈕按下去後開始動作
 begin
  if (ediAns.Text <> '') and (not(DubCheck(ediAns.Text))) and (AddZero(StrToInt(ediAns.Text)) <> '0000') then
  begin
    ansList.Lines.Clear;
    ReSet();
    Ans := AddZero(StrToInt(ediAns.Text));
    Start();
  end
  else
    Showmessage('Please Enter Number ! ');
 end;

end.