Unit1.pas

   1 unit Unit1;\r
   2 \r
   3 interface\r
   4 \r
   5 uses\r
   6   System.SysUtils, System.Types, System.UITypes, System.Classes,\r
   7   System.Variants, Generics.Collections,\r
   8   FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,\r
   9   System.Math, FMX.Objects, FMX.StdCtrls, FMX.Menus;\r
  10 \r
  11 const\r
  12   bmp_count = 8;\r
  13 \r
  14 type\r
  15   TStoneType = (stNone, stWhite, stBlack, stError, stEffect);\r
  16 \r
  17   TEffectData = record\r
  18     X, Y: integer;\r
  19     Left, Top: integer;\r
  20   end;\r
  21 \r
  22   TGridData = record\r
  23     Strings: array [0 .. bmp_count - 1] of array [0 .. bmp_count - 1]\r
  24       of TStoneType;\r
  25     Stone: TStoneType;\r
  26   end;\r
  27 \r
  28   TPlayer = class(TObject)\r
  29   private\r
  30     FAuto: Boolean;\r
  31     FStone: TStoneType;\r
  32   public\r
  33     property Auto: Boolean read FAuto write FAuto;\r
  34     property Stone: TStoneType read FStone write FStone;\r
  35   end;\r
  36 \r
  37   TStoneGrid = class(TObject)\r
  38   private\r
  39     FStrings: TGridData;\r
  40     FBuffer: array [0 .. bmp_count * bmp_count - 4] of TGridData;\r
  41     FTurnNumber: integer;\r
  42     FTurnIndex: integer;\r
  43     FActive: Boolean;\r
  44     FList: TList<TEffectData>;\r
  45     FEffectStone: TStoneType;\r
  46     FIndex_X: integer;\r
  47     FIndex_Y: integer;\r
  48     FGameOver: Boolean;\r
  49     function GetStrings(X, Y: integer): TStoneType;\r
  50     procedure SetStrings(X, Y: integer; const Value: TStoneType);\r
  51     procedure SetTurnNumber(const Value: integer);\r
  52     function GetActive: Boolean;\r
  53     procedure SetActive(const Value: Boolean);\r
  54     function GetStone: TStoneType;\r
  55   public\r
  56     constructor Create;\r
  57     destructor Destroy; override;\r
  58     procedure Clear;\r
  59     function CalScore(Stone: TStoneType; X, Y: integer;\r
  60       out Score: integer): Boolean;\r
  61     function CanSetStone(Stone: TStoneType; X, Y: integer; Reverse: Boolean;\r
  62       const Visible: Boolean = false): Boolean;\r
  63     function NextStone(Stone: TStoneType; var Pos: TPoint): Boolean;\r
  64     procedure Start;\r
  65     procedure Restart;\r
  66     procedure Pause;\r
  67     function ListExecute: Boolean;\r
  68     procedure GameOver;\r
  69     procedure Paint(Canvas: TCanvas);\r
  70     procedure ImageCount(X, Y: integer);\r
  71     function AddScore(X, Y: integer; const NG: array of TPoint): integer;\r
  72     property Strings[X, Y: integer]: TStoneType read GetStrings\r
  73       write SetStrings; default;\r
  74     property TurnNumber: integer read FTurnNumber write SetTurnNumber;\r
  75     property Active: Boolean read GetActive write SetActive;\r
  76     property Stone: TStoneType read GetStone;\r
  77   end;\r
  78 \r
  79   TForm1 = class(TForm)\r
  80     MainMenu1: TMainMenu;\r
  81     MenuItem1: TMenuItem;\r
  82     MenuItem2: TMenuItem;\r
  83     MenuItem3: TMenuItem;\r
  84     MenuItem4: TMenuItem;\r
  85     MenuItem5: TMenuItem;\r
  86     MenuItem6: TMenuItem;\r
  87     MenuItem7: TMenuItem;\r
  88     MenuItem8: TMenuItem;\r
  89     MenuItem9: TMenuItem;\r
  90     MenuItem10: TMenuItem;\r
  91     MenuItem11: TMenuItem;\r
  92     MenuItem12: TMenuItem;\r
  93     Timer1: TTimer;\r
  94     Timer2: TTimer;\r
  95     PaintBox1: TPaintBox;\r
  96     Image1: TImage;\r
  97     Image2: TImage;\r
  98     Image3: TImage;\r
  99     MenuItem13: TMenuItem;\r
 100     MenuItem14: TMenuItem;\r
 101     MenuItem15: TMenuItem;\r
 102     procedure FormCreate(Sender: TObject);\r
 103     procedure FormDestroy(Sender: TObject);\r
 104     procedure Timer1Timer(Sender: TObject);\r
 105     procedure FormResize(Sender: TObject);\r
 106     procedure MenuItem4Click(Sender: TObject);\r
 107     procedure MenuItem2Click(Sender: TObject);\r
 108     procedure PaintBox1Tap(Sender: TObject; const Point: TPointF);\r
 109     procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;\r
 110       Shift: TShiftState; X, Y: Single);\r
 111     procedure PaintBox1Paint(Sender: TObject; Canvas: TCanvas);\r
 112     procedure MenuItem6Click(Sender: TObject);\r
 113     procedure PaintBox1Resize(Sender: TObject);\r
 114     procedure MenuItem8Click(Sender: TObject);\r
 115     procedure MenuItem10Click(Sender: TObject);\r
 116     procedure MenuItem11Click(Sender: TObject);\r
 117     procedure Timer2Timer(Sender: TObject);\r
 118   private\r
 119     { Private \90é\8c¾ }\r
 120     StoneGrid: TStoneGrid;\r
 121     Index: TPlayer;\r
 122     Size: integer;\r
 123     procedure CompStone;\r
 124     procedure GameStart;\r
 125     procedure ChangePlayer;\r
 126     procedure ChMain(var CapStr: string);\r
 127   public\r
 128     { Public \90é\8c¾ }\r
 129   end;\r
 130 \r
 131 var\r
 132   Player1: TPlayer;\r
 133   Player2: TPlayer;\r
 134 \r
 135   Form1: TForm1;\r
 136 \r
 137 implementation\r
 138 \r
 139 {$R *.fmx}\r
 140 \r
 141 { TStoneGrid }\r
 142 \r
 143 function TStoneGrid.AddScore(X, Y: integer; const NG: array of TPoint): integer;\r
 144 var\r
 145   s: TPoint;\r
 146 begin\r
 147   result := 0;\r
 148   for s in NG do\r
 149     if (X = s.X) and (Y = s.Y) then\r
 150     begin\r
 151       result := 10;\r
 152       break;\r
 153     end;\r
 154 end;\r
 155 \r
 156 function TStoneGrid.CalScore(Stone: TStoneType; X, Y: integer;\r
 157   out Score: integer): Boolean;\r
 158 var\r
 159   loop: integer;\r
 160 const\r
 161   waste: array [1 .. 12] of TPoint = ((X: 1; Y: 0), (X: 6; Y: 0), (X: 0; Y: 1),\r
 162     (X: 1; Y: 1), (X: 6; Y: 1), (X: 7; Y: 1), (X: 0; Y: 6), (X: 1; Y: 6), (X: 6;\r
 163     Y: 6), (X: 7; Y: 6), (X: 1; Y: 7), (X: 6; Y: 7));\r
 164   worth: array [1 .. 4] of TPoint = ((X: 0; Y: 0), (X: 7; Y: 0), (X: 0; Y: 7),\r
 165     (X: 7; Y: 7));\r
 166   procedure Easy;\r
 167   var\r
 168     m, n: integer;\r
 169   begin\r
 170     for m := 0 to bmp_count - 1 do\r
 171       for n := 0 to bmp_count - 1 do\r
 172         if CanSetStone(Stone, m, n, false) = true then\r
 173         begin\r
 174           inc(Score);\r
 175           inc(Score, AddScore(m, n, worth));\r
 176         end;\r
 177   end;\r
 178   procedure Hard;\r
 179   var\r
 180     m, n: integer;\r
 181   begin\r
 182     if loop > 1 then\r
 183       Exit;\r
 184     inc(loop);\r
 185     for m := 0 to bmp_count - 1 do\r
 186       for n := 0 to bmp_count - 1 do\r
 187       begin\r
 188         if CanSetStone(Stone, m, n, true) = true then\r
 189         begin\r
 190           if (loop mod 2) > 0 then\r
 191             inc(Score)\r
 192           else\r
 193             dec(Score);\r
 194           case Stone of\r
 195             stBlack:\r
 196               Stone := stWhite;\r
 197             stWhite:\r
 198               Stone := stBlack;\r
 199           end;\r
 200           Hard;\r
 201           if loop > 1 then\r
 202           begin\r
 203             Easy;\r
 204             FStrings := FBuffer[FTurnIndex + loop];\r
 205           end\r
 206           else\r
 207             FBuffer[FTurnIndex + loop] := FStrings;\r
 208         end;\r
 209       end;\r
 210     dec(loop);\r
 211   end;\r
 212 \r
 213 begin\r
 214   if CanSetStone(Stone, X, Y, true) = true then\r
 215   begin\r
 216     Score := 0;\r
 217     result := true;\r
 218 //    if FTurnIndex < 50 then\r
 219       inc(Score, AddScore(X, Y, waste));\r
 220     dec(Score, AddScore(X, Y, worth));\r
 221     case Stone of\r
 222       stBlack:\r
 223         Stone := stWhite;\r
 224       stWhite:\r
 225         Stone := stBlack;\r
 226     end;\r
 227     if (Form1.MenuItem14.IsChecked = true) and (FTurnIndex + 2 <= 60) then\r
 228     begin\r
 229       loop := 0;\r
 230       Hard;\r
 231     end\r
 232     else\r
 233       Easy;\r
 234   end\r
 235   else\r
 236     result := false;\r
 237   FStrings := FBuffer[FTurnIndex];\r
 238 end;\r
 239 \r
 240 function TStoneGrid.CanSetStone(Stone: TStoneType; X, Y: integer;\r
 241   Reverse: Boolean; const Visible: Boolean): Boolean;\r
 242 var\r
 243   i: integer;\r
 244   p: Boolean;\r
 245   q: TEffectData;\r
 246   procedure Method(m, n: integer);\r
 247   var\r
 248     s: TStoneType;\r
 249     j: integer;\r
 250     k: integer;\r
 251   begin\r
 252     if p = false then\r
 253       Exit;\r
 254     i := 1;\r
 255     while true do\r
 256     begin\r
 257       s := GetStrings(X + m * i, Y + n * i);\r
 258       if s = stEffect then\r
 259         s := FEffectStone;\r
 260       if (s = stNone) or (s = stError) then\r
 261         break\r
 262       else if s = Stone then\r
 263         if i > 1 then\r
 264         begin\r
 265           if (result = false) and (Reverse = true) then\r
 266             SetStrings(X, Y, Stone);\r
 267           result := true;\r
 268           if Reverse = true then\r
 269           begin\r
 270             Form1.PaintBox1.Repaint;\r
 271             for j := 1 to i - 1 do\r
 272             begin\r
 273               if Visible = true then\r
 274               begin\r
 275                 FEffectStone := Stone;\r
 276                 q.Left := X + m * j;\r
 277                 q.Top := Y + n * j;\r
 278                 q.X := 0;\r
 279                 q.Y := 0;\r
 280                 FList.Add(q);\r
 281                 SetStrings(q.Left, q.Top, stEffect);\r
 282                 for k := 1 to 10 do\r
 283                 begin\r
 284                   Sleep(15);\r
 285                   Application.ProcessMessages;\r
 286                 end;\r
 287               end\r
 288               else\r
 289                 SetStrings(X + m * j, Y + n * j, Stone);\r
 290             end;\r
 291             break;\r
 292           end\r
 293           else\r
 294           begin\r
 295             p := false;\r
 296             break;\r
 297           end;\r
 298         end\r
 299         else\r
 300           break\r
 301       else\r
 302         inc(i);\r
 303     end;\r
 304   end;\r
 305 \r
 306 begin\r
 307   result := false;\r
 308   p := true;\r
 309   if GetStrings(X, Y) = stNone then\r
 310   begin\r
 311     Method(-1, -1);\r
 312     Method(-1, 0);\r
 313     Method(-1, 1);\r
 314     Method(0, -1);\r
 315     Method(0, 1);\r
 316     Method(1, -1);\r
 317     Method(1, 0);\r
 318     Method(1, 1);\r
 319   end;\r
 320 end;\r
 321 \r
 322 procedure TStoneGrid.Clear;\r
 323 var\r
 324   i, j: integer;\r
 325 begin\r
 326   FList.Clear;\r
 327   for i := 0 to bmp_count - 1 do\r
 328     for j := 0 to bmp_count - 1 do\r
 329       Strings[i, j] := stNone;\r
 330   Strings[3, 3] := stBlack;\r
 331   Strings[4, 4] := stBlack;\r
 332   Strings[4, 3] := stWhite;\r
 333   Strings[3, 4] := stWhite;\r
 334   FTurnNumber := 0;\r
 335   FTurnIndex := 0;\r
 336   FBuffer[0] := FStrings;\r
 337 end;\r
 338 \r
 339 constructor TStoneGrid.Create;\r
 340 begin\r
 341   inherited;\r
 342   FList := TList<TEffectData>.Create;\r
 343 end;\r
 344 \r
 345 destructor TStoneGrid.Destroy;\r
 346 begin\r
 347   FList.Free;\r
 348   inherited;\r
 349 end;\r
 350 \r
 351 procedure TStoneGrid.GameOver;\r
 352 begin\r
 353   FGameOver := true;\r
 354   FActive := false;\r
 355 end;\r
 356 \r
 357 function TStoneGrid.GetActive: Boolean;\r
 358 begin\r
 359   if (FActive = true) and (FList.Count = 0) then\r
 360     result := true\r
 361   else\r
 362     result := false;\r
 363 end;\r
 364 \r
 365 function TStoneGrid.GetStone: TStoneType;\r
 366 begin\r
 367   result := FBuffer[FTurnNumber].Stone;\r
 368 end;\r
 369 \r
 370 function TStoneGrid.GetStrings(X, Y: integer): TStoneType;\r
 371 begin\r
 372   if (X >= 0) and (X < bmp_count) and (Y >= 0) and (Y < bmp_count) then\r
 373     result := FStrings.Strings[X, Y]\r
 374   else\r
 375     result := stError;\r
 376 end;\r
 377 \r
 378 procedure TStoneGrid.ImageCount(X, Y: integer);\r
 379 begin\r
 380   FIndex_X := X;\r
 381   FIndex_Y := Y;\r
 382 end;\r
 383 \r
 384 function TStoneGrid.ListExecute: Boolean;\r
 385 var\r
 386   i: integer;\r
 387   s: TEffectData;\r
 388 begin\r
 389   if FList.Count = 0 then\r
 390     result := false\r
 391   else\r
 392   begin\r
 393     i := 0;\r
 394     while i < FList.Count do\r
 395     begin\r
 396       s := FList[i];\r
 397       if s.X < FIndex_X - 1 then\r
 398         s.X := s.X + 1\r
 399       else if s.Y < FIndex_Y - 1 then\r
 400       begin\r
 401         s.X := 0;\r
 402         s.Y := s.Y + 1;\r
 403       end\r
 404       else\r
 405       begin\r
 406         SetStrings(s.Left, s.Top, FEffectStone);\r
 407         FList.Delete(i);\r
 408         inc(i);\r
 409         continue;\r
 410       end;\r
 411       FList[i] := s;\r
 412       inc(i);\r
 413     end;\r
 414     if FList.Count = 0 then\r
 415     begin\r
 416       inc(FTurnIndex);\r
 417       inc(FTurnNumber);\r
 418       FBuffer[FTurnIndex] := FStrings;\r
 419       FBuffer[FTurnIndex].Stone := FEffectStone;\r
 420       Form1.PaintBox1.Repaint;\r
 421       Form1.ChangePlayer;\r
 422       if FGameOver = false then\r
 423         FActive := true\r
 424     end;\r
 425     result := true;\r
 426   end;\r
 427 end;\r
 428 \r
 429 function TStoneGrid.NextStone(Stone: TStoneType; var Pos: TPoint): Boolean;\r
 430 var\r
 431   i, j, m, n: integer;\r
 432 begin\r
 433   result := false;\r
 434   n := 0;\r
 435   for i := 0 to bmp_count - 1 do\r
 436     for j := 0 to bmp_count - 1 do\r
 437       if (CalScore(Stone, i, j, m) = true) and ((result = false) or (m < n))\r
 438       then\r
 439       begin\r
 440         if result = false then\r
 441           result := true;\r
 442         n := m;\r
 443         Pos := Point(i, j);\r
 444       end;\r
 445 end;\r
 446 \r
 447 procedure TStoneGrid.Paint(Canvas: TCanvas);\r
 448 var\r
 449   k: integer;\r
 450   s: TBitmap;\r
 451   p: TEffectData;\r
 452 begin\r
 453   k := Form1.Size;\r
 454   if FEffectStone = stBlack then\r
 455     s := Form1.Image1.Bitmap\r
 456   else\r
 457     s := Form1.Image2.Bitmap;\r
 458   for p in FList do\r
 459   begin\r
 460     Canvas.DrawBitmap(s, RectF(p.X * 50, p.Y * 50, (p.X + 1) * 50,\r
 461       (p.Y + 1) * 50), RectF(p.Left * k, p.Top * k, (p.Left + 1) * k,\r
 462       (p.Top + 1) * k), 1);\r
 463   end;\r
 464 end;\r
 465 \r
 466 procedure TStoneGrid.Pause;\r
 467 begin\r
 468   FActive := false;\r
 469 end;\r
 470 \r
 471 procedure TStoneGrid.Restart;\r
 472 begin\r
 473   FActive := true;\r
 474   FGameOver := false;\r
 475   FTurnIndex := FTurnNumber;\r
 476 end;\r
 477 \r
 478 procedure TStoneGrid.SetActive(const Value: Boolean);\r
 479 begin\r
 480   if (FGameOver = false) or (Value = false) then\r
 481     FActive := Value;\r
 482 end;\r
 483 \r
 484 procedure TStoneGrid.SetStrings(X, Y: integer; const Value: TStoneType);\r
 485 begin\r
 486   if (X >= 0) and (X < bmp_count) and (Y >= 0) and (Y < bmp_count) then\r
 487     FStrings.Strings[X, Y] := Value;\r
 488 end;\r
 489 \r
 490 procedure TStoneGrid.SetTurnNumber(const Value: integer);\r
 491 begin\r
 492   if Value > FTurnIndex then\r
 493     FTurnNumber := FTurnIndex\r
 494   else if Value < 0 then\r
 495     FTurnNumber := 0\r
 496   else\r
 497     FTurnNumber := Value;\r
 498   FStrings := FBuffer[FTurnNumber];\r
 499 end;\r
 500 \r
 501 procedure TStoneGrid.Start;\r
 502 begin\r
 503   Clear;\r
 504   FActive := true;\r
 505   FGameOver := false;\r
 506 end;\r
 507 \r
 508 { TForm1 }\r
 509 \r
 510 procedure TForm1.ChangePlayer;\r
 511 var\r
 512   i, j, m, n: integer;\r
 513   s: string;\r
 514   function Execute: Boolean;\r
 515   var\r
 516     i, j: integer;\r
 517   begin\r
 518     for i := 0 to bmp_count - 1 do\r
 519       for j := 0 to bmp_count - 1 do\r
 520         if StoneGrid.CanSetStone(Index.Stone, i, j, false) = true then\r
 521         begin\r
 522           result := true;\r
 523           Exit;\r
 524         end;\r
 525     result := false;\r
 526   end;\r
 527 \r
 528 begin\r
 529   s := '';\r
 530   ChMain(s);\r
 531   if Execute = false then\r
 532   begin\r
 533     ChMain(s);\r
 534     if Execute = false then\r
 535     begin\r
 536       m := 0;\r
 537       n := 0;\r
 538       for i := 0 to bmp_count - 1 do\r
 539         for j := 0 to bmp_count - 1 do\r
 540           case StoneGrid[i, j] of\r
 541             stBlack:\r
 542               inc(m);\r
 543             stWhite:\r
 544               inc(n);\r
 545           end;\r
 546       ChMain(s);\r
 547       Caption := '\8fI\97¹\82µ\82Ü\82µ\82½';\r
 548       if m > n then\r
 549         s := 'Player1 Win:' + #13#10\r
 550       else if m < n then\r
 551         s := 'Player2 Win:' + #13#10\r
 552       else\r
 553         s := 'Draw:' + #13#10;\r
 554       StoneGrid.GameOver;\r
 555       Showmessage(s + '(Player1) ' + m.ToString + #13#10 + '(Player2) ' +\r
 556         n.ToString);\r
 557     end\r
 558     else\r
 559       Caption := s;\r
 560   end\r
 561   else\r
 562     Caption := s;\r
 563 end;\r
 564 \r
 565 procedure TForm1.ChMain(var CapStr: string);\r
 566 begin\r
 567   CapStr := (StoneGrid.TurnNumber + 1).ToString + '\8eè\96Ú\81F';\r
 568   if Index = Player1 then\r
 569   begin\r
 570     Index := Player2;\r
 571     CapStr := CapStr + '\94\92\82Ì\8eè\94Ô\82Å\82·';\r
 572   end\r
 573   else\r
 574   begin\r
 575     Index := Player1;\r
 576     CapStr := CapStr + '\8d\95\82Ì\8eè\94Ô\82Å\82·';\r
 577   end;\r
 578 end;\r
 579 \r
 580 procedure TForm1.CompStone;\r
 581 var\r
 582   s: TPoint;\r
 583 begin\r
 584   StoneGrid.Active := false;\r
 585   if StoneGrid.NextStone(Index.Stone, s) = true then\r
 586   begin\r
 587     StoneGrid.CanSetStone(Index.Stone, s.X, s.Y, true, true);\r
 588     PaintBox1.Repaint;\r
 589   end\r
 590   else\r
 591     ChangePlayer;\r
 592 end;\r
 593 \r
 594 procedure TForm1.GameStart;\r
 595 begin\r
 596   Index := Player1;\r
 597   StoneGrid.Start;\r
 598   PaintBox1.Repaint;\r
 599   Caption := '1\8eè\96Ú\81F\8d\95\82©\82ç\8en\82ß\82Ü\82·';\r
 600 end;\r
 601 \r
 602 procedure TForm1.MenuItem10Click(Sender: TObject);\r
 603 begin\r
 604   StoneGrid.Restart;\r
 605 end;\r
 606 \r
 607 procedure TForm1.MenuItem11Click(Sender: TObject);\r
 608 var\r
 609   i: integer;\r
 610   s: string;\r
 611 begin\r
 612   with StoneGrid do\r
 613   begin\r
 614     i := TurnNumber;\r
 615     if Sender = MenuItem11 then\r
 616       TurnNumber := TurnNumber + 1\r
 617     else\r
 618       TurnNumber := TurnNumber - 1;\r
 619     if (i = TurnNumber) then\r
 620       Exit\r
 621     else\r
 622       Pause;\r
 623     PaintBox1.Repaint;\r
 624     s := '';\r
 625     if ((TurnNumber = 0) and (Index <> Player1)) or\r
 626       (Index.Stone = FBuffer[TurnNumber].Stone) then\r
 627     begin\r
 628       if TurnNumber = 60 then\r
 629         ChangePlayer\r
 630       else\r
 631       begin\r
 632         ChMain(s);\r
 633         Caption := s;\r
 634       end;\r
 635     end\r
 636     else\r
 637     begin\r
 638       ChMain(s);\r
 639       Caption := s;\r
 640       if Index = Player1 then\r
 641         Index := Player2\r
 642       else\r
 643         Index := Player1;\r
 644     end;\r
 645   end;\r
 646 end;\r
 647 \r
 648 procedure TForm1.MenuItem2Click(Sender: TObject);\r
 649 begin\r
 650   Timer1.Enabled := false;\r
 651   Timer2.Enabled := false;\r
 652   GameStart;\r
 653   Timer1.Enabled := true;\r
 654   Timer2.Enabled := true;\r
 655 end;\r
 656 \r
 657 procedure TForm1.MenuItem4Click(Sender: TObject);\r
 658 begin\r
 659   Close;\r
 660 end;\r
 661 \r
 662 procedure TForm1.MenuItem6Click(Sender: TObject);\r
 663 begin\r
 664   Player1.Auto := MenuItem6.IsChecked;\r
 665   Player2.Auto := MenuItem7.IsChecked;\r
 666 end;\r
 667 \r
 668 procedure TForm1.MenuItem8Click(Sender: TObject);\r
 669 begin\r
 670   StoneGrid.Pause;\r
 671 end;\r
 672 \r
 673 procedure TForm1.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);\r
 674 var\r
 675   i, j: integer;\r
 676 begin\r
 677   if StoneGrid.Active = false then\r
 678     StoneGrid.Paint(Canvas);\r
 679   for i := 0 to bmp_count - 1 do\r
 680   begin\r
 681     for j := 0 to bmp_count - 1 do\r
 682     begin\r
 683       case StoneGrid.Strings[i, j] of\r
 684         stWhite:\r
 685           Canvas.DrawBitmap(Image3.Bitmap, RectF(100, 0, 150, 50),\r
 686             RectF(i * Size, j * Size, (i + 1) * Size, (j + 1) * Size), 1);\r
 687         stBlack:\r
 688           Canvas.DrawBitmap(Image3.Bitmap, RectF(50, 0, 100, 50),\r
 689             RectF(i * Size, j * Size, (i + 1) * Size, (j + 1) * Size), 1);\r
 690         stEffect:\r
 691           continue;\r
 692       else\r
 693         Canvas.DrawBitmap(Image3.Bitmap, RectF(0, 0, 50, 50),\r
 694           RectF(i * Size, j * Size, (i + 1) * Size, (j + 1) * Size), 1);\r
 695       end;\r
 696       Canvas.DrawLine(PointF(0, j * Size), PointF(bmp_count * Size,\r
 697         j * Size), 1);\r
 698     end;\r
 699     Canvas.DrawLine(PointF(i * Size, 0), PointF(i * Size, Size * bmp_count), 1);\r
 700   end;\r
 701   Canvas.DrawLine(PointF(bmp_count * Size, 0), PointF(bmp_count * Size,\r
 702     bmp_count * Size), 1);\r
 703   Canvas.DrawLine(PointF(0, bmp_count * Size), PointF(bmp_count * Size,\r
 704     bmp_count * Size), 1);\r
 705 end;\r
 706 \r
 707 procedure TForm1.PaintBox1Resize(Sender: TObject);\r
 708 begin\r
 709   Size := Min(ClientWidth, ClientHeight) div bmp_count;\r
 710 end;\r
 711 \r
 712 procedure TForm1.FormCreate(Sender: TObject);\r
 713 begin\r
 714   ClientWidth := 400;\r
 715   ClientHeight := 400;\r
 716   StoneGrid := TStoneGrid.Create;\r
 717   StoneGrid.ImageCount(6, 5);\r
 718   Player1 := TPlayer.Create;\r
 719   Player2 := TPlayer.Create;\r
 720   Player1.Stone := stBlack;\r
 721   Player2.Stone := stWhite;\r
 722   Player2.Auto := true;\r
 723   with PaintBox1.Canvas do\r
 724   begin\r
 725     StrokeDash := TStrokeDash.Solid;\r
 726     Stroke.Color := TAlphaColors.Black;\r
 727     StrokeThickness := 3;\r
 728   end;\r
 729   PaintBox1Resize(Sender);\r
 730   GameStart;\r
 731 end;\r
 732 \r
 733 procedure TForm1.FormDestroy(Sender: TObject);\r
 734 begin\r
 735   StoneGrid.Free;\r
 736   Player1.Free;\r
 737   Player2.Free;\r
 738 end;\r
 739 \r
 740 procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;\r
 741   Shift: TShiftState; X, Y: Single);\r
 742 begin\r
 743   PaintBox1Tap(Sender, PointF(X, Y));\r
 744 end;\r
 745 \r
 746 procedure TForm1.Timer1Timer(Sender: TObject);\r
 747 begin\r
 748   if (StoneGrid.Active = true) and (Index.Auto = true) then\r
 749     CompStone;\r
 750 end;\r
 751 \r
 752 procedure TForm1.Timer2Timer(Sender: TObject);\r
 753 begin\r
 754   if (StoneGrid.Active = false) and (StoneGrid.ListExecute = true) then\r
 755     PaintBox1.Repaint;\r
 756 end;\r
 757 \r
 758 procedure TForm1.FormResize(Sender: TObject);\r
 759 begin\r
 760   Size := Min(ClientWidth, ClientHeight) div bmp_count;\r
 761   PaintTo(Canvas);\r
 762 end;\r
 763 \r
 764 procedure TForm1.PaintBox1Tap(Sender: TObject; const Point: TPointF);\r
 765 begin\r
 766   if Index.Auto = false then\r
 767   begin\r
 768     StoneGrid.Restart;\r
 769     if (StoneGrid.Active = true) and\r
 770       (StoneGrid.CanSetStone(Index.Stone, Floor(Point.X / Size),\r
 771       Floor(Point.Y / Size), true, true) = true) then\r
 772     begin\r
 773       StoneGrid.Active := false;\r
 774       PaintBox1.Repaint;\r
 775       StoneGrid.Active := true;\r
 776     end;\r
 777   end;\r
 778 end;\r
 779 \r
 780 end.\r