1.txt

有很多不足,需要在次修改!特别是算法和有点弱,要用需要好好考虑!

 
    
  unit   study;   
    
  interface   
    
  uses   
      Windows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms,   
      Dialogs,   ExtCtrls,   StdCtrls,   Grids,   Menus;   
    
  type   
      TMainform   =   class(TForm)   
          Panel1:   TPanel;   
          DrawGrid1:   TDrawGrid;   
          Timer1:   TTimer;   
          PopupMenu1:   TPopupMenu;   
          A1:   TMenuItem;   
          procedure   FormCreate(Sender:   TObject);   
          procedure   Timer1Timer(Sender:   TObject);   
          procedure   A1Click(Sender:   TObject);   
          procedure   DrawGrid1MouseDown(Sender:   TObject;   Button:   TMouseButton;   
              Shift:   TShiftState;   X,   Y:   Integer);   
          procedure   DrawGrid1DrawCell(Sender:   TObject;   ACol,   ARow:   Integer;   
              Rect:   TRect;   State:   TGridDrawState);   
    
    
      private   
          {   Private   declarations   }   
          Tag:array[0..18,0..18]of   integer;   
          {0   for   nome,1   for   black,2   for   while}   
          IsBlack:Boolean;   
      public   
          {   Public   declarations   }   
          MainDir:string[80];   
          function   IsWin(IsBlack:boolean):boolean;   
      end;   
    
  var   
      Mainform:   TMainform;   
    
  implementation   
    
  uses   about;   
    
  {$R   *.dfm}   
    
  function   Tmainform.IsWin(IsBlack:boolean):boolean;   
  label   exit1;   
  var   
      i,j:integer;   
      wtag:integer;   
  begin   
      IsWin:=false;   
      if   IsBlack   then   
          wtag:=1   else   
          wtag:=2;   
      for   i:=0   to   18   do   
          for   j:=0   to   14   do   
          begin   
              if   (i<15)       //是否有行连成   
              and(Tag[i,j]=wtag)   
              and(Tag[i+1,j]=wtag)   
              and(Tag[i+2,j]=wtag)   
              and(Tag[i+3,j]=wtag)   
              and(Tag[i+4,j]=wtag)   
              then   
              begin   
                  IsWin:=True;   
                  goto   exit1;   
              end;   
              if   (Tag[i,j]=wtag)         //是否有列连成   
              and(Tag[i,j+1]=wtag)   
              and(Tag[i,j+2]=wtag)   
              and(Tag[i,j+3]=wtag)   
              and(Tag[i,j+4]=wtag)   
              then   
              begin   
                  IsWin:=True;   
                  goto   exit1;   
              end;   
              if   (i<15)         //是否有主对角线连成   
              and(Tag[i,j]=wtag)   
              and(Tag[i+1,j+1]=wtag)   
              and(Tag[i+2,j+2]=wtag)   
              and(Tag[i+3,j+3]=wtag)   
              and(Tag[i+4,j+4]=wtag)   
              then   
              begin   
                  IsWin:=True;   
                  goto   exit1;   
              end;   
              if   (Tag[i,j]=wtag)         //是否有副对角线连成   
              and(Tag[i-1,j+1]=wtag)   
              and(Tag[i-2,j+2]=wtag)   
              and(Tag[i-3,j+3]=wtag)   
              and(Tag[i-4,j+4]=wtag)   
              then   
              begin   
                  IsWin:=True;   
                  goto   exit1;   
              end;   
          end;   
      exit1:   
  end;   
    
    
  procedure   Tmainform.FormCreate(Sender:   TObject);   
  var   
      i,j:integer;   
  begin   
      for   i:=0   to   18   do   
          for   j:=0   to   18   do   
          begin   
              Tag[i,j]:=0;   
          end;   
      IsBlack:=true;     //设置IsBlack初值，第一局黑棋先下   
      MainDir:=ExtractFilePath(ParamStr(0));     //获取程序路径   
  end;   
    
  procedure   TMainform.Timer1Timer(Sender:   TObject);   
  begin   
        case   Timer1.Tag   of   
          0:MainForm.Icon.LoadFromFile(MainDir+'Icon\'+'Face01.ico');   
          1:MainForm.Icon.LoadFromFile(MainDir+'Icon\'+'Face02.ico');   
          2:MainForm.Icon.LoadFromFile(MainDir+'Icon\'+'Face03.ico');   
          3:MainForm.Icon.LoadFromFile(MainDir+'Icon\'+'Face04.ico');   
        end;   
    
        if   Timer1.Tag>2   then   //更新图标   
          Timer1.Tag:=0   
        else   
          Timer1.Tag:=Timer1.Tag+1;   
  end;   
    
  procedure   TMainform.A1Click(Sender:   TObject);   
  begin   
          tabout.Show   ;   
  end;   
    
  procedure   TMainform.DrawGrid1MouseDown(Sender:   TObject;   
      Button:   TMouseButton;   Shift:   TShiftState;   X,   Y:   Integer);   
  var   
      col,row:integer;   
      i,j:integer;   
  begin   
      DrawGrid1.Canvas.Pen.Color   :=clBlack;     //设置画笔颜色   
      DrawGrid1.Canvas.Brush.Color   :=clBlack;     //设置画刷颜色   
      DrawGrid1.MouseToCell(x,y,col,row);       //绘制网格   
      if   tag[col,row]=0   then   
      begin   
          if   IsBlack   then   
          begin   
              DrawGrid1.Canvas.Ellipse(col*21,row*21,(col+1)*21,(row+1)*21);   
              tag[col,row]:=1;       //判断黑棋的标志   
          end   else   
          begin   
              DrawGrid1.Canvas.Arc(col*21,row*21,(col+1)*21,(row+1)*21,col*21,row*21,col*21,row*21);   
              tag[col,row]:=2;       //判断白棋的标志   
          end;   
          if   IsWin(IsBlack)   then   
          begin   
              if   IsBlack   then   
                  if   MessageDlg('   黑方胜利',mtInformation,[mbOK],0)=mrOK   then   
                  begin   
                      for   i:=0   to   18   do   
                          for   j:=0   to   18   do   
                          begin   
                              tag[i,j]:=0;   
                          end;   
                      DrawGrid1.Invalidate;     //网格初始化，下局白方先下   
                  end;   
              if   not   IsBlack   then   
                  if   MessageDlg('白方胜利',mtInformation,[mbOK],0)=mrOK   then   
                  begin   
                      for   i:=0   to   18   do   
                          for   j:=0   to   18   do   
                          begin   
                              tag[i,j]:=0;   
                          end;   
                      DrawGrid1.Invalidate;       //网格初始化   
                  end;   
              end;   
              IsBlack:=not   IsBlack;       //白方胜利则下局黑方先下   
          end;   
  end;   
    
  procedure   TMainform.DrawGrid1DrawCell(Sender:   TObject;   ACol,   ARow:   Integer;   
      Rect:   TRect;   State:   TGridDrawState);   
  begin   
      DrawGrid1.Canvas.Pen.Color   :=clBlack;     //设置画笔颜色   
      DrawGrid1.Canvas.Brush.Color   :=clBlack;     //设置画刷颜色   
      if   tag[acol,arow]=1   then   
          DrawGrid1.Canvas.Ellipse(acol*21,arow*21,(acol+1)*21,(arow+1)*21)   //绘制黑棋   
          else   if   tag[acol,arow]=2   then   
              DrawGrid1.Canvas.Arc(acol*21,arow*21,(acol+1)*21,(arow+1)*21,acol*21,arow*21,acol*21,arow*21)     //绘制白棋   
              else   
              begin   
                  DrawGrid1.Canvas.Pen.Color   :=clWhite;     //设置画笔颜色   
                  DrawGrid1.Canvas.Brush.Color   :=clWhite;     //设置画刷颜色   
                  DrawGrid1.Canvas.Ellipse(acol*21,arow*21,(acol+1)*21,(arow+1)*21);   
              end;   
  end;   
    
  end.
Top


    
  unit   Unit1;   
    
  interface   
    
  uses   
      Windows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms,   
      Dialogs,printers,   StdCtrls,   ExtCtrls,   Menus;   
    
  type   
      TForm1   =   class(TForm)   
          Button1:   TButton;   
          Button2:   TButton;   
          procedure   FormPaint(Sender:   TObject);   
          procedure   FormCreate(Sender:   TObject);   
          procedure   Button1Click(Sender:   TObject);   
          procedure   FormMouseDown(Sender:   TObject;   Button:   TMouseButton;   
              Shift:   TShiftState;   X,   Y:   Integer);   
      private   
          {   Private   declarations   }   
          function   hasWin(x,y:integer):integer;   
          function   threecount(x,y:integer):integer;   
      public   
          {   Public   declarations   }   
          loc:array[1..15,1..15]of   integer;   
          whocontrol:integer;//0   is   none,,,,1   is   black,,,,2   is   white;   
      end;   
    
  var   
      Form1:   TForm1;   
    
  implementation   
    
  {$R   *.dfm}   
    
  procedure   TForm1.FormPaint(Sender:   TObject);   
  var   
      i,j:integer;   
  begin   
      with   canvas   do   
      begin   
          Pen.Color:=clred;   
          Brush.Color:=color;   
          for   i:=1   to   15   do   
          begin   
              MoveTo(i*30,30);   
              LineTo(i*30,15*30);   
              TextOut(i*30-5,5,inttostr(i));   
              ////////////////////////////////////   
              MoveTo(30,i*30);   
              LineTo(15*30,i*30);   
              TextOut(5,i*30-5,inttostr(i));   
          end;   
          Brush.Color:=clred;   
          Ellipse(8*30-7,8*30-7,8*30+7,8*30+7);   
          for   i:=1   to   15   do   
              for   j:=1   to   15   do   
              begin   
                  if   loc[i,j]=1   then   
                  begin   
                      Pen.Color:=clblack;   
                      Brush.Color:=clblack;   
                      Ellipse(i*30-14,j*30-14,i*30+14,j*30+14);   
                  end   
                  else   if   loc[i,j]=2   then   
                  begin   
                      Pen.Color:=clwhite;   
                      Brush.Color:=clwhite;   
                      Ellipse(i*30-14,j*30-14,i*30+14,j*30+14);   
                  end;   
              end;   
      end;   
  end;   
    
  procedure   TForm1.FormCreate(Sender:   TObject);   
  begin   
      left:=(screen.Width-width)div   2;   
      top:=(screen.Height-height)div   2;   
      ////////////   
      self.Button1Click(sender);   
  end;   
    
  procedure   TForm1.Button1Click(Sender:   TObject);   
  var   
      i,j:integer;   
  begin   
      WhoControl:=1;//black;   
      for   i:=1   to   15   do   
          for   j:=1   to   15   do   
              loc[i,j]:=0;   
      self.Refresh;   
  end;   
    
  procedure   TForm1.FormMouseDown(Sender:   TObject;   Button:   TMouseButton;   
      Shift:   TShiftState;   X,   Y:   Integer);   
  var   
      i,j:integer;