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 1 by yamat0jp, Sat Jul 11 05:06:38 2015 UTC revision 3 by yamat0jp, Sat Jul 11 06:28:05 2015 UTC
# Line 1  Line 1 
1  unit Unit1;  ?ｿunit Unit1;
2    
3  interface  interface
4    
# Line 12  const Line 12  const
12  type  type
13    TStoneType = (stNone, stWhite, stBlack, stError);    TStoneType = (stNone, stWhite, stBlack, stError);
14    
15    TGridData = array [0..Count-1] of array [0..Count-1] of TStoneType;    TGridData = array [0 .. Count - 1] of array [0 .. Count - 1] of TStoneType;
16    
17    TPlayer = class    TPlayer = class
18    private    private
# Line 24  type Line 24  type
24    TStoneGrid = class    TStoneGrid = class
25    private    private
26      FStrings: TGridData;      FStrings: TGridData;
27      FBuffer: array [1..Count*Count-4] of TGridData;      FBuffer: array [1 .. Count * Count - 4] of TGridData;
28      FTurnNumber: integer;      FTurnNumber: integer;
29      FTurnIndex: integer;      FTurnIndex: integer;
30      function GetStrings(X, Y: integer): TStoneType;      function GetStrings(X, Y: integer): TStoneType;
# Line 34  type Line 34  type
34      procedure Clear;      procedure Clear;
35      procedure BackUp;      procedure BackUp;
36      function CalScore(Player: TPlayer; X, Y: integer): integer;      function CalScore(Player: TPlayer; X, Y: integer): integer;
37      function CanSetStone(Player: TPlayer; X, Y: integer; Reverse: Boolean): Boolean;      function CanSetStone(Player: TPlayer; X, Y: integer;
38          Reverse: Boolean): Boolean;
39      function NextStone(Player: TPlayer): TPoint;      function NextStone(Player: TPlayer): TPoint;
40      property Strings[X,Y: integer]: TStoneType read GetStrings write SetStrings; default;      property Strings[X, Y: integer]: TStoneType read GetStrings
41          write SetStrings; default;
42      property TurnNumber: integer read FTurnNumber write SetTurnNumber;      property TurnNumber: integer read FTurnNumber write SetTurnNumber;
43    end;    end;
44    
# Line 54  type Line 56  type
56      procedure FormDestroy(Sender: TObject);      procedure FormDestroy(Sender: TObject);
57      procedure FormPaint(Sender: TObject);      procedure FormPaint(Sender: TObject);
58      procedure FormMouseDown(Sender: TObject; Button: TMouseButton;      procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
59        Shift: TShiftState; X, Y: Integer);        Shift: TShiftState; X, Y: integer);
60      procedure Timer1Timer(Sender: TObject);      procedure Timer1Timer(Sender: TObject);
61      procedure FormResize(Sender: TObject);      procedure FormResize(Sender: TObject);
62      procedure Player(Sender: TObject);      procedure Player(Sender: TObject);
63      procedure Start1Click(Sender: TObject);      procedure Start1Click(Sender: TObject);
64      procedure End1Click(Sender: TObject);      procedure End1Click(Sender: TObject);
65    private    private
66      { Private 宣言 }      { Private 螳｣險? }
67      StoneGrid: TStoneGrid;      StoneGrid: TStoneGrid;
68      Index: TPlayer;      Index: TPlayer;
69      Active: Boolean;      Active: Boolean;
# Line 71  type Line 73  type
73      procedure ChangePlayer;      procedure ChangePlayer;
74      procedure CheckGame;      procedure CheckGame;
75    public    public
76      { Public 宣言 }      { Public 螳｣險? }
77    end;    end;
78    
79  var  var
# Line 83  var Line 85  var
85  implementation  implementation
86    
87  {$R *.dfm}  {$R *.dfm}
   
88  { TStoneGrid }  { TStoneGrid }
89    
90  procedure TStoneGrid.BackUp;  procedure TStoneGrid.BackUp;
91  begin  begin
92          FBuffer[FTurnNumber]:=FStrings;    FBuffer[FTurnNumber] := FStrings;
93    if FTurnNumber < Count*Count-4 then    if FTurnNumber < Count * Count - 4 then
94    begin    begin
95          inc(FTurnNumber);      inc(FTurnNumber);
96          FTurnIndex:=FTurnNumber;      FTurnIndex := FTurnNumber;
97          FBuffer[FTurnNumber]:=FStrings;      FBuffer[FTurnNumber] := FStrings;
98    end;    end;
99  end;  end;
100    
# Line 101  function TStoneGrid.CalScore(Player: TPl Line 102  function TStoneGrid.CalScore(Player: TPl
102  var  var
103    i, j: integer;    i, j: integer;
104  begin  begin
105    if CanSetStone(Player,X,Y,true) = true then    if CanSetStone(Player, X, Y, true) = true then
106    begin    begin
107      if Player = Player1 then      if Player = Player1 then
108      begin      begin
109          Player:=Player2;        Player := Player2;
110      end else      end
111        else
112      begin      begin
113          Player:=Player1;        Player := Player1;
114      end;      end;
115          result:=0;      result := 0;
116      for i:=0 to Count-1 do      for i := 0 to Count - 1 do
117      begin      begin
118        for j:=0 to Count-1 do        for j := 0 to Count - 1 do
119        begin        begin
120          if CanSetStone(Player,i,j,false) = true then          if CanSetStone(Player, i, j, false) = true then
121          begin          begin
122                  inc(result);            inc(result);
123          end;          end;
124        end;        end;
125      end;      end;
126          FStrings:=FBuffer[FTurnNumber];      FStrings := FBuffer[FTurnNumber];
127    end else    end
128      else
129    begin    begin
130          FStrings:=FBuffer[FTurnNumber];      FStrings := FBuffer[FTurnNumber];
131          result:=-1;      result := -1;
132    end;    end;
133  end;  end;
134    
135  function TStoneGrid.CanSetStone(Player: TPlayer;  function TStoneGrid.CanSetStone(Player: TPlayer; X, Y: integer;
136    X, Y: integer; Reverse: Boolean): Boolean;    Reverse: Boolean): Boolean;
137  var  var
138    i, j: integer;    i: integer;
139  begin    procedure Method1(m, n: integer);
140          result:=false;    var
141    if GetStrings(X,Y) = stNone then      j: integer;
142    begin    begin
143      if Player = Player1 then      i:=1;
144      begin      while true do
145          i:=1;        case GetStrings(X + m*i, Y+n*i) of
       while true do  
       begin  
         case GetStrings(X-i,Y) of  
         stBlack:  
           if i > 1 then  
           begin  
                 result:=true;  
             if Reverse = true then  
             begin  
               for j:=1 to i-1 do  
               begin  
                         SetStrings(X-j,Y,stBlack);  
               end;  
                 break;  
             end else  
             begin  
                 Exit;  
             end;  
           end else  
           begin  
                 break;  
           end;  
         stWhite:  
                 inc(i);  
         else  
                 break;  
         end;  
       end;  
         i:=1;  
       while true do  
       begin  
         case GetStrings(X-i,Y+i) of  
         stBlack:  
           if i > 1 then  
           begin  
                 result:=true;  
             if Reverse = true then  
             begin  
               for j:=1 to i-1 do  
               begin  
                         SetStrings(X-j,Y+j,stBlack);  
               end;  
                 break;  
             end else  
             begin  
                 Exit;  
             end;  
           end else  
           begin  
                 break;  
           end;  
         stWhite:  
                 inc(i);  
         else  
                 break;  
         end;  
       end;  
         i:=1;  
       while true do  
       begin  
         case GetStrings(X,Y+i) of  
         stBlack:  
           if i > 1 then  
           begin  
                 result:=true;  
             if Reverse = true then  
             begin  
               for j:=1 to i-1 do  
               begin  
                         SetStrings(X,Y+j,stBlack);  
               end;  
                 break;  
             end else  
             begin  
                 Exit;  
             end;  
           end else  
           begin  
                 break;  
           end;  
         stWhite:  
                 inc(i);  
         else  
                 break;  
         end;  
       end;  
         i:=1;  
       while true do  
       begin  
         case GetStrings(X+i,Y+i) of  
         stBlack:  
           if i > 1 then  
           begin  
                 result:=true;  
             if Reverse = true then  
             begin  
               for j:=1 to i-1 do  
               begin  
                         SetStrings(X+j,Y+j,stBlack);  
               end;  
                 break;  
             end else  
             begin  
                 Exit;  
             end;  
           end else  
           begin  
                 break;  
           end;  
         stWhite:  
                 inc(i);  
         else  
                 break;  
         end;  
       end;  
         i:=1;  
       while true do  
       begin  
         case GetStrings(X+i,Y) of  
         stBlack:  
           if i > 1 then  
           begin  
                 result:=true;  
             if Reverse = true then  
             begin  
               for j:=1 to i-1 do  
               begin  
                         SetStrings(X+j,Y,stBlack);  
               end;  
                 break;  
             end else  
             begin  
                 Exit;  
             end;  
           end else  
           begin  
                 break;  
           end;  
         stWhite:  
                 inc(i);  
         else  
                 break;  
         end;  
       end;  
         i:=1;  
       while true do  
       begin  
         case GetStrings(X+i,Y-i) of  
146          stBlack:          stBlack:
147            if i > 1 then            if i > 1 then
148            begin            begin
149                  result:=true;              result := true;
150              if Reverse = true then              if Reverse = true then
151              begin              begin
152                for j:=1 to i-1 do                for j := 1 to i - 1 do
153                begin                  SetStrings(X + m*j, Y+n*j, stBlack);
154                          SetStrings(X+j,Y-j,stBlack);                break;
155                end;              end
156                  break;              else
157              end else                Exit;
158              begin            end
159                  Exit;            else
160              end;              break;
           end else  
           begin  
                 break;  
           end;  
161          stWhite:          stWhite:
162                  inc(i);            inc(i);
163          else        else
164                  break;          break;
         end;  
165        end;        end;
166          i:=1;    end;
167        while true do    procedure Method2(m,n: integer);
168        begin    var
169          case GetStrings(X,Y-i) of      j: integer;
170      begin
171        i:=1;
172        while true do
173          case GetStrings(X+m*i,Y+n*i) of
174          stBlack:          stBlack:
175            if i > 1 then            inc(i);
           begin  
                 result:=true;  
             if Reverse = true then  
             begin  
               for j:=1 to i-1 do  
               begin  
                         SetStrings(X,Y-j,stBlack);  
               end;  
                 break;  
             end else  
             begin  
                 Exit;  
             end;  
           end else  
           begin  
                 break;  
           end;  
176          stWhite:          stWhite:
                 inc(i);  
         else  
                 break;  
         end;  
       end;  
         i:=1;  
       while true do  
       begin  
         case GetStrings(X-i,Y-i) of  
         stBlack:  
177            if i > 1 then            if i > 1 then
178            begin            begin
179                  result:=true;              result:=true;
180              if Reverse = true then              if Reverse = true then
181              begin              begin
182                for j:=1 to i-1 do                for j := 1 to i-1 do
183                begin                  SetStrings(X+m*j,Y+n*j,stWhite);
184                          SetStrings(X-j,Y-j,stBlack);                break;
185                end;              end
186                  break;              else
187              end else                Exit;
188              begin            end
189                  Exit;            else
190              end;              break;
191            end else        else
192            begin          break;
                 break;  
           end;  
         stWhite:  
                 inc(i);  
         else  
                 break;  
         end;  
       end;  
       if (Reverse = true)and(result = true) then  
       begin  
                 SetStrings(X,Y,stBlack);  
193        end;        end;
194      end else    end;
195    
196    begin
197      result := false;
198      if GetStrings(X, Y) = stNone then
199      begin
200        if Player = Player1 then
201      begin      begin
202          i:=1;        Method1(-1,-1);
203        while true do        Method1(-1,0);
204          Method1(-1,1);
205          Method1(0,-1);
206          Method1(0,1);
207          Method1(1,-1);
208          Method1(1,0);
209          Method1(1,1);
210          if (Reverse = true) and (result = true) then
211          begin
212            SetStrings(X, Y, stBlack);
213          end;
214        end
215        else
216        begin
217          Method2(-1,-1);
218          Method2(-1,0);
219          Method2(-1,1);
220          Method2(0,-1);
221          Method2(0,1);
222          Method2(1,-1);
223          Method2(1,0);
224          Method2(1,1);
225          if (Reverse = true) and (result = true) then
226        begin        begin
227          case GetStrings(X-i,Y) of          Strings[X, Y] := stWhite;
         stBlack:  
                 inc(i);  
         stWhite:  
           if i > 1 then  
           begin  
                 result:=true;  
             if Reverse = true then  
             begin  
               for j:=1 to i-1 do  
               begin  
                         SetStrings(X-j,Y,stWhite);  
               end;  
                 break;  
             end else  
             begin  
                 Exit;  
             end;  
           end else  
           begin  
                 break;  
           end;  
         else  
                 break;  
         end;  
       end;  
         i:=1;  
       while true do  
       begin  
         case GetStrings(X+i,Y) of  
         stBlack:  
                 inc(i);  
         stWhite:  
           if i > 1 then  
           begin  
                 result:=true;  
             if Reverse = true then  
             begin  
               for j:=1 to i-1 do  
               begin  
                         SetStrings(X+j,Y,stWhite);  
               end;  
                 break;  
             end else  
             begin  
                 Exit;  
             end;  
           end else  
           begin  
                 break;  
           end;  
         else  
                 break;  
         end;  
       end;  
         i:=1;  
       while true do  
       begin  
         case GetStrings(X-i,Y-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  
               begin  
                         SetStrings(X-j,Y-j,stWhite);  
               end;  
                 break;  
             end else  
             begin  
                 Exit;  
             end;  
           end else  
           begin  
                 break;  
           end;  
         else  
                 break;  
         end;  
       end;  
         i:=1;  
       while true do  
       begin  
         case GetStrings(X,Y-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  
               begin  
                         SetStrings(X,Y-j,stWhite);  
               end;  
                 break;  
             end else  
             begin  
                 Exit;  
             end;  
           end else  
           begin  
                 break;  
           end;  
         else  
                 break;  
         end;  
       end;  
         i:=1;  
       while true do  
       begin  
         case GetStrings(X+i,Y-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  
               begin  
                         SetStrings(X+j,Y-j,stWhite);  
               end;  
                 break;  
             end else  
             begin  
                 Exit;  
             end;  
           end else  
           begin  
                 break;  
           end;  
         else  
                 break;  
         end;  
       end;  
         i:=1;  
       while true do  
       begin  
         case GetStrings(X-i,Y+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  
               begin  
                         SetStrings(X-j,Y+j,stWhite);  
               end;  
                 break;  
             end else  
             begin  
                 Exit;  
             end;  
           end else  
           begin  
                 break;  
           end;  
         else  
                 break;  
         end;  
       end;  
         i:=1;  
       while true do  
       begin  
         case GetStrings(X,Y+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  
               begin  
                         SetStrings(X,Y+j,stWhite);  
               end;  
                 break;  
             end else  
             begin  
                 Exit;  
             end;  
           end else  
           begin  
                 break;  
           end;  
         else  
                 break;  
         end;  
       end;  
         i:=1;  
       while true do  
       begin  
         case GetStrings(X+i,Y+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  
               begin  
                         SetStrings(X+j,Y+j,stWhite);  
               end;  
                 break;  
             end else  
             begin  
                 Exit;  
             end;  
           end else  
           begin  
                 break;  
           end;  
         else  
                 break;  
         end;  
       end;  
       if (Reverse = true)and(result = true) then  
       begin  
                 Strings[X,Y]:=stWhite;  
228        end;        end;
229      end;      end;
230    end;    end;
# Line 621  procedure TStoneGrid.Clear; Line 234  procedure TStoneGrid.Clear;
234  var  var
235    i, j: integer;    i, j: integer;
236  begin  begin
237    for i:=0 to Count-1 do    for i := 0 to Count - 1 do
238    begin    begin
239      for j:=0 to Count-1 do      for j := 0 to Count - 1 do
240      begin      begin
241          Strings[i,j]:=stNone;        Strings[i, j] := stNone;
242      end;      end;
243    end;    end;
244          Strings[3,3]:=stBlack;    Strings[3, 3] := stBlack;
245          Strings[4,4]:=stBlack;    Strings[4, 4] := stBlack;
246          Strings[4,3]:=stWhite;    Strings[4, 3] := stWhite;
247          Strings[3,4]:=stWhite;    Strings[3, 4] := stWhite;
248          FTurnNumber:=1;    FTurnNumber := 1;
249          FTurnIndex:=1;    FTurnIndex := 1;
250  end;  end;
251    
252  function TStoneGrid.GetStrings(X, Y: integer): TStoneType;  function TStoneGrid.GetStrings(X, Y: integer): TStoneType;
253  begin  begin
254    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
255    begin    begin
256          result:=FStrings[X,Y];      result := FStrings[X, Y];
257    end else    end
258      else
259    begin    begin
260          result:=stError;      result := stError;
261    end;    end;
262  end;  end;
263    
# Line 651  function TStoneGrid.NextStone(Player: TP Line 265  function TStoneGrid.NextStone(Player: TP
265  var  var
266    i, j, m, n: integer;    i, j, m, n: integer;
267  begin  begin
268          n:=-1;    n := -1;
269    for i:=0 to Count-1 do    for i := 0 to Count - 1 do
270    begin    begin
271      for j:=0 to Count-1 do      for j := 0 to Count - 1 do
272      begin      begin
273          m:=CalScore(Player,i,j);        m := CalScore(Player, i, j);
274        if (n = -1)or((m > -1)and(n > m)) then        if (n = -1) or ((m > -1) and (n > m)) then
275        begin        begin
276                  n:=m;          n := m;
277                  result:=Point(i,j);          result := Point(i, j);
278        end;        end;
279      end;      end;
280    end;    end;
281    if n = -1 then    if n = -1 then
282    begin    begin
283          result:=Point(-1,-1);      result := Point(-1, -1);
284    end;    end;
285  end;  end;
286    
287  procedure TStoneGrid.SetStrings(X, Y: integer; const Value: TStoneType);  procedure TStoneGrid.SetStrings(X, Y: integer; const Value: TStoneType);
288  begin  begin
289    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
290    begin    begin
291          FStrings[X,Y]:=Value;      FStrings[X, Y] := Value;
292    end;    end;
293  end;  end;
294    
# Line 682  procedure TStoneGrid.SetTurnNumber(const Line 296  procedure TStoneGrid.SetTurnNumber(const
296  begin  begin
297    if Value > FTurnIndex then    if Value > FTurnIndex then
298    begin    begin
299          FTurnNumber:=FTurnIndex;      FTurnNumber := FTurnIndex;
300    end else    end
301      else
302    begin    begin
303          FTurnNumber:=Value;      FTurnNumber := Value;
304    end;    end;
305          FStrings:=FBuffer[FTurnNumber];    FStrings := FBuffer[FTurnNumber];
306  end;  end;
307    
308  { TForm1 }  { TForm1 }
# Line 700  var Line 315  var
315    begin    begin
316      if Index = Player1 then      if Index = Player1 then
317      begin      begin
318          Index:=Player2;        Index := Player2;
319      end else      end
320        else
321      begin      begin
322          Index:=Player1;        Index := Player1;
323      end;      end;
324    end;    end;
325    function Execute: Boolean;    function Execute: Boolean;
326    var    var
327      i, j: integer;      i, j: integer;
328    begin    begin
329          result:=false;      result := false;
330      for i:=0 to Count-1 do      for i := 0 to Count - 1 do
331      begin      begin
332        for j:=0 to Count-1 do        for j := 0 to Count - 1 do
333        begin        begin
334          if StoneGrid.CanSetStone(Index,i,j,false) = true then          if StoneGrid.CanSetStone(Index, i, j, false) = true then
335          begin          begin
336                  result:=true;            result := true;
337                  break;            break;
338          end;          end;
339        end;        end;
340        if result = true then        if result = true then
341        begin        begin
342              break;          break;
343        end;        end;
344      end;      end;
345    end;    end;
346    
347  begin  begin
348          StoneGrid.BackUp;    StoneGrid.BackUp;
349          Main;    Main;
350    if Execute = false then    if Execute = false then
351    begin    begin
352          Main;      Main;
353      if Execute = false then      if Execute = false then
354      begin      begin
355          Timer1.Enabled:=false;        Timer1.Enabled := false;
356          Active:=false;        Active := false;
357          m:=0;        m := 0;
358          n:=0;        n := 0;
359        for i:=0 to Count-1 do        for i := 0 to Count - 1 do
360        begin        begin
361          for j:=0 to Count-1 do          for j := 0 to Count - 1 do
362          begin          begin
363            case StoneGrid[i,j] of            case StoneGrid[i, j] of
364            stBlack:              stBlack:
365                  inc(m);                inc(m);
366            stWhite:              stWhite:
367                  inc(n);                inc(n);
368            end;            end;
369          end;          end;
370        end;        end;
371        if m > n then        if m > n then
372        begin        begin
373                  s:='Player1 Win:'+#13#10;          s := 'Player1 Win:' + #13#10;
374        end else        end
375          if m < n then        else if m < n then
376        begin        begin
377                  s:='Player2 Win:'+#13#10;          s := 'Player2 Win:' + #13#10;
378        end else        end
379          else
380        begin        begin
381                  s:='Draw:'+#13#10;          s := 'Draw:' + #13#10;
382        end;        end;
383          Showmessage(s+'(Player1) '+IntToStr(m)+'(Player2) '+IntToStr(n));        Showmessage(s + '(Player1) ' + IntToStr(m) + '(Player2) ' + IntToStr(n));
384      end;      end;
385    end;    end;
386  end;  end;
# Line 772  var Line 390  var
390    i, j, m, n: integer;    i, j, m, n: integer;
391    s: string;    s: string;
392  begin  begin
393          m:=0;    m := 0;
394          n:=0;    n := 0;
395    for i:=0 to Count-1 do    for i := 0 to Count - 1 do
396    begin    begin
397      for j:=0 to Count-1 do      for j := 0 to Count - 1 do
398      begin      begin
399        case StoneGrid.Strings[i,j] of        case StoneGrid.Strings[i, j] of
400        stWhite:          stWhite:
401                  inc(m);            inc(m);
402        stBlack:          stBlack:
403                  inc(n);            inc(n);
404        end;        end;
405      end;      end;
406    end;    end;
407    if (m = 0)or(n = 0)or(m+n = Count*Count) then    if (m = 0) or (n = 0) or (m + n = Count * Count) then
408    begin    begin
409      if n > m then      if n > m then
410      begin      begin
411          s:='Player1 Win'+#13#10;        s := 'Player1 Win' + #13#10;
412      end else      end
413          if n < m then      else if n < m then
414      begin      begin
415          s:='Player2 Win'+#13#10;        s := 'Player2 Win' + #13#10;
416      end else      end
417      begin      else
418          s:='draw'+#13#10;      begin
419      end;        s := 'draw' + #13#10;
420          Timer1.Enabled:=false;      end;
421          Active:=false;      Timer1.Enabled := false;
422          Showmessage(s+'(Player1) '+IntToStr(n)+#13#10+'(Player2) '+IntToStr(m));      Active := false;
423    end else      Showmessage(s + '(Player1) ' + IntToStr(n) + #13#10 + '(Player2) ' +
424          IntToStr(m));
425      end
426      else
427    begin    begin
428          ChangePlayer;      ChangePlayer;
429    end;    end;
430  end;  end;
431    
# Line 812  procedure TForm1.CompStone; Line 433  procedure TForm1.CompStone;
433  var  var
434    s: TPoint;    s: TPoint;
435  begin  begin
436          s:=StoneGrid.NextStone(Index);    s := StoneGrid.NextStone(Index);
437          StoneGrid.CanSetStone(Index,s.X,s.Y,true);    StoneGrid.CanSetStone(Index, s.X, s.Y, true);
438          FormPaint(nil);    FormPaint(nil);
439          CheckGame;    CheckGame;
440  end;  end;
441    
442  procedure TForm1.GameStart;  procedure TForm1.GameStart;
443  begin  begin
444          StoneGrid.Clear;    StoneGrid.Clear;
445          StoneGrid.BackUp;    StoneGrid.BackUp;
446          FormPaint(nil);    FormPaint(nil);
447          Index:=Player1;    Index := Player1;
448          Active:=true;    Active := true;
449          Timer1.Enabled:=true;    Timer1.Enabled := true;
450  end;  end;
451    
452  procedure TForm1.FormCreate(Sender: TObject);  procedure TForm1.FormCreate(Sender: TObject);
453  begin  begin
454          StoneGrid:=TStoneGrid.Create;    StoneGrid := TStoneGrid.Create;
455          Player1:=TPlayer.Create;    Player1 := TPlayer.Create;
456          Player2:=TPlayer.Create;    Player2 := TPlayer.Create;
457          Player2.Auto:=true;    Player2.Auto := true;
458          GameStart;    GameStart;
459  end;  end;
460    
461  procedure TForm1.FormDestroy(Sender: TObject);  procedure TForm1.FormDestroy(Sender: TObject);
462  begin  begin
463          StoneGrid.Free;    StoneGrid.Free;
464          Player1.Free;    Player1.Free;
465          Player2.Free;    Player2.Free;
466  end;  end;
467    
468  procedure TForm1.FormPaint(Sender: TObject);  procedure TForm1.FormPaint(Sender: TObject);
469  var  var
470    i, j: integer;    i, j: integer;
471  begin  begin
472          Canvas.Brush.Color:=clWhite;    Canvas.Brush.Color := clWhite;
473          Canvas.Rectangle(0,0,Count*Size,Count*Size);    Canvas.Rectangle(0, 0, Count * Size, Count * Size);
474    for i:=0 to Count-1 do    for i := 0 to Count - 1 do
475    begin    begin
476          Canvas.MoveTo(i*Size,0);      Canvas.MoveTo(i * Size, 0);
477          Canvas.LineTo(i*Size,Size*Count);      Canvas.LineTo(i * Size, Size * Count);
478      for j:=0 to Count-1 do      for j := 0 to Count - 1 do
479      begin      begin
480          Canvas.MoveTo(0,j*Size);        Canvas.MoveTo(0, j * Size);
481          Canvas.LineTo(Count*Size,j*Size);        Canvas.LineTo(Count * Size, j * Size);
482        case StoneGrid.Strings[i,j] of        case StoneGrid.Strings[i, j] of
483        stWhite:          stWhite:
484        begin            begin
485                  Canvas.Brush.Color:=clWhite;              Canvas.Brush.Color := clWhite;
486                  Canvas.Ellipse(i*Size,j*Size,(i+1)*Size,(j+1)*Size);              Canvas.Ellipse(i * Size, j * Size, (i + 1) * Size, (j + 1) * Size);
487        end;            end;
488        stBlack:          stBlack:
489        begin            begin
490                  Canvas.Brush.Color:=clBlack;              Canvas.Brush.Color := clBlack;
491                  Canvas.Ellipse(i*Size,j*Size,(i+1)*Size,(j+1)*Size);              Canvas.Ellipse(i * Size, j * Size, (i + 1) * Size, (j + 1) * Size);
492        end;            end;
493        end;        end;
494      end;      end;
495    end;    end;
496  end;  end;
497    
498  procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;  procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
499    Shift: TShiftState; X, Y: Integer);    Shift: TShiftState; X, Y: integer);
500  begin  begin
501    if (Active = true)and(Index.Auto = false)and(X <= Count*Size)and(Y <= Count*Size) then    if (Active = true) and (Index.Auto = false) and (X <= Count * Size) and
502        (Y <= Count * Size) then
503    begin    begin
504          X:=X div Size;      X := X div Size;
505          Y:=Y div Size;      Y := Y div Size;
506      if StoneGrid.CanSetStone(Index,X,Y,true) = true then      if StoneGrid.CanSetStone(Index, X, Y, true) = true then
507      begin      begin
508          FormPaint(Sender);        FormPaint(Sender);
509          CheckGame;        CheckGame;
510      end;      end;
511    end;    end;
512  end;  end;
513    
514  procedure TForm1.Timer1Timer(Sender: TObject);  procedure TForm1.Timer1Timer(Sender: TObject);
515  begin  begin
516    if (Active = true)and(Index.Auto = true) then    if (Active = true) and (Index.Auto = true) then
517    begin    begin
518          Timer1.Enabled:=false;        Timer1.Enabled := false;
519          CompStone;      CompStone;
520          Timer1.Enabled:=true;      Timer1.Enabled := true;
521    end;    end;
522  end;  end;
523    
524  procedure TForm1.FormResize(Sender: TObject);  procedure TForm1.FormResize(Sender: TObject);
525  begin  begin
526          Size:=Min(ClientWidth,ClientHeight) div Count;    Size := Min(ClientWidth, ClientHeight) div Count;
527          FormPaint(Sender);    FormPaint(Sender);
528  end;  end;
529    
530  procedure TForm1.Player(Sender: TObject);  procedure TForm1.Player(Sender: TObject);
531  begin  begin
532          (Sender as TMenuItem).Checked:=not (Sender as TMenuItem).Checked;    (Sender as TMenuItem).Checked := not(Sender as TMenuItem).Checked;
533    if Sender = Player11 then    if Sender = Player11 then
534    begin    begin
535          Player1.Auto:=Player11.Checked;      Player1.Auto := Player11.Checked;
536    end else    end
537      else
538    begin    begin
539          Player2.Auto:=Player21.Checked;      Player2.Auto := Player21.Checked;
540    end;    end;
541  end;  end;
542    
543  procedure TForm1.Start1Click(Sender: TObject);  procedure TForm1.Start1Click(Sender: TObject);
544  begin  begin
545          GameStart;    GameStart;
546  end;  end;
547    
548  procedure TForm1.End1Click(Sender: TObject);  procedure TForm1.End1Click(Sender: TObject);
549  begin  begin
550          Close;    Close;
551  end;  end;
552    
553  end.  end.
   
Legend:
Removed from v.1  
changed lines
  Added in v.3
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help