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 33 by yamat0jp, Wed Aug 19 14:41:09 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 91  type Line 96  type
96      Image1: TImage;      Image1: TImage;
97      Image2: TImage;      Image2: TImage;
98      Image3: TImage;      Image3: TImage;
99      Image4: TImage;      MenuItem13: TMenuItem;
100      Image5: TImage;      MenuItem14: TMenuItem;
101        MenuItem15: TMenuItem;
102      procedure FormCreate(Sender: TObject);      procedure FormCreate(Sender: TObject);
103      procedure FormDestroy(Sender: TObject);      procedure FormDestroy(Sender: TObject);
104      procedure Timer1Timer(Sender: TObject);      procedure Timer1Timer(Sender: TObject);
# Line 117  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 150  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
160    i, j: integer;    loop: integer;
161  const  const
162    wast: 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),
163      (X: 1; Y: 1), (X: 6; Y: 1), (X: 7; Y: 1), (X: 0; Y: 6), (X: 1; Y: 6), (X: 6;      (X: 1; Y: 1), (X: 6; Y: 1), (X: 7; Y: 1), (X: 0; Y: 6), (X: 1; Y: 6), (X: 6;
164      Y: 6), (X: 7; Y: 6), (X: 1; Y: 7), (X: 6; Y: 7));      Y: 6), (X: 7; Y: 6), (X: 1; Y: 7), (X: 6; Y: 7));
165    worth: array [1 .. 4] of TPoint = ((X: 0; Y: 0), (X: 7; Y: 0), (X: 0; Y: 7),    worth: array [1 .. 4] of TPoint = ((X: 0; Y: 0), (X: 7; Y: 0), (X: 0; Y: 7),
166      (X: 7; Y: 7));      (X: 7; Y: 7));
167    label Last;
168      procedure Easy;
169      var
170        m, n: integer;
171      begin
172        for m := 0 to bmp_count - 1 do
173          for n := 0 to bmp_count - 1 do
174            if CanSetStone(Stone, m, n, false) = true then
175            begin
176              inc(Score);
177              inc(Score, AddScore(m, n, worth));
178            end;
179      end;
180      procedure Hard;
181      var
182        m, n: integer;
183      begin
184        if loop > 1 then
185          Exit;
186        inc(loop);
187        for m := 0 to bmp_count - 1 do
188          for n := 0 to bmp_count - 1 do
189          begin
190            if CanSetStone(Stone, m, n, true) = true then
191            begin
192              if (loop mod 2) > 0 then
193                inc(Score)
194              else
195                dec(Score);
196              case Stone of
197                stBlack:
198                  Stone := stWhite;
199                stWhite:
200                  Stone := stBlack;
201              end;
202              Hard;
203              if loop > 1 then
204              begin
205                Easy;
206                FStrings := FBuffer[FTurnIndex + loop];
207              end
208              else
209                FBuffer[FTurnIndex + loop] := FStrings;
210            end;
211          end;
212        dec(loop);
213      end;
214    
215  begin  begin
216    if CanSetStone(Stone, X, Y, true) = true then    if CanSetStone(Stone, X, Y, true) = true then
217    begin    begin
218      Score := 0;      Score := 0;
219      result := true;      result := true;
220      if FTurnIndex < 50 then      if FTurnIndex < 50 then
221        inc(Score, AddScore(X, Y, wast));        inc(Score, AddScore(X, Y, waste));
222      dec(Score, AddScore(X, Y, worth));      dec(Score, AddScore(X, Y, worth));
223      case Stone of      case Stone of
224        stBlack:        stBlack:
# Line 171  begin Line 226  begin
226        stWhite:        stWhite:
227          Stone := stBlack;          Stone := stBlack;
228      end;      end;
229      for i := 0 to bmp_count - 1 do      if (Form1.MenuItem14.IsChecked = true) and (FTurnIndex + 2 <= 60) then
230        for j := 0 to bmp_count - 1 do      begin
231          if CanSetStone(Stone, i, j, false) = true then        loop := 0;
232          begin        Hard;
233            inc(Score);      end
234            inc(Score, AddScore(i, j, worth));      else
235          end;        Easy;
236    end    end
237    else    else
238      result := false;      result := false;
# Line 309  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 332  begin Line 392  begin
392      result := false      result := false
393    else    else
394    begin    begin
395      i:=0;      i := 0;
396      while i < FList.Count do      while i < FList.Count do
397      begin      begin
398        s := FList[i];        s := FList[i];
# Line 350  begin Line 410  begin
410          inc(i);          inc(i);
411          continue;          continue;
412        end;        end;
413        FList[i]:=s;        FList[i] := s;
414        inc(i);        inc(i);
415      end;      end;
416      if FList.Count = 0 then      if FList.Count = 0 then
# Line 358  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 387  end; Line 448  end;
448    
449  procedure TStoneGrid.Paint(Canvas: TCanvas);  procedure TStoneGrid.Paint(Canvas: TCanvas);
450  var  var
451    k, m, n: integer;    k: integer;
452    s: TBitmap;    s: TBitmap;
453    p: TEffectData;    p: TEffectData;
454  begin  begin
   m := Form1.Image3.Bitmap.Width;  
   n := Form1.Image3.Bitmap.Height;  
455    k := Form1.Size;    k := Form1.Size;
456    if FEffectStone = stBlack then    if FEffectStone = stBlack then
457      s := Form1.Image1.Bitmap      s := Form1.Image1.Bitmap
# Line 400  begin Line 459  begin
459      s := Form1.Image2.Bitmap;      s := Form1.Image2.Bitmap;
460    for p in FList do    for p in FList do
461    begin    begin
462      Canvas.DrawBitmap(s, RectF(p.X * m, p.Y * n, (p.X + 1) * m, (p.Y + 1) * n),      Canvas.DrawBitmap(s, RectF(p.X * 50, p.Y * 50, (p.X + 1) * 50,
463        RectF(p.Left * k, p.Top * k, (p.Left + 1) * k, (p.Top + 1) * k), 1);        (p.Y + 1) * 50), RectF(p.Left * k, p.Top * k, (p.Left + 1) * k,
464          (p.Top + 1) * k), 1);
465    end;    end;
466  end;  end;
467    
# Line 426  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 453  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 481  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 497  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 515  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 534  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 545  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 557  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 599  begin Line 684  begin
684      begin      begin
685        case StoneGrid.Strings[i, j] of        case StoneGrid.Strings[i, j] of
686          stWhite:          stWhite:
687            Canvas.DrawBitmap(Image4.Bitmap, RectF(0, 0, Image4.Bitmap.Width,            Canvas.DrawBitmap(Image3.Bitmap, RectF(100, 0, 150, 50),
688              Image4.Bitmap.Height), RectF(i * Size, j * Size, (i + 1) * Size,              RectF(i * Size, j * Size, (i + 1) * Size, (j + 1) * Size), 1);
             (j + 1) * Size), 1);  
689          stBlack:          stBlack:
690            Canvas.DrawBitmap(Image3.Bitmap, RectF(0, 0, Image3.Bitmap.Width,            Canvas.DrawBitmap(Image3.Bitmap, RectF(50, 0, 100, 50),
691              Image3.Bitmap.Height), RectF(i * Size, j * Size, (i + 1) * Size,              RectF(i * Size, j * Size, (i + 1) * Size, (j + 1) * Size), 1);
             (j + 1) * Size), 1);  
692          stEffect:          stEffect:
693            continue;            continue;
694        else        else
695          Canvas.DrawBitmap(Image5.Bitmap, RectF(0, 0, Image5.Bitmap.Width,          Canvas.DrawBitmap(Image3.Bitmap, RectF(0, 0, 50, 50),
696            Image5.Bitmap.Height), RectF(i * Size, j * Size, (i + 1) * Size,            RectF(i * Size, j * Size, (i + 1) * Size, (j + 1) * Size), 1);
           (j + 1) * Size), 1);  
697        end;        end;
698        Canvas.DrawLine(PointF(0, j * Size), PointF(bmp_count * Size,        Canvas.DrawLine(PointF(0, j * Size), PointF(bmp_count * Size,
699          j * Size), 1);          j * Size), 1);
# Line 631  end; Line 713  end;
713    
714  procedure TForm1.FormCreate(Sender: TObject);  procedure TForm1.FormCreate(Sender: TObject);
715  begin  begin
716    ClientWidth := 50 * bmp_count;    ClientWidth := 400;
717    ClientHeight := 50 * bmp_count;    ClientHeight := 400;
718    StoneGrid := TStoneGrid.Create;    StoneGrid := TStoneGrid.Create;
719    StoneGrid.ImageCount(6, 5);    StoneGrid.ImageCount(6, 5);
720    Player1 := TPlayer.Create;    Player1 := TPlayer.Create;
# Line 685  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.33  
changed lines
  Added in v.38
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help