487 lines
12 KiB
ObjectPascal
487 lines
12 KiB
ObjectPascal
unit umain;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
{ This unit provides a user interface for showing the scenes, create the
|
|
scene objects with different parameters, and handle mouse interaction.
|
|
|
|
It also show information about rendering counters and speed.
|
|
|
|
Scene 5 is handled differently in BGRASurfaceMouseMove because it is
|
|
a first-person view, whereas in other scenes, it is the viewed object
|
|
that gets rotated. }
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
|
Spin, StdCtrls, BGRAVirtualScreen, BCButton, BCPanel, BGRABitmap, BGRAScene3D,
|
|
EpikTimer{$IFNDEF NO_OPENGL_SURFACE}, BGLVirtualScreen, BGRAOpenGL, BGRAOpenGL3D{$ENDIF};
|
|
|
|
type
|
|
|
|
{ TForm1 }
|
|
|
|
TForm1 = class(TForm)
|
|
BCButton1: TBCButton;
|
|
BCButton10: TBCButton;
|
|
BCButton2: TBCButton;
|
|
BCButton3: TBCButton;
|
|
BCButton4: TBCButton;
|
|
BCButton5: TBCButton;
|
|
BCButton6: TBCButton;
|
|
BCButton7: TBCButton;
|
|
BCButton8: TBCButton;
|
|
BCButton9: TBCButton;
|
|
BGRASurface: TBGRAVirtualScreen;
|
|
ComboBox_Render: TComboBox;
|
|
Label1: TLabel;
|
|
SpinEdit_AA: TSpinEdit;
|
|
Timer1: TTimer;
|
|
vsToolbar: TBCPanel;
|
|
procedure BCButton10Click(Sender: TObject);
|
|
procedure BCButton1Click(Sender: TObject);
|
|
procedure BCButton2Click(Sender: TObject);
|
|
procedure BCButton3Click(Sender: TObject);
|
|
procedure BCButton4Click(Sender: TObject);
|
|
procedure BCButton5Click(Sender: TObject);
|
|
procedure BCButton6Click(Sender: TObject);
|
|
procedure BCButton7Click(Sender: TObject);
|
|
procedure BCButton8Click(Sender: TObject);
|
|
procedure BCButton9Click(Sender: TObject);
|
|
{$IFNDEF NO_OPENGL_SURFACE}
|
|
procedure BGLSurfaceMouseEnter(Sender: TObject);
|
|
procedure BGLSurfaceRedraw(Sender: TObject; BGLContext: TBGLContext);
|
|
{$ENDIF}
|
|
procedure SurfaceMouseDown(Sender: TObject; Button: TMouseButton;
|
|
{%H-}Shift: TShiftState; X, Y: Integer);
|
|
procedure BGRASurfaceMouseEnter(Sender: TObject);
|
|
procedure SurfaceMouseMove(Sender: TObject; {%H-}Shift: TShiftState; X,
|
|
Y: Integer);
|
|
procedure SurfaceMouseUp(Sender: TObject; Button: TMouseButton;
|
|
{%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
|
|
procedure BGRASurfaceRedraw(Sender: TObject; Bitmap: TBGRABitmap);
|
|
procedure ComboBox_RenderChange(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure FormKeyPress(Sender: TObject; var Key: char);
|
|
procedure FormResize(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure SpinEdit_AAChange(Sender: TObject);
|
|
procedure Timer1Timer(Sender: TObject);
|
|
procedure vsToolbarMouseEnter(Sender: TObject);
|
|
procedure vsToolbarRedraw(Sender: TObject; Bitmap: TBGRABitmap);
|
|
private
|
|
{ private declarations }
|
|
public
|
|
{ public declarations }
|
|
{$IFNDEF NO_OPENGL_SURFACE}
|
|
BGLSurface: TBGLVirtualScreen;
|
|
glFont: IBGLFont;
|
|
scene: TBGLScene3D;
|
|
{$ELSE}
|
|
scene: TBGRAScene3D;
|
|
{$ENDIF}
|
|
moving: boolean;
|
|
moveOrigin: TPoint;
|
|
timer: TEpikTimer;
|
|
procedure AdjustSceneSize;
|
|
procedure RedrawScene;
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
uses ubgrasamples, ex1, ex2, ex3, ex4, ex5, BGRABitmapTypes;
|
|
|
|
{ TForm1 }
|
|
|
|
procedure TForm1.vsToolbarRedraw(Sender: TObject; Bitmap: TBGRABitmap);
|
|
begin
|
|
DrawWin7ToolBar(Bitmap,vsToolBar.Align);
|
|
end;
|
|
|
|
procedure TForm1.AdjustSceneSize;
|
|
begin
|
|
{$IFNDEF NO_OPENGL_SURFACE}
|
|
if ComboBox_Render.Text = 'BGRA' then
|
|
begin
|
|
if BGLSurface.Visible then
|
|
begin
|
|
BGRASurface.Visible := false;
|
|
BGLSurface.Visible := false;
|
|
|
|
BGRASurface.Visible := true;
|
|
BGRASurface.Align := alClient;
|
|
end;
|
|
end else
|
|
if ComboBox_Render.Text = 'OpenGL' then
|
|
begin
|
|
if BGRASurface.Visible then
|
|
begin
|
|
BGRASurface.Visible := false;
|
|
BGLSurface.Visible := false;
|
|
|
|
BGLSurface.Visible := true;
|
|
BGLSurface.Align := alClient;
|
|
end;
|
|
end else //BGRA&OpenGL
|
|
begin
|
|
if not BGRASurface.Visible or not BGLSurface.Visible then
|
|
begin
|
|
BGRASurface.Visible := false;
|
|
BGLSurface.Visible := false;
|
|
|
|
BGRASurface.Visible := true;
|
|
BGLSurface.Visible := true;
|
|
BGRASurface.Align := alLeft;
|
|
BGLSurface.Align := alClient;
|
|
end;
|
|
BGRASurface.Width := ClientWidth div 2;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TForm1.RedrawScene;
|
|
begin
|
|
if BGRASurface.Visible then BGRASurface.DiscardBitmap;
|
|
{$IFNDEF NO_OPENGL_SURFACE}
|
|
if Assigned(BGLSurface) and BGLSurface.Visible then BGLSurface.Invalidate;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TForm1.FormCreate(Sender: TObject);
|
|
begin
|
|
scene := nil;
|
|
timer := TEpikTimer.Create(nil);
|
|
timer.TimebaseSource := HardwareTimebase;
|
|
|
|
{$IFNDEF NO_OPENGL_SURFACE}
|
|
BGLSurface := TBGLVirtualScreen.Create(self);
|
|
BGLSurface.Color := clGray;
|
|
BGLSurface.OnMouseEnter:= @BGLSurfaceMouseEnter;
|
|
BGLSurface.OnMouseDown:= @SurfaceMouseDown;
|
|
BGLSurface.OnMouseMove:= @SurfaceMouseMove;
|
|
BGLSurface.OnMouseUp:= @SurfaceMouseUp;
|
|
BGLSurface.OnRedraw:= @BGLSurfaceRedraw;
|
|
BGLSurface.Align := alClient;
|
|
BGLSurface.Parent := self;
|
|
{$ELSE}
|
|
BGRASurface.Align := alClient;
|
|
ComboBox_Render.Items.Clear;
|
|
ComboBox_Render.Items.Add('BGRA');
|
|
ComboBox_Render.ItemIndex := 0;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TForm1.FormDestroy(Sender: TObject);
|
|
begin
|
|
FreeAndNil(scene);
|
|
timer.Free;
|
|
end;
|
|
|
|
procedure TForm1.FormKeyPress(Sender: TObject; var Key: char);
|
|
begin
|
|
if Key = '+' then
|
|
begin
|
|
if scene <> nil then
|
|
begin
|
|
scene.Zoom := scene.Zoom*1.5;
|
|
Key := #0;
|
|
end;
|
|
end;
|
|
if Key = '-' then
|
|
begin
|
|
if scene <> nil then
|
|
begin
|
|
scene.Zoom := scene.Zoom*(1/1.5);
|
|
Key := #0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.FormResize(Sender: TObject);
|
|
begin
|
|
AdjustSceneSize;
|
|
end;
|
|
|
|
procedure TForm1.FormShow(Sender: TObject);
|
|
begin
|
|
AdjustSceneSize;
|
|
end;
|
|
|
|
procedure TForm1.SpinEdit_AAChange(Sender: TObject);
|
|
begin
|
|
|
|
end;
|
|
|
|
procedure TForm1.Timer1Timer(Sender: TObject);
|
|
begin
|
|
Timer1.Enabled := false;
|
|
if assigned(scene) and (scene is TExample2) then
|
|
TExample2(scene).Elapse else
|
|
if assigned(scene) and (scene is TExample4) then
|
|
TExample4(scene).Elapse;
|
|
RedrawScene;
|
|
end;
|
|
|
|
procedure TForm1.vsToolbarMouseEnter(Sender: TObject);
|
|
begin
|
|
SpinEdit_AA.Enabled := true;
|
|
end;
|
|
|
|
procedure TForm1.BGRASurfaceRedraw(Sender: TObject; Bitmap: TBGRABitmap);
|
|
var h,cury: integer;
|
|
|
|
procedure TextLine(str: string);
|
|
var
|
|
c: TBGRAPixel;
|
|
begin
|
|
c := Bitmap.GetPixel(0,cury+h div 2);
|
|
if GetLightness(GammaExpansion(c)) > 32768 then
|
|
c := BGRABlack else c := BGRAWhite;
|
|
Bitmap.TextOut(0,cury,str,c);
|
|
cury += h;
|
|
end;
|
|
|
|
begin
|
|
if scene <> nil then
|
|
begin
|
|
timer.Clear;
|
|
timer.Start;
|
|
|
|
scene.RenderingOptions.AntialiasingMode := am3dResample;
|
|
scene.RenderingOptions.AntialiasingResampleLevel := SpinEdit_AA.Value;
|
|
scene.RenderingOptions.MinZ := 1;
|
|
|
|
scene.Surface := Bitmap;
|
|
scene.Render;
|
|
scene.Surface := nil;
|
|
|
|
timer.Stop;
|
|
|
|
Bitmap.FontFullHeight := 20;
|
|
Bitmap.FontQuality := fqSystemClearType;
|
|
h := Bitmap.FontFullHeight;
|
|
|
|
cury := 0;
|
|
TextLine(inttostr(round(timer.Elapsed*1000)) + ' ms');
|
|
TextLine(inttostr(scene.Object3DCount) + ' object(s)');
|
|
TextLine(inttostr(scene.VertexCount) + ' vertices');
|
|
TextLine(inttostr(scene.FaceCount) + ' faces');
|
|
TextLine(inttostr(scene.RenderedFaceCount) + ' rendered');
|
|
TextLine(inttostr(scene.LightCount) + ' light(s)');
|
|
Timer1.Enabled := true;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.ComboBox_RenderChange(Sender: TObject);
|
|
begin
|
|
AdjustSceneSize;
|
|
end;
|
|
|
|
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
|
begin
|
|
{$IFNDEF NO_OPENGL_SURFACE}
|
|
if Assigned(BGLSurface) then BGLSurface.UnloadTextures;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TForm1.BCButton1Click(Sender: TObject);
|
|
begin
|
|
FreeAndNil(scene);
|
|
scene := TExample1.Create;
|
|
RedrawScene;
|
|
end;
|
|
|
|
procedure TForm1.BCButton10Click(Sender: TObject);
|
|
begin
|
|
if not (scene is TExample4) then
|
|
begin
|
|
FreeAndNil(scene);
|
|
scene := TExample4.Create;
|
|
RedrawScene;
|
|
end;
|
|
TExample4(scene).NextModel;
|
|
end;
|
|
|
|
procedure TForm1.BCButton2Click(Sender: TObject);
|
|
begin
|
|
if scene is TExample2 then
|
|
TExample2(scene).Lighting := e2lNone
|
|
else
|
|
begin
|
|
FreeAndNil(scene);
|
|
scene := TExample2.Create(e2lNone);
|
|
end;
|
|
RedrawScene;
|
|
end;
|
|
|
|
procedure TForm1.BCButton3Click(Sender: TObject);
|
|
begin
|
|
if scene is TExample2 then
|
|
TExample2(scene).Lighting := e2lLightness
|
|
else
|
|
begin
|
|
FreeAndNil(scene);
|
|
scene := TExample2.Create(e2lLightness);
|
|
end;
|
|
RedrawScene;
|
|
end;
|
|
|
|
procedure TForm1.BCButton4Click(Sender: TObject);
|
|
begin
|
|
if scene is TExample2 then
|
|
TExample2(scene).Lighting := e2lColored
|
|
else
|
|
begin
|
|
FreeAndNil(scene);
|
|
scene := TExample2.Create(e2lColored);
|
|
end;
|
|
RedrawScene;
|
|
end;
|
|
|
|
procedure TForm1.BCButton5Click(Sender: TObject);
|
|
begin
|
|
FreeAndNil(scene);
|
|
scene := TExample3.Create;
|
|
scene.DefaultLightingNormal := lnFace;
|
|
scene.RenderingOptions.LightingInterpolation := liLowQuality;
|
|
scene.RenderingOptions.AntialiasingMode := am3dMultishape;
|
|
RedrawScene;
|
|
end;
|
|
|
|
procedure TForm1.BCButton6Click(Sender: TObject);
|
|
begin
|
|
FreeAndNil(scene);
|
|
scene := TExample3.Create;
|
|
scene.DefaultLightingNormal := lnFaceVertexMix;
|
|
scene.RenderingOptions.LightingInterpolation := liLowQuality;
|
|
scene.RenderingOptions.AntialiasingMode := am3dResample;
|
|
RedrawScene;
|
|
end;
|
|
|
|
procedure TForm1.BCButton7Click(Sender: TObject);
|
|
begin
|
|
FreeAndNil(scene);
|
|
scene := TExample3.Create;
|
|
scene.DefaultLightingNormal := lnVertex;
|
|
scene.RenderingOptions.LightingInterpolation := liSpecularHighQuality;
|
|
RedrawScene;
|
|
end;
|
|
|
|
procedure TForm1.BCButton8Click(Sender: TObject);
|
|
begin
|
|
if not (scene is TExample4) then
|
|
begin
|
|
FreeAndNil(scene);
|
|
scene := TExample4.Create;
|
|
RedrawScene;
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.BCButton9Click(Sender: TObject);
|
|
begin
|
|
FreeAndNil(scene);
|
|
scene := TExample5.Create;
|
|
RedrawScene;
|
|
end;
|
|
|
|
{$IFNDEF NO_OPENGL_SURFACE}
|
|
procedure TForm1.BGLSurfaceMouseEnter(Sender: TObject);
|
|
begin
|
|
SpinEdit_AA.Enabled := false;
|
|
end;
|
|
|
|
procedure TForm1.BGLSurfaceRedraw(Sender: TObject; BGLContext: TBGLContext);
|
|
var h,cury: integer;
|
|
|
|
procedure TextLine(str: string);
|
|
var
|
|
c: TBGRAPixel;
|
|
begin
|
|
{c := Bitmap.GetPixel(0,cury+h div 2);
|
|
if GetLightness(GammaExpansion(c)) > 32768 then
|
|
c := BGRABlack else }c := BGRAWhite;
|
|
glFont.TextOut(0,cury,str,c);
|
|
cury += h;
|
|
end;
|
|
begin
|
|
if scene <> nil then
|
|
begin
|
|
timer.Clear;
|
|
timer.Start;
|
|
|
|
scene.RenderingOptions.AntialiasingMode := am3dResample;
|
|
scene.RenderingOptions.AntialiasingResampleLevel := SpinEdit_AA.Value;
|
|
scene.RenderingOptions.MinZ := 1;
|
|
scene.RenderGL(BGLContext.Canvas);
|
|
BGLContext.Canvas.WaitForGPU(wfgFinishAllCommands);
|
|
|
|
timer.Stop;
|
|
|
|
h := 20;
|
|
if glFont = nil then
|
|
glFont := BGLFont('Arial',-h);
|
|
|
|
cury := 0;
|
|
TextLine(inttostr(round(timer.Elapsed*1000)) + ' ms');
|
|
TextLine(inttostr(scene.Object3DCount) + ' object(s)');
|
|
TextLine(inttostr(scene.VertexCount) + ' vertices');
|
|
TextLine(inttostr(scene.FaceCount) + ' faces');
|
|
TextLine(inttostr(scene.RenderedFaceCount) + ' rendered');
|
|
TextLine(inttostr(scene.LightCount) + ' light(s)');
|
|
Timer1.Enabled := true;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TForm1.SurfaceMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if (button = mbLeft) and (scene <> nil) then
|
|
begin
|
|
moving := true;
|
|
moveOrigin := point(x,y);
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.BGRASurfaceMouseEnter(Sender: TObject);
|
|
begin
|
|
SpinEdit_AA.Enabled := false;
|
|
end;
|
|
|
|
procedure TForm1.SurfaceMouseMove(Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
begin
|
|
if moving then
|
|
begin
|
|
if scene is TExample5 then
|
|
begin
|
|
scene.LookRight(X-moveOrigin.X);
|
|
scene.LookDown(Y-moveOrigin.Y);
|
|
end else
|
|
if scene.Object3DCount > 0 then
|
|
begin
|
|
scene.Object3D[0].MainPart.RotateYDeg(-(X-moveOrigin.X),False);
|
|
scene.Object3D[0].MainPart.RotateXDeg(Y-moveOrigin.Y,False);
|
|
end;
|
|
RedrawScene;
|
|
moveOrigin := point(x,y);
|
|
end;
|
|
end;
|
|
|
|
procedure TForm1.SurfaceMouseUp(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if button = mbLeft then moving := false;
|
|
end;
|
|
|
|
end.
|
|
|