Windows-Energieoptionen: Monitor aus -> OpenGL friert ein

[idontknow]

Habe gerade ein hässliches Problem mit OpenGL, das ich nicht gelöst kriege...

Das angehängte Programm wirbelt ein Dreieck im Fenster umher und zeigt in der Titelzeile die Uhrzeit an.

In Windows eingestellt ist "Bildschirm ausschalten nach: 2 Minuten" und "Energiesparmodus nach: Niemals".

Wenn Windows den Monitor ausschaltet und ich ihn kurze Zeit später durch Bewegen der Maus/Touchpad wieder einschalte, hängt meine OpenGL-Darstellung.

Dreieck zeichnen und Uhrzeit anzeigen werden über den IdleHandler getriggert.

Die Uhrzeit läuft weiter, das Dreieck bewegt sich nicht mehr. Nach einigen Sekunden bis hin zu Minuten wacht es wieder auf und dreht sich weiter.

Das Phänomen tritt anscheinend nicht auf jedem PC auf, aber auf vielen.

Hat da jemand eine Idee? Bin etwas ratlos...

Schon mal vielen Dank für Ideen und Tipps im voraus!

Der Quellcode funktioniert mit dglOpengl.pas oder mit den Windows-eigenen OpenGl-Headern. Das ändert aber leider nix.

Delphi-Quellcode:

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)
    procedure FormCreate(Sender: TObject);
  private
    procedure DreieckMalen(Sender: TObject);
  public
    glPanel: 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);  // Ist das hier Schuld am Hänger? Könnte sein, testen!

  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;

  glPanel := TglPanel.Create(Self);
  glPanel.Parent := Self;
  glPanel.Name := 'glPanel';
  glPanel.Color := clBlack;
  glPanel.ParentColor := FALSE;
  glPanel.ParentBackground := FALSE;
  glPanel.Align := alClient;
  glPanel.CreateRenderContext(OpenGLContextMain);
  glPanel.OnPaint := DreieckMalen;

  OpenGLContextMain.Control := glPanel;

  Application.OnIdle := IdleHandler;
end;

procedure TForm1.IdleHandler(Sender: TObject; var Done: Boolean);
begin
  glPanel.Invalidate; // fglPanel.onPaint = DreieckMalen zeichnet für uns...

  Form1.Caption := TimeToStr(Now); // Uhrzeit als WindowTitle läuft weiter

  Done := FALSE;
end;

procedure TForm1.DreieckMalen(Sender: TObject);
var
  i: Cardinal;
  x: Array [0..2] of Double;
  y: Array [0..2] of Double;
begin
  OpenGLContextMain.MakeCurrent;

  // 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;

  // 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();

  SwapBuffers(OpenGLContextMain.DevCon);
end;


end.

[TurboMagic]

Schon mal mit OutputDebugString('Meine Meldung') geprüft, ob DreieckMalen nach der Reaktivierung des Bildschirms gleich aufgerufen wird?

[idontknow]

Ja, wird immer aufgerufen.

Ich habe mittlerweile auch die "Caption := Uhrzeit"-Zeile in DreieckMalen verlagert. Uhrzeit wird immer sofort nach dem Aufwachen des Bildschirms aktualisiert.

Ausserdem prüfe ich jetzt die Rückgabe von SwapBuffers (immer TRUE) und prüfe auf GL-Fehler. Es gibt keine...

Echt seltsam.

Es liegt übrigens irgendwie mit am Grafikchip oder Treiber:
- Auf meinem 2011er-Imac (Windows 10) mit AMD-6900M kommt es zu dem Hänger.
- Auf meinem Acer Predator Notebook (Windows 10) kommt es zu dem Hänger, wenn das Programm auf dem intel UHD530 Grafikkern läuft. Wenn die Grafikausgabe auf den Nvidia-Chip umgeschaltet wurde, hängt das Programm nicht.
- Auf einem dritten Rechner (Asus-Mainboard, Core-i7-10700K, Windows 11) gab es bisher nie einen Hänger. Allerdings auch hier intel-Chipsatz-Grafik.

So ein richtiges System kann ich da nicht erkennen:

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

Delphi-Quellcode:

  ...
  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

[TiGü]

Finde doch bitte mal die Versionen der Intel-Treiber raus (Gerätemanager | Grafikarten | Deine Intelkarte | Eigenschaften per Rechtsklick | Tab Treiber).
Wir haben mit neueren Intel-Treibern ab Major-Version 27 für integrierte GPU in OpenGL immer Probleme.

[idontknow]

Hallo TiGü, danke für die Info.

Auf dem Acer ist ein uralter intel-Treiber 20.19.15.4352. Was neueres lässt sich da anscheinend nicht installieren. Der intel-Installer beschwert sich dann mit "...Treiber, der an die Spezifikationen des Herstellers gebunden ist. Versuchen Sie... neuesten Treiber von der Herstellerseite... bla". Witzig.

Auf dem Rechner mit i7-10700K ist 27.20.100.8681, damit geht es.

Habe mittlerweile einen Workaround gefunden, scheint zumindest unter Idealbedingungen (sprich: Bei mir auf dem Schreibtisch, nicht beim Kunden) zu funktionieren.

Delphi-Quellcode:

...
procedure PowerMessageHandler(var MyMessage: TMessage); message WM_POWERBROADCAST; 
...

procedure TDisplayPower.PowerMessageHandler(var MyMessage: TMessage);
var
  PowerBroadcastSetting: PPowerBroadcastSetting;
  fOldDisplayState: Integer;
begin
  // Beim Abschalten und Einschalten des Monitors landen wir hier!
  // Wir werden über Änderungen des Energieverbrauchs benachrichtigt (ab Vista), wenn
  // wir uns für den Empfang registrieren: RegisterPowerSettingNotification(Self.Handle, GUID_CONSOLE_DISPLAY_STATE, 0);
  fOldDisplayState := fDisplayState;
  if (MyMessage.WParam = PBT_POWERSETTINGCHANGE) then
  begin
    PowerBroadcastSetting := PPowerBroadcastSetting(MyMessage.LParam);
    if PowerBroadcastSetting^.PowerSetting = GUID_CONSOLE_DISPLAY_STATE then
    begin
      if (PowerBroadcastSetting^.DataLength > 0) then
      begin
        case PowerBroadcastSetting^.Data[0] of
          0: fDisplayState := 0;  // Memo1.Lines.Add(timetostr(Now) + ' Console-Display aus');
          1: fDisplayState := 1;  // Memo1.Lines.Add(timetostr(Now) + ' Console-Display an');
          2: fDisplayState := 2;  // Memo1.Lines.Add(timetostr(Now) + ' Console-Display an (gedimmt)');
        end;
      end;
    end;

    if fOldDisplayState <> fDisplayState then
      if Assigned(fonNotify) then
        fonNotify(Self, fDisplayState, fPreviousDisplayState);

    fPreviousDisplayState := fDisplayState;
  end;

informiert über "Monitor eingeschaltet", dann wird am Fenster gewackelt

Delphi-Quellcode:

procedure TForm1.DisplayPowerNotify(Sender: TObject; State: Integer; PreviousState: Integer);
begin
  Info('DisplayPowerNotify: ' + State.ToString);

  if (PreviousState=0) and (State=1) then  // Display wird wach.
    WakeUpGL();
end;

procedure TForm1.WakeUpGL;
var
  ws: TWindowState;
begin
  ws := Form1.WindowState;
  if (ws = TWindowState.wsMaximized) then
    Form1.WindowState := TWindowState.wsNormal;

  Left := Left+1;
  Left := Left-1;

  if (ws = TWindowState.wsMaximized) then
    Form1.WindowState := TWindowState.wsMaximized;
end;

und dann läuft die OpenGL-Darstellung sofort weiter...

Prmpff... Das kann es doch eigentlich nicht sein...