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 3 by yamat0jp, Sat Jul 11 06:28:05 2015 UTC revision 4 by yamat0jp, Sat Jul 11 08:02:13 2015 UTC
# Line 17  type Line 17  type
17    TPlayer = class    TPlayer = class
18    private    private
19      FAuto: Boolean;      FAuto: Boolean;
20        FStone: TStoneType;
21    public    public
22      property Auto: Boolean read FAuto write FAuto;      property Auto: Boolean read FAuto write FAuto;
23        property Stone: TStoneType read FStone write FStone;
24    end;    end;
25    
26    TStoneGrid = class    TStoneGrid = class
# Line 105  begin Line 107  begin
107    if CanSetStone(Player, X, Y, true) = true then    if CanSetStone(Player, X, Y, true) = true then
108    begin    begin
109      if Player = Player1 then      if Player = Player1 then
110      begin        Player := Player2
       Player := Player2;  
     end  
111      else      else
     begin  
112        Player := Player1;        Player := Player1;
     end;  
113      result := 0;      result := 0;
114      for i := 0 to Count - 1 do      for i := 0 to Count - 1 do
     begin  
115        for j := 0 to Count - 1 do        for j := 0 to Count - 1 do
       begin  
116          if CanSetStone(Player, i, j, false) = true then          if CanSetStone(Player, i, j, false) = true then
         begin  
117            inc(result);            inc(result);
         end;  
       end;  
     end;  
118      FStrings := FBuffer[FTurnNumber];      FStrings := FBuffer[FTurnNumber];
119    end    end
120    else    else
# Line 136  function TStoneGrid.CanSetStone(Player: Line 128  function TStoneGrid.CanSetStone(Player:
128    Reverse: Boolean): Boolean;    Reverse: Boolean): Boolean;
129  var  var
130    i: integer;    i: integer;
131    procedure Method1(m, n: integer);    p: Boolean;
132      procedure Method(m, n: integer);
133    var    var
134        s: TStoneType;
135      j: integer;      j: integer;
136    begin    begin
137      i:=1;      if p = false then
138          Exit;
139        i := 1;
140      while true do      while true do
141        case GetStrings(X + m*i, Y+n*i) of      begin
142          stBlack:        s := GetStrings(X + m * i, Y + n * i);
143            if i > 1 then        if (s = stNone) or (s = stError) then
144            break
145          else if s = Player.Stone then
146            if i > 1 then
147            begin
148              result := true;
149              if Reverse = true then
150            begin            begin
151              result := true;              for j := 1 to i - 1 do
152              if Reverse = true then                SetStrings(X + m * j, Y + n * j, Player.Stone);
             begin  
               for j := 1 to i - 1 do  
                 SetStrings(X + m*j, Y+n*j, stBlack);  
               break;  
             end  
             else  
               Exit;  
           end  
           else  
153              break;              break;
         stWhite:  
           inc(i);  
       else  
         break;  
       end;  
   end;  
   procedure Method2(m,n: integer);  
   var  
     j: integer;  
   begin  
     i:=1;  
     while true do  
       case GetStrings(X+m*i,Y+n*i) of  
         stBlack:  
           inc(i);  
         stWhite:  
           if i > 1 then  
           begin  
             result:=true;  
             if Reverse = true then  
             begin  
               for j := 1 to i-1 do  
                 SetStrings(X+m*j,Y+n*j,stWhite);  
               break;  
             end  
             else  
               Exit;  
154            end            end
155            else            else
156              begin
157                p := false;
158              break;              break;
159              end;
160            end
161            else
162              break
163        else        else
164          break;          inc(i);
165        end;      end;
166    end;    end;
167    
168  begin  begin
169    result := false;    result := false;
170    if GetStrings(X, Y) = stNone then    if GetStrings(X, Y) = stNone then
171    begin    begin
172      if Player = Player1 then      p := true;
173        if Player.Stone = stBlack then
174      begin      begin
175        Method1(-1,-1);        Method(-1, -1);
176        Method1(-1,0);        Method(-1, 0);
177        Method1(-1,1);        Method(-1, 1);
178        Method1(0,-1);        Method(0, -1);
179        Method1(0,1);        Method(0, 1);
180        Method1(1,-1);        Method(1, -1);
181        Method1(1,0);        Method(1, 0);
182        Method1(1,1);        Method(1, 1);
183        if (Reverse = true) and (result = true) then        if (Reverse = true) and (result = true) then
184        begin        begin
185          SetStrings(X, Y, stBlack);          SetStrings(X, Y, stBlack);
# Line 214  begin Line 187  begin
187      end      end
188      else      else
189      begin      begin
190        Method2(-1,-1);        Method(-1, -1);
191        Method2(-1,0);        Method(-1, 0);
192        Method2(-1,1);        Method(-1, 1);
193        Method2(0,-1);        Method(0, -1);
194        Method2(0,1);        Method(0, 1);
195        Method2(1,-1);        Method(1, -1);
196        Method2(1,0);        Method(1, 0);
197        Method2(1,1);        Method(1, 1);
198        if (Reverse = true) and (result = true) then        if (Reverse = true) and (result = true) then
199        begin        begin
200          Strings[X, Y] := stWhite;          Strings[X, Y] := stWhite;
# Line 235  var Line 208  var
208    i, j: integer;    i, j: integer;
209  begin  begin
210    for i := 0 to Count - 1 do    for i := 0 to Count - 1 do
   begin  
211      for j := 0 to Count - 1 do      for j := 0 to Count - 1 do
     begin  
212        Strings[i, j] := stNone;        Strings[i, j] := stNone;
     end;  
   end;  
213    Strings[3, 3] := stBlack;    Strings[3, 3] := stBlack;
214    Strings[4, 4] := stBlack;    Strings[4, 4] := stBlack;
215    Strings[4, 3] := stWhite;    Strings[4, 3] := stWhite;
# Line 252  end; Line 221  end;
221  function TStoneGrid.GetStrings(X, Y: integer): TStoneType;  function TStoneGrid.GetStrings(X, Y: integer): TStoneType;
222  begin  begin
223    if (X >= 0) and (X < Count) and (Y >= 0) and (Y < Count) then    if (X >= 0) and (X < Count) and (Y >= 0) and (Y < Count) then
224    begin      result := FStrings[X, Y]
     result := FStrings[X, Y];  
   end  
225    else    else
   begin  
226      result := stError;      result := stError;
   end;  
227  end;  end;
228    
229  function TStoneGrid.NextStone(Player: TPlayer): TPoint;  function TStoneGrid.NextStone(Player: TPlayer): TPoint;
# Line 267  var Line 232  var
232  begin  begin
233    n := -1;    n := -1;
234    for i := 0 to Count - 1 do    for i := 0 to Count - 1 do
   begin  
235      for j := 0 to Count - 1 do      for j := 0 to Count - 1 do
236      begin      begin
237        m := CalScore(Player, i, j);        m := CalScore(Player, i, j);
# Line 277  begin Line 241  begin
241          result := Point(i, j);          result := Point(i, j);
242        end;        end;
243      end;      end;
   end;  
244    if n = -1 then    if n = -1 then
   begin  
245      result := Point(-1, -1);      result := Point(-1, -1);
   end;  
246  end;  end;
247    
248  procedure TStoneGrid.SetStrings(X, Y: integer; const Value: TStoneType);  procedure TStoneGrid.SetStrings(X, Y: integer; const Value: TStoneType);
249  begin  begin
250    if (X >= 0) and (X < Count) and (Y >= 0) and (Y < Count) then    if (X >= 0) and (X < Count) and (Y >= 0) and (Y < Count) then
   begin  
251      FStrings[X, Y] := Value;      FStrings[X, Y] := Value;
   end;  
252  end;  end;
253    
254  procedure TStoneGrid.SetTurnNumber(const Value: integer);  procedure TStoneGrid.SetTurnNumber(const Value: integer);
255  begin  begin
256    if Value > FTurnIndex then    if Value > FTurnIndex then
257    begin      FTurnNumber := FTurnIndex
     FTurnNumber := FTurnIndex;  
   end  
258    else    else
   begin  
259      FTurnNumber := Value;      FTurnNumber := Value;
   end;  
260    FStrings := FBuffer[FTurnNumber];    FStrings := FBuffer[FTurnNumber];
261  end;  end;
262    
# Line 314  var Line 269  var
269    procedure Main;    procedure Main;
270    begin    begin
271      if Index = Player1 then      if Index = Player1 then
272      begin        Index := Player2
       Index := Player2;  
     end  
273      else      else
     begin  
274        Index := Player1;        Index := Player1;
     end;  
275    end;    end;
276    function Execute: Boolean;    function Execute: Boolean;
277    var    var
# Line 330  var Line 281  var
281      for i := 0 to Count - 1 do      for i := 0 to Count - 1 do
282      begin      begin
283        for j := 0 to Count - 1 do        for j := 0 to Count - 1 do
       begin  
284          if StoneGrid.CanSetStone(Index, i, j, false) = true then          if StoneGrid.CanSetStone(Index, i, j, false) = true then
285          begin          begin
286            result := true;            result := true;
287            break;            break;
288          end;          end;
       end;  
289        if result = true then        if result = true then
       begin  
290          break;          break;
       end;  
291      end;      end;
292    end;    end;
293    
# Line 357  begin Line 304  begin
304        m := 0;        m := 0;
305        n := 0;        n := 0;
306        for i := 0 to Count - 1 do        for i := 0 to Count - 1 do
       begin  
307          for j := 0 to Count - 1 do          for j := 0 to Count - 1 do
         begin  
308            case StoneGrid[i, j] of            case StoneGrid[i, j] of
309              stBlack:              stBlack:
310                inc(m);                inc(m);
311              stWhite:              stWhite:
312                inc(n);                inc(n);
313            end;            end;
         end;  
       end;  
314        if m > n then        if m > n then
315        begin          s := 'Player1 Win:' + #13#10
         s := 'Player1 Win:' + #13#10;  
       end  
316        else if m < n then        else if m < n then
317        begin          s := 'Player2 Win:' + #13#10
         s := 'Player2 Win:' + #13#10;  
       end  
318        else        else
       begin  
319          s := 'Draw:' + #13#10;          s := 'Draw:' + #13#10;
       end;  
320        Showmessage(s + '(Player1) ' + IntToStr(m) + '(Player2) ' + IntToStr(n));        Showmessage(s + '(Player1) ' + IntToStr(m) + '(Player2) ' + IntToStr(n));
321      end;      end;
322    end;    end;
# Line 393  begin Line 330  begin
330    m := 0;    m := 0;
331    n := 0;    n := 0;
332    for i := 0 to Count - 1 do    for i := 0 to Count - 1 do
   begin  
333      for j := 0 to Count - 1 do      for j := 0 to Count - 1 do
     begin  
334        case StoneGrid.Strings[i, j] of        case StoneGrid.Strings[i, j] of
335          stWhite:          stWhite:
336            inc(m);            inc(m);
337          stBlack:          stBlack:
338            inc(n);            inc(n);
339        end;        end;
     end;  
   end;  
340    if (m = 0) or (n = 0) or (m + n = Count * Count) then    if (m = 0) or (n = 0) or (m + n = Count * Count) then
341    begin    begin
342      if n > m then      if n > m then
343      begin        s := 'Player1 Win' + #13#10
       s := 'Player1 Win' + #13#10;  
     end  
344      else if n < m then      else if n < m then
345      begin        s := 'Player2 Win' + #13#10
       s := 'Player2 Win' + #13#10;  
     end  
346      else      else
     begin  
347        s := 'draw' + #13#10;        s := 'draw' + #13#10;
     end;  
348      Timer1.Enabled := false;      Timer1.Enabled := false;
349      Active := false;      Active := false;
350      Showmessage(s + '(Player1) ' + IntToStr(n) + #13#10 + '(Player2) ' +      Showmessage(s + '(Player1) ' + IntToStr(n) + #13#10 + '(Player2) ' +
351        IntToStr(m));        IntToStr(m));
352    end    end
353    else    else
   begin  
354      ChangePlayer;      ChangePlayer;
   end;  
355  end;  end;
356    
357  procedure TForm1.CompStone;  procedure TForm1.CompStone;
# Line 454  begin Line 379  begin
379    StoneGrid := TStoneGrid.Create;    StoneGrid := TStoneGrid.Create;
380    Player1 := TPlayer.Create;    Player1 := TPlayer.Create;
381    Player2 := TPlayer.Create;    Player2 := TPlayer.Create;
382      Player1.Stone := stBlack;
383      Player2.Stone := stWhite;
384    Player2.Auto := true;    Player2.Auto := true;
385    GameStart;    GameStart;
386  end;  end;
# Line 531  procedure TForm1.Player(Sender: TObject) Line 458  procedure TForm1.Player(Sender: TObject)
458  begin  begin
459    (Sender as TMenuItem).Checked := not(Sender as TMenuItem).Checked;    (Sender as TMenuItem).Checked := not(Sender as TMenuItem).Checked;
460    if Sender = Player11 then    if Sender = Player11 then
461    begin      Player1.Auto := Player11.Checked
     Player1.Auto := Player11.Checked;  
   end  
462    else    else
   begin  
463      Player2.Auto := Player21.Checked;      Player2.Auto := Player21.Checked;
   end;  
464  end;  end;
465    
466  procedure TForm1.Start1Click(Sender: TObject);  procedure TForm1.Start1Click(Sender: TObject);
Legend:
Removed from v.3  
changed lines
  Added in v.4
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help