unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
BGLVirtualScreen, BGRAGraphicControl, BCExpandPanels, BGRAOpenGL, BGRABitmap,
BGRABitmapTypes;
const
StarCount = 1200;
MaxSpeed = 8;
type
TStar = record //
X, Y, Z: Double;
Speed: Double;
end;
{ TForm1 }
TForm1 = class(TForm)
BGLVirtualScr: TBGLVirtualScreen;
Timer1: TTimer;
procedure BGLVirtualScrLoadTextures(Sender: TObject;
BGLContext: TBGLContext);
procedure BGLVirtualScrRedraw(Sender: TObject; BGLContext: TBGLContext);
procedure BGLVirtualScrUnloadTextures(Sender: TObject;
BGLContext: TBGLContext);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
GLFont, GLBigFont: IBGLFont;
Stars : array of TStar;
a_logo : IBGLTexture;
rr,gg,bb : Byte;
private
const cop : Array [0..6] of String = ('#ff0000','#ffff00','#ffffff','#0000ff','#00ffff','#00ff00','#ff00ff');
const rasterz : Array [0..64] of String = ('#004848','#006C6C','#009090','#00B4B4','#00D8D8','#00FFFF','#00D8D8','#00B4B4','#009090','#006C6C','#004848','#000048',
'#00006C','#000090','#0000B4','#0000D8','#0000FF','#0000D8','#0000B4','#000090','#00006C','#000048','#480048','#6C006C','#900090',
'#B400B4','#D800D8','#FF00FF','#D800D8','#B400B4','#900090','#6C006C','#480048','#480000','#6C0000','#900000','#B40000','#D80000',
'#FF0000','#D80000','#B40000','#900000','#6C0000','#480000','#484800','#6C6C00','#909000','#B4B400','#D8D800','#FFFF00','#D8D800',
'#B4B400','#909000','#6C6C00','#484800','#004800','#006C00','#009000','#00B400','#00D800','#00FF00','#00D800','#00B400','#009000',
'#006C00');
procedure InitializeStarfield;
procedure UpdateStarfield;
procedure WavyText(BGLContext: TBGLContext; AFont: IBGLFont; AColor: TBGRAPixel;AText: string; X, Y, AWavePosDeg, AWaveStepDeg, AWaveSize: single);
procedure Copperbar(BGLContext: TBGLContext;x1,y1:single;centered: boolean);
public
end;
var
Form1: TForm1;
ct : integer;
hexColor: string;
red, green, blue: Byte;
pause : integer;
j: integer;
cop_num : integer = 0; // copper bar index color
vbl_timer :integer = 0;
implementation
{$R *.lfm}
uses BGRAUTF8,BGRATextFX,BGRAGradients,BGRAFontGL;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
InitializeStarfield;
j:=0;
pause := 0;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
a_logo := BGLTexture('gtr.png');
end;
procedure TForm1.InitializeStarfield;
var
i: Integer;
begin
SetLength(Stars, StarCount); // Nombre d'étoiles
for i := 0 to High(Stars) do
begin
Stars[i].X := Random(ClientWidth);
Stars[i].Y := (60+Random(ClientHeight-120));
Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire
end;
end;
procedure TForm1.UpdateStarfield;
var
i : integer;
begin
for i := 0 to High(Stars) do
begin
Stars[i].X := Stars[i].X - Stars[i].Speed ;
if Stars[i].X < 0 then // Réinitialiser la position si l'étoile sort de l'écran
begin
Stars[i].X := ClientWidth;
Stars[i].Y := (60+Random(ClientHeight-120));
Stars[i].Speed := Random * 7 + 1;
end;
end;
end;
procedure HexToRGB(hex: string; var r, g, b: Byte);
begin
r := StrToInt('$' + Copy(hex, 2, 2));
g := StrToInt('$' + Copy(hex, 4, 2));
b := StrToInt('$' + Copy(hex, 6, 2));
end;
procedure Tform1.Copperbar(BGLContext: TBGLContext;x1,y1:single;centered: boolean);
begin
hexColor := cop[cop_num];
HexToRGB(hexColor, rr,gg,bb);
BGLContext.Canvas.FillRectLinearColor(x1,y1,x1+ClientWidth,y1+16, RGBToColor(0,0,0),RGBToColor(0,0,0),RGBToColor(rr,gg,bb),RGBToColor(rr,gg,bb),centered);
BGLContext.Canvas.FillRectLinearColor(x1,y1+32,x1+ClientWidth,y1+16,RGBToColor(0,0,0),RGBToColor(0,0,0),RGBToColor(rr,gg,bb),RGBToColor(rr,gg,bb),centered);
end;
// from Circular
procedure Tform1.WavyText(BGLContext: TBGLContext; AFont: IBGLFont; AColor: TBGRAPixel;
AText: string; X,Y, AWavePosDeg, AWaveStepDeg, AWaveSize: single);
var glyphCursor : TGlyphCursorUtf8;
glyph: TGlyphUtf8;
glyphText: string;
begin
X -= AFont.TextWidth(AText)/2;
glyphCursor := TGlyphCursorUtf8.New(AText, fbmAuto);
while not glyphCursor.EndOfString do
begin
glyph := glyphCursor.GetNextGlyph;
if glyph.MirroredGlyphUtf8 <> '' then
glyphText := glyph.MirroredGlyphUtf8
else
glyphText := glyph.GlyphUtf8;
AFont.TextOut(x,y + AWaveSize*Sin(AWavePosDeg*Pi/180), glyphText, AColor);
x += AFont.TextWidth(glyphText);
AWavePosDeg += AWaveStepDeg;
end;
end;
procedure TForm1.BGLVirtualScrRedraw(Sender: TObject; BGLContext: TBGLContext);
var
i : integer;
StarPosition: TPoint;
sttype : Int16 ;
col: TColor;
cl : string;
begin
// stars
for i := 0 to High(Stars) do
begin
StarPosition.X := Round(Stars[i].X );
StarPosition.Y := Round(Stars[i].Y);
sttype := Round(Stars[i].Speed);
col := RGBToColor(50,50,50);
// bitplanes colors
case (sttype) of
1: col := RGBToColor(50,50,50);
2: col := RGBToColor(75,75,75);
3: col := RGBToColor(100,100,100);
4: col := RGBToColor(125,125,125);
5: col := RGBToColor(150,150,150);
6: col := RGBToColor(175,175,175);
7: col := RGBToColor(200,200,200);
8: col := RGBToColor(254,254,254);
end;
BGLContext.Canvas.Rectangle(StarPosition.X, StarPosition.Y,StarPosition.X+1,StarPosition.Y+1,col);
end;
// copper bars
for i := 0 to 8 do
begin
Copperbar(BGLContext,0,240+i*2+80*sin(ct/20+(i/2)), true);
end;
col := RGBToColor(Random(256), Random(256), Random(256));
WavyText(BGLContext,GLFont,col,'PRESENTS',150+BGLContext.Width/4+30*sin(ct/10),100,
180*sin(ct/13), 0, 0);
WavyText(BGLContext,GLBigFont,BGRAWhite,'LAZARUS DEMO ',10+BGLContext.Width/2,410,0, 0, 0);
// raster bars cycle colors with pause like A-Team intro
for i := 0 to 10 do
begin
hexColor := rasterz[i+j];
HexToRGB(hexColor, red, green, blue);
BGLContext.Canvas.FillRect(0,i*8,640,i*8-8,RGBToColor(red,green,blue));
end;
inc(pause);
if (pause>=10) then
begin
inc(j);
pause := 0;
if(j>=63-8) then j:=0;
end;
// draw logo and update Sf
BGLCanvas.StretchPutImage(0,0,a_logo.Width,a_logo.Height+2, a_logo);
UpdateStarfield;
// general demo_timer , increase copper colortable to 7
inc(vbl_timer);
if(vbl_timer>200) then
begin
vbl_timer := 0;
cop_num := cop_num +1;
if(cop_num>6) then cop_num :=0;
end;
end;
procedure TForm1.BGLVirtualScrUnloadTextures(Sender: TObject;
BGLContext: TBGLContext);
begin
GLFont := nil;
GLBigFont := nil;
a_logo := nil;
end;
procedure TForm1.BGLVirtualScrLoadTextures(Sender: TObject;
BGLContext: TBGLContext);
var bigRender: TBGRATextEffectFontRenderer;
shader: TPhongShading;
bigFont: TBGLRenderedFont;
begin
GLFont := BGLFont('Arial', 40, [fsBold]);
shader := TPhongShading.Create;
bigRender := TBGRATextEffectFontRenderer.Create(shader, true);
bigFont := TBGLRenderedFont.Create(bigRender, true);
bigFont.Name := 'Arial';
bigFont.EmHeight := 72;
bigFont.Color := CSSSkyBlue;
GLBigFont := bigFont;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
ct := ct + 1 ;
BGLVirtualScr.Repaint;
end;
end.
Recent
