unit uMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
StdCtrls, BGRABitmap, BGRABitmapTypes,
BGRAGradientScanner, BGRAVirtualScreen, BCTypes;
type
TCopperBar = packed record
Gradient: TBGRACustomGradient;
Y: Integer;
Size: Integer;
IsAdd: Boolean;
end;
TCopperBars = array of TCopperBar;
type
{ TForm1 }
TForm1 = class(TForm)
BGRAVirtualScreen1: TBGRAVirtualScreen;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Panel1: TPanel;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
SpinEdit3: TSpinEdit;
Timer1: TTimer;
procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
procedure BGRAVirtualScreen1Resize(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormShow(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure SpinEdit2Change(Sender: TObject);
procedure SpinEdit3Change(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
strict private
FCB: TCopperBars;
FMaxBars: Integer;
private
procedure ReleaseCB;
procedure GenerateCB;
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
var
i: Integer;
sy: Integer;
bmp: TBGRABitmap;
begin
bmp := TBGRABitmap.Create(BGRAVirtualScreen1.Width, BGRAVirtualScreen1.Height);
bmp.Canvas.Brush.Color := BGRAVirtualScreen1.Color;
bmp.Canvas.FillRect(bmp.Canvas.ClipRect);
try
for i := High(FCB) downto Low(FCB) do
begin
for sy := 0 to FCB[i].Size do
begin
if FCB[i].IsAdd then
Inc(FCB[i].Y)
else
Dec(FCB[i].Y);
if (FCB[i].Y < (bmp.Canvas.ClipRect.Top - FCB[i].Size)) then
FCB[i].IsAdd := True;
if (FCB[i].Y > (bmp.Canvas.ClipRect.Height + FCB[i].Size)) then
FCB[i].IsAdd := False;
bmp.Canvas.Brush.Color := FCB[i].Gradient.GetColorAtF(sy);
bmp.Canvas.FillRect(bmp.Canvas.ClipRect.Left, FCB[i].Y, bmp.Canvas.ClipRect.Width, Succ(FCB[i].Y));
bmp.Canvas.Brush.Color := FCB[i].Gradient.GetColorAtF(FCB[i].Size - sy);
if FCB[i].IsAdd then
bmp.Canvas.FillRect(bmp.Canvas.ClipRect.Left, FCB[i].Y - FCB[i].Size, bmp.Canvas.ClipRect.Width, Succ(FCB[i].Y - FCB[i].Size))
else
bmp.Canvas.FillRect(bmp.Canvas.ClipRect.Left, FCB[i].Y + FCB[i].Size, bmp.Canvas.ClipRect.Width, Succ(FCB[i].Y + FCB[i].Size));
end;
end;
Bitmap.Assign(bmp);
finally
bmp.Free;
end;
end;
procedure TForm1.BGRAVirtualScreen1Resize(Sender: TObject);
begin
Timer1.Enabled := False;
ReleaseCB;
GenerateCB;
Timer1.Enabled := True;
end;
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
Timer1.Enabled := False;
ReleaseCB;
CloseAction := caFree;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Randomize;
GenerateCB;
Timer1.Interval := SpinEdit3.Value;
Timer1.Enabled := True;
end;
procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
Timer1.Enabled := False;
ReleaseCB;
GenerateCB;
Timer1.Enabled := True;
end;
procedure TForm1.SpinEdit2Change(Sender: TObject);
begin
Timer1.Enabled := False;
ReleaseCB;
GenerateCB;
Timer1.Enabled := True;
end;
procedure TForm1.SpinEdit3Change(Sender: TObject);
begin
Timer1.Interval := SpinEdit3.Value;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
BGRAVirtualScreen1.RedrawBitmap;
end;
procedure TForm1.ReleaseCB;
var
i: Integer;
begin
for i := High(FCB) downto Low(FCB) do
begin
FCB[i].Size := 0;
FCB[i].Y := 0;
FCB[i].IsAdd := False;
FCB[i].Gradient.Free;
FCB[i].Gradient := nil;
end;
SetLength(FCB, 0);
FCB := nil;
end;
procedure TForm1.GenerateCB;
var
i: Integer;
Y: Integer;
Gradient: TBGRACustomGradient;
begin
Y := BGRAVirtualScreen1.Height;
FMaxBars := Succ(Round(Y / SpinEdit2.Value) * 2);
SpinEdit1.Value := FMaxBars;
SetLength(FCB, FMaxBars);
Gradient := TBGRAMultiGradient.Create([RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte))), clBlackOpaque], [0, FMaxBars], True, False);
try
for i := Low(FCB) to High(FCB) do
begin
FCB[i].Size := SpinEdit2.Value;
Y := Y - (FCB[i].Size);
FCB[i].Y := Y;
FCB[i].Gradient := TBGRAMultiGradient.Create([Gradient.GetColorAtF(i), clBlackOpaque], [0, FCB[i].Size], True, False);
FCB[i].IsAdd := True;
end;
finally
Gradient.Free;
end;
end;
end.
Recent Posts
From my experience with the trunk compiler, it works in principle for simple programs, but there are two showstopper bugs I have reported:
