Develop and Download Open Source Software

reversi-of-d

Browse Subversion Repository

/[reversi-of-d]/Unit1.pas

Diff of /Unit1.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 25 by yamat0jp, Mon Jul 20 00:50:13 2015 UTC revision 27 by yamat0jp, Mon Jul 20 09:01:47 2015 UTC
# Line 53  type Line 53  type
53      function CalScore(Stone: TStoneType; X, Y: integer): integer;      function CalScore(Stone: TStoneType; X, Y: integer): integer;
54      function CanSetStone(Stone: TStoneType; X, Y: integer; Reverse: Boolean;      function CanSetStone(Stone: TStoneType; X, Y: integer; Reverse: Boolean;
55        const Visible: Boolean = false): Boolean;        const Visible: Boolean = false): Boolean;
56      function NextStone(Stone: TStoneType): TPoint;      function NextStone(Stone: TStoneType; var Pos: TPoint): Boolean;
57      procedure Start;      procedure Start;
58      procedure Restart;      procedure Restart;
59      procedure Pause;      procedure Pause;
# Line 104  type Line 104  type
104      procedure MenuItem10Click(Sender: TObject);      procedure MenuItem10Click(Sender: TObject);
105      procedure MenuItem11Click(Sender: TObject);      procedure MenuItem11Click(Sender: TObject);
106      procedure Timer2Timer(Sender: TObject);      procedure Timer2Timer(Sender: TObject);
     procedure FormDeactivate(Sender: TObject);  
     procedure FormActivate(Sender: TObject);  
107    private    private
108      { Private 宣言 }      { Private 宣言 }
109      StoneGrid: TStoneGrid;      StoneGrid: TStoneGrid;
# Line 134  function TStoneGrid.CalScore(Stone: TSto Line 132  function TStoneGrid.CalScore(Stone: TSto
132  var  var
133    i, j: integer;    i, j: integer;
134  begin  begin
   result:=0;  
135    if CanSetStone(Stone, X, Y, true) = true then    if CanSetStone(Stone, X, Y, true) = true then
136    begin    begin
137      if Stone = stEffect then      result := 0;
       Stone:=FEffectStone;  
138      case Stone of      case Stone of
139        stBlack:        stBlack:
140          Stone := stWhite;          Stone := stWhite;
141        stWhite:        stWhite:
142          Stone := stBlack;          Stone := stBlack;
       else  
         Exit;  
143      end;      end;
144      for i := 0 to Count - 1 do      for i := 0 to Count - 1 do
145        for j := 0 to Count - 1 do        for j := 0 to Count - 1 do
146          if CanSetStone(Stone, i, j, false) = true then          if CanSetStone(Stone, i, j, false) = true then
147            inc(result);            inc(result);
148    end;    end
149      else
150        result := -1;
151    FStrings := FBuffer[FTurnIndex];    FStrings := FBuffer[FTurnIndex];
152  end;  end;
153    
# Line 334  begin Line 330  begin
330    end;    end;
331  end;  end;
332    
333  function TStoneGrid.NextStone(Stone: TStoneType): TPoint;  function TStoneGrid.NextStone(Stone: TStoneType; var Pos: TPoint): Boolean;
334  var  var
335    i, j, m, n: integer;    i, j, m, n: integer;
336  begin  begin
337    n := 0;    n := -1;
338    for i := 0 to Count - 1 do    for i := 0 to Count - 1 do
339      for j := 0 to Count - 1 do      for j := 0 to Count - 1 do
340      begin      begin
341        m := CalScore(Stone, i, j);        m := CalScore(Stone, i, j);
342        if ((n = 0)and(m > 0)) or ((0 < m) and (m < n)) then        if (n = -1) or ((0 < m) and (m < n)) then
343        begin        begin
344          n := m;          n := m;
345          result := Point(i, j);          Pos := Point(i, j);
346        end;        end;
347      end;      end;
348    if n = 0 then    result := not(n = -1);
     result := Point(-1, -1);  
349  end;  end;
350    
351  procedure TStoneGrid.Paint(Canvas: TCanvas);  procedure TStoneGrid.Paint(Canvas: TCanvas);
# Line 485  procedure TForm1.CompStone; Line 480  procedure TForm1.CompStone;
480  var  var
481    s: TPoint;    s: TPoint;
482  begin  begin
483    s := StoneGrid.NextStone(Index.Stone);    if StoneGrid.NextStone(Index.Stone, s) = true then
484    StoneGrid.CanSetStone(Index.Stone, s.X, s.Y, true, true);    begin
485    PaintBox1.Repaint;      StoneGrid.CanSetStone(Index.Stone, s.X, s.Y, true, true);
486        PaintBox1.Repaint;
487      end;
488    ChangePlayer;    ChangePlayer;
489  end;  end;
490    
491  procedure TForm1.GameStart;  procedure TForm1.GameStart;
492  begin  begin
   Timer1.Enabled:=false;  
493    Index := Player1;    Index := Player1;
494    StoneGrid.Start;    StoneGrid.Start;
495    PaintBox1.Repaint;    PaintBox1.Repaint;
496    Caption := '黒から始めます';    Caption := '黒から始めます';
   Timer1.Enabled:=true;  
497  end;  end;
498    
499  procedure TForm1.MenuItem10Click(Sender: TObject);  procedure TForm1.MenuItem10Click(Sender: TObject);
# Line 588  begin Line 583  begin
583    Size := Min(ClientWidth, ClientHeight) div Count;    Size := Min(ClientWidth, ClientHeight) div Count;
584  end;  end;
585    
 procedure TForm1.FormActivate(Sender: TObject);  
 begin  
   Timer1.Enabled := true;  
 end;  
   
586  procedure TForm1.FormCreate(Sender: TObject);  procedure TForm1.FormCreate(Sender: TObject);
587  begin  begin
588    StoneGrid := TStoneGrid.Create;    StoneGrid := TStoneGrid.Create;
# Line 613  begin Line 603  begin
603    GameStart;    GameStart;
604  end;  end;
605    
 procedure TForm1.FormDeactivate(Sender: TObject);  
 begin  
   Timer1.Enabled := false;  
 end;  
   
606  procedure TForm1.FormDestroy(Sender: TObject);  procedure TForm1.FormDestroy(Sender: TObject);
607  begin  begin
608    StoneGrid.Free;    StoneGrid.Free;
Legend:
Removed from v.25  
changed lines
  Added in v.27
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help