unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus,
  DirectDraw, DirectInput, DirectSound, DirectSetup;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    DirectX1: TMenuItem;
    List: TListBox;
    Button1: TButton;
    Display1: TMenuItem;
    Modes1: TMenuItem;
    Capabilities1: TMenuItem;
    Input1: TMenuItem;
    Sound1: TMenuItem;
    SoundCapabilities1: TMenuItem;
    DirectXVersion1: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure MainClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure Display;
    procedure DisplayModes;
    procedure Capabilities;
    procedure Input;
    procedure Sound;
    procedure SoundCapabilities;
    procedure DirectXVersion;
  end;

var
  Form1: TForm1;
  FDirectDraw : IDirectDraw4;
  FDirectInput : IDirectInput;

implementation

{$R *.DFM}

uses GetDXVer;

procedure TForm1.Button1Click(Sender: TObject);
begin
  List.Items.Clear;
end;

function EnumDevices(lpGUID: PGUID; lpDriverDescrption: PAnsiChar;
         lpDriverName: PAnsiChar; lpContext: Pointer; Monitor: HMonitor):BOOL; stdcall;
begin
  TStringList(lpContext).Add(lpDriverName+' - '+lpDriverDescrption);
  Result := True;
end;

procedure TForm1.Display;
begin
  DirectDrawEnumerateEx(EnumDevices, List.Items, 0);
end;

function EnumModesCallback(const lpDDSurfaceDesc : TDDSurfaceDesc2;
                                 lpContext: Pointer):HResult; stdcall;
begin
  TStringList(lpContext).Add(IntToStr(lpDDSurfaceDesc.dwWidth)+' X '+
                         IntToStr(lpDDSurfaceDesc.dwHeight)+' , '+
                         IntToStr(lpDDSurfaceDesc.ddpfPixelFormat.dwRGBBitcount)+
                         ' bits');
  Result := DDENUMRET_OK;
end;

procedure TForm1.DisplayModes;
var
  TempDirectDraw : IDirectDraw;
begin
  DirectDrawCreate(nil, TempDirectDraw, nil);
  try
    TempDirectDraw.QueryInterface(IID_IDirectDraw4, FDirectDraw);
  finally
    TempDirectDraw := nil;
  end;

  FDirectDraw.EnumDisplayModes(0,nil, List.Items, EnumModesCallback);
end;

procedure TForm1.MainClick(Sender: TObject);
begin
  if List.Items.Count > 0 then List.Items.Add('');
  if TComponent(Sender) = Display1 then Display;
  if TComponent(Sender) = Modes1 then DisplayModes;
  if TComponent(Sender) = Capabilities1 then Capabilities;
  if TComponent(Sender) = Input1 then Input;
  if TComponent(Sender) = Sound1 then Sound;
  if TComponent(Sender) = SoundCapabilities1 then SoundCapabilities;
  if TComponent(Sender) = DirectXVersion1 then DirectXVersion;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.Capabilities;
var
  TempDirectDraw : IDirectDraw;
  HALCaps, HELCaps : TDDCaps;
begin
  DirectDrawCreate(nil, TempDirectDraw, nil);
  try
    TempDirectDraw.QueryInterface(IID_IDirectDraw4, FDirectDraw);
  finally
    TempDirectDraw := nil;
  end;

  FillChar(HALCaps, SizeOf(TDDCaps), 0);
  FillChar(HELCaps, SizeOf(TDDCaps), 0);
  HALCaps.dwSize := SizeOf(TDDCaps);
  HELCaps.dwSize := SizeOf(TDDCaps);

  FDirectDraw.GetCaps(@HALCaps, @HELCaps);

  with List.Items do begin
      Add('Total Video Memory: ' + IntToStr(HALCaps.dwVidMemTotal div 1000)+' KB');
      Add('');

      Add('Hardware Capabilities');
      Add('--------------------------------------------------');

      if (HALCaps.dwCaps and DDCAPS_BLT) = DDCAPS_BLT
         then Add('Hardware accelerated blits');
      if (HALCaps.dwCaps and DDCAPS_BLTCOLORFILL) = DDCAPS_BLTCOLORFILL
         then Add('Hardware accelerated color blits');
      if (HALCaps.dwCaps and DDCAPS_BLTQUEUE) = DDCAPS_BLTQUEUE
         then Add('Asynchronous hardware blits');
      if (HALCaps.dwCaps and DDCAPS_BLTSTRETCH) = DDCAPS_BLTSTRETCH
         then Add('Hardware stretch blits');
      if (HALCaps.dwCaps2 and DDCAPS2_CERTIFIED) = DDCAPS2_CERTIFIED
         then Add('Microsoft certified driver');
      if (HALCaps.dwCaps2 and DDCAPS2_NONLOCALVIDMEM) = DDCAPS2_NONLOCALVIDMEM
         then Add('AGP video card');
      if (HALCaps.dwCKeyCaps and DDCKEYCAPS_SRCBLT) = DDCKEYCAPS_SRCBLT
         then Add('Hardware accelerated source color key blits');

      Add('');
      Add('');

      Add('Emulated Capabilities');
      Add('--------------------------------------------------');

      if (HELCaps.dwCaps and DDCAPS_BLT) = DDCAPS_BLT
         then Add('Emulated blits');

      if (HELCaps.dwCaps and DDCAPS_BLTCOLORFILL) = DDCAPS_BLTCOLORFILL
         then Add('Emulated color blits');

      if (HELCaps.dwCaps and DDCAPS_BLTQUEUE) = DDCAPS_BLTQUEUE
         then Add('Emulated asynchronous blits');

      if (HELCaps.dwCaps and DDCAPS_BLTSTRETCH) = DDCAPS_BLTSTRETCH
         then Add('Emulated stretch blits');

      if (HELCaps.dwCaps2 and DDCAPS2_CERTIFIED) = DDCAPS2_CERTIFIED
         then Add('Microsoft certified driver');

      if (HELCaps.dwCaps2 and DDCAPS2_NONLOCALVIDMEM) = DDCAPS2_NONLOCALVIDMEM
         then Add('Emulated AGP video card');

      if (HELCaps.dwCKeyCaps and DDCKEYCAPS_SRCBLT) = DDCKEYCAPS_SRCBLT
         then Add('Emulated source color key blits');
    end;
end;

function EnumInputDevs(var lpddi: TDIDeviceInstance; pvRef: Pointer): Integer; stdcall;
begin
  TStringList(pvRef).Add(lpddi.tszInstanceName + ' - ' + lpddi.tszProductName);

  Result := 1;
end;

procedure TForm1.Input;
begin
  DirectInputCreate(hInstance, DIRECTINPUT_VERSION, FDirectInput, nil);

  FDirectInput.EnumDevices(0, EnumInputDevs, List.Items, DIEDFL_ATTACHEDONLY);
end;

function EnumSoundDevices(lpGuid: PGUID; lpstrDescription: PAnsiChar;
                           lpstrModule : PAnsiChar; lpContext: Pointer):BOOL; stdcall;
begin
  Form1.List.Items.Add(lpstrDescription+' - '+lpstrModule);

  Result := True;
end;

procedure TForm1.Sound;
begin
  DirectSoundEnumerate(EnumSoundDevices, Nil);
end;

procedure TForm1.SoundCapabilities;
var
  DXSound : IDirectSound;
  DevCaps : TDSCaps;
begin
  DirectSoundCreate(Nil, DXSound, Nil);
  DXSound.SetCooperativeLevel(Handle, DSSCL_NORMAL);

  FillChar(DevCaps, SizeOf(TDSCaps), 0);
  DevCaps.dwSize := SizeOf(TDSCaps);

  DXSound.GetCaps(DevCaps);

  with List.Items do begin
    Add('General sound driver capabilities - ');
    Add('');
    if (DevCaps.dwFlags and DSCAPS_CERTIFIED) = DSCAPS_CERTIFIED
       then Add('Driver tested and certified by Microsoft');
    if (DevCaps.dwFlags and DSCAPS_CONTINUOUSRATE) = DSCAPS_CONTINUOUSRATE
       then Add('Supports all sample rates between min and max');
    if (DevCaps.dwFlags and DSCAPS_EMULDRIVER) = DSCAPS_EMULDRIVER
       then Add('No DirectSound driver detected');
    if (DevCaps.dwFlags and DSCAPS_PRIMARY16BIT) = DSCAPS_PRIMARY16BIT
       then Add('Supports 16-bit primary buffer');
    if (DevCaps.dwFlags and DSCAPS_PRIMARY8BIT) = DSCAPS_PRIMARY8BIT
       then Add('Supports 8-bit primary buffer');
    if (DevCaps.dwFlags and DSCAPS_PRIMARYMONO) = DSCAPS_PRIMARYMONO
       then Add('Supports a 1-channel primary buffer');
    if (DevCaps.dwFlags and DSCAPS_PRIMARYSTEREO) = DSCAPS_PRIMARYSTEREO
       then Add('Supports a 2-channel primary buffer');
    if (DevCaps.dwFlags and DSCAPS_SECONDARY16BIT) = DSCAPS_SECONDARY16BIT
       then Add('Supports 16-bit hardware mixed secondary buffer');
    if (DevCaps.dwFlags and DSCAPS_SECONDARY8BIT) = DSCAPS_SECONDARY8BIT
       then Add('Supports 8-bit hardware mixed secondary buffer');
    if (DevCaps.dwFlags and DSCAPS_SECONDARYMONO) = DSCAPS_SECONDARYMONO
       then Add('Supports a 1-channel hardware mixed secondary buffer');
    if (DevCaps.dwFlags and DSCAPS_SECONDARYSTEREO) = DSCAPS_SECONDARYSTEREO
       then Add('Supports a 2-channel hardware mixed secondary buffer');

    Add('Number of primary buffers: '+IntToStr(DevCaps.dwPrimaryBuffers));
    Add('Sofware mixing CPU overhead: '+IntToStr(DevCaps.dwPlayCpuOverheadSwBuffers)+'%');

    if (DevCaps.dwFlags and DSCAPS_EMULDRIVER) = DSCAPS_EMULDRIVER then begin
      Add('');
      Add('');
      Add('Hardware specific capabilites -');
      Add('');
      Add('Minimum secondary hardware buffer sample rate: '+
                   IntToStr(DevCaps.dwMinSecondarySampleRate));
      Add('Maximum secondary hardware buffer sample rate: '+
                   IntToStr(DevCaps.dwMaxSecondarySampleRate));
      Add('Maximum hardware buffers: '+
                   IntToStr(DevCaps.dwMaxHwMixingAllBuffers));
      Add('Maximum static hardware buffers: '+
                   IntToStr(DevCaps.dwMaxHwMixingStaticBuffers));
      Add('Maximum streaming hardware buffes: '+
                   IntToStr(DevCaps.dwMaxHwMixingStreamingBuffers));
      Add('Free hardware buffers: '+
                   IntToStr(DevCaps.dwFreeHwMixingAllBuffers));
      Add('Free static hardware buffers: '+
                   IntToStr(DevCaps.dwFreeHwMixingStaticBuffers));
      Add('Free streaming hardware buffes: '+
                   IntToStr(DevCaps.dwFreeHwMixingStreamingBuffers));
      Add('Maximum 3-D hardware buffers: '+
                   IntToStr(DevCaps.dwMaxHw3DAllBuffers));
      Add('Maximum static 3-D hardware buffers: '+
                   IntToStr(DevCaps.dwMaxHw3DStaticBuffers));
      Add('Maximum streaming 3-D hardware buffers: '+
                   IntToStr(DevCaps.dwMaxHw3DStreamingBuffers));
      Add('Free 3-D hardware buffers: '+
                   IntToStr(DevCaps.dwFreeHw3DAllBuffers));
      Add('Free static 3-D hardware buffers: '+
                   IntToStr(DevCaps.dwFreeHw3DStaticBuffers));
      Add('Free streaming 3-D hardware buffers: '+
                   IntToStr(DevCaps.dwFreeHw3DStreamingBuffers));
      Add('Total hardware memory: '+
                   IntToStr(DevCaps.dwTotalHwMemBytes)+' bytes');
      Add('Free hardware memory: '+
                   IntToStr(DevCaps.dwFreeHwMemBytes)+' bytes');
      Add('Maximum contiguous free hardware memory: '+
                   IntToStr(DevCaps.dwMaxContigFreeHwMemBytes)+' bytes');
      Add('Data transfer rate: '+
                   IntToStr(DevCaps.dwUnlockTransferRateHwBuffers)+' kb per second');

      end;
    end;
end;

procedure TForm1.DirectXVersion;
var
  Version : TDXVersion;
begin
  Cursor := crHourGlass;
  Version := GetDXVersionEx;
  case Version of
    DXVER_NOTINSTALLED :  List.Items.Add('DirectX not installed');
    DXVER_DIRECTX_1    :  List.Items.Add('DirectX 1');
    DXVER_DIRECTX_2    :  List.Items.Add('DirectX 2');
    DXVER_DIRECTX_3    :  List.Items.Add('DirectX 3');
    DXVER_DIRECTX_5    :  List.Items.Add('DirectX 5');
    DXVER_DIRECTX_6    :  List.Items.Add('DirectX 6');
    DXVER_DIRECTX_61   :  List.Items.Add('DirectX 6.1');
    DXVER_DIRECTX_7    :  List.Items.Add('DirectX 7');
    DXVER_DIRECTX_8    :  List.Items.Add('DirectX 8');
  end;
  Cursor := crDefault;
end;

end.
