DGL • Thema anzeigen - 100% CPU-Auslastun

100% CPU-Auslastun - wieso?

Moderator: DGL-Team

Seite 1 von 1

[ 5 Beiträge ]

Vorheriges Thema | Nächstes Thema

Autor

Nachricht

SunBlack

Betreff des Beitrags: 100% CPU-Auslastun - wieso?

Verfasst: So Okt 28, 2007 16:04

DGL Member

Registriert: Di Jan 24, 2006 18:46
Beiträge: 97

Hallo,

ich habe mir ein kleines Grundgerüst geschrieben für Apps, wo ich mal schnell OpenGL drin haben möchte. Allerdings habe ich das Prob, dass das Proggi dann immer auf maximaler CPU-Auslastung läuft. Weiß einer von euch warum?

Code:

unit SBComponents;
 
interface
 
uses
  Messages, Windows, Controls, Classes, Math, dglOpenGL;
 
type
  TSBBwInfControl = class(TWinControl)
    private
      //OpenGL-Vars
      FDC    : HDC;
      FRC    : HGLRC;
      FGLInit: Boolean;
      procedure CreateGL;
      procedure DestroyGL;
      //Messages
      procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
      procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
    protected
      procedure SetParent(AParent: TWinControl); override;
      procedure SetOpenGLSetting; virtual;
      procedure Resize; override;
 
      procedure CreateWnd; override;
      procedure DestroyWnd; override;
 
      procedure PaintControl; virtual; abstract;
      procedure ResizeControl; virtual; abstract;
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
  end;
 
implementation
 
{******************************************************************************}
{* --public--                                                                 *}
{******************************************************************************}
 
constructor TSBBwInfControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGLInit:=false;
end;
 
{------------------------------------------------------------------------------}
 
destructor TSBBwInfControl.Destroy;
begin
  DestroyGL;
  inherited Destroy;
end;
 
{******************************************************************************}
{* --protected--                                                              *}
{******************************************************************************}
 
procedure TSBBwInfControl.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
end;
 
{------------------------------------------------------------------------------}
 
procedure TSBBwInfControl.SetOpenGLSetting;
begin
  if FGLInit then
  begin
    glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_FASTEST);
    glDepthFunc(GL_LEQUAL);
    glEnable(GL_DEPTH_TEST);
    glDepthMask(True);
    glClearDepth(1);
    glDisable(GL_BLEND);
    glDisable(GL_ALPHA_TEST);
    glEnable(GL_COLOR_MATERIAL);
 
    glClearColor(1, 1, 1, 0);
  end;
end;
 
{------------------------------------------------------------------------------}
 
procedure TSBBwInfControl.Resize;
begin
  inherited Resize;
  if FGLInit then
  begin
    ResizeControl;
 
    glClear(GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT);
    PaintControl;
    SwapBuffers(FDC);
  end;
end;
 
{------------------------------------------------------------------------------}
 
procedure TSBBwInfControl.CreateWnd;
begin
  inherited CreateWnd;
  if (not (csDestroying in ComponentState)) and (not FGLInit) then CreateGL;
end;
 
{------------------------------------------------------------------------------}
 
procedure TSBBwInfControl.DestroyWnd;
begin
  DestroyGL;
  inherited DestroyWnd;
end;
 
{------------------------------------------------------------------------------}
 
procedure TSBBwInfControl.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  Msg.Result:=1;
end;
 
{******************************************************************************}
{* --private--                                                                *}
{******************************************************************************}
 
procedure TSBBwInfControl.CreateGL;
begin
  FDC:=GetDC(Handle);
 
  InitOpenGL;
  FRC:=CreateRenderingContext(FDC, [opDoubleBuffered], 32, 24, 0, 0, 0, 0);
  ReadExtensions;
  ReadImplementationProperties;
 
  wglMakeCurrent(FDC, FRC);
 
  FGLInit:=true;
  SetOpenGLSetting;
  Resize;
end;
 
{------------------------------------------------------------------------------}
 
procedure TSBBwInfControl.DestroyGL;
begin
  if FGLInit then
  begin
    wglMakeCurrent(FDC, 0);
    if FRC<>0 then wglDeleteContext(FRC);
    ReleaseDC(Handle, FDC);
    FDC:=0;
  end;
end;
 
{------------------------------------------------------------------------------}
 
procedure TSBBwInfControl.WMPaint(var Msg: TWMPaint);
begin
  if FGLInit then
  begin
    glClear(GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT);
    PaintControl;
    SwapBuffers(FDC);
  end;
end;
 
end.

Grüße
SunBlack

//EDIT: Falls es bei der fehlersuche hilft: er zeichnet es dauernd, aber wenn ich WMPaint ausklammere, ändert das auch nichts an der CPU-Auslastung.

Nach oben

Lossy eX

Betreff des Beitrags:

Verfasst: So Okt 28, 2007 17:56

DGL Member

Registriert: Do Dez 05, 2002 10:35
Beiträge: 4234
Wohnort: Dortmund

Wie benutzt du die Komponente denn? Evtl solltest du mal schauen ob
- ob die Anwendung ansonsten noch reagiert
- was der Debugger zum WMPaint sagt (Callstack). Bzw solltest du generell mal schauen ob du was im debugger finden kannst.

Denn so direkt kann ich nichts offensichtliches finden.

Nach oben

SunBlack

Betreff des Beitrags:

Verfasst: So Okt 28, 2007 18:10

DGL Member

Registriert: Di Jan 24, 2006 18:46
Beiträge: 97

Das ist ja das problem, ich erkenne auch keinen Grund, denn ich mache ansonsten mit dem eigentlich nichts *schulterzuck*:

Code:

unit Main;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Math,
 
  SBComponents, dglOpenGL, StdCtrls, ComCtrls;
 
type
  TGLDrawArea = class(TSBBwInfControl)
  protected
    procedure PaintControl; override;
    procedure ResizeControl; override;
  public
 
  end;
 
  TMainForm = class(TForm)
    OptionsPanel: TPanel;
    ZoomLabel: TLabel;
    ZoomTrackBar: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ZoomTrackBarChange(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;
 
var
  MainForm: TMainForm;
 
  //OpenGL-Variablen
  GLDrawArea: TGLDrawArea;
 
const
  //Kreisgeneauigkeit von OpenGL
  CircleRes = 36;
  //Radius des Sterns
  rs = 0.05;
 
implementation
 
{$R *.dfm}
 
{ TGLDrawArea }
 
{##############################################################################}
{                                     OpenGL-Zeug                              }
{##############################################################################}
 
procedure TGLDrawArea.PaintControl;
var
  i: integer;
begin
  glColor3ub(255, 0, 0);
  glBegin(GL_TRIANGLE_FAN);
    for i:=0 to CircleRes do
      glVertex3f(Sin(2*Pi/CircleRes*i)*rs, Cos(2*Pi/CircleRes*i)*rs, 0);
  glEnd;
  MainForm.OptionsPanel.Repaint;
end;
 
procedure TGLDrawArea.ResizeControl;
var
  CS: array[0..1] of Integer;
  MaxWidth : Integer;
  MaxHeight: Integer;
begin
  glGetIntegerv(GL_MAX_VIEWPORT_DIMS, @CS);
  MaxWidth := Max(Min(CS[0], Width ), 1);
  MaxHeight:= Max(Min(CS[1], Height), 1);
 
  glViewport(0, 0, MaxWidth, MaxHeight);
 
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
 
  if MaxWidth>MaxHeight then
    glOrtho(-MaxWidth/MaxHeight, MaxWidth/MaxHeight, -1, 1, 0, 100)
  else
    glOrtho(-1, 1, -MaxHeight/MaxWidth, MaxHeight/MaxWidth, 0, 100);
 
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity();
end;
 
{##############################################################################}
{                                       MainForm                               }
{##############################################################################}
 
procedure TMainForm.FormCreate(Sender: TObject);
begin
  GLDrawArea:=TGLDrawArea.Create(Self);
  with GLDrawArea do
  begin
    Parent:=MainForm;
    Align:=alClient;
  end;
end;
 
procedure TMainForm.FormDestroy(Sender: TObject);
begin
  GLDrawArea.Free;
end;
 
//Zoom übernehmen
procedure TMainForm.ZoomTrackBarChange(Sender: TObject);
begin
  glTranslatef(0, 0, ZoomTrackBar.Position); //funzt irgendwie nicht
end;
 
end.

Nach oben

Lossy eX

Betreff des Beitrags:

Verfasst: So Okt 28, 2007 19:31

DGL Member

Registriert: Do Dez 05, 2002 10:35
Beiträge: 4234
Wohnort: Dortmund

Mach mal innerhalb des WMPaint als erstes noch ein inherited damit die Message auch sinnvoll abgearbeitet werden kann. Denn aktuell scheint es, als ob diese Message nicht aus der Messagequeue entfernt wird und dadurch wird es dauerhaft aufgerufen.

Wobei ich persönlich empfehlen würde, statt dessen lieber die Methode Paint zu überschreiben. Aber ich glaube die gibt es in dieser Klasse noch nicht. Sonderst erst später.

Nach oben

SunBlack

Betreff des Beitrags:

Verfasst: So Okt 28, 2007 19:36

DGL Member

Registriert: Di Jan 24, 2006 18:46
Beiträge: 97

thx, es funzt. Woran es liegt, versuche ich mal herauszufinden

.

//EDIT: k, das WinControl hatte doch schon ne message darauf laufen...

Nach oben

Seite 1 von 1

[ 5 Beiträge ]

Foren-Übersicht » Programmierung » OpenGL

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 16 Gäste

Du darfst keine neuen Themen in diesem Forum erstellen.
Du darfst keine Antworten zu Themen in diesem Forum erstellen.
Du darfst deine Beiträge in diesem Forum nicht ändern.
Du darfst deine Beiträge in diesem Forum nicht löschen.
Du darfst keine Dateianhänge in diesem Forum erstellen.