DGL • Thema anzeigen - OpenGL hängt nach Energiesparen durch Windows

OpenGL hängt nach Energiesparen durch Windows

Moderator: DGL-Team

Seite 1 von 1

[ 1 Beitrag ]

Vorheriges Thema | Nächstes Thema

Autor

Nachricht

idontknow

Betreff des Beitrags: OpenGL hängt nach Energiesparen durch Windows

Verfasst: Di Apr 26, 2022 19:07

DGL Member

Registriert: Di Apr 26, 2022 15:52
Beiträge: 1
Programmiersprache: Delphi 11.1

Hallo OpenGL-Profis,

ich hoffe, jemand hier im Forum hat eine Idee zu diesem Problem... Ich habe das Problem auch bei delphipraxis.net eingestellt (https://www.delphipraxis.net/210444-windows-energieoptionen-monitor-aus-opengl-friert-ein.html#post1505122) , aber hier ist es wahrscheinlich auch gut aufgehoben :-)

Nachdem Windows aufgrund der Energieoptionen den Monitor ausgeschaltet hat, und ich ihn mit Mausbewegung wieder wecke, kommt es auf der Hälfte der Rechner, mit denen ich es probiert habe, vor, das die OpenGL-Ausgabe hängt, während Ausgaben in z.B. die Titelzeile des Fensters weiterhin stattfinden. Nach einigen Sekunden bis Minuten läuft die Grafikausgabe dann einfach so weiter.

Habe das Problem auf ein kleines Testprogramm reduziert, daß lediglich ein Dreieck dreht und bei den Testrechnern die "Monitor ausschalten nach"-zeit auf 1 Minute gesetzt.

UHD530 Win10 hängt
UHD630 Win11 läuft
AMD 6900M Win10 hängt
Nvidia GTX980M Win 10 läuft

Das ganze ist absolut reproduzierbar.

Hat jemand hier im Forum das auch schon erlebt und eine Idee, was man da tun kann?

Das folgende einfach auf ein leeres Form1 werfen reicht, keine weiteren Komponenten erforderlich:

Code:

unit Unit1;
 
interface
 
{$DEFINE DGLOGL}
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, System.UITypes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls,
  {$IFDEF DGLOGL}dglOpenGL{$ELSE}Winapi.OpenGL, Winapi.OpenGLext{$ENDIF};
 
type
  TOpenGLContext = class
  public
    Control: TControl;
    DevCon: HDC;
    RenderCon: HGLRC;
    class procedure SetViewport(ClientWidth, ClientHeight: Integer);
    procedure MakeCurrent;
  end;
 
  TglPanel = class(TPanel)
  public
    OnPaint: TNotifyEvent;
    procedure CreateRenderContext(oglc: TOpenGLContext); //var DeviceContext: HDC; var RenderingContext: HGLRC);
  protected
    procedure WMEraseBkgnd(var msg: TWmEraseBkgnd); message WM_ERASEBKGND;
    procedure WMPaint(var msg: TWMPaint); message WM_PAINT;
  end;
 
  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    HoldError: Boolean;
    procedure DreieckMalen(Sender: TObject);
    procedure glPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  public
    fglPanel: TglPanel;
    procedure IdleHandler(Sender: TObject; var Done: Boolean); // GL zeichnen
  end;
 
var
  Form1: TForm1;
  OpenGLContextMain: TOpenGLContext;
 
{$IFNDEF DGLOGL}
type
  TRCOptions = set of (opDoubleBuffered, opGDI, opStereo);
function CreateRenderingContext(DC: HDC; Options: TRCOptions; ColorBits, ZBits, StencilBits, AccumBits, AuxBuffers: Integer; Layer: Integer): HGLRC;
{$ENDIF}
 
implementation
 
{$R *.dfm}
 
{$IFNDEF DGLOGL}
function CreateRenderingContext(DC: HDC; Options: TRCOptions; ColorBits, ZBits, StencilBits, AccumBits, AuxBuffers: Integer; Layer: Integer): HGLRC;
const
  MemoryDCs = [OBJ_MEMDC, OBJ_METADC, OBJ_ENHMETADC];
var
  pfd: TPixelFormatDescriptor;
  PixelFormat: Integer;
  AType: DWORD;
begin
  System.FillChar(pfd, SizeOf(pfd), 0);
 
  pfd.nSize := SizeOf(pfd);
  pfd.nVersion := 1;
  pfd.dwFlags := PFD_SUPPORT_OPENGL;
 
  AType := GetObjectType(DC);
 
  if (AType = 0) then
    RaiseLastOSError;
 
  if (AType in MemoryDCs) then
    pfd.dwFlags := pfd.dwFlags or PFD_DRAW_TO_BITMAP
  else
    pfd.dwFlags := pfd.dwFlags or PFD_DRAW_TO_WINDOW;
 
  if opDoubleBuffered in Options then pfd.dwFlags := pfd.dwFlags or PFD_DOUBLEBUFFER;
  if opGDI in Options then pfd.dwFlags := pfd.dwFlags or PFD_SUPPORT_GDI;
  if opStereo in Options then pfd.dwFlags := pfd.dwFlags or PFD_STEREO;
 
  pfd.iPixelType := PFD_TYPE_RGBA;
  pfd.cColorBits := ColorBits;
  pfd.cDepthBits := zBits;
  pfd.cStencilBits := StencilBits;
  pfd.cAccumBits := AccumBits;
  pfd.cAuxBuffers := AuxBuffers;
 
  if (Layer = 0) then
    pfd.iLayerType := PFD_MAIN_PLANE
  else
    if (Layer > 0) then
      pfd.iLayerType := PFD_OVERLAY_PLANE
    else
      pfd.iLayerType := Byte(PFD_UNDERLAY_PLANE);
 
  PixelFormat := ChoosePixelFormat(DC, @pfd);
 
  if PixelFormat = 0 then
    RaiseLastOSError;
 
  if GetPixelFormat(DC) <> PixelFormat then
    if not SetPixelFormat(DC, PixelFormat, @pfd) then
      RaiseLastOSError;
 
  DescribePixelFormat(DC, PixelFormat, SizeOf(pfd), pfd);
 
  Result := wglCreateContext(DC);
 
  if Result = 0 then
    RaiseLastOSError;
end;
{$ENDIF}
 
{ TglPanel }
procedure TglPanel.WMEraseBkgnd(var msg: TWMEraseBkgnd);
begin
  msg.Result := 1;
end;
 
procedure TglPanel.WMPaint(var msg: TWMPaint);
var
  PS: TPaintStruct;
begin
  BeginPaint(Handle, PS);
 
  if Assigned(OnPaint) then
    OnPaint(Self);
 
  EndPaint(Handle, PS);
 
  msg.Result := 0;
end;
 
procedure TglPanel.CreateRenderContext(oglc: TOpenGLContext); //var DeviceContext: HDC; var RenderingContext: HGLRC);
begin
  try
    oglc.DevCon := GetDC(Self.Handle);
    oglc.RenderCon := CreateRenderingContext(oglc.DevCon, [opDoubleBuffered], 32, 24, 8, 0, 0, 0);
 
    wglMakeCurrent(oglc.DevCon, oglc.RenderCon);
 
    {$IFNDEF DGLOGL}
    Winapi.OpenGLExt.InitOpenGLext; // Darf erst hier, nach wglMakeCurrent(), aufgerufen werden... Für z.B. MultiTexturing erforderlich...
    {$ELSE}
    ActivateRenderingContext(oglc.DevCon, oglc.RenderCon);
    {$ENDIF}
 
    glEnable(GL_DEPTH_TEST);
    glDepthFunc(GL_LESS);
    glEnable(GL_TEXTURE_2D);
  except
    MessageDlg('Can''t create OpenGL Rendering Context!', mtError, [mbOK], 0);
  end;
end;
 
class procedure TOpenGLContext.SetViewport(ClientWidth, ClientHeight: Integer);
begin
  glViewport(0, 0, ClientWidth, ClientHeight);
 
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
 
  glOrtho(-ClientWidth / 2, ClientWidth / 2,
          -ClientHeight / 2, ClientHeight / 2,
          0, 100);
 
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
end;
 
procedure TOpenGLContext.MakeCurrent;
begin
  wglMakeCurrent(DevCon, RenderCon);
 
  TOpenGLContext.SetViewport(Control.Width, Control.Height);
 
  glDisable(GL_BLEND);
  glClearColor(0, 0, 0, 0);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);// or GL_STENCIL_BUFFER_BIT);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  OpenGLContextMain := TOpenGLContext.Create;
 
  fglPanel := TglPanel.Create(Self);
  fglPanel.Parent := Self;
  fglPanel.Name := 'glPanel';
  fglPanel.Color := clBlack;
  fglPanel.ParentColor := FALSE;
  fglPanel.ParentBackground := FALSE;
  fglPanel.Align := alClient;
  fglPanel.CreateRenderContext(OpenGLContextMain);
  fglPanel.OnPaint := DreieckMalen;
  fglPanel.OnMouseMove := glPanelMouseMove;
 
  OpenGLContextMain.Control := fglPanel;
 
  Application.OnIdle := IdleHandler;
end;
 
procedure TForm1.FormResize(Sender: TObject);
var
  Done: Boolean;
begin
  IdleHandler(Sender, Done);
end;
 
procedure TForm1.IdleHandler(Sender: TObject; var Done: Boolean);
begin
  fglPanel.Invalidate; // fglPanel.onPaint = DreieckMalen zeichnet für uns...
  sleep(1);
  Done := FALSE;
end;
 
procedure TForm1.glPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
(*
  sinnlos, bringt auch nix.
  PostMessage(Self.Handle, WM_MOVE, 0, $00010001);
  PostMessage(Self.Handle, WM_MOVE, 0, NativeInt($FFFFFFFF));
*)
end;
 
procedure TForm1.DreieckMalen(Sender: TObject);
var
  i: Cardinal;
  x: Array [0..2] of Double;
  y: Array [0..2] of Double;
  e: GLenum;
begin
 // OpenGLContextMain.MakeCurrent;
 
  // Mal nur so probieren:
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);// or GL_STENCIL_BUFFER_BIT);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
 
  glOrtho(-ClientWidth / 2, ClientWidth / 2,
          -ClientHeight / 2, ClientHeight / 2,
          0, 100);
 
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
 
  // Drei Punkte rumwirbeln
  for i := 0 to 2 do
  begin
    x[i] := 400 * sin((GetTickCount+(i*1000)) / 500);
    y[i] := 300 * cos((GetTickCount+(i*1000)) / 700);
  end;
 
  glTranslated(0, 0, -10);
 
  // und Dreieck füllen
  glDisable(GL_TEXTURE_2D);
  glBegin(GL_TRIANGLES);
    glColor4f(1.0, 0.0, 0.0, 1.0);
    glVertex2f(x[0], y[0]);
    glColor4f(0.0, 1.0, 0.0, 1.0);
    glVertex2f(x[1], y[1]);
    glColor4f(0.0, 0.0, 1.0, 1.0);
    glVertex2f(x[2], y[2]);
  glEnd();
 
  if not SwapBuffers(OpenGLContextMain.DevCon) then
  begin
    Caption := 'SwapBuffers fehlgeschlagen: ' + GetLastError().ToString;
    HoldError := TRUE; // einmal Error, immer Error anzeigen.
  end;
 
  if not HoldError then
  begin
    e := glGetError();
    if e <> GL_NO_ERROR then
    begin
      Caption := gluErrorString(e);
      HoldError := TRUE; // einmal Error, immer Error anzeigen.
    end;
  end;
 
  if not HoldError then
    Form1.Caption := TimeToStr(Now); // Uhrzeit als WindowTitle läuft weiter
end;
 
end.

Nach oben

Seite 1 von 1

[ 1 Beitrag ]

Foren-Übersicht » Programmierung » OpenGL

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 26 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.