unit1.pas

Delphi7编程80例(完全版)

{
这个程序是从下面的作者那里改进过来的。
Name: Priit Serk
Mail: [e-mail]
Homepage: http://www.hot.ee/serk
Living place: Riia 44-1 Tartu, ESTONIA}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons, Menus, ComCtrls, jpeg;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    MainMenu1: TMainMenu;
    Nupud1: TMenuItem;
    vdown1: TMenuItem;
    vup1: TMenuItem;
    computer: TTimer;
    ball: TRadioButton;
    Timer2: TTimer;
    Timer3: TTimer;
    Timer4: TTimer;
    Panel2: TPanel;
    Panel3: TPanel;
    pat1: TMenuItem;
    File1: TMenuItem;
    Timer1: TTimer;
    right1: TMenuItem;
    left1: TMenuItem;
    Eit1: TMenuItem;
    NewGame1: TMenuItem;
    a1: TMenuItem;
    z1: TMenuItem;
    TrackBar1: TTrackBar;
    Label1: TLabel;
    Timer5: TTimer;
    N1: TMenuItem;
    N2: TMenuItem;
    ColorDialog1: TColorDialog;
    N3: TMenuItem;
    ColorDialog2: TColorDialog;
    Label2: TLabel;
    Shape1: TShape;
    procedure vdown1Click(Sender: TObject);   //
    procedure vup1Click(Sender: TObject);     //
    procedure Timer2Timer(Sender: TObject);   //乒乓球右下移
    procedure Timer3Timer(Sender: TObject);   //乒乓球左上移
    procedure Timer5Timer(Sender: TObject);   //乒乓球右下移
    procedure Timer4Timer(Sender: TObject);   //乒乓球左上移
    procedure FormActivate(Sender: TObject);  //
    procedure vdown2Click(Sender: TObject);   //
    procedure les1Click(Sender: TObject);     //
    procedure computerTimer(Sender: TObject);  //
    procedure FormCreate(Sender: TObject);     //
    procedure pat1Click(Sender: TObject);      //
    procedure Timer1Timer(Sender: TObject);    //发球
    procedure right1Click(Sender: TObject);    //
    procedure left1Click(Sender: TObject);     //
    procedure NewGame1Click(Sender: TObject);  //
    procedure Eit1Click(Sender: TObject);      //
    procedure a1Click(Sender: TObject);        //
    procedure z1Click(Sender: TObject);        //
    procedure TrackBar1Change(Sender: TObject);//
    procedure N2Click(Sender: TObject);        //
    procedure N3Click(Sender: TObject);        //
  private
    { Private declarations }
  public
    { Public declarations }
  end;
                 
var
  Form1: TForm1;
  vleft,vdown,vup,right:boolean;        //检测小球的运移
  vasakult,paremalt:boolean;            //检测电脑的速度
  bspeed:integer;                       //显示小球的速度
  patspeed:real;                        //球拍的速度
  pat:boolean;                          //检测球拍
  moveup,movedown:boolean;              //向上，向下移动
  comspeed:real;                        //电脑的球拍
  ballspeed:integer;                    //小球的原始速度
  implementation

{$R *.DFM}
procedure TForm1.vdown1Click(Sender: TObject);
begin
vleft:=false;
vdown:=true;
vup:=false;
right:=false;
end;

procedure TForm1.vup1Click(Sender: TObject);
begin
vleft:=false;
vdown:=false;
vup:=true;
right:=false;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin      //乒乓球右下移
ball.left:=ball.left-ballspeed-trunc(patspeed);
ball.top:=ball.top+ballspeed+trunc(patspeed);

if patspeed>0 then patspeed:=patspeed-0.1;
if patspeed<0 then patspeed:=patspeed+0.1;

if ball.left>panel3.left+panel3.width then
 begin
   if ball.top+ball.height>panel1.height-ball.height then
   begin
   Timer2.enabled:=False;
   Timer5.enabled:=false;
   Timer4.enabled:=false;
   Timer3.enabled:=true;
   end;
 end;

if (ball.left<panel3.left+panel3.width+4)and(ball.left>panel3.left)and
(ball.top<panel3.top+panel3.height)and
(ball.top>panel3.top)  then
  begin
  if(movedown=false)and(moveup=false) then
  begin
  Timer5.enabled:=true;
  Timer2.enabled:=false;
  Timer3.enabled:=False;
  Timer4.enabled:=false;
  end;
  if moveup=true then
    begin
    Timer5.enabled:=false;
    Timer2.enabled:=false;
    Timer3.enabled:=False;
    Timer4.enabled:=true;
      end;
  if movedown=true then
  begin
   Timer5.enabled:=true;
   Timer2.enabled:=false;
   Timer3.enabled:=False;
   Timer4.enabled:=false;
  end;
  end;

end;

procedure TForm1.Timer3Timer(Sender: TObject);
begin   //乒乓球左上移
ball.left:=ball.left-ballspeed-trunc(patspeed);
ball.top:=ball.top-ballspeed-trunc(patspeed);

if patspeed>0 then
 patspeed:=patspeed-0.1;
if patspeed<0 then
 patspeed:=patspeed+0.1;
if ball.top<4 then
begin
   Timer2.enabled:=true ;
   Timer3.enabled:=False;
   Timer5.enabled:=false;
   Timer4.enabled:=false;
end;

if (ball.left<panel3.left+panel3.width+4)and(ball.left>panel3.left)and
   (ball.top<panel3.top+panel3.height)and(ball.top>panel3.top)  then
   begin
   if(movedown=false)and(moveup=false) then
   begin
   Timer2.enabled:=false;
   Timer3.enabled:=False;
   Timer5.enabled:=False;
   Timer4.enabled:=true;
   end;
if moveup=true then       //上移
begin
   Timer2.enabled:=false;
   Timer3.enabled:=False;
   Timer5.enabled:=False;
   Timer4.enabled:=true;
end;
if movedown=true then   //下移
begin
   Timer2.enabled:=false;
   Timer3.enabled:=False;
   Timer5.enabled:=true;
   Timer4.enabled:=false;
end;
end;
end;

procedure TForm1.Timer5Timer(Sender: TObject);
begin    //乒乓球右下移
ball.left:=ball.left+ballspeed+trunc(patspeed);
ball.top:=ball.top+ballspeed+trunc(patspeed);
if pat=false then
 begin
  if patspeed<0 then
   patspeed:=patspeed+0.05;
  if patspeed>0 then
   patspeed:=patspeed-0.1;
 end;
if pat=true then
 patspeed:=patspeed+0.05;

 if ball.top+ball.height>panel1.height-ball.height then
  begin
   Timer4.enabled:=true;
   Timer5.enabled:=false;
   Timer3.enabled:=falsE;
   Timer2.enabled:=falsE;
   end;

  //限制小球在panel1的范围内运动
 if(ball.left+ball.height>panel2.left)and
   (ball.top<panel2.top+panel2.height)and
   (ball.top>panel2.top)  then
   begin
   pat:=false;
   moveup:=falsE;
   movedown:=falsE;
   patspeed:=5;
   if pat=true then
    patspeed:=patspeed+5;

   Timer2.enabled:=true;
   Timer5.enabled:=False;
   Timer4.enabled:=False;
   Timer3.enabled:=false;
   end;
end;

procedure TForm1.Timer4Timer(Sender: TObject);
begin      //乒乓球左上移
ball.left:=ball.left+ballspeed+trunc(patspeed);
ball.top:=ball.top-ballspeed-trunc(patspeed);

if pat=true then
 patspeed:=patspeed+0.05;

if(ball.left+ball.width>panel2.left)and
(ball.top>panel2.top) then
   begin
   moveup:=falsE;
   movedown:=falsE;
   pat:=false;
   patspeed:=5;
   if pat=true then
    patspeed:=patspeed+5;
   Timer2.enabled:=false;
   Timer5.enabled:=False;
   Timer4.enabled:=False;
   Timer3.enabled:=true;
   end;
if ball.left<panel2.left then
begin
If ball.top<2 then
   begin
   Timer2.enabled:=false;
   Timer5.enabled:=true;
   Timer4.enabled:=False;
   Timer3.enabled:=false;
   end;
   end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin                             //程序运行时的相关设置
 vasakult:=false;
 paremalt:=false;
end;

procedure TForm1.vdown2Click(Sender: TObject);
begin
if panel3.top<form1.top+panel1.height then  //你的球拍下移
 panel3.top:=panel3.top+2;
end;

procedure TForm1.les1Click(Sender: TObject);
begin
if panel3.top>2 then       //你的球拍上移
 panel3.top:=panel3.top-2;
end;

procedure TForm1.computerTimer(Sender: TObject);
begin
if ball.left<0 then
begin                    //输球
   Timer2.enabled:=false;
   Timer5.enabled:=false;
   Timer4.enabled:=False;
   Timer3.enabled:=false;
   computer.enabled:=false;
   Timer1.enabled:=true;

end;

if ball.left+ball.width>panel1.width then
begin                     //输球
   Timer2.enabled:=false;
   Timer5.enabled:=false;
   Timer4.enabled:=False;
   Timer3.enabled:=false;
   computer.enabled:=false;
   Timer1.enabled:=true;
end;

if vleft=true then
begin
if panel3.left<shape1.left then
 panel3.left:=panel3.left+2;
end;

if right=true then
begin
if panel3.left>2 then
 panel3.left:=panel3.left-2;
end;

if vdown=true then
begin
 if panel3.top+panel3.height<panel1.height-25 then
  panel3.top:=panel3.top+4;
 end;

if vup=true then
begin
 if panel3.top>2 then
  panel3.top:=panel3.top-4;
 end;

if ball.left>shape1.left then
 begin
 if panel2.top+panel2.height div 2<ball.top then
 begin
 if panel2.top+panel2.height<panel1.height-25 then
  panel2.top:=panel2.top+4;
 end;

if (panel2.top+panel2.height div 2>ball.top) then
 begin
  if panel2.top>4 then
    panel2.top:=panel2.top-4;
 end;
end;
 bspeed:=4;
 bspeed:=bspeed+Trunc(patspeed);
 bspeed:=bspeed *10;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 ballspeed:=4;
 comspeed:=0;
 movedown:=false;
 moveup:=false;
 pat:=false;
 patspeed:=0;
 shape1.Brush.Color:=clblack; //拦网颜色
end;

procedure TForm1.pat1Click(Sender: TObject);
begin
if pat=false then
begin
 if(Timer2.enabled=true)or(Timer3.enabled=true) then
 begin
 pat:=true;
 Timer1.enabled:=true;
 end else
begin
 Timer1.enabled:=true;
end;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin    //发球
if computer.enabled=false then
begin
 patspeed:=0;
 pat:=false;
 ball.left:=form1.width div 2;
 ball.top:=random(form1.height);
 Timer3.enabled:=true;
 computer.enabled:=true;
end;
 Timer1.enabled:=false;
end;

procedure TForm1.Left1Click(Sender: TObject);
begin
 vleft:=false;
 vdown:=false;
 vup:=false;
 right:=true;
end;

procedure TForm1.right1Click(Sender: TObject);
begin
 vleft:=true;
 vdown:=false;
 vup:=false;
 right:=false;
end;

procedure TForm1.NewGame1Click(Sender: TObject);
begin
 patspeed:=0;
 pat:=false;
 ball.left:=panel2.left;
 ball.top:=panel2.top+panel2.height div 2;
 Timer3.enabled:=true;
 computer.enabled:=true;
end;

procedure TForm1.Eit1Click(Sender: TObject);
begin
   //关闭所有时钟，然后退出程序
 Timer1.Enabled:=False;
 Timer2.Enabled:=False;
 Timer3.Enabled:=False;
 Timer4.Enabled:=False;
 Timer5.Enabled:=False;
 computer.Enabled:=False;
 Application.Terminate; //终止程序
 end;

procedure TForm1.a1Click(Sender: TObject);
begin         //上下移动切换
 moveup:=true;
 movedown:=false;
end;

procedure TForm1.z1Click(Sender: TObject);
begin        //上下移动切换
 moveup:=false;
 movedown:=true;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
 ballspeed:=trackbar1.Position;     //乒乓球的运动速度
end;

procedure TForm1.N2Click(Sender: TObject);
begin
If ColorDialog1.Execute Then      //更换球台背景
 Begin
 ball.Color:=ColorDialog1.Color;
 Panel1.Color:=ColorDialog1.Color;
 end;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
If ColorDialog2.Execute Then  //更换球拍颜色
 Begin
  Panel2.Color:=ColorDialog2.Color;
  Panel3.Color:=ColorDialog2.Color;
  Shape1.Brush.Color:=ColorDialog2.Color;
 end;
end;

end.