商业网站源码免费下载,德州软件开发公司,wordpress设置固定链接和伪静态,苏州seo外包这是我以前用Delphi写的一个教学软件。内容是关于“八皇后”问题的求解动态图形演示。这个软件采用多线程设计#xff0c;包含了递归回溯与非递归回溯两种算法#xff0c;还可随时调整演示速度#xff0c;界面共有五种前景和五种背景图形。包含所有源程序和资源文件。 以… 这是我以前用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://mengliao.blog.51cto.com/p_w_upload/201101/876134_1293891480.rar 转载于:https://blog.51cto.com/mengliao/470620
