(文档请参考: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;
interface
uses
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.
作品名称: 小球问题通用解决方案
开发作者: 成晓旭
开发时间: 2003年01月22日
完成时间: 2003年01月23日
修改时间1: 2003年11月14日
增加用户问题条件设置绘制方法
修改时间2: 2003年11月18日
增加比较过程的记录功能
}
unit Common;
interface
uses
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;
interface
uses
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.
作品名称: 小球问题通用解决方案
开发作者: 成晓旭
开发时间: 2003年01月22日
完成时间: 2003年01月22日
修改时间1: 2003年11月15日
增加小于问题初始状态绘制方法
}
unit BallType;
interface
uses
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;
interface
uses
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.
作品名称: 小球问题通用解决方案
开发作者: 成晓旭
开发时间: 2003年01月21日
完成时间: 2003年01月22日
修改时间1: 2003年02月10日 新增Delphi绘图功能
修改时间2: 2003年11月14日 新增对问题模拟条件的用户设置功能
修改时间2: 2003年11月20日 新增ClearCanvas()方法,解决不能清除画面问题
}
unit BMain;
interface
uses
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.