Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

 
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 19.11.2013, 12:54
smile741 smile741 вне форума
Прохожий
 
Регистрация: 26.10.2013
Сообщения: 1
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Помощь с алгоритмом крестиков-ноликов

Добрый день! Мучаюсь с непониманием алгоритма игры, а именно с функцией NewNolik. Переменные в коде названы не были, а интуитивно понять не выходит, имхо. Можете ли помоч с объяснением алгоритма?
Программа написана на Delphi, WinAPI. Константа C_CC обозначает размер поля.
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, XPMan;

type
  TForm1 = class(TForm)
    Image1: TImage;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    XPManifest1: TXPManifest;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  C_CellWH = 60; // толщина пера
  C_CC = 5; // колво клеток

type
  TKrestikNolik = (knKrestik,knNolik); //
  TGorVertDiag = (gvGor,gvVert,gvD1,gvD2,gvAll); // 
  TPole = array [0..C_CC-1] of array [0..C_CC-1] of Byte;

var
  Form1: TForm1;
  Pl: TPole;

procedure PaintKN(S:TKrestikNolik; CellX,CellY:byte);
function isYes(var P:TPole):byte;
function RandomNolik(var P:TPole; N:TGorVertDiag; K:byte):Boolean;
function NewNolik(var P:TPole; prevX,prevY:byte):byte;
procedure NewGame;

implementation

{$R *.dfm}
//
procedure PaintKN(S:TKrestikNolik; CellX,CellY:byte);
begin
 Form1.Image1.Canvas.Pen.Width:=8;   // толщина пера
 Case S of
  knKrestik: begin
              Form1.Image1.Canvas.Pen.Color:=clRed;
              Form1.Image1.Canvas.MoveTo( (C_CellWH div 8) + CellX*C_CellWH,
                                          (C_CellWH div 8) + CellY*C_CellWH );
              Form1.Image1.Canvas.LineTo( 7*(C_CellWH div 8) + CellX*C_CellWH,
                                          7*(C_CellWH div 8) + CellY*C_CellWH );
              Form1.Image1.Canvas.MoveTo( (C_CellWH div 8) + CellX*C_CellWH,
                                          7*(C_CellWH div 8) + CellY*C_CellWH );
              Form1.Image1.Canvas.LineTo( 7*(C_CellWH div 8) + CellX*C_CellWH,
                                          (C_CellWH div 8) + CellY*C_CellWH );
             end;
  knNolik: begin
            Form1.Image1.Canvas.Pen.Color:=clBlue;
            Form1.Image1.Canvas.Brush.Style:=bsClear;
            Form1.Image1.Canvas.Ellipse( (C_CellWH div 8) + CellX*C_CellWH,
                                         (C_CellWH div 8) + CellY*C_CellWH,
                                          7*(C_CellWH div 8) + CellX*C_CellWH,
                                          7*(C_CellWH div 8) + CellY*C_CellWH  );
           end;
 End;
 
end;

function isYes(var P:TPole):byte;
var i,j:byte; A:Boolean; k,n:byte;
begin
 // проверяем гл диоганаль
 k:=0; n:=0;
 for i:=0 to C_CC-1 do
 if p[i,i] = 1 then Inc(k) else if p[i,i] = 2 then Inc(n);
 if k = C_CC then begin Result:=1; Exit; end;
 if n = C_CC then begin Result:=2; Exit; end;
 // пров вторую диагональ
 k:=0; n:=0;
 for i:=0 to C_CC-1 do
 if p[i,C_CC-1-i] = 1 then Inc(k) else if p[i,C_CC-1-i] = 2 then Inc(n);
 if k = C_CC then begin Result:=1; Exit; end;
 if n = C_CC then begin Result:=2; Exit; end;
 for i:=0 to C_CC-1 do
  begin
   // вертикаль
   k:=0; n:=0;
   for j:=0 to C_CC-1 do
   if p[i,j] = 1 then Inc(k) else if p[i,j] = 2 then Inc(n);
   if k = C_CC then begin Result:=1; Exit; end;
   if n = C_CC then begin Result:=2; Exit; end;
   // горизонталь
   k:=0; n:=0;
   for j:=0 to C_CC-1 do
   if p[j,i] = 1 then Inc(k) else if p[j,i] = 2 then Inc(n);
   if k = C_CC then begin Result:=1; Exit; end;
   if n = C_CC then begin Result:=2; Exit; end;
  end;
 // занятость всех клеток
 A:=false;
 for i:=0 to C_CC-1 do
  begin
   for j:=0 to C_CC-1 do
   if P[i,j] = 0 then begin A:=true; Break; end;
   if A then Break;
  end;
 if not A then begin Result:=3; Exit; end;
 Result:=0;
end;

function RandomNolik(var P:TPole; N:TGorVertDiag; K:byte):Boolean;
var i,j:byte;
begin
Result:=False;
 if N = gvAll then
  begin
   if P[0,0] = 0 then
    begin
     P[0,0]:=2;
     PaintKN(knNolik,0,0);
     Result:=True; Exit;
    end;
   if P[C_CC-1,C_CC-1] = 0 then
    begin
     P[C_CC-1,C_CC-1]:=2;
     PaintKN(knNolik,C_CC-1,C_CC-1);
     Result:=True; Exit;
    end;
   if P[0,C_CC-1] = 0 then
    begin
     P[0,C_CC-1]:=2;
     PaintKN(knNolik,0,C_CC-1);
     Result:=True; Exit;
    end;
   if P[C_CC-1,0] = 0 then
    begin
     P[C_CC-1,0]:=2;
     PaintKN(knNolik,C_CC-1,0);
     Result:=True; Exit;
    end;
    for i:=0 to C_CC-1 do
    for j:=0 to C_CC-1 do
     if P[i,j] = 0 then
      begin
       P[i,j]:=2;
       PaintKN(knNolik,i,j);
       Result:=True; Exit;
      end;
  end;
 for i:=0 to C_CC-1 do
  begin
   Case N of
    gvGor: begin
            if P[i,K] = 0 then
             begin
              P[i,K] := 2;
              PaintKN(knNolik,i,K);
              Result:=True;
              Exit;
             end else Result:=False;
           end;
    gvVert: begin
             if P[K,i] = 0 then
             begin
              P[K,i] := 2;
              PaintKN(knNolik,K,i);
              Result:=True;
              Exit;
             end else Result:=False;
            end;
    gvD1: begin
           if P[i,i] = 0 then
            begin
             P[i,i] := 2;
             PaintKN(knNolik,i,i);
             Result:=True;
             Exit;
            end else Result:=False;
           end;
    gvD2: begin
           if P[i,C_CC-1-i] = 0 then
            begin
             P[i,C_CC-1-i] := 2;
             PaintKN(knNolik,i,C_CC-1-i);
             Result:=True;
             Exit;
            end else Result:=False;
          end;
   End;
  end;
end;

function NewNolik(var P:TPole; prevX,prevY:byte):byte;
var i,j,n:byte; KG,KV,KD1,KD2,NG,NV,ND1,ND2,RN:Boolean;
    vinX,vinY:byte;
begin
 Result:=0;
 i:=isYes(P);
 if i in [1,3] then begin Result:=i; Exit; end;
 KG:=False; KV:=False; KD1:=False; KD2:=False;
 NG:=False; NV:=False; ND1:=False; ND2:=False;
 RN:=False;
 // Анализ
 for i:=0 to C_CC-1 do
  begin
   if i <> prevX then
    Case P[i,prevY] of
     1: KG:=True;
     2: NG:=True;
    end;
   if i <> prevY then
    Case P[prevX,i] of
     1: KV:=True;
     2: NV:=True;
    end;
  end;
 if prevX = prevY then
  for i:=0 to C_CC-1 do
   if i <> prevX then
    Case P[i,i] of
     1: KD1:=True;
     2: ND1:=True;
    end;
 if prevX + prevY = C_CC-1 then
  for i:=0 to C_CC-1 do
   if i <> prevX then
    Case P[i,C_CC-1-i] of
     1: KD2:=True;
     2: ND2:=True;
    end;
 vinX:=255; vinY:=255;
 for i:=0 to C_CC-1 do
  begin
   n:=0;
   for j:=0 to C_CC-1 do if P[i,j] = 2 then Inc(n);
   if n = C_CC-1 then
    begin
     for j:=0 to C_CC-1 do if P[i,j] = 0 then begin VinY:=j; VinX:=i; Break; end;
     if (VinX <> 255) and (VinY <> 255) then Break;
    end;
   n:=0;
   for j:=0 to C_CC-1 do if P[j,i] = 2 then Inc(n);
   if n = C_CC-1 then
    begin
     for j:=0 to C_CC-1 do if P[j,i] = 0 then begin VinY:=i; VinX:=j; Break; end;
     if (VinX <> 255) and (VinY <> 255) then Break;
    end;
  end;
 // выбор решения
 while True do
  begin
   if (VinX <> 255) and (VinY <> 255) then
    begin
     P[VinX,VinY]:=2;
     PaintKN(knNolik,VinX,VinY);
     RN:=true;
    end;
   if RN then Break; 
   if KG and not NG then RN := RandomNolik(P,gvGor,prevY);
   if RN then Break;
   if KV and not NV then RN := RandomNolik(P,gvVert,prevX);
   if RN then Break;
   if KD1 and not ND1 then RN := RandomNolik(P,gvD1,0);
   if RN then Break;
   if KD2 and not ND2 then RN := RandomNolik(P,gvD2,0);
   if RN then Break;
   RandomNolik(P,gvAll,0);
   Break;
  end;
 i:=isYes(P);
 if i in [2,3] then begin Result:=i; Exit; end;
end;

procedure NewGame;
var i:integer;
begin
 Form1.Image1.Picture:=nil;
 Form1.Image1.Canvas.Pen.Color:=clBlack;
 for i:=1 to C_CC-1 do
  begin
   Form1.Image1.Canvas.MoveTo(C_CellWH*i,0);
   Form1.Image1.Canvas.LineTo(C_CellWH*i,Form1.Image1.Height);
   Form1.Image1.Canvas.MoveTo(0,C_CellWH*i);
   Form1.Image1.Canvas.LineTo(Form1.Image1.Width,C_CellWH*i);
  end;
 FillChar(Pl,SizeOf(pl),0);
end;

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
 Form1.ClientHeight:=C_CellWH*C_CC;
 Form1.ClientWidth:=Form1.ClientHeight;      // C_CellWH*C_CC
 Image1.ClientWidth:=Form1.ClientWidth;
 Image1.ClientHeight:=Image1.ClientWidth;  //Form1.ClientHeight
 Image1.Picture:=nil;
 Image1.Canvas.Pen.Color:=clBlack;
 for i:=1 to C_CC-1 do
  begin
   Image1.Canvas.MoveTo(C_CellWH*i,0);
   Image1.Canvas.LineTo(C_CellWH*i,Image1.Height);
   Image1.Canvas.MoveTo(0,C_CellWH*i);
   Image1.Canvas.LineTo(Image1.Width,C_CellWH*i);
  end;
 FillChar(Pl,SizeOf(pl),0);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var Mess:String;
begin
 if Button in [mbRight,mbMiddle] then Exit;
 if Pl[(X div C_CellWH), (Y div C_CellWH)] <> 0 then Exit;
 PaintKN(knKrestik,(X div C_CellWH), (Y div C_CellWH));
 Pl[(X div C_CellWH),(Y div C_CellWH)]:=1;
 Case NewNolik(Pl,(X div C_CellWH),(Y div C_CellWH)) of
  0: Mess:='';
  1: Mess:='Крестики выиграли!';
  2: Mess:='Нолики выиграли!';
  3: Mess:='Ничья';
 End;
 if Mess <> '' then
  Case MessageDlg(Mess+#13#10+'Хотите сыграть ещё раз?',mtConfirmation,[mbYes, mbNo, mbCancel],0) of
   mrYes: NewGame;
   mrNo: Application.Terminate;
  End;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
 NewGame;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
 Application.Terminate;
end;

end.
Вложения
Тип файла: rar xo.rar (13.4 Кбайт, 3 просмотров)

Последний раз редактировалось smile741, 19.11.2013 в 12:57.
Ответить с цитированием
 


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 03:37.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025