gomain.pas 36 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153
  1. unit gomain;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5. StdCtrls, ExtCtrls, jpeg, Menus, CheckLst;
  6. type
  7. TForm1 = class(TForm)
  8. GroupBox1: TGroupBox;
  9. board: TImage;
  10. state: TPanel;
  11. PutBlack: TRadioButton;
  12. PutWhite: TRadioButton;
  13. Start: TButton;
  14. first: TComboBox;
  15. Panel4: TPanel;
  16. new: TButton;
  17. Save: TButton;
  18. load: TButton;
  19. OpenFile: TOpenDialog;
  20. SaveFile: TSaveDialog;
  21. BlackImage: TImage;
  22. WhiteImage: TImage;
  23. Panel1: TPanel;
  24. Timer1: TTimer;
  25. MainMenu1: TMainMenu;
  26. Game: TMenuItem;
  27. new1: TMenuItem;
  28. save1: TMenuItem;
  29. load1: TMenuItem;
  30. N1: TMenuItem;
  31. exit1: TMenuItem;
  32. help: TMenuItem;
  33. procedure boardMouseUp(Sender: TObject; Button: TMouseButton;
  34. Shift: TShiftState; X, Y: Integer);
  35. procedure FormCreate(Sender: TObject);
  36. procedure Exit1Click(Sender: TObject);
  37. procedure New1Click(Sender: TObject);
  38. procedure StartClick(Sender: TObject);
  39. procedure newClick(Sender: TObject);
  40. procedure SaveClick(Sender: TObject);
  41. procedure loadClick(Sender: TObject);
  42. procedure Timer1Timer(Sender: TObject);
  43. procedure save1Click(Sender: TObject);
  44. procedure load1Click(Sender: TObject);
  45. procedure helpClick(Sender: TObject);
  46. private
  47. { Private declarations }
  48. public
  49. { Public declarations }
  50. end;
  51. type boardtype = array [1..10,1..10] of char;
  52. valuetype = array [1..10,1..10] of integer;
  53. booltype = array [1..10,1..10] of boolean;
  54. var
  55. Form1: TForm1;
  56. NowColor: char;
  57. m:integer;
  58. stone:array [1..10,1..10] of TImage;
  59. die,canplay:boolean;
  60. h:array [1..10,1..10] of boolean;
  61. g:array [1..10,1..10] of integer;
  62. f,f0:boardtype;
  63. v,sl:valuetype;
  64. rb,rw,wx,wy,lastx,lasty,time,qnum:integer;
  65. queue:array [1..100] of integer;
  66. aa,bb,cc,dd,ee,ff:shortint;
  67. num:array [1..100] of integer;
  68. n,sn:array [1..100] of integer;
  69. x0,y0:array [1..100,1..10] of shortint;
  70. ch:array [1..100,0..10] of char;
  71. implementation
  72. uses readme;
  73. const dir : array [0..4,0..1] of shortint
  74. = ((0,0),(0,1),(1,0),(0,-1),(-1,0));
  75. dir8 : array [1..8,0..1] of shortint
  76. = ((0,1),(1,0),(0,-1),(-1,0),(1,1),(-1,-1),(1,-1),(-1,1));
  77. {$R *.DFM}
  78. procedure Initialize; {初始化}
  79. var i,j : integer;
  80. begin
  81. Form1.first.enabled:=true;
  82. Form1.start.enabled:=true;
  83. Form1.putblack.enabled:=true;
  84. Form1.putwhite.enabled:=true;
  85. Form1.state.caption:='';
  86. canplay:=true;
  87. NowColor:=' ';
  88. m:=0;
  89. lastx:=0;lasty:=0;
  90. for i:=1 to 10 do
  91. for j:=1 to 10 do
  92. stone[i,j].visible:=false;
  93. fillchar(f,sizeof(f),' ');
  94. end;
  95. procedure search(f:boardtype;p,q:shortint);{寻找连片的棋子}
  96. var i : shortint;
  97. begin
  98. h[p,q]:=true;
  99. for i:=1 to 4 do
  100. if ((p+dir[i,0]) in [1..10])and((q+dir[i,1]) in [1..10]) then
  101. if not h[p+dir[i,0],q+dir[i,1]] then
  102. if f[p+dir[i,0],q+dir[i,1]]=' ' then
  103. begin
  104. die:=false;
  105. exit;
  106. end
  107. else
  108. if f[p+dir[i,0],q+dir[i,1]]=f[p,q] then
  109. begin
  110. search(f,p+dir[i,0],q+dir[i,1]);
  111. if not die then exit;
  112. end;
  113. end;
  114. procedure Clear(var f:boardtype;p,q:shortint); {提去一片棋子}
  115. var i,j,k : integer;
  116. begin
  117. for i:=1 to 4 do
  118. if ((p+dir[i,0]) in [1..10])and((q+dir[i,1]) in [1..10]) then
  119. if (f[p+dir[i,0],q+dir[i,1]]<>' ')and(f[p+dir[i,0],q+dir[i,1]]<>f[p,q]) then
  120. begin
  121. fillchar(h,sizeof(h),false);
  122. die:=true;
  123. search(f,p+dir[i,0],q+dir[i,1]);
  124. if die then
  125. for j:=1 to 10 do
  126. for k:=1 to 10 do
  127. if h[j,k] then f[j,k]:=' ';
  128. end;
  129. for i:=0 to 4 do
  130. if ((p+dir[i,0]) in [1..10])and((q+dir[i,1]) in [1..10]) then
  131. if (f[p+dir[i,0],q+dir[i,1]]=f[p,q]) then
  132. begin
  133. fillchar(h,sizeof(h),false);
  134. die:=true;
  135. search(f,p+dir[i,0],q+dir[i,1]);
  136. if die then
  137. for j:=1 to 10 do
  138. for k:=1 to 10 do
  139. if h[j,k] then f[j,k]:=' ';
  140. end;
  141. end;
  142. procedure PutStone(var f:boardtype;p,q:integer;Color:char); {在f中的(p,q)位落子}
  143. begin
  144. f[p,q]:=Color;
  145. Clear(f,p,q);
  146. end;
  147. procedure SearchBlackBlocks(f:boardtype;var black:valuetype;x,y,no:shortint);
  148. var i : shortint;
  149. begin
  150. Black[x,y]:=no;
  151. for i:=1 to 4 do
  152. if ((x+dir[i,0]) in [1..10])and((y+dir[i,1]) in [1..10]) then
  153. if (Black[x+dir[i,0],y+dir[i,1]]=0)and(f[x+dir[i,0],y+dir[i,1]]='B') then
  154. SearchBlackBlocks(f,black,x+dir[i,0],y+dir[i,1],no);
  155. for i:=5 to 8 do
  156. if ((x+dir8[i,0]) in [1..10])and((y+dir8[i,1]) in [1..10]) then
  157. if (Black[x+dir8[i,0],y+dir8[i,1]]=0)and(f[x+dir8[i,0],y+dir8[i,1]]='B')
  158. and(f[x+dir8[i,0],y]=' ')and(f[x,y+dir8[i,1]]=' ') then
  159. SearchBlackBlocks(f,black,x+dir8[i,0],y+dir8[i,1],no);
  160. end;
  161. procedure CheckBlack(f:boardtype;var black:valuetype;no:shortint); {检查整片黑子死活}
  162. var f0,f1 : boolean;
  163. i,j,x : shortint;
  164. begin
  165. f0:=false;
  166. for i:=1 to 10 do
  167. begin
  168. for j:=1 to 10 do
  169. if black[i,j]=no then
  170. begin
  171. f1:=false;
  172. for x:=i+1 to 10 do
  173. if (sl[x,j]<0)or(f[x,j]<>' ') then begin f1:=true;break;end;
  174. if not f1 then
  175. begin
  176. f0:=true;
  177. break;
  178. end;
  179. f1:=false;
  180. for x:=j+1 to 10 do
  181. if (sl[i,x]<0)or(f[i,x]<>' ') then begin f1:=true;break;end;
  182. if not f1 then
  183. begin
  184. f0:=true;
  185. break;
  186. end;
  187. end;
  188. if f0 then break;
  189. end;
  190. if f0 then
  191. for i:=1 to 10 do
  192. for j:=1 to 10 do
  193. if black[i,j]=no then black[i,j]:=-black[i,j];
  194. end;
  195. procedure SearchInBlack(f:boardtype;black:valuetype;var InBlack:booltype;x,y:shortint);{搜索一片黑子}
  196. var i : shortint;
  197. begin
  198. InBlack[x,y]:=true;
  199. for i:=1 to 4 do
  200. if ((x+dir[i,0]) in [1..10])and((y+dir[i,1]) in [1..10]) then
  201. if (not InBlack[x+dir[i,0],y+dir[i,1]])and
  202. (((black[x+dir[i,0],y+dir[i,1]]>=0)and(sl[x+dir[i,0],y+dir[i,1]]<=0))
  203. or((f[x+dir[i,0],y+dir[i,1]]='W')and(sl[x+dir[i,0],y+dir[i,1]]<=2))) then
  204. SearchInBlack(f,black,InBlack,x+dir[i,0],y+dir[i,1]);
  205. end;
  206. function ShowStone(var f:boardtype;p,q:integer;Color:char):boolean;{在f中落子,且显示}
  207. var i,j : shortint;
  208. begin
  209. f0:=f;
  210. PutStone(f,p,q,Color);
  211. if f[p,q]=' ' then
  212. begin
  213. f:=f0;
  214. Form1.state.caption:='非法着点';
  215. ShowStone:=false;
  216. exit;
  217. end
  218. else
  219. for i:=1 to 10 do
  220. for j:=1 to 10 do
  221. if f0[i,j]<>f[i,j] then
  222. case f[i,j] of
  223. ' ' : stone[i,j].visible:=false;
  224. 'B' : begin
  225. stone[i,j].picture:=Form1.BlackImage.Picture;
  226. stone[i,j].visible:=true;
  227. end;
  228. 'W' : begin
  229. stone[i,j].picture:=Form1.WhiteImage.Picture;
  230. stone[i,j].visible:=true;
  231. end;
  232. end;
  233. if Color='B' then
  234. stone[p,q].picture:=Form1.BlackImage.Picture
  235. else
  236. stone[p,q].picture:=Form1.WhiteImage.Picture;
  237. if NowColor='B' then NowColor:='W'
  238. else NowColor:='B';
  239. ShowStone:=true;
  240. end;
  241. function noroundblack(f:boardtype;black,v:valuetype;p,q:shortint):boolean;{(p,q)位周围有否黑子或黑势}
  242. var k : shortint;
  243. begin
  244. for k:=1 to 4 do
  245. if ((p+dir[k,0]) in [1..10])and((q+dir[k,1]) in [1..10]) then
  246. if ((v[p+dir[k,0],q+dir[k,1]]>0)and(f[p+dir[k,0],q+dir[k,1]]=' '))or
  247. ((v[p+dir[k,0],q+dir[k,1]]>=-6)and(f[p+dir[k,0],q+dir[k,1]]='B')and(black[p+dir[k,0],q+dir[k,1]]<0)) then
  248. begin
  249. noroundblack:=false;
  250. exit;
  251. end;
  252. noroundblack:=true;
  253. end;
  254. procedure findinwhite(f:boardtype;black,v:valuetype;p,q,no:shortint); {寻找白子区域}
  255. var k : shortint;
  256. begin
  257. g[p,q]:=no;
  258. num[no]:=num[no]+1;
  259. k:=1;
  260. repeat
  261. if ((p+dir[k,0]) in [1..10])and((q+dir[k,1])in[1..10]) then
  262. begin
  263. if (f[p+dir[k,0],q+dir[k,1]]=' ')and
  264. ((v[p+dir[k,0],q+dir[k,1]]<0)or((v[p,q]=0)and(v[p+dir[k,0],q+dir[k,1]]=0)))
  265. and(g[p+dir[k,0],q+dir[k,1]]=0)and(noroundblack(f,black,v,p+dir[k,0],q+dir[k,1])) then
  266. findinwhite(f,black,v,p+dir[k,0],q+dir[k,1],no)
  267. else
  268. begin
  269. if f[p+dir[k,0],q+dir[k,1]]='W' then rw:=rw+1
  270. else
  271. if v[p+dir[k,0],q+dir[k,1]]<0 then rw:=rw+1
  272. else if v[p+dir[k,0],q+dir[k,1]]>0 then rb:=rb+1;
  273. end;
  274. end;
  275. k:=k+1;
  276. until k>4;
  277. end;
  278. function findjy(f:boardtype;black,v:valuetype;k:integer):integer; {找假眼}
  279. var i,x,y,r,n0,n1,n2 : integer;
  280. c : boolean;
  281. begin
  282. r:=0;
  283. for x:=1 to 10 do
  284. for y:=1 to 10 do
  285. if g[x,y]=k then
  286. begin
  287. c:=false;
  288. i:=1;
  289. while i<=4 do
  290. begin
  291. if (x+dir[i,0]>=1)and(x+dir[i,0]<=10)and(y+dir[i,1]>=1)and(y+dir[i,1]<=10) then
  292. if f[x+dir[i,0],y+dir[i,1]]=' ' then
  293. begin
  294. if not NoRoundBlack(f,black,v,x+dir[i,0],y+dir[i,1]) then
  295. begin
  296. c:=true;
  297. break;
  298. end;
  299. end;
  300. i:=i+1;
  301. end;
  302. n0:=0;
  303. for i:=1 to 4 do
  304. if ((x+dir[i,0]) in [1..10])and((y+dir[i,1]) in [1..10]) then
  305. if g[x+dir[i,0],y+dir[i,1]]=k then n0:=n0+1;
  306. if n0<>1 then
  307. begin
  308. if c then r:=r+1;
  309. continue;
  310. end;
  311. n0:=0;n1:=0;n2:=0;
  312. for i:=5 to 8 do
  313. if ((x+dir8[i,0]) in [1..10])and((y+dir8[i,1]) in [1..10]) then
  314. begin
  315. n0:=n0+1;
  316. if (f[x+dir8[i,0],y+dir8[i,1]]='B')and(black[x+dir8[i,0],y+dir8[i,1]]<0) then n1:=n1+1;
  317. if (v[x+dir8[i,0],y+dir8[i,1]]<=-2)or(f[x+dir8[i,0],y+dir8[i,1]]='W') then n2:=n2+1;
  318. end;
  319. if n0=1 then continue;
  320. if ((n0=2)and(n1=1))or((n0=4)and(n1=2)) then r:=r+2
  321. else
  322. begin
  323. if c then r:=r+1;
  324. if n0=2 then
  325. begin
  326. if n2<2 then r:=r+1;
  327. end
  328. else
  329. if (n2<2)or((n2=2)and(n1>0)) then r:=r+1;
  330. end;
  331. end;
  332. findjy:=r;
  333. end;
  334. function check(f:boardtype;k:integer;value:valuetype):boolean; {检查某片是否真正为白子区域}
  335. var i,j : integer;
  336. begin
  337. for i:=1 to 10 do
  338. for j:=1 to 10 do
  339. if g[i,j]=k then
  340. if value[i,j]<0 then
  341. begin
  342. check:=true;
  343. exit;
  344. end;
  345. check:=false;
  346. end;
  347. procedure ShiLi(f:boardtype;var value:valuetype); {按"气位"赋值}
  348. var i,j,k : integer;
  349. find : boolean;
  350. begin
  351. for i:=1 to 10 do
  352. for j:=1 to 10 do
  353. begin
  354. find:=false;
  355. for k:=1 to 4 do
  356. if ((i+dir[k,0]) in [1..10])and((j+dir[k,1]) in [1..10]) then
  357. if (f[i+dir[k,0],j+dir[k,1]]='B') then
  358. begin
  359. find:=true;
  360. break;
  361. end;
  362. if find then
  363. begin
  364. value[i,j]:=value[i,j]+6;
  365. continue;
  366. end;
  367. for k:=5 to 8 do
  368. if ((i+dir8[k,0]) in [1..10])and((j+dir8[k,1]) in [1..10]) then
  369. if (f[i+dir8[k,0],j+dir8[k,1]]='B')
  370. and(f[i+dir8[k,0],j]=' ')and(f[i,j+dir8[k,1]]=' ') then
  371. begin
  372. find:=true;
  373. break;
  374. end;
  375. if find then
  376. begin
  377. value[i,j]:=value[i,j]+5;
  378. continue;
  379. end;
  380. for k:=5 to 8 do
  381. if ((i+dir8[k,0]) in [1..10])and((j+dir8[k,1]) in [1..10]) then
  382. if (f[i+dir8[k,0],j+dir8[k,1]]='B') then
  383. begin
  384. find:=true;
  385. break;
  386. end;
  387. if find then
  388. begin
  389. value[i,j]:=value[i,j]+3;
  390. continue;
  391. end;
  392. for k:=1 to 4 do
  393. if ((i+2*dir[k,0]) in [1..10])and((j+2*dir[k,1]) in [1..10]) then
  394. if (f[i+2*dir[k,0],j+2*dir[k,1]]='B')and(f[i+dir[k,0],j+dir[k,1]]=' ') then
  395. begin
  396. find:=true;
  397. break;
  398. end;
  399. if find then
  400. begin
  401. value[i,j]:=value[i,j]+3;
  402. continue;
  403. end;
  404. if ((i+1) in [1..10])and((j+1) in [1..10]) then
  405. if f[i+1,j+1]=' ' then
  406. begin
  407. if (f[i+1,j]=' ')and((i+2) in [1..10]) then
  408. if f[i+2,j+1]='B' then find:=true;
  409. if (f[i,j+1]=' ')and((j+2) in [1..10]) then
  410. if f[i+1,j+2]='B' then find:=true;
  411. end;
  412. if ((i+1) in [1..10])and((j-1) in [1..10]) then
  413. if f[i+1,j-1]=' ' then
  414. begin
  415. if (f[i+1,j]=' ')and((i+2) in [1..10]) then
  416. if f[i+2,j-1]='B' then find:=true;
  417. if (f[i,j-1]=' ')and((j-2) in [1..10]) then
  418. if f[i+1,j-2]='B' then find:=true;
  419. end;
  420. if ((i-1) in [1..10])and((j+1) in [1..10]) then
  421. if f[i-1,j+1]=' ' then
  422. begin
  423. if (f[i-1,j]=' ')and((i-2) in [1..10]) then
  424. if f[i-2,j+1]='B' then find:=true;
  425. if (f[i,j+1]=' ')and((j+2) in [1..10]) then
  426. if f[i-1,j+2]='B' then find:=true;
  427. end;
  428. if ((i-1) in [1..10])and((j-1) in [1..10]) then
  429. if f[i-1,j-1]=' ' then
  430. begin
  431. if (f[i-1,j]=' ')and((i-2) in [1..10]) then
  432. if f[i-2,j-1]='B' then find:=true;
  433. if (f[i,j-1]=' ')and((j-2) in [1..10]) then
  434. if f[i-1,j-2]='B' then find:=true;
  435. end;
  436. if find then value[i,j]:=value[i,j]+2;
  437. end;
  438. for i:=1 to 10 do
  439. for j:=1 to 10 do
  440. begin
  441. find:=false;
  442. for k:=1 to 4 do
  443. if ((i+dir[k,0]) in [1..10])and((j+dir[k,1]) in [1..10]) then
  444. if (f[i+dir[k,0],j+dir[k,1]]='W') then
  445. begin
  446. find:=true;
  447. break;
  448. end;
  449. if find then
  450. begin
  451. value[i,j]:=value[i,j]-6;
  452. continue;
  453. end;
  454. for k:=5 to 8 do
  455. if ((i+dir8[k,0]) in [1..10])and((j+dir8[k,1]) in [1..10]) then
  456. if (f[i+dir8[k,0],j+dir8[k,1]]='W')
  457. and(f[i+dir8[k,0],j]=' ')and(f[i,j+dir8[k,1]]=' ') then
  458. begin
  459. find:=true;
  460. break;
  461. end;
  462. if find then
  463. begin
  464. value[i,j]:=value[i,j]-5;
  465. continue;
  466. end;
  467. for k:=5 to 8 do
  468. if ((i+dir8[k,0]) in [1..10])and((j+dir8[k,1]) in [1..10]) then
  469. if (f[i+dir8[k,0],j+dir8[k,1]]='W') then
  470. begin
  471. find:=true;
  472. break;
  473. end;
  474. if find then
  475. begin
  476. value[i,j]:=value[i,j]-3;
  477. continue;
  478. end;
  479. for k:=1 to 4 do
  480. if ((i+2*dir[k,0]) in [1..10])and((j+2*dir[k,1]) in [1..10]) then
  481. if (f[i+2*dir[k,0],j+2*dir[k,1]]='W')and(f[i+dir[k,0],j+dir[k,1]]=' ') then
  482. begin
  483. find:=true;
  484. break;
  485. end;
  486. if find then
  487. begin
  488. value[i,j]:=value[i,j]-3;
  489. continue;
  490. end;
  491. if ((i+1) in [1..10])and((j+1) in [1..10]) then
  492. if f[i+1,j+1]=' ' then
  493. begin
  494. if (f[i+1,j]=' ')and((i+2) in [1..10]) then
  495. if f[i+2,j+1]='W' then find:=true;
  496. if (f[i,j+1]=' ')and((j+2) in [1..10]) then
  497. if f[i+1,j+2]='W' then find:=true;
  498. end;
  499. if ((i+1) in [1..10])and((j-1) in [1..10]) then
  500. if f[i+1,j-1]=' ' then
  501. begin
  502. if (f[i+1,j]=' ')and((i+2) in [1..10]) then
  503. if f[i+2,j-1]='W' then find:=true;
  504. if (f[i,j-1]=' ')and((j-2) in [1..10]) then
  505. if f[i+1,j-2]='W' then find:=true;
  506. end;
  507. if ((i-1) in [1..10])and((j+1) in [1..10]) then
  508. if f[i-1,j+1]=' ' then
  509. begin
  510. if (f[i-1,j]=' ')and((i-2) in [1..10]) then
  511. if f[i-2,j+1]='W' then find:=true;
  512. if (f[i,j+1]=' ')and((j+2) in [1..10]) then
  513. if f[i-1,j+2]='W' then find:=true;
  514. end;
  515. if ((i-1) in [1..10])and((j-1) in [1..10]) then
  516. if f[i-1,j-1]=' ' then
  517. begin
  518. if (f[i-1,j]=' ')and((i-2) in [1..10]) then
  519. if f[i-2,j-1]='W' then find:=true;
  520. if (f[i,j-1]=' ')and((j-2) in [1..10]) then
  521. if f[i-1,j-2]='W' then find:=true;
  522. end;
  523. if find then value[i,j]:=value[i,j]-2;
  524. end;
  525. end;
  526. procedure QiWei(f:boardtype;var black,value:valuetype;var InBlack:booltype); {按"气位"赋值}
  527. var i,j,no,xx,yy : integer;
  528. begin
  529. ShiLi(f,value);
  530. fillchar(black,sizeof(black),0);
  531. no:=0;
  532. for i:=1 to 10 do
  533. for j:=1 to 10 do
  534. if (black[i,j]=0)and(f[i,j]='B') then
  535. begin
  536. no:=no+1;
  537. SearchBlackBlocks(f,black,i,j,no);
  538. CheckBlack(f,black,no);
  539. end; for i:=1 to 10 do
  540. for j:=1 to 10 do
  541. if (f[i,j]='B')and(black[i,j]>=0) then f[i,j]:=' ';
  542. ShiLi(f,value);
  543. xx:=1;yy:=1;
  544. while (xx<=10)and(f[xx,yy]<>'W') do
  545. begin
  546. yy:=yy+1;
  547. if yy>10 then
  548. begin
  549. yy:=1;
  550. xx:=xx+1;
  551. end;
  552. end;
  553. fillchar(InBlack,sizeof(InBlack),false);
  554. if xx<=10 then SearchInBlack(f,Black,InBlack,xx,yy);
  555. end;
  556. procedure calc(f:boardtype;var black,value:valuetype;var InBlack:booltype;var aa,bb,cc,dd,ee,ff:shortint);{计算各种眼位数}
  557. var i,j,k,t,no,p,q,x,y,sb,sw : integer;
  558. a0,b0,jy,p0,q0,u : integer;
  559. pn : real;
  560. c,same,found,find : boolean;
  561. f0 : boardtype;
  562. begin
  563. fillchar(value,sizeof(value),0);
  564. fillchar(h,sizeof(h),true);
  565. QiWei(f,black,value,InBlack);
  566. f0:=f;
  567. for i:=1 to 10 do
  568. for j:=1 to 10 do
  569. if (f[i,j]='B')and(Black[i,j]>=0) then f[i,j]:=' ';
  570. fillchar(g,sizeof(g),0);
  571. no:=0;m:=0;
  572. fillchar(num,sizeof(num),0);
  573. for i:=1 to 10 do
  574. for j:=1 to 10 do
  575. if (f[i,j]=' ')and(g[i,j]=0)and(value[i,j]<=0) then
  576. begin
  577. no:=no+1;
  578. rb:=0;rw:=0;
  579. FindInWhite(f,black,value,i,j,no);
  580. if ((rb=0)or(rw/rb>4))and(rw>0)and(check(f,no,value)) then
  581. begin
  582. m:=m+1;
  583. queue[m]:=no;
  584. end;
  585. end;
  586. aa:=0;bb:=0;cc:=0;dd:=0;ee:=0;ff:=0;
  587. f:=f0;
  588. for i:=1 to m do
  589. if num[queue[i]]=1 then
  590. begin
  591. a0:=aa;b0:=bb;
  592. x:=1;y:=1;
  593. while g[x,y]<>queue[i] do
  594. begin
  595. y:=y+1;
  596. if y>10 then
  597. begin
  598. x:=x+1;
  599. y:=1;
  600. end;
  601. end;
  602. if (x=10)or(y=10) then continue;
  603. if (x=1)and(y=1) then
  604. begin
  605. if ((value[2,2]<=-2)and(noroundblack(f,black,value,2,2)))or(f[2,2]='W') then aa:=aa+1;
  606. end
  607. else
  608. if x=1 then
  609. begin
  610. sw:=0;sb:=0;
  611. if ((value[2,y-1]<=-2)and(noroundblack(f,black,value,2,y-1)))or(f[2,y-1]='W') then sw:=sw+1
  612. else if (value[2,y-1]>=0)and(f[2,y-1]='B') then sb:=sb+1;
  613. if ((value[2,y+1]<=-2)and(noroundblack(f,black,value,2,y+1)))or(f[2,y+1]='W') then sw:=sw+1
  614. else if (value[2,y+1]>=0)and(f[2,y+1]='B') then sb:=sb+1;
  615. if sw=2 then aa:=aa+1
  616. else if (sw=1)and(sb=0) then bb:=bb+1;
  617. end
  618. else
  619. if y=1 then
  620. begin
  621. sw:=0;sb:=0;
  622. if ((value[x-1,2]<=-2)and(noroundblack(f,black,value,x-1,2)))or(f[x-1,2]='W') then sw:=sw+1
  623. else if (value[x-1,2]>=0)and(f[x-1,2]='B') then sb:=sb+1;
  624. if ((value[x+1,2]<=-2)and(noroundblack(f,black,value,x+1,2)))or(f[x+1,2]='W') then sw:=sw+1
  625. else if (value[x+1,2]>=0)and(f[x+1,2]='B') then sb:=sb+1;
  626. if sw=2 then aa:=aa+1
  627. else if (sw=1)and(sb=0) then bb:=bb+1;
  628. end
  629. else
  630. begin
  631. sb:=0;sw:=0;
  632. if (value[x+1,y+1]>=0)and(f[x+1,y+1]='B') then sb:=sb+1
  633. else if ((value[x+1,y+1]<=-2){and(noroundblack(f,value,x+1,y+1))})or(f[x+1,y+1]='W') then sw:=sw+1;
  634. if (value[x-1,y+1]>=0)and(f[x-1,y+1]='B') then sb:=sb+1
  635. else if ((value[x-1,y+1]<=-2){and(noroundblack(f,value,x-1,y+1))})or(f[x-1,y+1]='W') then sw:=sw+1;
  636. if (value[x+1,y-1]>=0)and(f[x+1,y-1]='B') then sb:=sb+1
  637. else if ((value[x+1,y-1]<=-2){and(noroundblack(f,value,x+1,y-1))})or(f[x+1,y-1]='W') then sw:=sw+1;
  638. if (value[x-1,y-1]>=0)and(f[x-1,y-1]='B') then sb:=sb+1
  639. else if ((value[x-1,y-1]<=-2){and(noroundblack(f,value,x-1,y-1))})or(f[x-1,y-1]='W') then sw:=sw+1;
  640. if sb=1 then
  641. begin
  642. case sw of
  643. 2 : bb:=bb+1;
  644. 3 : aa:=aa+1;
  645. end;
  646. end
  647. else
  648. if sb=0 then
  649. case sw of
  650. 1 : bb:=bb+1;
  651. 2,3,4 : aa:=aa+1;
  652. end;
  653. end;
  654. if (aa<>a0)or(bb<>b0) then
  655. begin
  656. c:=false;
  657. for j:=1 to 4 do
  658. if ((x+dir[j,0]) in [1..10])and((y+dir[j,1]) in [1..10]) then
  659. if f[x+dir[j,0],y+dir[j,1]]=' ' then
  660. begin
  661. c:=not noroundblack(f,black,value,x+dir[j,0],y+dir[j,1]);
  662. if c then break;
  663. end;
  664. if c then
  665. if aa<>a0 then
  666. begin
  667. aa:=a0;
  668. bb:=bb+1;
  669. end
  670. else bb:=b0;
  671. end;
  672. end;
  673. for k:=1 to m do
  674. if num[queue[k]] in [2..5] then
  675. begin
  676. found:=false;
  677. for u:=1 to qnum do
  678. begin
  679. if n[u]=num[queue[k]] then
  680. begin
  681. x:=1;y:=1;
  682. while g[x,y]<>queue[k] do
  683. begin
  684. y:=y+1;
  685. if y>10 then
  686. begin
  687. x:=x+1;
  688. y:=1;
  689. end;
  690. end;
  691. x:=x-x0[u,1];y:=y-y0[u,1];
  692. same:=true;
  693. for i:=2 to n[u] do
  694. begin
  695. if (x0[u,i]+x<1)or(x0[u,i]+x>10)or(y0[u,i]+y<1)or(y0[u,i]+y>10) then
  696. begin
  697. same:=false;
  698. break;
  699. end;
  700. if g[x0[u,i]+x,y0[u,i]+y]<>queue[k] then
  701. begin
  702. same:=false;
  703. break;
  704. end;
  705. end;
  706. if same then
  707. begin
  708. jy:=findjy(f,black,value,queue[k]);
  709. found:=true;
  710. c:=true;
  711. if ch[u,jy]>'d' then
  712. begin
  713. i:=1;j:=1;
  714. while i<=10 do
  715. begin
  716. if (g[i,j]=queue[k])and(f0[i,j]='B') then
  717. begin
  718. dd:=dd+1;
  719. c:=false;
  720. break;
  721. end;
  722. j:=j+1;
  723. if j>10 then
  724. begin
  725. j:=1;
  726. i:=i+1;
  727. end;
  728. end;
  729. end;
  730. if not c then break;
  731. case ch[u,jy] of
  732. 'a' : aa:=aa+1;
  733. 'b' : bb:=bb+1;
  734. 'c' : cc:=cc+1;
  735. 'd' : dd:=dd+1;
  736. 'e' : ee:=ee+1;
  737. 'f' : ff:=ff+1;
  738. end;
  739. break;
  740. end;
  741. end;
  742. readln;
  743. end;
  744. close(input);
  745. if (num[queue[k]]=5)and(not found) then
  746. begin
  747. jy:=findjy(f,black,value,queue[k]);
  748. case jy of
  749. 0,1 : ff:=ff+1;
  750. 2 : ee:=ee+1;
  751. 3,4 : dd:=dd+1;
  752. 5 : cc:=cc+1;
  753. end;
  754. end;
  755. end
  756. else
  757. if num[queue[k]]>5 then
  758. begin
  759. i:=1;j:=1;c:=true;
  760. while i<=10 do
  761. begin
  762. if (g[i,j]=queue[k])and(f0[i,j]='B') then
  763. begin
  764. dd:=dd+1;
  765. c:=false;
  766. break;
  767. end;
  768. j:=j+1;
  769. if j>10 then
  770. begin
  771. j:=1;
  772. i:=i+1;
  773. end;
  774. end;
  775. if not c then continue;
  776. jy:=findjy(f,black,value,queue[k]);
  777. if num[queue[k]]-jy>=4 then ff:=ff+1
  778. else
  779. case num[queue[k]]-jy of
  780. 3 : ee:=ee+1;
  781. 2 : dd:=dd+1;
  782. 1 : cc:=cc+1;
  783. end;
  784. end;
  785. end;
  786. function RoundWhite(f:boardtype;x,y:integer):boolean; {判断某位置是否与白子或白势相邻}
  787. var i : integer;
  788. begin
  789. for i:=1 to 4 do
  790. if ((x+dir[i,0]) in [1..10])and((y+dir[i,1]) in [1..10]) then
  791. if f[x+dir[i,0],y+dir[i,1]]='W' then
  792. begin
  793. RoundWhite:=true;
  794. exit;
  795. end;
  796. RoundWhite:=false;
  797. end;
  798. function WhiteSearch(l:integer;f:boardtype):real; {博弈搜索}
  799. var i,j,s,t : integer;
  800. f0,f1 : boardtype;
  801. live,minlive,temp : real;
  802. black : valuetype;
  803. InBlack : booltype;
  804. begin
  805. if l>2 then
  806. begin
  807. WhiteSearch:=0;
  808. exit;
  809. end;
  810. WhiteSearch:=1;
  811. minlive:=1;
  812. for i:=10 downto 1 do
  813. for j:=10 downto 1 do
  814. if (f[i,j]=' ')and((roundwhite(f,i,j)) or (v[i,j]<0)) then
  815. begin
  816. f0:=f;
  817. putstone(f0,i,j,'B');
  818. if f0[i,j]=' ' then continue;
  819. calc(f0,black,v,InBlack,aa,bb,cc,dd,ee,ff);
  820. if (ee>0)or(aa+dd+2*ff>=2)or((aa+dd=1)and(bb+cc>=2))or(bb+cc>=4) then continue;
  821. f1:=f0;
  822. s:=10;t:=10;
  823. live:=0;
  824. while s>0 do
  825. begin
  826. f0:=f1;
  827. if (f0[s,t]=' ')and(InBlack[s,t]) then
  828. begin
  829. putstone(f0,s,t,'W');
  830. if f0[s,t]='W' then
  831. begin
  832. calc(f0,black,v,InBlack,aa,bb,cc,dd,ee,ff);
  833. if aa+dd+2*ff+ee*1.5+(bb+cc)/2>=2 then live:=1
  834. else
  835. begin
  836. temp:=WhiteSearch(l+1,f0);
  837. if temp>live then live:=temp;
  838. end;
  839. end;
  840. end;
  841. if live=1 then break;
  842. t:=t-1;
  843. if t<1 then
  844. begin
  845. t:=10;
  846. s:=s-1;
  847. end;
  848. end;
  849. if live<minlive then minlive:=live;
  850. if minlive=0 then break;
  851. end;
  852. WhiteSearch:=minlive;
  853. end;
  854. procedure WhiteTurn; {考虑白棋策略}
  855. var c,i,j,k,xx,yy,n,min,no,count,t : integer;
  856. w,maxw : real;
  857. lst : array [1..100,0..1] of shortint;
  858. black : valuetype;
  859. InBlack : booltype;
  860. begin
  861. count:=0;
  862. if lastx>0 then
  863. for i:=1 to 10 do
  864. for j:=1 to 10 do
  865. if f[i,j]=' ' then
  866. begin
  867. f0:=f;
  868. PutStone(f0,i,j,'W');
  869. if f0[lastx,lasty]=' ' then
  870. begin
  871. ShowStone(f,i,j,'W');
  872. exit;
  873. end;
  874. end;
  875. fillchar(InBlack,sizeof(InBlack),false);
  876. QiWei(f,black,sl,InBlack);
  877. calc(f,black,sl,InBlack,aa,bb,cc,dd,ee,ff);
  878. if aa+dd+2*ff+ee*1.5+(bb+cc)/2>=2 then
  879. begin
  880. c:=0;
  881. for i:=1 to 10 do
  882. for j:=1 to 10 do
  883. if (f[i,j]=' ')and(InBlack[i,j]) then c:=c+1;
  884. if c=2 then
  885. begin
  886. Form1.state.caption:='白棋活';
  887. canplay:=false;
  888. exit;
  889. end;
  890. end;
  891. for i:=10 downto 1 do
  892. for j:=10 downto 1 do
  893. if (f[i,j]=' ')and(InBlack[i,j]) then
  894. begin
  895. f0:=f;
  896. PutStone(f0,i,j,'W');
  897. if f0[i,j]=' ' then continue;
  898. calc(f0,black,v,InBlack,aa,bb,cc,dd,ee,ff);
  899. if aa+dd+2*ff+ee*1.5+(bb+cc)/2>=2 then
  900. begin
  901. count:=count+1;
  902. lst[count,0]:=i;
  903. lst[count,1]:=j;
  904. end;
  905. end;
  906. if count=0 then
  907. begin
  908. for i:=10 downto 1 do
  909. for j:=10 downto 1 do
  910. if (f[i,j]=' ')and(Inblack[i,j]) then
  911. begin
  912. f0:=f;
  913. PutStone(f0,i,j,'W');
  914. if f0[i,j]=' ' then continue;
  915. count:=count+1;
  916. lst[count,0]:=i;
  917. lst[count,1]:=j;
  918. end;
  919. end;
  920. j:=1;
  921. if lastx=1 then
  922. begin
  923. i:=j+1;
  924. while (i<=count)and((lst[i,0]<>lastx)or(lst[i,1]<>lasty+1)) do i:=i+1;
  925. if i<=count then
  926. begin
  927. t:=lst[i,0];lst[i,0]:=lst[j,0];lst[j,0]:=t;
  928. t:=lst[i,1];lst[i,1]:=lst[j,1];lst[j,1]:=t;
  929. end;
  930. j:=j+1;
  931. i:=j+1;
  932. while (i<=count)and((lst[i,0]<>lastx)or(lst[i,1]<>lasty-1)) do i:=i+1;
  933. if i<=count then
  934. begin
  935. t:=lst[i,0];lst[i,0]:=lst[j,0];lst[j,0]:=t;
  936. t:=lst[i,1];lst[i,1]:=lst[j,1];lst[j,1]:=t;
  937. end;
  938. j:=j+1;
  939. end
  940. else
  941. if lasty=1 then
  942. begin
  943. i:=j+1;
  944. while (i<=count)and((lst[i,0]<>lastx+1)or(lst[i,1]<>lasty)) do i:=i+1;
  945. if i<=count then
  946. begin
  947. t:=lst[i,0];lst[i,0]:=lst[j,0];lst[j,0]:=t;
  948. t:=lst[i,1];lst[i,1]:=lst[j,1];lst[j,1]:=t;
  949. end;
  950. j:=j+1;
  951. i:=j+1;
  952. while (i<=count)and((lst[i,0]<>lastx-1)or(lst[i,1]<>lasty)) do i:=i+1;
  953. if i<=count then
  954. begin
  955. t:=lst[i,0];lst[i,0]:=lst[j,0];lst[j,0]:=t;
  956. t:=lst[i,1];lst[i,1]:=lst[j,1];lst[j,1]:=t;
  957. end;
  958. j:=j+1;
  959. end;
  960. xx:=0;yy:=0;
  961. maxw:=0;
  962. for i:=1 to count do
  963. begin
  964. f0:=f;
  965. PutStone(f0,lst[i,0],lst[i,1],'W');
  966. if f0[lst[i,0],lst[i,1]]=' ' then continue;
  967. calc(f0,black,v,InBlack,aa,bb,cc,dd,ee,ff);
  968. w:=WhiteSearch(1,f0);
  969. if w>maxw then
  970. begin
  971. maxw:=w;
  972. xx:=lst[i,0];
  973. yy:=lst[i,1];
  974. end;
  975. if maxw=1 then break;
  976. end;
  977. if maxw>0.3 then ShowStone(f,xx,yy,'W')
  978. else
  979. begin
  980. Form1.state.caption:='白棋死';
  981. canplay:=false;
  982. exit;
  983. end;
  984. end;
  985. procedure TForm1.boardMouseUp(Sender: TObject; Button: TMouseButton;
  986. Shift: TShiftState; X, Y: Integer);
  987. var p,q : shortint;
  988. begin
  989. if not canplay then exit;
  990. if timer1.enabled then exit;
  991. q:=x div 38+1;
  992. p:=y div 38+1;
  993. if (p<1)or(p>10)or(q<1)or(q>10) then exit;
  994. if f[p,q] in ['B','W'] then
  995. begin
  996. Form1.state.caption:='非法着点';
  997. exit;
  998. end;
  999. if Start.Enabled then
  1000. begin
  1001. if PutBlack.Checked then ShowStone(f,p,q,'B')
  1002. else ShowStone(f,p,q,'W');
  1003. NowColor:=' ';
  1004. exit;
  1005. end;
  1006. if ShowStone(f,p,q,NowColor) then
  1007. begin
  1008. lastx:=p;
  1009. lasty:=q;
  1010. WhiteTurn;
  1011. end;
  1012. end;
  1013. procedure TForm1.FormCreate(Sender: TObject);
  1014. var i,j : integer;
  1015. temp : char;
  1016. begin
  1017. AssignFile(input,'shape.dat');
  1018. reset(input);
  1019. qnum:=0;
  1020. while not eof (input) do
  1021. begin
  1022. qnum:=qnum+1;
  1023. read(n[qnum],sn[qnum]);
  1024. for i:=0 to sn[qnum] do read(temp,ch[qnum,i]);
  1025. for i:=1 to n[qnum] do read(x0[qnum,i],y0[qnum,i]);
  1026. readln;
  1027. end;
  1028. CloseFile(input);
  1029. for i:=1 to 10 do
  1030. for j:=1 to 10 do
  1031. begin
  1032. stone[i,j]:=TImage.Create(Form1.Board);
  1033. stone[i,j].parent:=Form1.GroupBox1;
  1034. stone[i,j].enabled:=false;
  1035. stone[i,j].autosize:=true;
  1036. stone[i,j].left:=j*38-32;
  1037. stone[i,j].top:=i*38-20;
  1038. end;
  1039. Initialize;
  1040. end;
  1041. procedure TForm1.Exit1Click(Sender: TObject);
  1042. begin
  1043. Form1.close;
  1044. end;
  1045. procedure TForm1.New1Click(Sender: TObject);
  1046. begin
  1047. initialize;
  1048. end;
  1049. procedure TForm1.StartClick(Sender: TObject);
  1050. begin
  1051. if first.text='黑方' then NowColor:='B'
  1052. else NowColor:='W';
  1053. state.caption:='';
  1054. first.enabled:=false;
  1055. start.enabled:=false;
  1056. putblack.enabled:=false;
  1057. putwhite.enabled:=false;
  1058. if first.text='白方' then WhiteTurn;
  1059. end;
  1060. procedure TForm1.newClick(Sender: TObject);
  1061. begin
  1062. Initialize;
  1063. end;
  1064. procedure savegame;
  1065. var i,j,n : shortint;
  1066. begin
  1067. if form1.SaveFile.Execute then
  1068. begin
  1069. AssignFile(output,form1.SaveFile.Filename);
  1070. rewrite(output);
  1071. n:=0;
  1072. for i:=1 to 10 do
  1073. for j:=1 to 10 do
  1074. if f[i,j]<>' ' then n:=n+1;
  1075. write(n,' ');
  1076. for i:=1 to 10 do
  1077. for j:=1 to 10 do
  1078. if f[i,j]<>' ' then
  1079. begin
  1080. if f[i,j]='B' then write('0 ')
  1081. else write('1 ');
  1082. write(i,' ',j,' ');
  1083. end;
  1084. CloseFile(output);
  1085. form1.timer1.enabled:=true;
  1086. time:=0;
  1087. end;
  1088. end;
  1089. procedure TForm1.SaveClick(Sender: TObject);
  1090. begin
  1091. savegame;
  1092. end;
  1093. procedure loadgame;
  1094. var i,k,n,x,y : integer;
  1095. begin
  1096. if form1.OpenFile.Execute then
  1097. begin
  1098. Initialize;
  1099. AssignFile(input,form1.OpenFile.Filename);
  1100. reset(input);
  1101. read(n);
  1102. for i:=1 to n do
  1103. begin
  1104. read(k,x,y);
  1105. if k=0 then ShowStone(f,x,y,'B')
  1106. else ShowStone(f,x,y,'W');
  1107. end;
  1108. CloseFile(input);
  1109. form1.timer1.enabled:=true;
  1110. time:=0;
  1111. end;
  1112. end;
  1113. procedure TForm1.loadClick(Sender: TObject);
  1114. begin
  1115. loadgame;
  1116. end;
  1117. procedure TForm1.Timer1Timer(Sender: TObject);
  1118. begin
  1119. time:=time+1;
  1120. if time>10 then timer1.enabled:=false;
  1121. end;
  1122. procedure TForm1.save1Click(Sender: TObject);
  1123. begin
  1124. savegame;
  1125. end;
  1126. procedure TForm1.load1Click(Sender: TObject);
  1127. begin
  1128. loadgame;
  1129. end;
  1130. procedure TForm1.helpClick(Sender: TObject);
  1131. begin
  1132. Form2.Show;
  1133. end;
  1134. end.