delphi 通过 PnP 获取显示器信息示例

uses edid;

procedure TForm1.Button1Click(Sender: TObject);

var

  AMonitors: TPnpMonitors;

  I: Integer;

begin

  AMonitors := TPnpMonitors.Create(Self);

  Memo1.Lines.Add('显示器数量:' + IntToStr(AMonitors.Count));

  for I := 0 to AMonitors.Count - 1 do

  begin

    Memo1.Lines.Add('型号:' + AMonitors[I].FullIdent);

    Memo1.Lines.Add('尺寸:' + IntToStr(AMonitors[I].PhyWidth) + 'cm x ' +IntToStr(AMonitors[I].PhyHeight) + ' cm');

    Memo1.Lines.Add('PPI:' + FormatFloat('0.#', AMonitors[I].XPPI) + ' x ' +FormatFloat('0.#', AMonitors[I].YPPI));

    Memo1.Lines.Add('水平点距:'+FormatFloat('0.###',AMonitors[I].PhyWidth*10/AMonitors[I].BoundsRect.Width));

    Memo1.Lines.Add('垂直点距:'+FormatFloat('0.###',AMonitors[I].PhyHeight*10/AMonitors[I].BoundsRect.Height));

  end;

end;

单元文件

unit edid;

interface

uses classes, sysutils, types, windows, MultiMon, messages, registry;

type

  TMonitorDate = record

    Year, Month, Week: Word;

  end;

  TPnpMonitors = class;

  TPnPMonitor = class

  private

    FKey: String;

    FIsUnknown: Boolean;

    FProvider: String;

    FIsPrimary: Boolean;

    FModel: String;

    FProvExt: String;

    FProvIdent: String;

    FMadeDate: TMonitorDate;

    FHandle: THandle;

    FWorkArea: TRect;

    FDevPath: String;

    FBoundsRect: TRect;

    FSN: Integer;

    FOwner: TPnpMonitors;

    FHeight: Word;

    FWidth: Word;

    function GetFullIdent: String;

    function GetSize: Single;

    procedure SetIsPrimary(const Value: Boolean);

    function GetXPPI: Single;

    function GetYPPI: Single;

  protected

  public

    function ChangeRes(W, H: Word): Boolean;

    property Handle: THandle read FHandle; // 显示器句柄

    property Provider: String read FProvider; // 供应商

    property Model: String read FModel; // 显示器型号

    property ProvIdent: String read FProvIdent; // 厂家标志

    property FullIdent: String read GetFullIdent; // 显示器完整描述

    property ProvExt: String read FProvExt; // 厂商扩展数据

    property Key: String read FKey;

    property DevPath: String read FDevPath;

    property MadeDate: TMonitorDate read FMadeDate;

    property PhyHeight: Word read FHeight;

    property PhyWidth: Word read FWidth;

    property BoundsRect: TRect read FBoundsRect;

    property Workarea: TRect read FWorkArea;

    property IsPrimary: Boolean read FIsPrimary write SetIsPrimary;

    property IsUnknown: Boolean read FIsUnknown;

    property Size: Single read GetSize;

    property XPPI:Single read GetXPPI;

    property YPPI:Single read GetYPPI;

  end;

  TPnpMonitors = class(TComponent)

  private

    function GetCount: Integer;

    function GetMonitors(AIndex: Integer): TPnPMonitor;

    procedure SetPrimary(const Value: TPnPMonitor);

  protected

    FMonitors: array of TPnPMonitor;

    FNotifyWnd: HWND;

    FDisplayChanged: Boolean;

    FOnChange: TNotifyEvent;

    FPrimary: TPnPMonitor;

    FChangesCount: Integer;

    procedure WndProc(var AMsg: TMessage);

    procedure DecodeEDID(const S: TBytes; AMonitor: TPnPMonitor);

    procedure BeginChanges;

    procedure EndChanges;

    procedure EnumMonitors;

    procedure RefreshMonitors;

    procedure Clear;

  public

    constructor Create(AOwner: TComponent);

    destructor Destroy; override;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;

    property Count: Integer read GetCount;

    property Monitors[AIndex: Integer]: TPnPMonitor read GetMonitors; default;

    property Primary: TPnPMonitor read FPrimary write SetPrimary;

  end;

implementation

const

  ENUM_CURRENT_SETTINGS = DWORD(-1);

  ENUM_REGISTRY_SETTINGS = DWORD(-2);

  DISP_CHANGE_BADDUALVIEW = DWORD(-6);

  DIGCF_PRESENT = $00000002;

  GUID_DEVCLASS_MONITOR: TGuid = '{4D36E96E-E325-11CE-BFC1-08002BE10318}';

type

  TDevModMonitor = record

    dmPosition: TPoint;

    dmDisplayOrientation: DWORD;

    dmDisplayFixedOutput: DWORD;

  end;

  PDevModMonitor = ^TDevModMonitor;

  SP_DEVINFO_DATA = packed record

    cbSize: DWORD;

    ClassGuid: TGuid;

    DevInst: DWORD; // DEVINST handle

    Reserved: ULONG_PTR;

  end;

  TSPDevInfoData = SP_DEVINFO_DATA;

  PSPDevInfoData = ^TSPDevInfoData;

  TMonitorEnumData = record

    Source: TPnpMonitors;

    ItemIndex: Integer;

  end;

  PMonitorEnumData = ^TMonitorEnumData;

  // SetupDiGetClassDevsW

function SetupDiGetClassDevsW(ClassGuid: PGUID; const Enumerator: PWideChar;

  hwndParent: HWND; Flags: DWORD): Pointer; stdcall; external 'SetupApi.dll';

function SetupDiEnumDeviceInfo(DeviceInfoSet: Pointer; MemberIndex: DWORD;

  var DeviceInfoData: TSPDevInfoData): BOOL; stdcall; external 'SetupApi.dll';

function SetupDiGetDeviceInstanceIdW(DeviceInfoSet: Pointer;

  DeviceInfoData: PSPDevInfoData; DeviceInstanceId: PWideChar;

  DeviceInstanceIdSize: DWORD; RequiredSize: PDWORD): BOOL; stdcall;

  external 'SetupApi.dll';

function SetupDiDestroyDeviceInfoList(DeviceInfoSet: Pointer): BOOL; stdcall;

  external 'SetupApi.dll';

{ TPnPMonitor }

function TPnPMonitor.ChangeRes(W, H: Word): Boolean;

var

  AMode: DEVMODE;

begin

  FillChar(AMode, SizeOf(AMode), 0);

  AMode.dmSize := SizeOf(DEVMODE);

  Result := False;

  if EnumDisplaySettingsW(PWideChar(DevPath), ENUM_CURRENT_SETTINGS, AMode) then

  begin

    if (AMode.dmPelsWidth <> W) and (AMode.dmPelsHeight <> H) then

    begin

      AMode.dmPelsWidth := W;

      AMode.dmPelsHeight := H;

      AMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;

      Result := ChangeDisplaySettingsEx(PWideChar(DevPath), AMode, 0, 0, nil)

        = DISP_CHANGE_SUCCESSFUL;

    end;

  end;

end;

function TPnPMonitor.GetFullIdent: String;

begin

  Result := FProvIdent + FModel;

  if not FIsUnknown then

  begin

    Result := Result +' '+ FormatFloat('#.#', Size) + '" ';

    if FMadeDate.Year <> 0 then

      Result := Result + IntToStr(FMadeDate.Year) + '-' +

        IntToStr(FMadeDate.Month);

    Result := Result + ' ' + IntToStr(FSN) + '-' + FProvExt;

  end;

end;

function TPnPMonitor.GetSize: Single;

begin

  if not FIsUnknown then

    Result := sqrt(FWidth * 1.0 * FWidth + FHeight * FHeight) / 2.54

  else

    Result := 0;

end;

function TPnPMonitor.GetXPPI: Single;

begin

Result:=FBoundsRect.Width*2.54/PhyWidth;

end;

function TPnPMonitor.GetYPPI: Single;

begin

Result:=FBoundsRect.Height*2.54/PhyWidth;

end;

procedure TPnPMonitor.SetIsPrimary(const Value: Boolean);

begin

  if FIsPrimary <> Value then

  begin

    if Value then

      FOwner.SetPrimary(Self);

  end;

end;

{ TPnpMonitors }

procedure TPnpMonitors.BeginChanges;

begin

  Inc(FChangesCount);

end;

procedure TPnpMonitors.Clear;

var

  I: Integer;

begin

  for I := 0 to High(FMonitors) do

    FreeAndNil(FMonitors[I]);

  SetLength(FMonitors, 0);

end;

constructor TPnpMonitors.Create(AOwner: TComponent);

begin

  inherited;

  FChangesCount := 0;

  FNotifyWnd := AllocateHWnd(WndProc); // classes.hpp

  FDisplayChanged := true;

  RefreshMonitors;

end;

procedure TPnpMonitors.DecodeEDID(const S: TBytes; AMonitor: TPnPMonitor);

var

  AMfg: array [0 .. 3] of Byte;

  AVal: Byte;

  AModel: Word;

  p: PByte;

  AExt: String;

  I, J: Integer;

begin

  FillChar(AMfg, 3, Ord('A'));

  AVal := S[8] shr 2;

  if AVal <> 0 then

    Inc(AMfg[0], AVal - 1)

  else

    AMfg[0] := 0;

  AVal := ((S[8] and $03) shl 3) or ((S[9] and $E0) shr 5);

  if AVal <> 0 then

    Inc(AMfg[1], AVal - 1)

  else

    AMfg[1] := 0;

  AVal := (S[9] and $1F);

  if AVal <> 0 then

    Inc(AMfg[2], AVal - 1)

  else

    AMfg[2] := 0;

  AMonitor.FProvIdent := PAnsiChar(@AMfg[0]);

  AModel := (S[11] shl 8) or S[10];

  AMonitor.FModel := IntToHex(AModel, 0);

  AMonitor.FSN := (S[12] shl 24) or (S[13] shl 16) or (S[14] shl 8) or S[15];

  AMonitor.FMadeDate.Week := S[16];

  AMonitor.FMadeDate.Year := 1990 + S[17];

  AMonitor.FWidth := S[21];

  AMonitor.FHeight := S[22];

  p := @S[108]; // 第一个扩展信息区

  AExt := '';

  for I := 0 to 3 do

  begin

    case PInteger(p)^ of

      $FF000000, $FC000000, $FE000000:

        begin

          Inc(p, 5);

          for J := 0 to 12 do

          begin

            if p[J] = $A then

            begin

              p[J] := 0;

              Break;

            end;

          end;

          AExt := AnsiString(PAnsiChar(p)) + ' ' + AExt;

          Dec(p, 5);

        end;

    end;

    Dec(p, 18);

  end;

  AMonitor.FProvExt := AExt;

  AMonitor.FProvider := PAnsiChar(@AMfg[0]); // ProviderByCode(AMfg);

end;

destructor TPnpMonitors.Destroy;

begin

  Clear;

  DeallocateHWnd(FNotifyWnd);

  inherited;

end;

procedure TPnpMonitors.EndChanges;

begin

  Dec(FChangesCount);

  if FChangesCount = 0 then

  begin

    if Assigned(FOnChange) then

      FOnChange(Self);

  end;

end;

procedure TPnpMonitors.EnumMonitors;

var

  RegSize: DWORD;

  hDev: Pointer;

  Index: Integer;

  C: Integer;

  DevData: SP_DEVINFO_DATA;

  Buf: array [0 .. 4095] of WideChar;

begin

  Clear;

  hDev := SetupDiGetClassDevsW(@GUID_DEVCLASS_MONITOR, nil, 0, DIGCF_PRESENT);

  if hDev <> nil then

  begin

    DevData.cbSize := SizeOf(SP_DEVINFO_DATA);

    Index := 0;

    C := 0;

    SetLength(FMonitors, 64); // 64个显示器？足够了，不够再改

    try

      while SetupDiEnumDeviceInfo(hDev, Index, DevData) do

      begin

        if SetupDiGetDeviceInstanceIdW(hDev, @DevData, Buf, 4096, nil) then

        begin

          FMonitors[C] := TPnPMonitor.Create;

          FMonitors[C].FKey := PWideChar(@Buf[0]);

          Inc(C);

        end;

        Inc(Index);

      end;

    finally

      SetupDiDestroyDeviceInfoList(hDev);

      SetLength(FMonitors, C);

    end;

  end;

end;

function TPnpMonitors.GetCount: Integer;

begin

  Result := Length(FMonitors);

end;

function TPnpMonitors.GetMonitors(AIndex: Integer): TPnPMonitor;

begin

  Result := FMonitors[AIndex];

end;

function DoMonitorEnum(AMonitorHandle: HMONITOR; hdcMonitor: HDC;

  lprcMonitor: PRect; dwData: LPARAM): Boolean; stdcall;

var

  AData: PMonitorEnumData;

  AMonitor: TPnPMonitor;

  AInfo: MONITORINFOEX;

  I: Integer;

begin

  AData := PMonitorEnumData(dwData);

  AInfo.cbSize := SizeOf(MONITORINFOEX);

  GetMonitorInfo(AMonitorHandle, @AInfo);

  for I := 0 to AData.Source.Count - 1 do

  begin

    AMonitor := AData.Source.Monitors[I];

    if AMonitor.FDevPath = AInfo.szDevice then

    begin

      AMonitor.FHandle := AMonitorHandle;

      AMonitor.FBoundsRect := lprcMonitor^;

      AMonitor.FWorkArea := AInfo.rcWork;

      if (AInfo.dwFlags and MONITORINFOF_PRIMARY) <> 0 then

        AMonitor.FIsPrimary := true;

      Break;

    end;

  end;

  Result := true;

end;

procedure TPnpMonitors.RefreshMonitors;

  procedure ReadEDID;

  var

    AData: TBytes;

    AReg: TRegistry;

    AItem: TPnPMonitor;

    I: Integer;

  begin

    AReg := TRegistry.Create;

    AReg.RootKey := HKEY_LOCAL_MACHINE;

    EnumMonitors();

    for I := 0 to High(FMonitors) do

    begin

      AItem := FMonitors[I];

      if AReg.OpenKeyReadOnly('System\CurrentControlSet\Enum\' + AItem.Key +

        '\Device Parameters') then

      begin

        try

          if AReg.ValueExists('EDID') then

          begin

            SetLength(AData, AReg.GetDataSize('EDID'));

            AReg.ReadBinaryData('EDID', AData[0], Length(AData));

            DecodeEDID(AData, AItem);

          end;

        finally

          AReg.CloseKey;

        end;

      end;

    end;

  end;

  procedure Bind;

  var

    AData: TMonitorEnumData;

    Dev: TDisplayDeviceW;

    I: Integer;

  begin

    AData.Source := Self;

    AData.ItemIndex := 0;

    Dev.cb := SizeOf(TDisplayDeviceW);

    I := 0;

    while EnumDisplayDevicesW(nil, I, Dev, 0) do

    begin

      if (Dev.StateFlags and DISPLAY_DEVICE_MIRRORING_DRIVER) = 0 then

      begin

        if (Dev.StateFlags and DISPLAY_DEVICE_ATTACHED_TO_DESKTOP) <> 0 then

        begin

          Monitors[AData.ItemIndex].FDevPath := Dev.DeviceName;

          if (Dev.StateFlags and DISPLAY_DEVICE_PRIMARY_DEVICE) <> 0 then

          begin

            Monitors[AData.ItemIndex].FIsPrimary := true;

            FPrimary := Monitors[AData.ItemIndex];

          end;

          Inc(AData.ItemIndex);

        end;

      end;

      Inc(I);

    end;

    AData.ItemIndex := 0;

    EnumDisplayMonitors(0, nil, DoMonitorEnum, IntPtr(@AData));

  end;

begin

  FDisplayChanged := False;

  ReadEDID;

  if Length(FMonitors) > 0 then // 接下来使用API来建立HMonitor相关的信息与显示器之间的关联

    Bind;

end;

procedure TPnpMonitors.SetPrimary(const Value: TPnPMonitor);

var

  AMode: DEVMODE;

  ADispMode: PDevModMonitor;

  ASorted: array of TPnPMonitor;

  AOffset: TSize;

  rc: Integer;

  ATemp: TPnPMonitor;

  I: Integer;

  function DoCompare(M1, M2: TPnPMonitor): Integer;

  begin

    Result := M1.BoundsRect.Left - M2.BoundsRect.Left;

    if Result = 0 then

      Result := M1.BoundsRect.Top - M2.BoundsRect.Top;

  end;

  procedure Sort(L, R: Integer);

  var

    I, J, p: Integer;

  begin

    repeat

      I := L;

      J := R;

      p := (L + R) shr 1;

      repeat

        while DoCompare(ASorted[I], ASorted[p]) < 0 do

          Inc(I);

        while DoCompare(ASorted[J], ASorted[p]) > 0 do

          Dec(J);

        if I <= J then

        begin

          if I <> J then

          begin

            ATemp := ASorted[I];

            ASorted[I] := ASorted[J];

            ASorted[J] := ATemp;

          end;

          if p = I then

            p := J

          else if p = J then

            p := I;

          Inc(I);

          Dec(J);

        end;

      until I > J;

      if L < J then

        Sort(L, J);

      L := I;

    until I >= R;

  end;

begin

  BeginChanges;

  try

    FillChar(AMode, SizeOf(AMode), 0);

    AMode.dmSize := SizeOf(DEVMODE);

    SetLength(ASorted, Count);

    Move(FMonitors[0], ASorted[0], Count * SizeOf(TPnPMonitor));

    Sort(0, High(ASorted));

    AOffset.cx := FPrimary.BoundsRect.Width;

    for I := 0 to High(ASorted) do

    begin

      ATemp := ASorted[I];

      if EnumDisplaySettings(PWideChar(ATemp.DevPath), ENUM_CURRENT_SETTINGS,

        AMode) then

      begin

        AMode.dmFields := DM_POSITION;

        ADispMode := @AMode.dmOrientation;

        Dec(ADispMode.dmPosition.X, AOffset.cx);

        if ChangeDisplaySettingsExW(PWideChar(Value.DevPath), AMode, 0,

          CDS_UPDATEREGISTRY or CDS_NORESET, nil) = DISP_CHANGE_SUCCESSFUL then

        begin

          FPrimary := Value;

          Break;

        end

        else

          RaiseLastOSError;

      end;

    end;

  finally

    EndChanges;

  end;

end;

procedure TPnpMonitors.WndProc(var AMsg: TMessage);

begin

  if AMsg.Msg = WM_DISPLAYCHANGE then

  begin

    FDisplayChanged := true;

    if FChangesCount = 0 then

      PostMessage(FNotifyWnd, WM_APP, 0, 0); // 异步而不是直接调用

  end

  else if AMsg.Msg = WM_APP then

    RefreshMonitors

  else

    AMsg.Result := DefWindowProc(FNotifyWnd, AMsg.Msg, AMsg.WParam,

      AMsg.LPARAM);

end;

end.