moveball.pas.~1~

《Delphi 2005程序设计及其应用开发》源代码

unit moveball;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Timer1: TTimer;
    Shape1: TShape;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    RedItem: TMenuItem;
    YellowItem: TMenuItem;
    GreenItem: TMenuItem;
    RectangleItem: TMenuItem;
    EllipseItem: TMenuItem;
    SquareItem: TMenuItem;
    CircleItem: TMenuItem;
    RoundSquare: TMenuItem;
    RoundRect: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RedItemClick(Sender: TObject);
    procedure YellowItemClick(Sender: TObject);
    procedure GreenItemClick(Sender: TObject);
    procedure CircleItemClick(Sender: TObject);
    procedure RectangleItemClick(Sender: TObject);
    procedure EllipseItemClick(Sender: TObject);
    procedure SquareItemClick(Sender: TObject);
    procedure RoundSquareClick(Sender: TObject);
    procedure RoundRectClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  bUp, bRight : Boolean;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   if bUp then
      Shape1.Top := Shape1.Top -5
   else
      Shape1.Top := Shape1.Top +5;
   if bRight then
      Shape1.Left := Shape1.Left +5
   else
      Shape1.Left := Shape1.Left -5;
   if Shape1.Top +Shape1.Height >= Panel1.Height then
      bUp := True;
   if Shape1.Top <= 0 then
      bUp := False;
   if Shape1.Left +Shape1.Width >= Panel1.Width then
      bRight := False;
   if Shape1.Left  <= 0 then
      bRight := True;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   bUp := False;
   bRight := True;
end;

procedure TForm1.RedItemClick(Sender: TObject);
begin
   Shape1.Brush.Color := clRed; //设置TShape组件的填充色为红色
end;

procedure TForm1.YellowItemClick(Sender: TObject);
begin
   Shape1.Brush.Color := clyellow; //设置TShape组件的填充色为黄色
end;

procedure TForm1.GreenItemClick(Sender: TObject);
begin
   Shape1.Brush.Color := clGreen; //设置TShape组件的填充色为绿色
end;

procedure TForm1.CircleItemClick(Sender: TObject);
begin
   Shape1.Shape := stCircle;     //设置TShape组件的形状为圆形
end;

procedure TForm1.RectangleItemClick(Sender: TObject);
begin
   Shape1.Shape := stRectangle;     //设置TShape组件的形状为矩形
end;

procedure TForm1.EllipseItemClick(Sender: TObject);
begin
   Shape1.Shape := stEllipse;     //设置TShape组件的形状为椭圆形
end;

procedure TForm1.SquareItemClick(Sender: TObject);
begin
   Shape1.Shape := stSquare;     //设置TShape组件的形状为正方形
end;

procedure TForm1.RoundSquareClick(Sender: TObject);
begin
   Shape1.Shape := stRoundSquare;     //设置TShape组件的形状为圆角正方形
end;

procedure TForm1.RoundRectClick(Sender: TObject);
begin
   Shape1.Shape := stRoundRect;     //设置TShape组件的形状为圆角矩形
end;

end.