八皇后问题求解动态图形演示

    这是我以前用Delphi写的一个教学软件。内容是关于“八皇后”问题的求解动态图形演示。这个软件采用多线程设计，包含了递归回溯与非递归回溯两种算法，还可随时调整演示速度，界面共有五种前景和五种背景图形。包含所有源程序和资源文件。
    以下是软件截图：

    其中的核心Unit如下： 

unit Unit2;

interface

uses
  Windows, Messages, Classes, SysUtils, StdCtrls, Graphics;

type
  TQS = function(n: integer): boolean of object;
  TQueenThread = class(TThread)
  private
    FBackgroundBitmap: TBitmap;
    FQueenIcon, FSeekIcon, FClashIcon: TIcon;
    FCanvas: TCanvas;
    FCounter: integer;
    FQueen: integer;
    FDemo: boolean;
    FDelay: integer;
    FClashRestoreIcon, FSeekQueenIcon: TIcon;
    FRecursion: boolean;
    QS: TQS;
    procedure SeekFinish(Sender: TObject);
    function QSeek(n: integer): boolean;
    function QSeekNonrecursion(n: integer): boolean;
    function QClash(n: integer): boolean;
    procedure ShowDelete;
    procedure ShowDraw;
    procedure ShowClashRestore;
    procedure SetRecursion(Value: boolean);
  protected
    procedure Execute; override;
  public
    constructor Create(ABackgroundBitmap: TBitmap; AQueenIcon, ASeekIcon, AClashIcon: TIcon; ACanvas: TCanvas);
    procedure ShowResult;
    property Demo: boolean write FDemo;
    property Delay: integer write FDelay;
    property Recursion: boolean write SetRecursion;
  end;

implementation

uses Unit1;

constructor TQueenThread.Create(ABackgroundBitmap: TBitmap; AQueenIcon, ASeekIcon, AClashIcon: TIcon; ACanvas: TCanvas);
begin
  FBackgroundBitmap := ABackgroundBitmap;
  FQueenIcon := AQueenIcon;
  FSeekIcon := ASeekIcon;
  FClashIcon := AClashIcon;
  FCanvas := ACanvas;
  FCounter := 0;
  FDemo := true;
  FDelay := 400;
  SetRecursion(true);
  OnTerminate := SeekFinish;
  inherited Create(true);
end;

procedure TQueenThread.SetRecursion(Value: boolean);
begin
  FRecursion := Value;
  if FRecursion then
    QS := QSeek
  else
    QS := QSeekNonrecursion;
end;

procedure TQueenThread.SeekFinish(Sender: TObject);
begin
  PostMessage(Form1.Handle, WM_SEEKFINISH, 0, 0);
end;

procedure TQueenThread.ShowClashRestore;
var
  i: integer;
  t: TRect;
begin
  for i := 1 to FQueen - 1 do
  begin
    if (Q[FQueen] = Q[i]) or (Abs(Q[FQueen] - Q[i]) = (FQueen - i)) then
    begin
      t := Rect((Q[i] - 1) * CellWidth, (i - 1) * CellHeight, Q[i] * CellWidth, i * CellHeight);
      FCanvas.CopyRect(t, FBackgroundBitmap.Canvas, t);
      FCanvas.Draw((Q[i] - 1) * CellWidth, (i - 1) * CellHeight, FClashRestoreIcon);
    end;
  end;
end;

procedure TQueenThread.ShowDelete;
var
  t: TRect;
begin
  t := Rect((Q[FQueen] - 1) * CellWidth, (FQueen - 1) * CellHeight, Q[FQueen] * CellWidth, FQueen * CellHeight);
  FCanvas.CopyRect(t, FBackgroundBitmap.Canvas, t);
end;

procedure TQueenThread.ShowDraw;
begin
  FCanvas.Draw((Q[FQueen] - 1) * CellWidth, (FQueen - 1) * CellHeight, FSeekQueenIcon);
end;

procedure TQueenThread.ShowResult;
var
  i: integer;
begin
  FCanvas.Draw(0, 0, FBackgroundBitmap);
  FSeekQueenIcon := FQueenIcon;
  for i := 1 to 8 do
  begin
    FQueen := i;
    ShowDraw;
  end;
end;

function TQueenThread.QSeek(n: integer): boolean;
begin
  if n > 0 then
  begin
    //==========demo begin==========
    if FDemo then
    begin
      FQueen := n; //Setup variable for call synchronize
      Synchronize(ShowDelete);
    end;
    //==========demo end============
    inc(Q[n]);
    //==========demo begin==========
    if FDemo then
    begin
      FSeekQueenIcon := FSeekIcon;
      Synchronize(ShowDraw);
      sleep(FDelay);
    end;
    //==========demo end============
    if Q[n] <= 8 then
      if QClash(n) then
      begin
        //==========demo begin==========
        if FDemo then
        begin
          FClashRestoreIcon := FClashIcon;
          Synchronize(ShowClashRestore);
          sleep(FDelay);
          FClashRestoreIcon := FQueenIcon;
          Synchronize(ShowClashRestore);
        end;
        //==========demo end============
        result := QSeek(n);
      end
      else
      begin
        //==========demo begin==========
        if FDemo then
        begin
          Synchronize(ShowDelete);
          FSeekQueenIcon := FQueenIcon;
          Synchronize(ShowDraw);
          sleep(FDelay);
        end;
        //==========demo end============
        result := true
      end
    else
    begin
      Q[n] := 0;
      if QSeek(n - 1) then
        result := Qseek(n)
      else
        result := false;
    end;
  end
  else
    result := false;
end;

function TQueenThread.QSeekNonrecursion(n: integer): boolean;
var
  flag: boolean;
  m: integer;
begin
  m := n;
  flag := false;
  repeat
    //==========demo begin==========
    if FDemo then
    begin
      FQueen := n;
      Synchronize(ShowDelete);
    end;
    //==========demo end============
    inc(Q[n]);
    //==========demo begin==========
    if FDemo then
    begin
      FSeekQueenIcon := FSeekIcon;
      Synchronize(ShowDraw);
      sleep(FDelay);
    end;
    //==========demo end============
    if Q[n] > 8 then
    begin
      Q[n] := 0;
      dec(n);
    end
    else
      if not QClash(n) then
      begin
        //==========demo begin==========
        if FDemo then
        begin
          Synchronize(ShowDelete);
          FSeekQueenIcon := FQueenIcon;
          Synchronize(ShowDraw);
          sleep(FDelay);
        end;
        //==========demo end============
        if m = n then
          flag := true
        else
          inc(n);
      end
      else
        //==========demo begin==========
        if FDemo then
        begin
          FClashRestoreIcon := FClashIcon;
          Synchronize(ShowClashRestore);
          sleep(FDelay);
          FClashRestoreIcon := FQueenIcon;
          Synchronize(ShowClashRestore);
        end;
        //==========demo end============
  until flag or (n < 1);
  result := flag;
end;

function TQueenThread.QClash(n: integer): boolean;
var
  flag: boolean;
  i: integer;
begin
  flag := false;
  i := 1;
  while (i < n) and not flag do
  begin
    flag := (Q[n] = Q[i]) or (Abs(Q[n] - Q[i]) = (n - i));
    inc(i);
  end;
  result := flag;
end;

procedure TQueenThread.Execute;
var
  i: integer;
begin
  for i := 1 to 7 do
    QS(i);
  while QS(8) do
  begin
    if FDemo then
      Beep
    else
      Synchronize(ShowResult);
    inc(FCounter);
    PostMessage(Form1.Handle, WM_SEEKSUSPEND, 0, 0);
    Suspend;
  end;
end;

end.

    这个程序虽然是一个教学软件，但涉及到许多方面的知识，比如Win32下的图像处理、多线程等等。这里并没有使用信号量，而是使用了用户自定义消息来完成多线程的同步、等待、挂起等操作。
下面是另一个Unit的源码： 

unit Unit1;

interface

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

const
  WM_SEEKFINISH = WM_USER + $1;
  WM_SEEKSUSPEND = WM_USER + $2;
  CellWidth = 50;
  CellHeight = 50;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    GroupBox5: TGroupBox;
    GroupBox6: TGroupBox;
    Panel1: TPanel;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    TrackBar1: TTrackBar;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    ListBox1: TListBox;
    Button1: TButton;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
  private
    BG: TBitmap;
    QIcon, SIcon, CIcon: TIcon;
    QResult: array of array[1..8] of integer;
    RunFlag: boolean;
  public
    procedure MsgSeekSuspend(var Msg: TMessage); message WM_SEEKSUSPEND;
    procedure MsgSeekFinish(var Msg: TMessage); message WM_SEEKFINISH;
  end;

var
  Form1: TForm1;
  Q: array[1..8] of integer;

implementation

{$R *.dfm}

uses Unit2;

var
  QueenThread: TQueenThread;
  CurrentResultIndex: integer;

procedure TForm1.MsgSeekSuspend(var Msg: TMessage);
var
  i: integer;
begin
  CurrentResultIndex := high(QResult) + 1;
  setlength(QResult, CurrentResultIndex + 1);
  for i := 1 to 8 do
    QResult[CurrentResultIndex, i] := Q[i];
  with ListBox1 do
  begin
    Items.Add(format('%u, %u, %u, %u, %u, %u, %u, %u [%u]', [Q[1], Q[2], Q[3], Q[4], Q[5], Q[6], Q[7], Q[8], CurrentResultIndex + 1]));
    ItemIndex := Count - 1;
  end;
  RunFlag := false;
  Button1.Caption := '&Seek';
end;

procedure TForm1.MsgSeekFinish(var Msg: TMessage);
begin
  MessageBox(Handle, 'End of seek.'+ #13#10#13#10 + 'Restart seek from first queen.', PWChar(Caption), MB_ICONINFORMATION or MB_OK);
  ListBox1.Clear;
  Image1.Canvas.Draw(0, 0, BG);
  QueenThread := nil;
  CurrentResultIndex := -1;
  setlength(QResult, 0);
  Button1.Caption := '&Seek';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
  if not Assigned(QueenThread) then
  begin
    QueenThread := TQueenThread.Create(BG, QIcon, SIcon, CIcon, Image1.Canvas);
    QueenThread.Demo := CheckBox1.Checked;
    QueenThread.Delay := TrackBar1.Position;
    QueenThread.Recursion := CheckBox2.Checked;
  end;
  if QueenThread.Suspended then
  begin
    with ListBox1 do
    begin
      if (CurrentResultIndex <> high(QResult)) and not RunFlag then
      begin
        for i := 1 to 8 do
          Q[i] := QResult[high(QResult), i];
        QueenThread.ShowResult;
      end;
      ItemIndex := Count - 1;
    end;
    QueenThread.Resume;
    Button1.Caption := '&Pause';
  end
  else
  begin
    QueenThread.Suspend;
    Button1.Caption := '&Resume';
  end;
  RunFlag := true;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  TrackBar1.Enabled := CheckBox1.Checked;
  if Assigned(QueenThread) then
    QueenThread.Demo := CheckBox1.Checked;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  if Assigned(QueenThread) then
    QueenThread.Recursion := CheckBox2.Checked;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
var
  n: integer;
begin
  n :=  + ComboBox1.ItemIndex * 3;
  ImageList1.GetIcon(0 + n, QIcon);
  ImageList1.GetIcon(1 + n, SIcon);
  ImageList1.GetIcon(2 + n, CIcon);
  if Assigned(QueenThread) then
    QueenThread.ShowResult;
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
begin
  BG.LoadFromResourceName(hInstance, 'BG' + IntToStr(ComboBox2.ItemIndex + 1));
  if Assigned(QueenThread) then
    QueenThread.ShowResult
  else
    Image1.Canvas.Draw(0, 0, BG);
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  if Assigned(QueenThread) then
    QueenThread.Delay := TrackBar1.Position;
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  i: integer;
begin
  if Assigned(QueenThread) and not RunFlag then
  begin
    CurrentResultIndex := ListBox1.ItemIndex;
    for i := 1 to 8 do
      Q[i] := QResult[CurrentResultIndex, i];
    QueenThread.ShowResult;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  for i := 1 to 8 do
    Q[i] := 0;
  BG := TBitmap.Create;
  QIcon := TIcon.Create;
  SIcon := TIcon.Create;
  CIcon := TIcon.Create;
  ComboBox1Change(self);
  ComboBox2Change(self);
  CurrentResultIndex := -1;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BG.Free;
  QIcon.Free;
  SIcon.Free;
  CIcon.Free;
end;

end.

    可以从后面的附件或者如下链接下载完整的源码项目（包含一个编译好的可执行文件）：
http://img1.51cto.com/attachment/201101/876134_1293891480.rar