(文档请参考:http://blog.csdn.net/CXXSoft/archive/2006/09/28/1299731.aspx)
3、 运行效果
4、 算法源码
...{ 作品名称: 小球问题通用解决方案 开发作者: 成晓旭 开发时间: 2003年01月22日 完成时间: 2003年01月23日 修改时间1: 2003年11月14日 增加用户问题条件设置绘制方法 修改时间2: 2003年11月18日 增加比较过程的记录功能}unit Common;interfaceuses Windows,SysUtils,Classes,Graphics,BallType; //清除画面方法 procedure ClearCanvas(aCanvas: TCanvas; aRect: TRect); //小球问题条件设置方法 procedure Draw_Ball_Config( AllBall:array of TC_Ball; ACanvas:TCanvas; aClearRect: TRect; bShowTrace:Boolean); //小球问题解决方法 procedure Serach_Error_Ball( AllBall:array of TC_Ball; ACanvas:TCanvas; aClearRect: TRect; bShowTrace:Boolean);var strLog1:AnsiString; strLog2:AnsiString; strLog3:AnsiString;implementation//单元内部常量定义const Fir_Pivot_X = 200; Fir_Pivot_Y = 80; Hint_X = 10; One_DrawDelta = 140; One_PreDelta = 70; One_FroDelta = 30; strADyB = '比较:A端(重) > B端(轻)' + CHR(13) + CHR(10); strAXDB = '比较:A端 = B端' + CHR(13) + CHR(10); strAXyB = '比较:A端(轻) < B端(重)' + CHR(13) + CHR(10); A_Team = 'A 组:'; B_Team = 'B 组:'; preTail0 = '号球' + CHR(13) + CHR(10); preTail1 = '号球'; proHead = '结论:异常球在 ['; lastResult = '结论:异常球是'; nextHint = CHR(13) + CHR(10) + '启示:'; ErrorHint = '命题不严密,请检查设置条件!';function SearchBall_At4(AllBall:array of TC_Ball; A,G:array of Byte;var vErr_Ball_Order:Byte; var vIsHeavy:Boolean;ACanvas:TCanvas;bShowTrace:Boolean):Boolean;var A2,B2:Word; A3,B3:Word; Loop:Word; bNumber:Byte; bPartA,bPartB:array of TC_Ball; bCmpPara:TC_CmpPara; str:AnsiString;begin vErr_Ball_Order := 0; vIsHeavy := False; A2 := AllBall[A[1]].Weight + AllBall[A[2]].Weight + AllBall[G[1]].Weight; B2 := AllBall[A[3]].Weight + AllBall[G[2]].Weight + AllBall[G[3]].Weight; str := A_Team + IntToStr(AllBall[A[1]].Order) + ',' + IntToStr(AllBall[A[2]].Order) + ',' + IntToStr(AllBall[G[1]].Order); str := str + preTail0; strLog2 := strLog2 + str; str := B_Team + IntToStr(AllBall[A[3]].Order) + ',' + IntToStr(AllBall[G[2]].Order) + ',' + IntToStr(AllBall[G[3]].Order); str := str + preTail0; strLog2 := strLog2 + str; bNumber := 3; SetLength(bPartA,bNumber); SetLength(bPartB,bNumber); bPartA[0] := AllBall[A[1]]; bPartA[1] := AllBall[A[2]]; bPartA[2] := AllBall[G[1]]; bPartB[0] := AllBall[A[3]]; bPartB[1] := AllBall[G[2]]; bPartB[2] := AllBall[G[3]]; Balance_One_Compare(Point(Fir_Pivot_X,Fir_Pivot_Y + One_DrawDelta), bNumber,bPartA,bPartB,ACanvas,bShowTrace); if A2 = B2 then begin A3 := AllBall[A[4]].Weight; B3 := AllBall[G[1]].Weight; strLog2 := strLog2 + strAXDB; str := proHead; str := str + IntToStr(AllBall[A[4]].Order); str := str + ']' + preTail1 + ' 【排3余1】'; strLog2 := strLog2 + str; str := '用任一正常球与之比较,即可知异常球是偏轻偏重!'; strLog2 := strLog2 + nextHint + str; with bCmpPara do begin Pre_LNumber := 4; Fro_LNumber := 1; SetLength(Pre_Latency,Pre_LNumber); SetLength(Fro_Latency,Fro_LNumber); for Loop := 0 to Pre_LNumber - 1 do Pre_Latency[Loop] := AllBall[Loop + 9]; Fro_Latency[0] := AllBall[A[4]]; end; Balance_One_Latency(Point(Hint_X,Fir_Pivot_Y + One_DrawDelta - One_PreDelta), Point(Hint_X,Fir_Pivot_Y + One_DrawDelta + One_FroDelta), bCmpPara,ACanvas,bShowTrace); bNumber := 1; SetLength(bPartA,bNumber); SetLength(bPartB,bNumber); bPartA[0] := AllBall[A[4]]; bPartB[0] := AllBall[G[1]]; Balance_One_Compare(Point(Fir_Pivot_X,Fir_Pivot_Y + One_DrawDelta * 2), bNumber,bPartA,bPartB,ACanvas,bShowTrace); if A3 = B3 then begin vErr_Ball_Order := 0; strLog3 := '异常球与正常球一样重!' + ErrorHint; end else begin vErr_Ball_Order := A[4]; vIsHeavy := A3 > B3; end; end else begin A3 := AllBall[A[1]].Weight; B3 := AllBall[A[2]].Weight; if A2 > B2 then strLog2 := strLog2 + strADYB else strLog2 := strLog2 + strAXYB; str := proHead; str := str + IntToStr(AllBall[A[1]].Order) + ',' + IntToStr(AllBall[A[2]].Order) + ',' + IntToStr(AllBall[A[3]].Order); str := str + ']' + preTail1 + ' 【排1余3】'; strLog2 := strLog2 + str; str := '下一轮必须在本轮比较的同一端的两球中进行.即取:' +IntToStr(AllBall[A[1]].Order) + ',' + IntToStr(AllBall[A[2]].Order) +'号球,在推算结果时,还必须用到此轮A、B端谁轻谁重!'; strLog2 := strLog2 + nextHint + str; bNumber := 1; SetLength(bPartA,bNumber); SetLength(bPartB,bNumber); bPartA[0] := AllBall[A[1]]; bPartB[0] := AllBall[A[2]]; Balance_One_Compare(Point(Fir_Pivot_X,Fir_Pivot_Y + One_DrawDelta * 2), bNumber,bPartA,bPartB,ACanvas,bShowTrace); if A3 = B3 then begin vErr_Ball_Order := A[3]; vIsHeavy := A2 < B2; end else begin if A2 > B2 then begin if A3 > B3 then vErr_Ball_Order := A[1] else vErr_Ball_Order := A[2]; //IsHeavy := True; end else begin if A3 > B3 then vErr_Ball_Order := A[2] else vErr_Ball_Order := A[1]; //IsHeavy := NOT True; end; vIsHeavy := A2 > B2; end; end; Result := vErr_Ball_Order <> 0;end;function SearchBall_At8(AllBall:array of TC_Ball;IsAdyB:Boolean; A,B,G:array of Byte;var vErr_Ball_Order:Byte; var vIsHeavy:Boolean;ACanvas:TCanvas;bShowTrace:Boolean):Boolean;var A2,B2:Word; A3,B3:Word; bNumber:Byte; bPartA,bPartB:array of TC_Ball; senPivot,thrPivot:TPoint; str:AnsiString;begin vErr_Ball_Order := 0; vIsHeavy := False; A2 := AllBall[A[1]].Weight + AllBall[A[2]].Weight + AllBall[B[1]].Weight; B2 := AllBall[A[3]].Weight + AllBall[B[2]].Weight + AllBall[G[1]].Weight; str := A_Team + IntToStr(AllBall[A[1]].Order) + ',' + IntToStr(AllBall[A[2]].Order) + ',' + IntToStr(AllBall[B[1]].Order); str := str + preTail0; strLog2 := strLog2 + str; str := B_Team + IntToStr(AllBall[A[3]].Order) + ',' + IntToStr(AllBall[B[2]].Order) + ',' + IntToStr(AllBall[G[1]].Order); str := str + preTail0; strLog2 := strLog2 + str; bNumber := 3; SetLength(bPartA,bNumber); SetLength(bPartB,bNumber); bPartA[0] := AllBall[A[1]]; bPartA[1] := AllBall[A[2]]; bPartA[2] := AllBall[B[1]]; bPartB[0] := AllBall[A[3]]; bPartB[1] := AllBall[B[2]]; bPartB[2] := AllBall[G[1]]; Balance_One_Compare(Point(Fir_Pivot_X,Fir_Pivot_Y + One_DrawDelta), bNumber,bPartA,bPartB,ACanvas,bShowTrace); if A2 = B2 then begin A3 := AllBall[B[3]].Weight; B3 := AllBall[B[4]].Weight; strLog2 := strLog2 + strAXDB; str := proHead; str := str + IntToStr(AllBall[A[4]].Order) + ',' + IntToStr(AllBall[B[3]].Order) + ',' + IntToStr(AllBall[B[4]].Order); str := str + ']' + preTail1 + ' 【排5余3】'; strLog2 := strLog2 + str; str := '下一轮必须在本轮比较的同一端的两球中进行.即取:' +IntToStr(AllBall[B[3]].Order) + ',' + IntToStr(AllBall[B[4]].Order) +'号球,在推算结果时,还必须用到此轮A、B端谁轻谁重!'; strLog2 := strLog2 + nextHint + str; bNumber := 1; SetLength(bPartA,bNumber); SetLength(bPartB,bNumber); bPartA[0] := AllBall[B[3]]; bPartB[0] := AllBall[B[4]]; Balance_One_Compare(Point(Fir_Pivot_X,Fir_Pivot_Y + One_DrawDelta * 2), bNumber,bPartA,bPartB,ACanvas,bShowTrace); if A3 = B3 then begin vErr_Ball_Order := A[4]; vIsHeavy := IsAdyB; end else begin if IsAdyB then begin if A3 > B3 then vErr_Ball_Order := B[4] else vErr_Ball_Order := B[3]; //IsHeavy := NOT IsAdyB; end else begin if A3 > B3 then vErr_Ball_Order := B[3] else vErr_Ball_Order := B[4]; //IsHeavy := NOT IsAdyB; end; vIsHeavy := NOT IsAdyB; end; end else begin if A2 > B2 then strLog2 := strLog2 + strADYB else strLog2 := strLog2 + strAXYB; str := proHead; str := str + IntToStr(AllBall[A[1]].Order) + ',' + IntToStr(AllBall[A[2]].Order) + ',' + IntToStr(AllBall[A[3]].Order) + ',' + IntToStr(AllBall[B[1]].Order) + ',' + IntToStr(AllBall[B[2]].Order); str := str + ']' + preTail1 + ' 【排3余5】'; strLog2 := strLog2 + str; str := '此时,必须综合分析近两次的比较结果.当近两次比较的天平倾向相同时,' + '必须比较共同产生倾向因素的两个球;倾向相反时,' + '任取一个正常球与A组第3个球(' + IntToStr(AllBall[A[2]].Order) + ')或B组第1个球(' + IntToStr(AllBall[B[1]].Order) + ')比较.'; strLog2 := strLog2 + nextHint + str; if ((IsAdyB = True) and (A2 > B2)) or ((IsAdyB = False) and (A2 < B2)) then begin A3 := AllBall[A[1]].Weight; B3 := AllBall[A[2]].Weight; bNumber := 1; SetLength(bPartA,bNumber); SetLength(bPartB,bNumber); bPartA[0] := AllBall[A[1]]; bPartB[0] := AllBall[A[2]]; Balance_One_Compare(Point(Fir_Pivot_X,Fir_Pivot_Y + One_DrawDelta * 2), bNumber,bPartA,bPartB,ACanvas,bShowTrace); if A3 = B3 then begin vErr_Ball_Order := B[2]; vIsHeavy := NOT IsAdyB; end else if A2 > B2 then begin if A3 > B3 then vErr_Ball_Order := A[1] else vErr_Ball_Order := A[2]; vIsHeavy := IsAdyB; end else if A2 < B2 then begin if A3 > B3 then vErr_Ball_Order := A[2] else vErr_Ball_Order := A[1]; vIsHeavy := IsAdyB; end; end else if ((IsAdyB = True) and (A2 < B2)) or ((IsAdyB = False) and (A2 > B2)) then begin A3 := AllBall[A[3]].Weight; B3 := AllBall[G[1]].Weight; bNumber := 1; SetLength(bPartA,bNumber); SetLength(bPartB,bNumber); bPartA[0] := AllBall[A[1]]; bPartB[0] := AllBall[G[1]]; Balance_One_Compare(Point(Fir_Pivot_X,Fir_Pivot_Y + One_DrawDelta * 2), bNumber,bPartA,bPartB,ACanvas,bShowTrace); if A3 = B3 then begin vErr_Ball_Order := B[1]; vIsHeavy := NOT IsAdyB; end else if A3 > B3 then begin if IsAdyB then begin vErr_Ball_Order := A[3]; vIsHeavy := IsAdyB; end else begin vErr_Ball_Order := 0; strLog3 := '"偏轻"的异常球 > 正常球!' + ErrorHint; end; end else begin if IsAdyB then begin vErr_Ball_Order := 0; strLog3 := '"偏重"的异常球 < 正常球!' + ErrorHint; end else begin vErr_Ball_Order := A[3]; vIsHeavy := IsAdyB; end end; end; end; Result := vErr_Ball_Order <> 0;end;procedure Serach_Error_Ball( AllBall:array of TC_Ball; ACanvas:TCanvas;aClearRect: TRect; bShowTrace:Boolean);var A,B:Word; Loop:Word; BufC:array[0..4] of Byte; BufT:array[0..8] of Byte; BufA,BufB:array[0..4] of Byte; BufG:array[0..4] of Byte; bOrder:Byte; bHeavy:Boolean; FoundBall :TC_SearchBall; str:AnsiString; bNumber:Byte; bPartA,bPartB:array of TC_Ball; bCmpPara:TC_CmpPara;begin A := 0; strLog1 := ''; strLog2 := ''; strLog3 := ''; ClearCanvas(aCanvas,aClearRect); str := A_Team; for Loop := 1 to 4 do begin A := A + AllBall[Loop].Weight; str := str + IntToStr(AllBall[Loop].Order) + ','; //bPartA[Loop] := AllBall[Loop]; end; str := str + preTail0; strLog1 := strLog1 + str; B := 0; str := B_Team; for Loop := 5 to 8 do begin B := B + AllBall[Loop].Weight; str := str + IntToStr(AllBall[Loop].Order) + ','; //bPartB[Loop] := AllBall[Loop]; end; str := str + preTail0; strLog1 := strLog1 + str; bNumber := 4; SetLength(bPartA,bNumber); SetLength(bPartB,bNumber); for Loop := 0 to bNumber - 1 do begin bPartA[Loop] := AllBall[Loop+1]; bPartB[Loop] := AllBall[Loop+bNumber + 1]; end; Balance_One_Compare(Point(Fir_Pivot_X,Fir_Pivot_Y), bNumber,bPartA,bPartB,ACanvas,bShowTrace); if A = B then begin strLog1 := strLog1 + strAXDB; str := proHead; for Loop := 1 to 4 do begin BufC[Loop] := AllBall[8 + Loop].Order; str := str + IntToStr(AllBall[8 + Loop].Order) + ','; end; str := str + '] ' + preTail1 + ' 【排8余4】'; strLog1 := strLog1 + str; for Loop := 1 to 8 do BufT[Loop] := AllBall[Loop].Order; with bCmpPara do begin Pre_LNumber := 12; Fro_LNumber := 4; SetLength(Pre_Latency,Pre_LNumber); SetLength(Fro_Latency,Fro_LNumber); for Loop := 0 to Pre_LNumber - 1 do Pre_Latency[Loop] := AllBall[Loop + 1]; for Loop := 0 to Fro_LNumber - 1 do Fro_Latency[Loop] := AllBall[Loop + 9]; end; Balance_One_Latency(Point(10,Fir_Pivot_Y - One_PreDelta),Point(10,Fir_Pivot_Y + One_FroDelta), bCmpPara,ACanvas,bShowTrace); if SearchBall_At4(AllBall,BufC,BufT,bOrder,bHeavy,ACanvas,bShowTrace) then begin FoundBall.Ball := AllBall[bOrder]; FoundBall.IsHeavy := bHeavy; if FoundBall.IsHeavy then FoundBall.ErrorMsg := '【偏重】' else FoundBall.ErrorMsg := '【偏轻】'; str := '【'+ IntToStr(FoundBall.Ball.Order) + '】 = ' + IntToStr(FoundBall.Ball.Weight) + ' ' + FoundBall.ErrorMsg; strLog3 := lastResult + str; end; end else begin if A > B then strLog1 := strLog1 + strADYB else strLog1 := strLog1 + strAXYB; str := proHead; for Loop := 1 to 8 do str := str + IntToStr(AllBall[Loop].Order) + ','; str := str + '] ' + preTail1 + '【排4余8】'; strLog1 := strLog1 + str; for Loop := 1 to 4 do begin BufA[Loop] := AllBall[Loop].Order; BufB[Loop] := AllBall[4 + Loop].Order; BufG[Loop] := AllBall[8 + Loop].Order; end; with bCmpPara do begin Pre_LNumber := 12; Fro_LNumber := 4; SetLength(Pre_Latency,Pre_LNumber); SetLength(Fro_Latency,Fro_LNumber); for Loop := 0 to Pre_LNumber - 1 do Pre_Latency[Loop] := AllBall[Loop + 1]; for Loop := 0 to Fro_LNumber - 1 do Fro_Latency[Loop] := AllBall[Loop + 9]; end; Balance_One_Latency(Point(Hint_X,Fir_Pivot_Y - One_PreDelta),Point(10,Fir_Pivot_Y + One_FroDelta), bCmpPara,ACanvas,bShowTrace); if SearchBall_At8(AllBall,A > B,BufA,BufB,BufG,bOrder,bHeavy,ACanvas,bShowTrace) then begin FoundBall.Ball := AllBall[bOrder]; FoundBall.IsHeavy := bHeavy; if FoundBall.IsHeavy then FoundBall.ErrorMsg := '【偏重】' else FoundBall.ErrorMsg := '【偏轻】'; str := '【'+ IntToStr(FoundBall.Ball.Order) + '】 = ' + IntToStr(FoundBall.Ball.Weight) + ' ' + FoundBall.ErrorMsg; strLog3 := lastResult + str; end; end; //MessageBox(0,PChar(Str),'小球问题',MB_OK or MB_IConInformation);end;procedure Draw_Ball_Config( AllBall:array of TC_Ball; ACanvas:TCanvas; aClearRect: TRect; bShowTrace:Boolean);begin ClearCanvas(aCanvas,aClearRect); Process_Initial_Ball( Point(0,Fir_Pivot_Y - One_PreDelta-10), AllBall,ACanvas,bShowTrace);end;procedure ClearCanvas(aCanvas: TCanvas; aRect: TRect);begin with aCanvas do begin Brush.Style := bsSolid; Brush.Color := clWhite; FillRect(aRect); end;end;end.5、 显示绘制源码
...{ 作品名称: 小球问题通用解决方案 开发作者: 成晓旭 开发时间: 2003年01月22日 完成时间: 2003年01月22日 修改时间1: 2003年11月15日 增加小于问题初始状态绘制方法}unit BallType;interfaceuses Dialogs,Windows,Classes,SysUtils,Graphics;type //小球问题:小球抽象数据类型 TC_Ball = Packed Record Order:Byte; Weight:Byte; BgColor:TColor; TextColor:TColor; end; //小球问题:被寻找的目标小球抽象数据类型 TC_SearchBall = Packed Record Ball:TC_Ball; IsHeavy:Boolean; ErrorMsg:AnsiString; end; //小球问题:一次比较的参数的抽象数据类型 TC_CmpPara = Packed Record Pre_LNumber:Byte; Pre_Latency:array of TC_Ball; Fro_LNumber:Byte; Fro_Latency:array of TC_Ball; end; //小球问题:小球抽象类 TC_Ball_Class = class private bDrawOrder: Boolean; bAbstractBall:TC_Ball; bStartPoint:TPoint; bSize:Integer; bTextColor:TColor; bBgColor:TColor; bColorChanged: Boolean; bCanvas: TCanvas; public procedure SetBgAndTextColor(bgColor: TColor; ttColor: TColor); procedure DrawSelf(); constructor Create(bTrance: Boolean); end; //小球问题:天平抽象类 TC_Balance = class// published bMainPivot:TPoint; bPartAPivot:TPoint; bPartBPivot:TPoint; bColor:TColor; bPivotColor:TColor; bCanvas: TCanvas; bWeightA:Integer; bWeightB:Integer; private bWidth:Integer; bHeight:Integer; bDelta:Integer; public procedure DrawSelf(); end; //小球问题:天平比较一次抽象类[行为抽象] TC_Compare = class cbPivot:TPoint; cbPreStart,cbFroStart:TPoint; cbCmpPara:TC_CmpPara; cbCount:Byte; cbPre_Latency:array of TC_Ball; cBallPartA:array of TC_Ball; cBallPartB:array of TC_Ball; cbFro_Latency:array of TC_Ball; cBalance:TC_Balance; cCanvas: TCanvas; private cbPPartA,cbPPartB:TPoint; pPre_Latency:array of TC_Ball_Class; pPartA:array of TC_Ball_Class; pPartB:array of TC_Ball_Class; pFro_Latency:array of TC_Ball_Class; isShowTrace:Boolean; procedure Draw_Balance(); procedure Draw_Part_A(); procedure Draw_Part_B(); procedure Draw_Latency(); public procedure Draw_AllBall(); procedure Weigh_Out(); constructor Create(bTrace: Boolean); end; //小球问题抽象类<2003-11-14至今未被使用,是为方法的通用性而设计> TC_Ball_Problem = class bpBall:array of TC_Ball; bpCompareCount:Byte; bpBallCount:Byte; bpCanvas: TCanvas; bpCompare:array of TC_Compare; pBalace:TC_Balance; public //procedure Weigh_Out(bCenterX,bCenterY:Integer); end;//天平的一次比较结果处理算法procedure Balance_One_Latency( BallStart1,BallStart2:TPoint; OneCmpPara:TC_CmpPara; ACanvas:TCanvas; bTrace:Boolean);//天平的一次比较执行算法procedure Balance_One_Compare( BalancePivot:TPoint; BallNum:Byte; PartA,PartB:array of TC_Ball; ACanvas:TCanvas; bTrace:Boolean);//问题条件设置处理算法(小于的初始状态演示算法)procedure Process_Initial_Ball( StartPoint:TPoint; AllBall:array of TC_Ball; ACanvas:TCanvas; bTrace:Boolean);implementation...{ TC_Ball_Class }constructor TC_Ball_Class.Create(bTrance: Boolean);begin bDrawOrder := NOT bTrance;end;procedure TC_Ball_Class.DrawSelf();var strDrawText:String; w,h,r:Integer;begin //暂时增加 if bDrawOrder then strDrawText := IntToStr(bAbstractBall.Order) else strDrawText := IntToStr(bAbstractBall.Weight); if bColorChanged then begin bCanvas.Brush.Color := bBgColor; bCanvas.Pen.Color := bBgColor; bCanvas.Font.Color := bTextColor; end else begin bCanvas.Brush.Color := bAbstractBall.BgColor; bCanvas.Pen.Color := bAbstractBall.BgColor; bCanvas.Font.Color := bAbstractBall.TextColor; end; bCanvas.Font.Size := bSize; bCanvas.Font.Style := [fsBold]; w := bCanvas.TextWidth(strDrawText); h := bCanvas.TextHeight(strDrawText); if w > h then r := w else r := h; //注意:此处的计算比例,是根据矩形的内接圆、外切圆推算出来的, //再加以实现绘制时的位置系数调试、调整而来 bCanvas.Ellipse(bStartPoint.X,bStartPoint.Y,bStartPoint.X + r * 1414 div 1000,bStartPoint.Y + r * 1414 div 1000); if (Length(strDrawText) = 1) then bCanvas.TextOut(bStartPoint.X + r * 414 div 1000,bStartPoint.Y + r * 207 div 1000,strDrawText) else if (Length(strDrawText) = 2) then bCanvas.TextOut(bStartPoint.X + r * 214 div 1000,bStartPoint.Y + r * 228 div 1000,strDrawText);end;procedure TC_Ball_Class.SetBgAndTextColor(bgColor: TColor; ttColor: TColor);begin Self.bBgColor := bgColor; Self.bTextColor := ttColor; bColorChanged := true;end;...{ TC_Balance }procedure TC_Balance.DrawSelf; procedure DrawTray(ACanvas:TCanvas;aX,aY,Awidth,AHeight:Integer;aDeltaY:Integer); begin with ACanvas do begin MoveTo(aX,aY); LineTo(aX - AWidth,aY + aDeltaY); LineTo(aX - AWidth - AHeight,aY - AHeight + aDeltaY); MoveTo(aX,aY); LineTo(aX + AWidth,aY - aDeltaY); LineTo(aX + AWidth + AHeight,aY - aHeight - aDeltaY); end; end;var X0,Y0,X1,Y1,X2,Y2,D,H:Integer;begin bDelta := 6; if bWeightA > bWeightB then//[A > B] bDelta := bDelta else if bWeightA = bWeightB then//[A = B] bDelta := 0 else//[A < B] bDelta := - bDelta; X0 := bMainPivot.X; Y0 := bMainPivot.Y; D := bWidth; H := bHeight; bCanvas.Pen.Color := bPivotColor; bCanvas.Brush.Color := bPivotColor; bCanvas.Polygon([Point(X0,Y0),Point(X0 - H,Y0 + H),Point(X0 + H,Y0 + H),Point(X0,Y0)]); bCanvas.Pen.Color := bColor; DrawTray(bCanvas,X0,Y0,D,H,bDelta); X1 := X0 - D - H; Y1 := Y0 - H + bDelta; DrawTray(bCanvas,X1,Y1,D div 2,H,0); X2 := X0 + D + H; Y2 := Y0 - H - bDelta; DrawTray(bCanvas,X2,Y2,D div 2,H,0); bPartAPivot.X := X1; bPartAPivot.Y := Y1; bPartBPivot.X := X2; bPartBPivot.Y := Y2;end;...{ TC_Compare }constructor TC_Compare.Create(bTrace: Boolean);begin isShowTrace := bTrace;end;procedure TC_Compare.Draw_AllBall;const strHint = '比较前:';var Loop:Integer;begin SetLength(pPre_Latency,cbCmpPara.Pre_LNumber); SetLength(cbCmpPara.Pre_Latency,cbCmpPara.Pre_LNumber); for Loop := 0 to cbCmpPara.Pre_LNumber - 1 do begin pPre_Latency[Loop] := TC_Ball_Class.Create(isShowTrace); pPre_Latency[Loop].bAbstractBall := cbCmpPara.Pre_Latency[Loop]; pPre_Latency[Loop].bSize := 10; pPre_Latency[Loop].bStartPoint := Point(80+cbPreStart.X + Loop * 25,cbPreStart.Y); pPre_Latency[Loop].SetBgAndTextColor(clBlue,clYellow); pPre_Latency[Loop].bCanvas := cCanvas; pPre_Latency[Loop].bCanvas.Font.Size := 11; pPre_Latency[Loop].bCanvas.Font.Style := [fsBold]; pPre_Latency[Loop].bCanvas.Font.Color := clBlack; pPre_Latency[Loop].bCanvas.Brush.Color := clWhite; pPre_Latency[Loop].bCanvas.TextOut(cbPreStart.X,cbPreStart.Y,strHint); pPre_Latency[Loop].DrawSelf(); pPre_Latency[Loop].Free(); end;end;procedure TC_Compare.Draw_Balance;var Loop:Integer;begin cBalance := TC_Balance.Create(); cBalance.bWeightA := 0; cBalance.bWeightB := 0; for Loop := 0 to cbCount - 1 do begin cBalance.bWeightA := cBalance.bWeightA + cBallPartA[Loop].Weight; cBalance.bWeightB := cBalance.bWeightB + cBallPartB[Loop].Weight; end; cBalance.bMainPivot := cbPivot; cBalance.bPivotColor := clFuchsia; cBalance.bColor := clBlue; cBalance.bWidth := 100; cBalance.bHeight := 18; cBalance.bCanvas := cCanvas; cBalance.DrawSelf(); cbPPartA := cBalance.bPartAPivot; cbPPartB := cBalance.bPartBPivot; cBalance.Free();end;procedure TC_Compare.Draw_Latency;const strHint = '比较后:';var Loop:Integer;begin SetLength(pFro_Latency,cbCmpPara.Fro_LNumber); //SetLength(cbCmpPara.Fro_Latency,cbCmpPara.Fro_LNumber); //注意:下面Pre_Latency不能用Fro_Latency来代替,不知道为什么2003-11-20 SetLength(cbCmpPara.Pre_Latency,cbCmpPara.Fro_LNumber); for Loop := 0 to cbCmpPara.Fro_LNumber - 1 do begin pFro_Latency[Loop] := TC_Ball_Class.Create(isShowTrace); pFro_Latency[Loop].bAbstractBall := cbCmpPara.Fro_Latency[Loop]; pFro_Latency[Loop].bSize := 10; pFro_Latency[Loop].bStartPoint := Point(80+cbFroStart.X + Loop * 25,cbFroStart.Y); pFro_Latency[Loop].SetBgAndTextColor(clGreen,clYellow); pFro_Latency[Loop].bCanvas := cCanvas; pFro_Latency[Loop].bCanvas.Font.Size := 11; pFro_Latency[Loop].bCanvas.Font.Style := [fsBold]; pFro_Latency[Loop].bCanvas.Font.Color := clBlack; pFro_Latency[Loop].bCanvas.Brush.Color := clWhite; pFro_Latency[Loop].bCanvas.TextOut(cbFroStart.X,cbFroStart.Y,strHint); pFro_Latency[Loop].DrawSelf(); pFro_Latency[Loop].Free(); end;end;procedure TC_Compare.Draw_Part_A;var Loop,r:Integer;begin SetLength(pPartA,cbCount); for Loop := 0 to cbCount - 1 do begin pPartA[Loop] := TC_Ball_Class.Create(isShowTrace); pPartA[Loop].bAbstractBall.Order := cBallPartA[Loop].Order; pPartA[Loop].bAbstractBall.Weight := cBallPartA[Loop].Weight; pPartA[Loop].bSize := 10; pPartA[Loop].SetBgAndTextColor(clYellow,clRed); pPartA[Loop].bCanvas := cCanvas; //注意:此句一定要有,设置字体的大小属性 pPartA[Loop].bCanvas.Font.Size := pPartA[Loop].bSize; if pPartA[Loop].bCanvas.TextWidth(IntToStr(pPartA[Loop].bAbstractBall.Order)) > pPartA[Loop].bCanvas.TextHeight(IntToStr(pPartA[Loop].bAbstractBall.Order)) then r := pPartA[Loop].bCanvas.TextWidth(IntToStr(pPartA[Loop].bAbstractBall.Order)) else r := pPartA[Loop].bCanvas.TextHeight(IntToStr(pPartA[Loop].bAbstractBall.Order)); r := r * 1414 div 1000; //下面的计算公式有点难 pPartA[Loop].bStartPoint.X := cbPPartA.X - (cbCount div 2) * r - r * 5 * (cbCount mod 2) div 10 + Loop * r; pPartA[Loop].bStartPoint.Y := cbPPartA.Y - r; pPartA[Loop].DrawSelf(); pPartA[Loop].Free(); end;end;procedure TC_Compare.Draw_Part_B;var Loop,r:Integer;begin SetLength(pPartb,cbCount); for Loop := 0 to cbCount - 1 do begin pPartB[Loop] := TC_Ball_Class.Create(isShowTrace); pPartB[Loop].bAbstractBall.Order := cBallPartB[Loop].Order; pPartB[Loop].bAbstractBall.Weight := cBallPartB[Loop].Weight; pPartB[Loop].bSize := 10; pPartB[Loop].SetBgAndTextColor(clYellow,clRed); pPartB[Loop].bCanvas := cCanvas; pPartB[Loop].bCanvas.Font.Size := pPartB[Loop].bSize; if pPartB[Loop].bCanvas.TextWidth(IntToStr(pPartB[Loop].bAbstractBall.Order)) > pPartB[Loop].bCanvas.TextHeight(IntToStr(pPartB[Loop].bAbstractBall.Order)) then r := pPartB[Loop].bCanvas.TextWidth(IntToStr(pPartB[Loop].bAbstractBall.Order)) else r := pPartB[Loop].bCanvas.TextHeight(IntToStr(pPartB[Loop].bAbstractBall.Order)); r := r * 1414 div 1000; pPartB[Loop].bStartPoint.X := cbPPartB.X - (cbCount div 2) * r - r * 5 * (cbCount mod 2) div 10 + Loop * r; pPartB[Loop].bStartPoint.Y := cbPPartB.Y - r; pPartB[Loop].DrawSelf(); pPartB[Loop].Free(); end;end;procedure TC_Compare.Weigh_Out();begin Draw_Balance(); Draw_Part_A(); Draw_Part_B();end;procedure Balance_One_Compare( BalancePivot:TPoint; BallNum:Byte; PartA,PartB:array of TC_Ball; ACanvas:TCanvas; bTrace:Boolean);var OneCmp:TC_Compare; Loop:Integer;begin OneCmp := TC_Compare.Create(bTrace); OneCmp.cbPivot := BalancePivot; OneCmp.cbCount := BallNum; OneCmp.cCanvas := ACanvas; SetLength(OneCmp.cBallPartA,OneCmp.cbCount); SetLength(OneCmp.cBallPartB,OneCmp.cbCount); for Loop := 0 to OneCmp.cbCount - 1 do begin OneCmp.cBallPartA[Loop] := PartA[Loop]; OneCmp.cBallPartB[Loop] := PartB[Loop]; end; OneCmp.Weigh_Out(); OneCmp.Free();end;procedure Balance_One_Latency( BallStart1,BallStart2:TPoint; OneCmpPara:TC_CmpPara; ACanvas:TCanvas; bTrace:Boolean);var OneCmp:TC_Compare;begin OneCmp := TC_Compare.Create(bTrace); OneCmp.cCanvas := ACanvas; OneCmp.cbCmpPara := OneCmpPara; OneCmp.cbPreStart := BallStart1; OneCmp.cbFroStart := BallStart2; OneCmp.Draw_AllBall(); OneCmp.Draw_Latency(); OneCmp.Free();end;//问题条件设置处理算法(小于的初始状态演示算法)procedure Process_Initial_Ball( StartPoint:TPoint; AllBall:array of TC_Ball; ACanvas:TCanvas; bTrace:Boolean);const //strHint = '初始状态:'; strHint = '';var Loop:Integer; aBall: TC_Ball_Class;begin for Loop := Low(AllBall) to High(AllBall) - 1 do begin aBall := TC_Ball_Class.Create(bTrace); aBall.bAbstractBall := AllBall[Loop + 1]; aBall.bSize := 10; aBall.bStartPoint := Point(2 + StartPoint.X + Loop * 25,StartPoint.Y); aBall.bCanvas := ACanvas; aBall.bCanvas.Font.Size := 11; aBall.bCanvas.Font.Style := [fsBold]; aBall.bCanvas.Font.Color := clBlack; aBall.bCanvas.Brush.Color := clWhite; aBall.bCanvas.TextOut(StartPoint.X,StartPoint.Y,strHint); aBall.DrawSelf(); aBall.Free(); end;end;end.6、 界面源码
...{ 作品名称: 小球问题通用解决方案 开发作者: 成晓旭 开发时间: 2003年01月21日 完成时间: 2003年01月22日 修改时间1: 2003年02月10日 新增Delphi绘图功能 修改时间2: 2003年11月14日 新增对问题模拟条件的用户设置功能 修改时间2: 2003年11月20日 新增ClearCanvas()方法,解决不能清除画面问题}unit BMain;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,BallType,Common, Buttons, ExtCtrls;type TExceptStyle = (esLight,esHeavy); //偏轻 偏重const strHint = '中国'; BallNumber = 12; //小球数量 BallValue = 10; //正常小球的质量 HeavyValue = 15; //偏重小球的质量 LightValue = 5; //偏轻小球的质量type TfrmMain = class(TForm) btnDemo: TButton; imgMain: TImage; gbConfig: TGroupBox; RadioButton1: TRadioButton; RadioButton2: TRadioButton; RadioButton3: TRadioButton; RadioButton4: TRadioButton; RadioButton5: TRadioButton; RadioButton6: TRadioButton; RadioButton7: TRadioButton; RadioButton8: TRadioButton; RadioButton9: TRadioButton; RadioButton10: TRadioButton; RadioButton11: TRadioButton; RadioButton12: TRadioButton; ImgConfig: TImage; cbEStyle: TCheckBox; Label1: TLabel; Memo0: TMemo; Label2: TLabel; Label3: TLabel; Memo1: TMemo; Label4: TLabel; Memo2: TMemo; Label5: TLabel; Memo3: TMemo; btnSetNumber: TButton; btnAuto: TButton; btnAbout: TButton; Label6: TLabel; cbTrance: TCheckBox; procedure FormShow(Sender: TObject); procedure RadioButton1Click(Sender: TObject); procedure btnDemoClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure btnSetNumberClick(Sender: TObject); procedure btnAutoClick(Sender: TObject); procedure btnAboutClick(Sender: TObject); private ...{ Private declarations } isTrance: Boolean; //是否跟踪(cbTrance的状态记录) SmallBall:array[0..BallNumber] of TC_Ball; //小球的抽象数据 ExceptBall: TC_Ball; //异常小球 ExceptStyle:TExceptStyle; //异常小球的特性 ExceptBallValue:Integer; //异常小球的质量 ExceptColor:TColor; //异常小球的表示颜色 //处理小球问题条件设置RadioGroup function ProcessRadioButton(isSort:Boolean):Integer; //选择异常小球方法 procedure ChooseExceptBall(); //绘制所有小球方法 // withExceptBall = true<有异常小球的绘制> // withExceptBall = false<无异常小球的绘制> procedure DrawSmallBall(withExceptBall: Boolean; isTrance: Boolean); procedure ClearCanvas (aCanvas: TCanvas); public ...{ Public declarations } end;var frmMain: TfrmMain;implementation...{$R *.dfm}//单元内部常量定义const Soft_Name = '小球问题解答过程演示程序0.2版'; strWaitHint = '本功能正在加紧完善中......' + CHR(13) + CHR(10) + '请拭目以待!'; strSetNumber = '设置[3-12]的小球数目,程序将自动演示问题的解答过程!' + CHR(13) + CHR(10) + strWaitHint; strAutoAnswer = '设置任意数目的小球,程序将根据本题的问题模式,' +'推算最少的比较次数,并自动演示推算过程!' + CHR(13) + CHR(10) + strWaitHint; About_Soft_Info = Soft_Name + CHR(13) + CHR(10) + '开发作者:成晓旭'+ CHR(13) + CHR(10) + '完成时间:2003年01月23日' + CHR(13) + CHR(10) + '最后修改:2003年11月20日' + CHR(13) + CHR(10) + '联系方式:CXXSoft@163.com' + CHR(13) + CHR(10) + '设计说明:本程序采用纯面向对象的分析、设计、实现。' + '也是本人的第一个运用' + ' 设计模式的作品。' + CHR(13) + CHR(10) + '发布说明:程序完成时,我将公布其源码<欢迎来信索取>。';function TfrmMain.ProcessRadioButton(isSort:Boolean):Integer;const space = 25;var aCtrl:TControl; aChoose:TRadioButton; //点击的小球索引号,循环计数器,第一个RadioButton的Top属性,GroupBox中RadioCount的计数器(关键) indexBall,I,aTop,RadioCount:Integer;begin indexBall := -1; aTop := 0; RadioCount := 0; //注意:此处初值 = -1 是错误的 for I := 0 to gbConfig.ControlCount - 1 do begin aCtrl := gbConfig.Controls[I]; if aCtrl.ClassType = TRadioButton then begin try Inc(RadioCount); aChoose := TRadioButton(aCtrl); if isSort then begin if indexBall = -1 then aTop := aChoose.Top else aChoose.Top := aTop; aChoose.Left := (RadioCount - 1) * space + 8; end else begin if aChoose.Checked then begin indexBall := RadioCount; //ShowMessage('Index Ball = ' + IntToStr(indexBall));break; //算法效率之关键
end; end; except end; end; end; Result := indexBall;end;procedure TfrmMain.FormShow(Sender: TObject);begin ProcessRadioButton(true); DrawSmallBall(false,cbTrance.Checked);end;procedure TfrmMain.ChooseExceptBall();var index:Integer;begin index := ProcessRadioButton(false); if (index >= 0) and (index <= BallNumber) then ExceptBall := SmallBall[index]; if cbEStyle.Checked then begin ExceptStyle := esHeavy; ExceptBallValue := HeavyValue; ExceptColor := clRed; end else begin ExceptStyle := esLight; ExceptBallValue := LightValue; ExceptColor := clFuchsia; end; ExceptBall.Weight := ExceptBallValue; ExceptBall.BgColor := ExceptColor; ExceptBall.TextColor := clBlack; SmallBall[index] := ExceptBall;end;procedure TfrmMain.DrawSmallBall(withExceptBall: Boolean; isTrance: Boolean);var Loop:Integer;begin for Loop := 1 to BallNumber do begin SmallBall[Loop].Order := Loop; SmallBall[Loop].Weight := BallValue; SmallBall[Loop].BgColor := clBlue; SmallBall[Loop].TextColor := clRed; end; if withExceptBall then begin ChooseExceptBall(); end; Draw_Ball_Config(SmallBall,ImgConfig.Canvas,ClientRect,isTrance);end;procedure TfrmMain.RadioButton1Click(Sender: TObject);begin try isTrance := cbTrance.Checked; except isTrance := NOT isTrance; end;; DrawSmallBall(true,isTrance); btnDemo.SetFocus();end;procedure TfrmMain.btnDemoClick(Sender: TObject);begin Serach_Error_Ball(SmallBall,imgMain.Canvas,ClientRect,isTrance); Memo1.Lines.Text := strLog1; Memo2.Lines.Text := strLog2; Memo3.Lines.Text := strLog3;end;procedure TfrmMain.FormCreate(Sender: TObject);begin// Width := Screen.Width;// Height := Screen.Height; Width := 800; Height := 600; Caption := Soft_Name;end;procedure TfrmMain.ClearCanvas(aCanvas: TCanvas);begin aCanvas.Brush.Style := bsSolid; aCanvas.Brush.Color := clWhite; aCanvas.FillRect(ClientRect);end;procedure TfrmMain.btnSetNumberClick(Sender: TObject);begin Application.MessageBox(strSetNumber,Soft_Name,MB_ICONINFORMATION);end;procedure TfrmMain.btnAutoClick(Sender: TObject);begin Application.MessageBox(strAutoAnswer,Soft_Name,MB_ICONINFORMATION);end;procedure TfrmMain.btnAboutClick(Sender: TObject);begin Application.MessageBox(About_Soft_Info,Soft_Name,MB_ICONINFORMATION);end;end.