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 37 by yamat0jp, Sun Aug 30 08:32:57 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 > 1 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              if (loop mod 2) > 0 then
188                inc(Score)
189              else
190                dec(Score);
191              case Stone of
192                stBlack:
193                  Stone := stWhite;
194                stWhite:
195                  Stone := stBlack;
196              end;
197              Hard;
198              if loop > 1 then
199              begin
200                Easy;
201                FStrings := FBuffer[FTurnIndex + loop];
202              end
203              else
204                FBuffer[FTurnIndex + loop] := FStrings;
205            end;
206          end;
207        dec(loop);
208      end;
209    
210  begin  begin
211    if CanSetStone(Stone, X, Y, true) = true then    if CanSetStone(Stone, X, Y, true) = true then
212    begin    begin
213      Score := 0;      Score := 0;
214      result := true;      result := true;
215      if FTurnIndex < 50 then      if FTurnIndex < 50 then
216        inc(Score, AddScore(X, Y, wast));        inc(Score, AddScore(X, Y, waste));
217      dec(Score, AddScore(X, Y, worth));      dec(Score, AddScore(X, Y, worth));
218      case Stone of      case Stone of
219        stBlack:        stBlack:
# Line 171  begin Line 221  begin
221        stWhite:        stWhite:
222          Stone := stBlack;          Stone := stBlack;
223      end;      end;
224      for i := 0 to bmp_count - 1 do      if (Form1.MenuItem14.IsChecked = true) and (FTurnIndex + 2 <= 60) then
225        for j := 0 to bmp_count - 1 do      begin
226          if CanSetStone(Stone, i, j, false) = true then        loop := 0;
227          begin        Hard;
228            inc(Score);      end
229            inc(Score, AddScore(i, j, worth));      else
230          end;        Easy;
231    end    end
232    else    else
233      result := false;      result := false;
# Line 332  begin Line 382  begin
382      result := false      result := false
383    else    else
384    begin    begin
385      i:=0;      i := 0;
386      while i < FList.Count do      while i < FList.Count do
387      begin      begin
388        s := FList[i];        s := FList[i];
# Line 350  begin Line 400  begin
400          inc(i);          inc(i);
401          continue;          continue;
402        end;        end;
403        FList[i]:=s;        FList[i] := s;
404        inc(i);        inc(i);
405      end;      end;
406      if FList.Count = 0 then      if FList.Count = 0 then
# Line 387  end; Line 437  end;
437    
438  procedure TStoneGrid.Paint(Canvas: TCanvas);  procedure TStoneGrid.Paint(Canvas: TCanvas);
439  var  var
440    k, m, n: integer;    k: integer;
441    s: TBitmap;    s: TBitmap;
442    p: TEffectData;    p: TEffectData;
443  begin  begin
   m := Form1.Image3.Bitmap.Width;  
   n := Form1.Image3.Bitmap.Height;  
444    k := Form1.Size;    k := Form1.Size;
445    if FEffectStone = stBlack then    if FEffectStone = stBlack then
446      s := Form1.Image1.Bitmap      s := Form1.Image1.Bitmap
# Line 400  begin Line 448  begin
448      s := Form1.Image2.Bitmap;      s := Form1.Image2.Bitmap;
449    for p in FList do    for p in FList do
450    begin    begin
451      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,
452        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,
453          (p.Top + 1) * k), 1);
454    end;    end;
455  end;  end;
456    
# Line 599  begin Line 648  begin
648      begin      begin
649        case StoneGrid.Strings[i, j] of        case StoneGrid.Strings[i, j] of
650          stWhite:          stWhite:
651            Canvas.DrawBitmap(Image4.Bitmap, RectF(0, 0, Image4.Bitmap.Width,            Canvas.DrawBitmap(Image3.Bitmap, RectF(100, 0, 150, 50),
652              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);  
653          stBlack:          stBlack:
654            Canvas.DrawBitmap(Image3.Bitmap, RectF(0, 0, Image3.Bitmap.Width,            Canvas.DrawBitmap(Image3.Bitmap, RectF(50, 0, 100, 50),
655              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);  
656          stEffect:          stEffect:
657            continue;            continue;
658        else        else
659          Canvas.DrawBitmap(Image5.Bitmap, RectF(0, 0, Image5.Bitmap.Width,          Canvas.DrawBitmap(Image3.Bitmap, RectF(0, 0, 50, 50),
660            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);  
661        end;        end;
662        Canvas.DrawLine(PointF(0, j * Size), PointF(bmp_count * Size,        Canvas.DrawLine(PointF(0, j * Size), PointF(bmp_count * Size,
663          j * Size), 1);          j * Size), 1);
# Line 631  end; Line 677  end;
677    
678  procedure TForm1.FormCreate(Sender: TObject);  procedure TForm1.FormCreate(Sender: TObject);
679  begin  begin
680    ClientWidth := 50 * bmp_count;    ClientWidth := 400;
681    ClientHeight := 50 * bmp_count;    ClientHeight := 400;
682    StoneGrid := TStoneGrid.Create;    StoneGrid := TStoneGrid.Create;
683    StoneGrid.ImageCount(6, 5);    StoneGrid.ImageCount(6, 5);
684    Player1 := TPlayer.Create;    Player1 := TPlayer.Create;
Legend:
Removed from v.33  
changed lines
  Added in v.37
Back to OSDN">Back to OSDN
 ViewVC Help
Powered by ViewVC 1.1.26  
About OSDN
Find Software
Develop Software
Help