八皇後問題求解動態圖形演示

    這是我以前用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

本文出自 “夢遼軟件工作室” 博客，請務必保留此出處http://mengliao.blog.51cto.com/876134/470620