Blame lazarus/scroller/unit1.pas

24449f
unit Unit1;
24449f
24449f
{$mode objfpc}{$H+}
24449f
24449f
interface
24449f
24449f
uses
24449f
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
24449f
  StdCtrls;
24449f
24449f
type
24449f
24449f
  { TForm1 }
24449f
24449f
  TForm1 = class(TForm)
24449f
    Label1: TLabel;
24449f
    Label2: TLabel;
24449f
    Timer1: TTimer;
24449f
    procedure FormCreate(Sender: TObject);
24449f
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
24449f
    procedure Timer1Timer(Sender: TObject);
24449f
  private
24449f
    { private declarations }
24449f
  public
24449f
    { public declarations }
24449f
  end;
24449f
24449f
const
24449f
  count = 20;
24449f
  speed = 10;
24449f
  br = 10;
24449f
  pr = 20;
24449f
24449f
var
24449f
  Form1: TForm1;
24449f
  score: integer;
24449f
  maxScore: integer;
24449f
  px, py: integer;
24449f
  bx, by: array[0..count] of integer;
24449f
24449f
implementation
24449f
24449f
{$R *.lfm}
24449f
24449f
procedure DrawPlayer(clear: boolean);
24449f
begin
24449f
  Form1.Canvas.Pen.Style := psClear;
24449f
  Form1.Canvas.Brush.Color := clBlue;
24449f
  if clear then Form1.Canvas.Brush.Color := Form1.Color;
24449f
  Form1.Canvas.Ellipse(px-pr, py-pr, px+pr, py+pr);
24449f
end;
24449f
24449f
procedure DrawBall(clear: boolean; i: integer);
24449f
begin
24449f
  Form1.Canvas.Pen.Style := psClear;
24449f
  Form1.Canvas.Brush.Color := clBlack;
24449f
  if clear then Form1.Canvas.Brush.Color := Form1.Color;
24449f
  Form1.Canvas.Ellipse(bx[i]-br, by[i]-br, bx[i]+br, by[i]+br);
24449f
end;
24449f
24449f
{ TForm1 }
24449f
24449f
procedure TForm1.FormCreate(Sender: TObject);
24449f
var
24449f
  i: integer;
24449f
begin
24449f
  score := 0;
24449f
  px := ClientWidth div 2;
24449f
  py := ClientHeight div 2;
24449f
  for i := 0 to count-1 do begin
24449f
    bx[i] := random(ClientWidth);
24449f
    by[i] := -random(ClientHeight);
24449f
  end;
24449f
  refresh;
24449f
end;
24449f
24449f
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
24449f
  Y: Integer);
24449f
begin
24449f
  DrawPlayer(true);
24449f
  px := x;
24449f
  py := y;
24449f
  DrawPlayer(false);
24449f
end;
24449f
24449f
procedure TForm1.Timer1Timer(Sender: TObject);
24449f
var
24449f
  i: integer;
24449f
begin
24449f
  for i := 0 to count-1 do begin
24449f
    DrawBall(true, i);
24449f
    by[i] := by[i] + speed;
24449f
    if by[i] > ClientHeight then begin
24449f
      bx[i] := random(ClientWidth);
24449f
      by[i] := -br;
24449f
    end;
24449f
    DrawBall(false, i);
24449f
  end;
24449f
24449f
  DrawPlayer(false);
24449f
24449f
  for i := 0 to count-1 do begin
24449f
    if sqr(br+pr) > sqr(bx[i]-px) + sqr(by[i]-py) then begin
24449f
      FormCreate(nil);
24449f
    end;
24449f
  end;
24449f
24449f
  score := score + 1;
24449f
  if score > maxScore then maxScore := score;
24449f
  Label1.Caption := IntToStr(score);
24449f
  Label2.Caption := IntToStr(maxScore);
24449f
end;
24449f
24449f
end.
24449f