1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:

unit UVHWAccel;

// (C) 2012 by Narses, v1.00 vom 20.04.2012

interface

// Registry-Key des primären Display-Devices holen
// ReturnCode:
// Leerstring: Fehler aufgetreten (primäres Device konnte nicht ermittelt werden)
// sonst: der Schlüssel im Hive HKEY_LOCAL_MACHINE zum primären Display-Device
function GetPrimaryDisplayKey(const ForceUpdate: Boolean = FALSE): AnsiString;

// Hardwarebeschleunigungs-Einstellung des aktuellen Videogerätes ermitteln
// Returncode:
// -1: Fehler aufgetreten
//  0: maximale Beschleunigung
//  1: Cursor und BitBlit deaktiviert
//  2: erweiterte Grafik und Cursor deaktiviert
//  3: alle DD-Funktionen und Cursor deaktiviert
//  4: alles ausser Basisbeschleunigung deaktiviert
//  5: alles deaktiviert
function GetHardwareAccelerationLevel: Integer;

// Hardwarebeschleunigungs-Einstellung des aktuellen Videogerätes setzen
// erlaubte Werte siehe oben
// Returncode:
// TRUE: alles OK, FALSE: Fehler aufgetreten, Wert nicht gesetzt
function SetHardwareAccelerationLevel(const NewLevel: Integer): Boolean;

// Display-Einstellungen aktualisieren
// Returncode:
// TRUE: alles OK, FALSE: Fehler aufgetreten
function ForceUpdateDisplaySettings: Boolean;

implementation

uses
  Windows, Registry, SysUtils;

const
  DISPLAY_DEVICE_PRIMARY_DEVICE = DWORD($00000004);

  REG_PATH_VIDEO = AnsiString('\HARDWARE\DEVICEMAP\VIDEO');
  REG_KEY_VIDEO0 = AnsiString('\Device\Video0');
  REG_PREFIX     = AnsiString('\REGISTRY\MACHINE');
  REG_ACCEL_VAL  = AnsiString('Acceleration.Level');

  ENUM_CURRENT_SETTINGS = DWORD(-1); // aus JwaWinUser.pas

type
  // http://msdn.microsoft.com/en-us/library/dd183569(v=vs.85).aspx
  TDisplayDevice = packed record
    cb: DWORD;
    DeviceName: array[0..31] of AnsiChar;
    DeviceString: array[0..127] of AnsiChar;
    StateFlags: DWORD;
    DeviceID: array[0..127] of AnsiChar;
    DeviceKey: array[0..127] of AnsiChar;
  end;

var
  PrimaryDisplayKeyCached: AnsiString;

// Import der API-Funktion  
function EnumDisplayDevices(Unused: Pointer; iDevNum: DWORD;
  var lpDisplayDevice: TDisplayDevice; dwFlags: DWORD): BOOL;
  stdcall; external user32 name 'EnumDisplayDevicesA';

function GetPrimaryDisplayKey(const ForceUpdate: Boolean = FALSE): AnsiString;
  var
    DisplayDevice: TDisplayDevice;
    iDevNum: DWORD;
    Reg: TRegistry;
begin
  if ForceUpdate then
    PrimaryDisplayKeyCached := '';
  if (PrimaryDisplayKeyCached = '') then begin
    // Standard: Registrierungs-Schlüssel per API ermitteln
    DisplayDevice.cb := SizeOf(DisplayDevice);
    iDevNum:= 0;
    // http://msdn.microsoft.com/en-us/library/dd162609(v=vs.85).aspx
    while (PrimaryDisplayKeyCached = '') and EnumDisplayDevices(NIL, iDevNum, DisplayDevice, 0) do begin
      if (DisplayDevice.StateFlags and DISPLAY_DEVICE_PRIMARY_DEVICE) <> 0 then
        PrimaryDisplayKeyCached := DisplayDevice.DeviceKey;
        // DisplayDevice.DeviceString -> da steht der Klartextname drin
      Inc(iDevNum);
    end;
    // Backup: Schlüssel aus Device \Video0 nehmen, wenn vorhanden
    if (PrimaryDisplayKeyCached = '') then begin
      Reg := TRegistry.Create(KEY_READ);
      try
        try
          Reg.RootKey := HKEY_LOCAL_MACHINE;
          if Reg.OpenKey(REG_PATH_VIDEO, FALSE) then
            PrimaryDisplayKeyCached := Reg.ReadString(REG_KEY_VIDEO0);
        finally
          Reg.Free;
        end;
      except
        PrimaryDisplayKeyCached := '';
      end;
    end;
    // Nacharbeiten: das Dummy-Prefix am Anfang entfernen
    if (UpperCase(Copy(PrimaryDisplayKeyCached, 1, Length(REG_PREFIX))) = REG_PREFIX) then
      Delete(PrimaryDisplayKeyCached, 1, Length(REG_PREFIX));
  end;
  Result := PrimaryDisplayKeyCached;
end;

function GetHardwareAccelerationLevel: Integer;
  var
    Reg: TRegistry;
begin
  Result := -1; // ERROR
  if (PrimaryDisplayKeyCached = '') then
    GetPrimaryDisplayKey;
  if (PrimaryDisplayKeyCached <> '') then begin
    Reg := TRegistry.Create(KEY_READ);
    try
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      if Reg.OpenKey(PrimaryDisplayKeyCached, FALSE) then begin
        if Reg.ValueExists(REG_ACCEL_VAL) then
          Result := Reg.ReadInteger(REG_ACCEL_VAL)
        else
          Result := 0; // Default, wenn Wert fehlt
      end
    finally
      Reg.Free;
    end;
  end;
end;

function SetHardwareAccelerationLevel(const NewLevel: Integer): Boolean;
  var
    Reg: TRegistry;
begin
  Result := FALSE; // ERROR
  if (PrimaryDisplayKeyCached = '') then
    GetPrimaryDisplayKey;
  if (PrimaryDisplayKeyCached <> '') then begin
    Reg := TRegistry.Create;
    try
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      if Reg.OpenKey(PrimaryDisplayKeyCached, FALSE) then begin
        if (NewLevel = 0) then begin
          Reg.DeleteValue(REG_ACCEL_VAL);
          Result := TRUE;
        end
        else if (NewLevel in [1..5]) then begin
          Reg.WriteInteger(REG_ACCEL_VAL, NewLevel);
          Result := TRUE;
        end;
      end
    finally
      Reg.Free;
    end;
  end;
end;

function ForceUpdateDisplaySettings: Boolean;
  var
    DevMode: TDevMode;
begin
  // http://msdn.microsoft.com/en-us/library/dd162611(v=vs.85).aspx
  Result := EnumDisplaySettings(NIL, ENUM_CURRENT_SETTINGS, DevMode);
  if Result then
    // http://msdn.microsoft.com/en-us/library/dd183411(v=vs.85).aspx
    ChangeDisplaySettings(DevMode, CDS_RESET);
end;

initialization
  PrimaryDisplayKeyCached := '';

end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:

uses
  ..., UVHWAccel;

  var
    i: Integer;
begin
  i := GetHardwareAccelerationLevel;
  if (i >= 0) then
    ShowMessage(IntToStr(i))
  else
    ShowMessage('Fehler!');
end;

begin
  if SetHardwareAccelerationLevel(0) then // max. Beschleunigung
    ForceUpdateDisplaySettings // Änderung aktivieren
  else
    ShowMessage('Fehler!');