changedisplaysettingsu.pas

Delphi Win32核心API参考光盘源码 本书包含了常用的Windows API函数

unit ChangeDisplaySettingsU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

{Whoops! Delphi imports this function incorrectly, so we must manually
 import it}
function ChangeDisplaySettings(lpDevMode: PDeviceMode;
                               dwFlags: DWORD): Longint; stdcall;
var
  Form1: TForm1;
  DevModeArray: TList;    // holds a list of device mode information structures

implementation

uses Math;

{$R *.DFM}

{import the function}
function ChangeDisplaySettings; external user32 name 'ChangeDisplaySettingsA';

procedure TForm1.FormCreate(Sender: TObject);
var
  DevModeCount: Integer;            // tracks the number of display modes
  DevModeInfo: ^TDevMode;           // a pointer to display mode information
begin
  {create the list to hold display mode information structures}
  DevModeArray := TList.Create;

  {initialize the counter}
  DevModeCount := 0;

  {dynamically allocate memory to hold display mode information}
  GetMem(DevModeInfo, SizeOf(TDevMode));

  {begin enumerating display modes}
  while EnumDisplaySettings(NIL, DevModeCount, DevModeInfo^) do
  begin
    {add the information to the list}
    DevModeArray.Add(DevModeInfo);

    {increment the counter}
    Inc(DevModeCount);

    {display the resolution of the enumerated display mode}
    ListBox1.Items.Add(IntToStr(DevModeInfo^.dmPelsWidth)+'x'+
                       IntToStr(DevModeInfo^.dmPelsHeight)+', '+
                       IntToStr(Trunc(IntPower(2, DevModeInfo^.dmBitsPerPel)))+
                       ' colors');

    {allocate another slot for device mode information}
    GetMem(DevModeInfo, SizeOf(TDevMode));
  end;

  {the above loop always exits with one extra, unused block of memory,
   so delete it}
  FreeMem(DevModeInfo, SizeOf(TDevMode));

  {select the first item in the list box}
  ListBox1.ItemIndex := 0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  iCount: Integer;         // a general loop counter
begin
  {free all memory pointed to by each item in the list}
  for iCount := 0 to DevModeArray.Count-1 do
    FreeMem(DevModeArray.Items[iCount], SizeOf(TDevMode));

  {free the list}
  DevModeArray.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ModeChange: Longint;        // indicates if a Windows reboot is necessary
begin
  {change the display mode}
  ModeChange:=ChangeDisplaySettings(DevModeArray[ListBox1.ItemIndex],
                                    CDS_UPDATEREGISTRY);

  {indicate if a dynamic change was successful or if Windows must be rebooted}
  if ModeChange=DISP_CHANGE_SUCCESSFUL then
    ShowMessage('Dynamic display mode change successful.');
  if ModeChange=DISP_CHANGE_RESTART then
    ShowMessage('Change successful; Windows must be restarted for the changes '+
                'to take effect');
end;

end.