Einzelnen Beitrag anzeigen

roboter202

Registriert seit: 6. Mär 2011
98 Beiträge
 
Delphi 6 Professional
 
#1

OpenGL zu wenig Frames

  Alt 24. Okt 2011, 11:13
Hallo,

eigentlich seid ihr ja nicht dafür verantwortlich aber da ich auf dem Forum von http://www.delphigl.com/ noch nicht freigeschaltet wurde frag ich hier mal nach.

Ich hab mal das 1. Beispiel ausprobiert was es da als Tutorial gab. Ein Viereck auf schwarzen Hintergrund. Der Code ist 1:1 übernommen aber trotzdem habe ich nur 60 Frames. Die CPU ist kaum ausgelastet < 2%, wenn ich jedoch das Fenster in den Hintergrund schiebe geht die Auslastung hoch > 80%. Das sollte eig. anders sein .
Vielleicht sollte ich sagen das ich bei wie ich denke ressourcenfressenderen Spielen (GTA SA, Minecraft, RSV2, ...) wesentlich mehr Frames (> 100) habe.

Die Grafikkarte (POV GeForce GT440) ist noch sehr neu und sollte bei so einem "Bildchen" nicht in die Knie gehen. Der Prozessor ist zwar nicht der neuste aber an der Auslastung sollte man erkennen das auch hier mehr drin ist.

Es kann natürlich auch sein das der Code selbst suboptimal ist.

CODE:
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DGLOpenGL;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure IdleHandler(Sender: TObject; var Done: Boolean);
  private
    { Private-Deklarationen }
    StartTime, TimeCount, FrameCount : Cardinal; //FrameCounter
    Frames, DrawTime : Cardinal; //& Timebased Movement
    procedure SetupGL;
    procedure Init;
    procedure Render;
    procedure ErrorHandler;
  public
    { Public-Deklarationen }
    DC : HDC; //Handle auf Zeichenfläche
    RC : HGLRC;//Rendering Context
  end;

var
  Form1: TForm1;

const
  NearClipping = 1;
  FarClipping = 1000;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  DC:= GetDC(Handle);
    if not InitOpenGL then Application.Terminate;
    RC:= CreateRenderingContext( DC,
                               [opDoubleBuffered],
                               32,
                               24,
                               0,0,0,
                               0);
    ActivateRenderingContext(DC, RC);
    SetupGL;
    Init; //Was man sonst so initialisieren will.
end;

procedure TForm1.SetupGL;
begin
  glClearColor(0.3, 0.4, 0.7, 0.0); //Hintergrundfarbe: Hier ein leichtes Blau
  glEnable(GL_DEPTH_TEST); //Tiefentest aktivieren
  glEnable(GL_CULL_FACE); //Backface Culling aktivieren
end;

procedure TForm1.Init;
begin
  Application.OnIdle := IdleHandler;
end;

procedure TForm1.Render;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
 
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(45.0, ClientWidth/ClientHeight, NearClipping, FarClipping);
 
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
 
  glTranslatef(0, 0, -5);
 
  glBegin(GL_QUADS);
    glColor3f(1, 0, 0); glVertex3f(0, 0, 0);
    glColor3f(0, 1, 0); glVertex3f(1, 0, 0);
    glColor3f(0, 0, 1); glVertex3f(1, 1, 0);
    glColor3f(1, 1, 0); glVertex3f(0, 1, 0);
  glEnd;
 
  SwapBuffers(DC);
end;

procedure TForm1.IdleHandler(Sender: TObject; var Done: Boolean);
begin
  StartTime:= GetTickCount;
  Render;
  DrawTime:= GetTickCount - StartTime;
  Inc(TimeCount, DrawTime);
  Inc(FrameCount);
 
  if TimeCount >= 1000 then begin
    Frames:= FrameCount;
    TimeCount:= TimeCount - 1000;
    FrameCount:= 0;
    Caption:= InttoStr(Frames) + 'FPS';
    ErrorHandler;
  end;
 
  Done:= false;
end;

procedure TForm1.FormResize(Sender: TObject);
var tmpBool : Boolean;
begin
  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(45.0, ClientWidth/ClientHeight, NearClipping, FarClipping);
 
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
  IdleHandler(Sender, tmpBool);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeactivateRenderingContext;
  DestroyRenderingContext(RC);
  ReleaseDC(Handle, DC);
end;

procedure TForm1.ErrorHandler;
var s: String;
begin
  s := gluErrorString(glGetError);
  If s <> 'no errorthen showmessage(s);
end;


end.
PS: Ich verwende die OnIdle Routine zum Aufruf des Renderns.
Christian
i := 0 ; While i = 0 do beep ;
  Mit Zitat antworten Zitat