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 35 by yamat0jp, Tue Aug 25 06:02:25 2015 UTC
# Line 91  type Line 91  type
91      Image1: TImage;      Image1: TImage;
92      Image2: TImage;      Image2: TImage;
93      Image3: TImage;      Image3: TImage;
94      Image4: TImage;      MenuItem13: TMenuItem;
95      Image5: TImage;      MenuItem14: TMenuItem;
96        MenuItem15: TMenuItem;
97      procedure FormCreate(Sender: TObject);      procedure FormCreate(Sender: TObject);
98      procedure FormDestroy(Sender: TObject);      procedure FormDestroy(Sender: TObject);
99      procedure Timer1Timer(Sender: TObject);      procedure Timer1Timer(Sender: TObject);
# Line 151  function TStoneGrid.CalScore(Stone: TSto Line 152  function TStoneGrid.CalScore(Stone: TSto
152    out Score: integer): Boolean;    out Score: integer): Boolean;
153  var  var
154    i, j: integer;    i, j: integer;
155      loop: integer;
156  const  const
157    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),
158      (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;
159      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));
160    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),
161      (X: 7; Y: 7));      (X: 7; Y: 7));
162    label Last;
163      procedure Easy;
164      var
165        m, n: integer;
166      begin
167        for m := 0 to bmp_count - 1 do
168          for n := 0 to bmp_count - 1 do
169            if CanSetStone(Stone, m, n, false) = true then
170            begin
171              inc(Score);
172              inc(Score, AddScore(m, n, worth));
173            end;
174      end;
175      procedure Hard;
176      var
177        m, n: integer;
178      begin
179        if loop > 2 then
180          Exit;
181        inc(loop);
182        for m := 0 to bmp_count - 1 do
183          for n := 0 to bmp_count - 1 do
184          begin
185            if CanSetStone(Stone, m, n, true) = true then
186            begin
187              inc(Score, AddScore(m, n, worth));
188              if FTurnIndex + 1 < 50 then
189                dec(Score, AddScore(m, n, waste));
190              case Stone of
191                stBlack:
192                  Stone := stWhite;
193                stWhite:
194                  Stone := stBlack;
195              end;
196              Hard;
197              Easy;
198            end;
199            FStrings := FBuffer[FTurnIndex + loop];
200          end;
201      end;
202    
203  begin  begin
204    if CanSetStone(Stone, X, Y, true) = true then    if CanSetStone(Stone, X, Y, true) = true then
205    begin    begin
206      Score := 0;      Score := 0;
207      result := true;      result := true;
208      if FTurnIndex < 50 then      if FTurnIndex < 50 then
209        inc(Score, AddScore(X, Y, wast));        inc(Score, AddScore(X, Y, waste));
210      dec(Score, AddScore(X, Y, worth));      dec(Score, AddScore(X, Y, worth));
211      case Stone of      case Stone of
212        stBlack:        stBlack:
# Line 171  begin Line 214  begin
214        stWhite:        stWhite:
215          Stone := stBlack;          Stone := stBlack;
216      end;      end;
217      for i := 0 to bmp_count - 1 do      if (Form1.MenuItem14.IsChecked = true) and (FTurnIndex + 1 <= 60) then
218        for j := 0 to bmp_count - 1 do      begin
219          if CanSetStone(Stone, i, j, false) = true then        FBuffer[FTurnIndex + 1] := FStrings;
220          begin        loop := 0;
221            inc(Score);        Hard;
222            inc(Score, AddScore(i, j, worth));      end;
223          end;      Easy;
224    end    end
225    else    else
226      result := false;      result := false;
# Line 332  begin Line 375  begin
375      result := false      result := false
376    else    else
377    begin    begin
378      i:=0;      i := 0;
379      while i < FList.Count do      while i < FList.Count do
380      begin      begin
381        s := FList[i];        s := FList[i];
# Line 350  begin Line 393  begin
393          inc(i);          inc(i);
394          continue;          continue;
395        end;        end;
396        FList[i]:=s;        FList[i] := s;
397        inc(i);        inc(i);
398      end;      end;
399      if FList.Count = 0 then      if FList.Count = 0 then
# Line 387  end; Line 430  end;
430    
431  procedure TStoneGrid.Paint(Canvas: TCanvas);  procedure TStoneGrid.Paint(Canvas: TCanvas);
432  var  var
433    k, m, n: integer;    k: integer;
434    s: TBitmap;    s: TBitmap;
435    p: TEffectData;    p: TEffectData;
436  begin  begin
   m := Form1.Image3.Bitmap.Width;  
   n := Form1.Image3.Bitmap.Height;  
437    k := Form1.Size;    k := Form1.Size;
438    if FEffectStone = stBlack then    if FEffectStone = stBlack then
439      s := Form1.Image1.Bitmap      s := Form1.Image1.Bitmap
# Line 400  begin Line 441  begin
441      s := Form1.Image2.Bitmap;      s := Form1.Image2.Bitmap;
442    for p in FList do    for p in FList do
443    begin    begin
444      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,
445        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,
446          (p.Top + 1) * k), 1);
447    end;    end;
448  end;  end;
449    
# Line 599  begin Line 641  begin
641      begin      begin
642        case StoneGrid.Strings[i, j] of        case StoneGrid.Strings[i, j] of
643          stWhite:          stWhite:
644            Canvas.DrawBitmap(Image4.Bitmap, RectF(0, 0, Image4.Bitmap.Width,            Canvas.DrawBitmap(Image3.Bitmap, RectF(100, 0, 150, 50),
645              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);  
646          stBlack:          stBlack:
647            Canvas.DrawBitmap(Image3.Bitmap, RectF(0, 0, Image3.Bitmap.Width,            Canvas.DrawBitmap(Image3.Bitmap, RectF(50, 0, 100, 50),
648              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);  
649          stEffect:          stEffect:
650            continue;            continue;
651        else        else
652          Canvas.DrawBitmap(Image5.Bitmap, RectF(0, 0, Image5.Bitmap.Width,          Canvas.DrawBitmap(Image3.Bitmap, RectF(0, 0, 50, 50),
653            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);  
654        end;        end;
655        Canvas.DrawLine(PointF(0, j * Size), PointF(bmp_count * Size,        Canvas.DrawLine(PointF(0, j * Size), PointF(bmp_count * Size,
656          j * Size), 1);          j * Size), 1);
# Line 631  end; Line 670  end;
670    
671  procedure TForm1.FormCreate(Sender: TObject);  procedure TForm1.FormCreate(Sender: TObject);
672  begin  begin
673    ClientWidth := 50 * bmp_count;    ClientWidth := 400;
674    ClientHeight := 50 * bmp_count;    ClientHeight := 400;
675    StoneGrid := TStoneGrid.Create;    StoneGrid := TStoneGrid.Create;
676    StoneGrid.ImageCount(6, 5);    StoneGrid.ImageCount(6, 5);
677    Player1 := TPlayer.Create;    Player1 := TPlayer.Create;
Legend:
Removed from v.33  
changed lines
  Added in v.35
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help