Skip to content

Instantly share code, notes, and snippets.

@pakLebah
Last active Jul 28, 2018
Embed
What would you like to do?
LCL canvas graphics demo.
program bounce;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, lazcontrols, ubounce;
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
object Form1: TForm1
Left = 240
Height = 300
Top = 120
Width = 600
Caption = 'Bouncing Balls'
ClientHeight = 300
ClientWidth = 600
Constraints.MinHeight = 100
Constraints.MinWidth = 200
KeyPreview = True
OnCreate = FormCreate
OnKeyDown = FormKeyDown
OnKeyPress = FormKeyPress
OnKeyUp = FormKeyUp
OnPaint = FormPaint
OnResize = FormResize
LCLVersion = '1.6.0.4'
Visible = False
object Timer1: TTimer
Interval = 20
OnTimer = Timer1Timer
left = 16
top = 8
end
end
unit ubounce;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Graphics, Controls, ExtCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyPress(Sender: TObject; var Key: char);
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormPaint(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
type
TBall = record
bc: TColor; // ball color
br: integer; // ball radius
bx,by: integer; // ball x,y
dx,dy: integer; // delta x,y
mx,my: integer; // max x,y
nx,ny: integer; // min x,y
gl,gu: boolean; // go left, go up
end;
const
BALL_COUNT = 10; // all balls count
BALL_COLORS: array[1..18] of TColor =
(clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clGray, clSkyBlue,
clMOneyGreen, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clSilver, clWhite);
var
Balls: array[1..BALL_COUNT] of TBall;
vi: boolean = false; // view info
sb: boolean = false; // select ball
bi: integer = 1; // ball index
k: integer; // key pressed
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
begin
Randomize;
DoubleBuffered := true;
Canvas.Pen.Style := psClear;
for i := 1 to BALL_COUNT do
with Balls[i] do
begin
bc := BALL_COLORS[random(18)+1];
gl := false;
gu := false;
br := random(30)+20;
bx := random(width)-br;
by := random(height)-br;
dx := random(9)+1;
dy := random(9)+1;
nx := 0;
ny := 0;
mx := width-br;
my := height-br;
end;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = 83 then sb := true; // s
k := key;
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: char);
begin
if Key = #27 then Close;
if UpCase(Key) = 'R' then FormCreate(self);
if UpCase(Key) = 'V' then vi := not vi;
if UpCase(Key) = 'N' then
begin
bi := bi + 1;
if bi > BALL_COUNT then bi := 1;
end;
if UpCase(Key) = 'P' then
begin
bi := bi - 1;
if bi < 1 then bi := BALL_COUNT;
end;
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = 83 then sb := false;
k := key;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
i: integer;
begin
for i := 0 to BALL_COUNT do
with Balls[i] do
begin
Canvas.Brush.Color := bc;
//if si and (i = bi) then Canvas.Brush.Color := Color;
Canvas.Ellipse(bx,by,bx+br,by+br);
end;
if sb then
begin
//if bi > BALL_COUNT then bi := BALL_COUNT;
Canvas.Brush.Color := Color;
Canvas.Ellipse(Balls[bi].bx+4,Balls[bi].by+4,
Balls[bi].bx+Balls[bi].br-4,
Balls[bi].by+Balls[bi].br-4);
end;
if vi then
begin
Canvas.Pen.Color := clBlack;
Canvas.Pen.Style := psSolid;
Canvas.Brush.Style := bsClear;
Canvas.TextOut(10,10,'['+IntToStr(bi)+']');
Canvas.TextOut(40,10,'Pos = '+IntToStr(Balls[bi].bx)+':'+IntToStr(Balls[bi].by));
Canvas.TextOut(40,30,'Vel = '+IntToStr(Balls[bi].dx)+':'+IntToStr(Balls[bi].dy));
Canvas.TextOut(40,50,'Rad = '+IntToStr(Balls[bi].br)+'px');
Canvas.TextOut(40,70,'Col = '+ColorToString(Balls[bi].bc));
//Canvas.TextOut(40,90,'Key = '+IntToStr(k));
Canvas.Pen.Style := psClear;
Canvas.Brush.Style := bsSolid;
end;
end;
procedure TForm1.FormResize(Sender: TObject);
var
i: integer;
begin
for i := 1 to BALL_COUNT do
with Balls[i] do
begin
mx := width-br;
my := height-br;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i: integer;
begin
for i := 0 to BALL_COUNT do
with Balls[i] do
begin
if gl then bx := bx - dx else bx := bx + dx;
if gu then by := by - dy else by := by + dy;
if bx < nx then
begin
bx := nx;
gl := false;
end;
if bx > mx then
begin
bx := mx;
gl := true;
end;
if by < ny then
begin
by := ny;
gu := false;
end;
if by > my then
begin
by := my;
gu := true;
end;
end;
//Canvas.Brush.Color := Color;
//Canvas.Clear;
//for i := 0 to BALL_COUNT do
//with Balls[i] do
//begin
// Canvas.Brush.Color := bc;
// Canvas.Ellipse(bx,by,bx+br,by+br);
//end;
//Paint;
Invalidate;
end;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment