Develop and Download Open Source Software

Browse Subversion Repository

Diff of /Unit1.pas

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

revision 37 by yamat0jp, Sun Aug 30 08:32:57 2015 UTC revision 38 by yamat0jp, Sun Aug 30 14:04:08 2015 UTC
# Line 19  type Line 19  type
19      Left, Top: integer;      Left, Top: integer;
20    end;    end;
21    
22    TGridData = array [0 .. bmp_count - 1] of array [0 .. bmp_count - 1]    TGridData = record
23      of TStoneType;      Strings: array [0 .. bmp_count - 1] of array [0 .. bmp_count - 1]
24          of TStoneType;
25        Stone: TStoneType;
26      end;
27    
28    TPlayer = class(TObject)    TPlayer = class(TObject)
29    private    private
# Line 48  type Line 51  type
51      procedure SetTurnNumber(const Value: integer);      procedure SetTurnNumber(const Value: integer);
52      function GetActive: Boolean;      function GetActive: Boolean;
53      procedure SetActive(const Value: Boolean);      procedure SetActive(const Value: Boolean);
54        function GetStone: TStoneType;
55    public    public
56      constructor Create;      constructor Create;
57      destructor Destroy; override;      destructor Destroy; override;
# Line 69  type Line 73  type
73        write SetStrings; default;        write SetStrings; default;
74      property TurnNumber: integer read FTurnNumber write SetTurnNumber;      property TurnNumber: integer read FTurnNumber write SetTurnNumber;
75      property Active: Boolean read GetActive write SetActive;      property Active: Boolean read GetActive write SetActive;
76        property Stone: TStoneType read GetStone;
77    end;    end;
78    
79    TForm1 = class(TForm)    TForm1 = class(TForm)
# Line 118  type Line 123  type
123      procedure CompStone;      procedure CompStone;
124      procedure GameStart;      procedure GameStart;
125      procedure ChangePlayer;      procedure ChangePlayer;
126        procedure ChMain(var CapStr: string);
127    public    public
128      { Public 宣言 }      { Public 宣言 }
129    end;    end;
# Line 151  end; Line 157  end;
157  function TStoneGrid.CalScore(Stone: TStoneType; X, Y: integer;  function TStoneGrid.CalScore(Stone: TStoneType; X, Y: integer;
158    out Score: integer): Boolean;    out Score: integer): Boolean;
159  var  var
   i, j: integer;  
160    loop: integer;    loop: integer;
161  const  const
162    waste: array [1 .. 12] of TPoint = ((X: 1; Y: 0), (X: 6; Y: 0), (X: 0; Y: 1),    waste: array [1 .. 12] of TPoint = ((X: 1; Y: 0), (X: 6; Y: 0), (X: 0; Y: 1),
# Line 359  begin Line 364  begin
364      result := false;      result := false;
365  end;  end;
366    
367    function TStoneGrid.GetStone: TStoneType;
368    begin
369      result := FBuffer[FTurnNumber].Stone;
370    end;
371    
372  function TStoneGrid.GetStrings(X, Y: integer): TStoneType;  function TStoneGrid.GetStrings(X, Y: integer): TStoneType;
373  begin  begin
374    if (X >= 0) and (X < bmp_count) and (Y >= 0) and (Y < bmp_count) then    if (X >= 0) and (X < bmp_count) and (Y >= 0) and (Y < bmp_count) then
375      result := FStrings[X, Y]      result := FStrings.Strings[X, Y]
376    else    else
377      result := stError;      result := stError;
378  end;  end;
# Line 408  begin Line 418  begin
418        inc(FTurnIndex);        inc(FTurnIndex);
419        inc(FTurnNumber);        inc(FTurnNumber);
420        FBuffer[FTurnIndex] := FStrings;        FBuffer[FTurnIndex] := FStrings;
421          FBuffer[FTurnIndex].Stone := FEffectStone;
422        Form1.PaintBox1.Repaint;        Form1.PaintBox1.Repaint;
423        Form1.ChangePlayer;        Form1.ChangePlayer;
424        if FGameOver = false then        if FGameOver = false then
# Line 475  end; Line 486  end;
486  procedure TStoneGrid.SetStrings(X, Y: integer; const Value: TStoneType);  procedure TStoneGrid.SetStrings(X, Y: integer; const Value: TStoneType);
487  begin  begin
488    if (X >= 0) and (X < bmp_count) and (Y >= 0) and (Y < bmp_count) then    if (X >= 0) and (X < bmp_count) and (Y >= 0) and (Y < bmp_count) then
489      FStrings[X, Y] := Value;      FStrings.Strings[X, Y] := Value;
490  end;  end;
491    
492  procedure TStoneGrid.SetTurnNumber(const Value: integer);  procedure TStoneGrid.SetTurnNumber(const Value: integer);
# Line 502  procedure TForm1.ChangePlayer; Line 513  procedure TForm1.ChangePlayer;
513  var  var
514    i, j, m, n: integer;    i, j, m, n: integer;
515    s: string;    s: string;
   procedure Main;  
   begin  
     if Index = Player1 then  
     begin  
       Index := Player2;  
       s := '白の手番です';  
     end  
     else  
     begin  
       Index := Player1;  
       s := '黒の手番です';  
     end;  
   end;  
516    function Execute: Boolean;    function Execute: Boolean;
517    var    var
518      i, j: integer;      i, j: integer;
# Line 530  var Line 528  var
528    end;    end;
529    
530  begin  begin
531    Main;    s := '';
532      ChMain(s);
533    if Execute = false then    if Execute = false then
534    begin    begin
535      Main;      ChMain(s);
536      if Execute = false then      if Execute = false then
537      begin      begin
538        m := 0;        m := 0;
# Line 546  begin Line 545  begin
545              stWhite:              stWhite:
546                inc(n);                inc(n);
547            end;            end;
548        Caption := s;        ChMain(s);
549          Caption := '終了しました';
550        if m > n then        if m > n then
551          s := 'Player1 Win:' + #13#10          s := 'Player1 Win:' + #13#10
552        else if m < n then        else if m < n then
# Line 564  begin Line 564  begin
564      Caption := s;      Caption := s;
565  end;  end;
566    
567    procedure TForm1.ChMain(var CapStr: string);
568    begin
569      CapStr := (StoneGrid.TurnNumber + 1).ToString + '手目:';
570      if Index = Player1 then
571      begin
572        Index := Player2;
573        CapStr := CapStr + '白の手番です';
574      end
575      else
576      begin
577        Index := Player1;
578        CapStr := CapStr + '黒の手番です';
579      end;
580    end;
581    
582  procedure TForm1.CompStone;  procedure TForm1.CompStone;
583  var  var
584    s: TPoint;    s: TPoint;
# Line 583  begin Line 598  begin
598    Index := Player1;    Index := Player1;
599    StoneGrid.Start;    StoneGrid.Start;
600    PaintBox1.Repaint;    PaintBox1.Repaint;
601    Caption := '黒から始めます';    Caption := '1手目:黒から始めます';
602  end;  end;
603    
604  procedure TForm1.MenuItem10Click(Sender: TObject);  procedure TForm1.MenuItem10Click(Sender: TObject);
# Line 594  end; Line 609  end;
609  procedure TForm1.MenuItem11Click(Sender: TObject);  procedure TForm1.MenuItem11Click(Sender: TObject);
610  var  var
611    i: integer;    i: integer;
612      s: string;
613  begin  begin
614    with StoneGrid do    with StoneGrid do
615    begin    begin
# Line 606  begin Line 622  begin
622        Exit        Exit
623      else      else
624        Pause;        Pause;
625        PaintBox1.Repaint;
626        s := '';
627        if ((TurnNumber = 0) and (Index <> Player1)) or
628          (Index.Stone = FBuffer[TurnNumber].Stone) then
629        begin
630          if TurnNumber = 60 then
631            ChangePlayer
632          else
633          begin
634            ChMain(s);
635            Caption := s;
636          end;
637        end
638        else
639        begin
640          ChMain(s);
641          Caption := s;
642          if Index = Player1 then
643            Index := Player2
644          else
645            Index := Player1;
646        end;
647    end;    end;
   PaintBox1.Repaint;  
   ChangePlayer;  
648  end;  end;
649    
650  procedure TForm1.MenuItem2Click(Sender: TObject);  procedure TForm1.MenuItem2Click(Sender: TObject);
# Line 731  procedure TForm1.PaintBox1Tap(Sender: TO Line 767  procedure TForm1.PaintBox1Tap(Sender: TO
767  begin  begin
768    if Index.Auto = false then    if Index.Auto = false then
769    begin    begin
770      MenuItem10Click(Sender);      StoneGrid.Restart;
771      StoneGrid.Active := false;      if (StoneGrid.Active = true) and
772      if StoneGrid.CanSetStone(Index.Stone, Floor(Point.X / Size),        (StoneGrid.CanSetStone(Index.Stone, Floor(Point.X / Size),
773        Floor(Point.Y / Size), true, true) = true then        Floor(Point.Y / Size), true, true) = true) then
774        begin
775          StoneGrid.Active := false;
776        PaintBox1.Repaint;        PaintBox1.Repaint;
777      StoneGrid.Active := true;        StoneGrid.Active := true;
778        end;
779    end;    end;
780  end;  end;
781    

Legend:
Removed from v.37  
changed lines
  Added in v.38

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26