Monitornamen wie in Systemsteuerung auslesen

[MessOldie]

Ausschnitt aus meiner Unit:

Delphi-Quellcode:

Unit MonitorInfo;

interface

uses Windows; //CCHDEVICENAME ist in Windows.pas definiert

type
  HMONITOR = type Integer;
  {$EXTERNALSYM HMONITOR}

function GetMonitorEDID(MonitorHandle: HMONITOR): String;
//die folgenden Funktionen nutzen dann die EDID)
function ExtractMonitorName(var edid: String): String;
function ExtractMonitorSerNumb(var edid: String): String;
function ExtractMonitorAddedText(var edid: String): String;
//function ExtractMonitorEisaId(var edid: String): String;
//function ExtractMonitorNumSerNumb(var edid: String): String;
//function ExtractMonitorManufacturingWeek(var edid: String): String;
//function ExtractNativeResolution(var edid: String): String;
//function ExtractMonitorRangeLimits(var edid: String): String;
//function ExtractMaxWidthHeightCm(var edid: String): String;
//function MonitorCheckSumCheck(var edid: String): Boolean; 
///...

implementation

uses SysUtils, Classes, Registry, Dialogs;

type
  TMonitorInfoEx = packed record
    Size: DWORD;
    rcMonitor: TRect;
    rcWork: TRect;
    dwFlags: DWORD;
    szDevice: array[0..CCHDEVICENAME-1] of AnsiChar;
  end;

function GetMonitorInfo(hMonitor: HMONITOR; 
                        var MonitorInfo: TMonitorInfoEx): Boolean; stdcall;
  external 'User32.dll' name 'GetMonitorInfoA';

type
  TDisplayDevice = packed record
    Size: DWORD;
    DeviceName: array[0 .. CCHDEVICENAME-1] of AnsiChar;
    DeviceString: array[0 .. 127] of AnsiChar;
    StateFlags: DWORD;
    DeviceID: array[0..127] of AnsiChar;
    DeviceKey: array[0..127] of AnsiChar;
  end;

function EnumDisplayDevices(ADeviceName: PChar; ADeviceIndex: DWORD;
                            Var ADisplayDevice: TDisplayDevice;
                            AFlags: DWORD): Boolean; stdcall;
   external 'User32.dll' Name 'EnumDisplayDevicesA';     
                        
function GetMonitorName(MonitorHandle: HMONITOR): String;
  var
    MoniInfo: TMonitorInfoEx;
begin
  Result := '';
  MoniInfo.Size := SizeOf(MoniInfo); //Wichtig!
  if not GetMonitorInfo(MonitorHandle, MoniInfo) then
    raise Exception.Create('GetMonitorInfo?') //***************
  else
    Result := MoniInfo.szDevice
end;

function GetMonitorEDID(MonitorHandle: HMONITOR): String;
  var
    DisplayInfo: TDisplayDevice;
    s: String;
    i, n: Integer;
    reg: TRegistry;
    keyList: TStringList;
begin
  s := GetMonitorName(MonitorHandle);
  if Length(s) > 0 then
  try
    DisplayInfo.Size := SizeOf(DisplayInfo);
    if not EnumDisplayDevices(PChar(s), 0, DisplayInfo, 0) then
      raise Exception.Create('EnumDisplayDevices?'); // ==> finally
    s := DisplayInfo.DeviceID;  
    n := Pos('MONITOR\', s);
    if n <> 1 then
      raise Exception.Create('DeviceID?'); // ==> finally
    Delete(s, 1, Length('MONITOR\'));  
    n := Pos('\{', s);
    if n = 0 then
      raise Exception.Create('DeviceID?'); // ==> finally
    Delete(s, n, Length(s));
    s := 'SYSTEM\CurrentControlSet\Enum\DISPLAY\' + s; 
    reg := TRegistry.Create;
    reg.RootKey := HKEY_LOCAL_MACHINE;
    keyList := TStringList.Create;
    keyList.Clear;
    try
      if not reg.OpenKeyReadOnly(s) then
        raise Exception.Create('DeviceID?');
      reg.GetKeyNames(keylist);
      reg.CloseKey;
      n := 0;
      for i := 0 to KeyList.Count-1 do
      begin
        if reg.OpenKeyReadOnly(s + '\' + keyList[i] + '\Control') then
        begin
          s := s + '\' + keyList[i] + '\Device Parameters';
          reg.CloseKey;
          if reg.OpenKeyReadOnly(s) then
          begin
            n := reg.GetDataSize('EDID');
            Break;
          end;
        end;
      end; //for i
      if n = 0 then
        raise Exception.Create('EDID?');  // ==> finally
      SetLength(Result, n);
      reg.ReadBinaryData( 'EDID', Result[1], n);
    finally
      reg.CloseKey;
      keyList.Free;
      reg.Free;
    end;
  except
    SetLength(Result, 0);
    raise;
  end;
end;

function ExtractMonitorNameNumbText(Tag: Byte; var edid: String): String;
  var i, k: Integer;
begin
  Result := '';
  if Length(edid) > 60 then
    for i := 55 to Length(edid) do
    begin
       if (edid[i] = Chr(0)) and (edid[i+1] = Chr(0)) and (edid[i+2] = Chr(0)) and 
          (edid[i+4] = Chr(0)) and (edid[i+3] = Chr(Tag)) then
      begin
        for k := i+5 to Length(edid) do
          if edid[k] = Chr($0A) then 
            Break
          else
            Result := Result + edid[k];
      end;
    end;
end;

function ExtractMonitorName(var edid: String): String;
begin
  Result := ExtractMonitorNameNumbText($FC, edid);
end;

function ExtractMonitorSerNumb(var edid: String): String;
begin
  Result := ExtractMonitorNameNumbText($FF, edid);
end;

function ExtractMonitorAddedText(var edid: String): String;
begin
  Result := ExtractMonitorNameNumbText($FE, edid);
end; 

//...
end.

Nutzung im Programm (z. B.):

Delphi-Quellcode:

//...
var 
  Memo1: TMemo;
  edid, s: String;
for i := 0 to Screen.MonitorCount-1 do
begin
  edid := GetMonitorEDID(Screen.Monitors[i].Handle);
  Memo.Lines.Add(ExtractMonitorName(edid));
end;

- Das meiste habe ich mir hier oder an anderer Internet-Stelle "aufgelesen".
- Wer den Programmierstil für unmodern hält, hat sicher recht. Aber ich bin inzwischen so alt, dass mir Überschaubarkeit wichtiger ist als Eleganz.
- Wer Fehler findet, sollte sie nicht behalten, sondern mir um die Ohren hauen