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 30 by yamat0jp, Sun Aug 16 04:15:52 2015 UTC revision 32 by yamat0jp, Sun Aug 16 07:03:42 2015 UTC
# Line 51  type Line 51  type
51      constructor Create;      constructor Create;
52      destructor Destroy; override;      destructor Destroy; override;
53      procedure Clear;      procedure Clear;
54      function CalScore(Stone: TStoneType; X, Y: integer): integer;      function CalScore(Stone: TStoneType; X, Y: integer; out Score: integer): Boolean;
55      function CanSetStone(Stone: TStoneType; X, Y: integer; Reverse: Boolean;      function CanSetStone(Stone: TStoneType; X, Y: integer; Reverse: Boolean;
56        const Visible: Boolean = false): Boolean;        const Visible: Boolean = false): Boolean;
57      function NextStone(Stone: TStoneType; var Pos: TPoint): Boolean;      function NextStone(Stone: TStoneType; var Pos: TPoint): Boolean;
# Line 130  implementation Line 130  implementation
130  {$R *.fmx}  {$R *.fmx}
131  {$R *.Windows.fmx MSWINDOWS}  {$R *.Windows.fmx MSWINDOWS}
132  {$R *.XLgXhdpiTb.fmx ANDROID}  {$R *.XLgXhdpiTb.fmx ANDROID}
   
133  { TStoneGrid }  { TStoneGrid }
134    
135  function TStoneGrid.AddScore(X, Y: integer; const NG: array of TPoint): integer;  function TStoneGrid.AddScore(X, Y: integer; const NG: array of TPoint): integer;
# Line 146  begin Line 145  begin
145      end;      end;
146  end;  end;
147    
148  function TStoneGrid.CalScore(Stone: TStoneType; X, Y: integer): integer;  function TStoneGrid.CalScore(Stone: TStoneType; X, Y: integer; out Score: integer): Boolean;
149  var  var
150    i, j: integer;    i, j: integer;
151    const
152      wast: array [0 .. 11] of TPoint = ((X: 1; Y: 0), (X: 6; Y: 0), (X: 0;
153        Y: 1), (X: 1; Y: 1), (X: 6; Y: 1), (X: 7; Y: 1), (X: 0; Y: 6), (X: 1; Y: 6),
154        (X: 6; Y: 6), (X: 7; Y: 6), (X: 1; Y: 7), (X: 6; Y: 7));
155      worth: array [0 .. 3] of TPoint = ((X: 0; Y: 0), (X: 7; Y: 0), (X: 0;
156        Y: 7), (X: 7; Y: 7));
157  begin  begin
158    if CanSetStone(Stone, X, Y, true) = true then    if CanSetStone(Stone, X, Y, true) = true then
159    begin    begin
160      result := 0;      Score := 0;
161        result:=true;
162      if FTurnIndex < 50 then      if FTurnIndex < 50 then
163        inc(result, AddScore(X, Y, [Point(1, 0), Point(6, 0), Point(0, 1),        inc(Score, AddScore(X, Y, wast));
164          Point(1, 1), Point(6, 1), Point(7, 1), Point(0, 6), Point(1, 6),      dec(Score, AddScore(X, Y, worth));
         Point(6, 6), Point(7, 6), Point(1, 7), Point(6, 7)]));  
165      case Stone of      case Stone of
166        stBlack:        stBlack:
167          Stone := stWhite;          Stone := stWhite;
# Line 167  begin Line 172  begin
172        for j := 0 to Count - 1 do        for j := 0 to Count - 1 do
173          if CanSetStone(Stone, i, j, false) = true then          if CanSetStone(Stone, i, j, false) = true then
174          begin          begin
175            inc(result);            inc(Score);
176            if FTurnIndex < 50 then            inc(Score, AddScore(i, j, worth));
             inc(result, AddScore(i, j, [Point(0, 0), Point(7, 0), Point(0, 7),  
               Point(7, 7)]));  
177          end;          end;
178    end    end
179    else    else
180      result := -1;      result := false;
181    FStrings := FBuffer[FTurnIndex];    FStrings := FBuffer[FTurnIndex];
182  end;  end;
183    
# Line 187  var Line 190  var
190    procedure Method(m, n: integer);    procedure Method(m, n: integer);
191    var    var
192      s: TStoneType;      s: TStoneType;
193      j, k: integer;      j: integer;
194        k: Integer;
195    begin    begin
196      if p = false then      if p = false then
197        Exit;        Exit;
# Line 207  var Line 211  var
211            result := true;            result := true;
212            if Reverse = true then            if Reverse = true then
213            begin            begin
214                Form1.PaintBox1.Repaint;
215              for j := 1 to i - 1 do              for j := 1 to i - 1 do
216              begin              begin
               Form1.PaintBox1.Repaint;  
217                if Visible = true then                if Visible = true then
218                begin                begin
219                  FEffectStone := Stone;                  FEffectStone := Stone;
# Line 220  var Line 224  var
224                  q^.Y := 0;                  q^.Y := 0;
225                  FList.Add(q);                  FList.Add(q);
226                  SetStrings(q^.Left, q^.Top, stEffect);                  SetStrings(q^.Left, q^.Top, stEffect);
227                  for k := 1 to 100 do                  for k := 1 to 10 do
228                  begin                  begin
229                    Sleep(1);                    Sleep(15);
230                    Application.ProcessMessages;                    Application.ProcessMessages;
231                  end;                  end;
232                end                end
# Line 357  begin Line 361  begin
361        inc(FTurnIndex);        inc(FTurnIndex);
362        inc(FTurnNumber);        inc(FTurnNumber);
363        FBuffer[FTurnIndex] := FStrings;        FBuffer[FTurnIndex] := FStrings;
364          Form1.PaintBox1.Repaint;
365          Form1.ChangePlayer;
366        if FGameOver = false then        if FGameOver = false then
367        begin          FActive := true
         Form1.ChangePlayer;  
         FActive:=true;  
       end;  
368      end;      end;
369      result := true;      result := true;
370    end;    end;
# Line 371  function TStoneGrid.NextStone(Stone: TSt Line 374  function TStoneGrid.NextStone(Stone: TSt
374  var  var
375    i, j, m, n: integer;    i, j, m, n: integer;
376  begin  begin
377    n := -1;    result:=false;
378      n:=0;
379    for i := 0 to Count - 1 do    for i := 0 to Count - 1 do
380      for j := 0 to Count - 1 do      for j := 0 to Count - 1 do
381      begin        if (CalScore(Stone, i, j, m) = true) and ((result = false)or(m < n)) then
       m := CalScore(Stone, i, j);  
       if (n = -1) or ((0 < m) and (m < n)) then  
382        begin        begin
383          n := m;          if result = false then
384              result:=true;
385            n:=m;
386          Pos := Point(i, j);          Pos := Point(i, j);
387        end;        end;
     end;  
   result := not(n = -1);  
388  end;  end;
389    
390  procedure TStoneGrid.Paint(Canvas: TCanvas);  procedure TStoneGrid.Paint(Canvas: TCanvas);
# Line 415  end; Line 417  end;
417    
418  procedure TStoneGrid.Restart;  procedure TStoneGrid.Restart;
419  begin  begin
420    FActive:=true;    FActive := true;
421    FGameOver := false;    FGameOver := false;
422    FTurnIndex := FTurnNumber;    FTurnIndex := FTurnNumber;
423  end;  end;
424    
425  procedure TStoneGrid.SetActive(const Value: Boolean);  procedure TStoneGrid.SetActive(const Value: Boolean);
426  begin  begin
427    if (FGameOver = false)or(Value = false) then    if (FGameOver = false) or (Value = false) then
428      FActive := Value;      FActive := Value;
429  end;  end;
430    
# Line 508  begin Line 510  begin
510        else        else
511          s := 'Draw:' + #13#10;          s := 'Draw:' + #13#10;
512        StoneGrid.GameOver;        StoneGrid.GameOver;
513        Showmessage(s + '(Player1) ' + IntToStr(m) + #13#10 + '(Player2) ' +        Showmessage(s + '(Player1) ' + m.ToString+ #13#10 + '(Player2) ' +
514          IntToStr(n));          n.ToString);
515      end      end
516      else      else
517        Caption := s;        Caption := s;
# Line 523  var Line 525  var
525    s: TPoint;    s: TPoint;
526  begin  begin
527    StoneGrid.Active := false;    StoneGrid.Active := false;
528    StoneGrid.NextStone(Index.Stone, s);    if StoneGrid.NextStone(Index.Stone, s) = true then
529    StoneGrid.CanSetStone(Index.Stone, s.X, s.Y, true, true);    begin
530    PaintBox1.Repaint;      StoneGrid.CanSetStone(Index.Stone, s.X, s.Y, true, true);
531        PaintBox1.Repaint;
532      end
533      else
534        ChangePlayer;
535  end;  end;
536    
537  procedure TForm1.GameStart;  procedure TForm1.GameStart;
# Line 629  end; Line 635  end;
635    
636  procedure TForm1.FormCreate(Sender: TObject);  procedure TForm1.FormCreate(Sender: TObject);
637  begin  begin
638    ClientWidth:=20*Count;    ClientWidth := 50 * Count;
639    ClientHeight:=20*Count;    ClientHeight := 50 * Count;
640    StoneGrid := TStoneGrid.Create;    StoneGrid := TStoneGrid.Create;
641    StoneGrid.ImageCount(Form1.Image1.Bitmap.Width div Form1.Image3.Bitmap.Width,    StoneGrid.ImageCount(Form1.Image1.Bitmap.Width div Form1.Image3.Bitmap.Width,
642      Form1.Image1.Bitmap.Height div Form1.Image3.Bitmap.Height);      Form1.Image1.Bitmap.Height div Form1.Image3.Bitmap.Height);
Legend:
Removed from v.30  
changed lines
  Added in v.32
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help