AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi Windows-Energieoptionen: Monitor aus -> OpenGL friert ein

Windows-Energieoptionen: Monitor aus -> OpenGL friert ein

Ein Thema von idontknow · begonnen am 26. Apr 2022 · letzter Beitrag vom 27. Apr 2022
Antwort Antwort
idontknow

Registriert seit: 21. Apr 2008
Ort: Schleswig-Holstein
47 Beiträge
 
Delphi 11 Alexandria
 
#1

Windows-Energieoptionen: Monitor aus -> OpenGL friert ein

  Alt 26. Apr 2022, 14:11
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.
Miniaturansicht angehängter Grafiken
dreieck-verwirblung.png  
Angehängte Dateien
Dateityp: 7z Quellcode, dglOpengl.pas erforderlich.7z (85,8 KB, 1x aufgerufen)
Oliver

Geändert von idontknow (26. Apr 2022 um 14:16 Uhr)
  Mit Zitat antworten Zitat
TurboMagic

Registriert seit: 28. Feb 2016
Ort: Nordost Baden-Württemberg
2.002 Beiträge
 
Delphi 10.3 Rio
 
#2

AW: Windows-Energieoptionen: Monitor aus -> OpenGL friert ein

  Alt 26. Apr 2022, 18:27
Schon mal mit OutputDebugString('Meine Meldung') geprüft, ob DreieckMalen nach der Reaktivierung des Bildschirms gleich aufgerufen wird?
  Mit Zitat antworten Zitat
idontknow

Registriert seit: 21. Apr 2008
Ort: Schleswig-Holstein
47 Beiträge
 
Delphi 11 Alexandria
 
#3

AW: Windows-Energieoptionen: Monitor aus -> OpenGL friert ein

  Alt 26. Apr 2022, 18:56
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
Oliver
  Mit Zitat antworten Zitat
TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
2.925 Beiträge
 
Delphi 10.2 Tokyo Enterprise
 
#4

AW: Windows-Energieoptionen: Monitor aus -> OpenGL friert ein

  Alt 27. Apr 2022, 09:02
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.
  Mit Zitat antworten Zitat
idontknow

Registriert seit: 21. Apr 2008
Ort: Schleswig-Holstein
47 Beiträge
 
Delphi 11 Alexandria
 
#5

AW: Windows-Energieoptionen: Monitor aus -> OpenGL friert ein

  Alt 27. Apr 2022, 13:04
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...
Oliver
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:56 Uhr.
Powered by vBulletin® Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf