Code:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants,
Classes, Graphics, Controls, Forms,Font2,dglOpenGL;
type
Rec = object
X,Y: single;
Txt: string;
Fade, HW, Scale: single;
Stage, StageTime, LastTime: integer;
Font: integer;
PRocedure Init(xx,yy: single;fn: integer;tt: string);
Procedure QuickInit;
Procedure Draw;
end;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
procedure StartOpenGl;
procedure EndOpenGl;
procedure FullScreen(pWidth, pHeight, pBPP, pFrequency : Word);
procedure ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
end;
var
Form1: TForm1;
RC : HGLRC;
DC : HDC;
h_Wnd : HWND; // Global window handle
h_DC : HDC; // Global device context
h_RC : HGLRC; // OpenGL rendering context
glWidth, glHeight: integer;
keys : Array[0..255] of Boolean; // Holds keystrokes
FPSCount : Integer = 0; // Counter for FPS
ElapsedTime : Integer; // Elapsed time between frames
fnt: array[0..3] of TFontObj;
R: Array[0..50] of Rec;
Messages2: array[0..10] of string = ( 'Free'
, 'Fast Rendering'
, 'Alpha Channel'
, 'Crisp and Clear'
, 'Infinite Variety'
, 'Flexible Studio'
, 'Small File Sizes'
, 'Cool Fonts'
, 'Simple Intergration'
, 'Supports Internation Character Sets.'
, 'C++ and Delphi Support.');
StartTick : Cardinal;
Frames : Integer;
FPS : Single;
MyFont : TFontObj;
FontBase: GLUInt;
i: Single;
xAngle,yAngle,zAngle,xSpeed,ySpeed,zSpeed: Single;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
var
intFPS,l: Integer;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); // Clear The Screen And The Depth Buffer
glLoadIdentity();
glOrtho(0,1024,768,0,-700,700);
intFPS := Trunc(FPS);
glPushMatrix;
gltranslatef(0,0, 0);
{for l := 0 to high(R) do
begin
R[l].Draw;
end;}
fnt[1].Draw(10,50,'simple time',0);
fnt[0].Draw(10,100,'simple time');
fnt[2].Draw(10,150,'simple time');
fnt[3].Draw(10,200,'simple time');
{fnt[1].Draw(400,500,'Y = '+FloatToStr(yAngle));
fnt[1].Draw(10,110,'Z = '+FloatToStr(zAngle));
fnt[1].Draw(100,400,'you');
fnt[3].Draw(100,100,'you');
fnt[2].Draw(0,200,0,0,0,'you');
fnt[1].Draw(0,-60,0,0,0,'you');
fnt[1].Draw(0,0,xAngle,0,0,IntToStr(intFPS)+' Frames per second');}
glPopMatrix;
if GetTickCount - StartTick >= 500 then
begin
FPS := Frames/(GetTickCount-StartTick)*1000;
Frames := 0;
StartTick := GetTickCount;
end;
SwapBuffers(DC);
Done := False;
inc(Frames);
xAngle :=xAngle + xSpeed;
yAngle :=yAngle + ySpeed;
zAngle :=zAngle + zSpeed;
end;
procedure TForm1.EndOpenGl;
begin
//DeactivateRenderingContext;
wglDeleteContext(RC);
ReleaseDC(Handle, DC);
ChangeDisplaySettings(devmode(nil^), 0);
end;
procedure TForm1.FullScreen(pWidth, pHeight, pBPP, pFrequency : Word);
var
dmScreenSettings : DevMode;
begin
WindowState := wsMaximized;
BorderStyle := bsNone;
ZeroMemory(@dmScreenSettings, SizeOf(dmScreenSettings));
with dmScreenSettings do
begin
dmSize := SizeOf(dmScreenSettings);
dmPelsWidth := pWidth;
dmPelsHeight := pHeight;
dmBitsPerPel := pBPP;
dmDisplayFrequency := pFrequency;
dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL or DM_DISPLAYFREQUENCY;
end;
if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN) = DISP_CHANGE_FAILED) then
begin
MessageBox(0, 'Fullscreen is inpossible!!! ', 'Error', MB_OK or MB_ICONERROR);
exit
end;
end;
procedure TForm1.StartOpenGl;
begin
Fullscreen(1024, 768, 32, 85);
InitOpenGL;
DC := GetDC(Handle);
RC := CreateRenderingContext(DC, [opDoubleBuffered], 32, 24, 0, 0, 0, 0);
ActivateRenderingContext(DC, RC);
glShadeModel(GL_SMOOTH); // Enables Smooth Color Shading
glClearDepth(1.0); // Depth Buffer Setup
glClearColor(0.1, 0.1, 0.1, 0.0); // Black Background
glColor4f(1,1,1,1);
glDisable(GL_DEPTH_TEST); // Enable Depth Buffer
glDepthFunc(GL_LEQUAL); // The Type Of Depth Test To Do
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
glEnable(GL_BLEND);
glEnable(GL_TEXTURE_2D);
glDisable(GL_LIGHTING);
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST); //Realy Nice perspective calculations
//LoadSelectPage;
StartTick := GetTickCount;
Application.OnIdle := ApplicationEventsIdle;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
x: Integer;
begin
StartOpenGl;
xSpeed := 0.0;
ySpeed := 0.1;
zSpeed := 0.0;
for X := 0 to high(Fnt) do
fnt[X] := TFontObj.Create('font'+inttostr(x)+'.fnt');
for X := 0 to high(R) do
R[X].QuickInit;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
EndOpenGl;
end;
{ Rec }
Procedure Rec.QuickInit ;
begin
Init(random*glWidth, random*glHeight, random(length(fnt)), Messages2[random(length(messages2))]);
end;
PRocedure Rec.Init(xx,yy: single;fn: integer;tt: string);
begin
StageTime := random(2000)+1000;
Scale := random*1.5+0.2;
X := Xx;
Y := Yy;
Txt := Tt;
Font := fn;
HW := Fnt[Fn].TextLen(Txt)*0.5;
Stage := 0;
Fade := 0;
LAstTime := GetTickCount;
end;
Procedure Rec.Draw;
begin
glPushMatrix;
gltranslatef(x-Hw, y, 0);
glScalef(Scale, Scale, Scale);
Fade := (GetTickCount-LastTime)/StageTime;
case Stage of
0: fnt[font].FadeIn(0,0, Txt, Fade, 8);
1: begin
glColor4f(255,1,255,1);
fnt[font].Draw(0,0, Txt, 0);
end;
2: fnt[font].FadeOut(0,0,Txt,Fade,8);
3: ;
end;
if (GetTickCount-LastTime) > StageTime then
begin
inc(Stage);
if Stage = 4 then
begin
Stage := 0;
QuickInit;
end;
LastTime := GetTickCount;
end;
glPopMatrix;
end;
end.
Reply With Quote
Bookmarks