⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.~pas

📁 些源程序给我们介绍了,Delphi编程的一些基础知识,看看用Delphi编程是一件多么简单的事情.
💻 ~PAS
字号:
unit Main;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    DrawGrid1: TDrawGrid;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    yy1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure DrawGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    tag:array[0..18,0..18]of integer;
    {0 for none,1 for black,2 for white}
    ISBlack:boolean;
  public
    { Public declarations }
    MainDir:String[80];
    function IsWin(IsBlack:boolean):boolean;
  end;

var
  Form1: TForm1;
 implementation

{$R *.dfm}

function TForm1.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 TForm1.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;
 MainDir:=ExtractFilePath(ParamStr(0));
 end;



procedure TForm1.Timer1Timer(Sender: TObject);
begin
     case Timer1.Tag of
     0 : Form1.Icon.LoadFromFile(MainDir+'Icon\'+'Face01.ico');
     1 : Form1.Icon.LoadFromFile(MainDir+'Icon\'+'Face02.ico');
     2 : Form1.Icon.LoadFromFile(MainDir+'Icon\'+'Face03.ico');
     3 : Form1.Icon.LoadFromFile(MainDir+'Icon\'+'Face04.ico');
     end;

     if Timer1.Tag >2 then
     Timer1.Tag :=0
     else
     Timer1.Tag:=Timer1.Tag+1;
end;

procedure TForm1.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,acol*21,(acol+1)*21,acol*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+1)*21,(arow+1)*21)
     else
      DrawGrid1.Canvas.Pen.Color:=clWhite;
      DrawGrid1.Canvas.Brush.Color:=clWhite;
      DrawGrid1.Canvas.Ellipse(acol*21,acol*21,(acol+1)*21,acol*21);

end;

procedure TForm1.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;



end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -