Получаем и устанавливаем различные режимы видео адаптера?

Code:

{...}

type

TForm1 = class(TForm)

   Button1: TButton;

   ListView1: TListView;

   procedure Button1Click(Sender: TObject);

   procedure FormCreate(Sender: TObject);

   procedure ListView1DblClick(Sender: TObject);

private

   { Private declarations }

   {Массив для хранения информации о видеорежимах}

   DevMode : array[0..20] of TDeviceMode;

public

   { Public declarations }

end;

{...}

procedure TForm1.FormCreate(Sender: TObject);

begin

{Настройка ListView}

ListView1.ViewStyle := vsReport;

ListView1.RowSelect := TRUE;

ListView1.Columns.Add;

ListView1.Columns.Add;

ListView1.Columns[0].Caption := 'Width x Height';

ListView1.Columns[0].Width := 100;

ListView1.Columns[1].Caption := 'Colors';

ListView1.Columns[1].Width := 100;

end;

{Процедура получения списка режимов}

procedure TForm1.Button1Click(Sender: TObject);

var

tmpStr1, tmpStr2 : string;

tmpDC : HDC;

x, Selection, cxScreen, cyScreen, Resolution : Integer;

begin

{ Запоминаем текущие настройки}

tmpDC := getDC(Handle);

try

   cxScreen := GetSystemMetrics(SM_CXSCREEN);

   cyScreen := GetSystemMetrics(SM_CYSCREEN);

   Resolution := GetDeviceCaps(tmpDC, BITSPIXEL);

finally

   ReleaseDC(Handle, tmpDC);

end;

ListView1.Items.Clear;

x := 0;

{ Получаем список видеорежимов}

while EnumDisplaySettings(nil,x,DevMode[x]) do

begin

   { Разрешение экрана }

   tmpStr1 := IntToStr(DevMode[x].dmPelsWidth) + 'x' +

   IntToStr(DevMode[x].dmPelsHeight);

   { Цвета }

   case DevMode[x].dmBitsPerPel of

     4 : tmpStr2 := '16 Colors';

     8 : tmpStr2 := '256 Colors';

     16 : tmpStr2 := 'High Color (16 Bit)';

     32 : tmpStr2 := 'True Color (32 Bit)';

   end;

   { А теперь полученную информацию надо отобразить }

   with ListView1.Items.Add do

   begin

     Caption := tmpStr1;

     SubItems.Add(tmpStr2);

   end;

   { В ListView надо встать не строку с описанием текущего режима,

   для этого сохраним индекс элемента с описанием этого режима }

   if ( cxScreen = DevMode[x].dmPelsWidth ) and

   ( cyScreen = DevMode[x].dmPelsHeight ) and

   ( Resolution = DevMode[x].dmBitsPerPel ) then

     Selection := x;

   inc(x);

   if x = 20 then

     Break;

end;

{ В ListView перемещаемся на строчку с описанием текущего режима }

ActiveControl := ListView1;

ListView1.Selected := ListView1.Items.Item[Selection];

end;

{Установка выбранного пользователем видеорежима}

procedure TForm1.ListView1DblClick(Sender: TObject);

var

tmpDevMode : TDevMode;

begin

{ Получаем сохраненную ранее информацию по выбранному режиму}

tmpDevMode := DevMode[ListView1.Items.IndexOf(ListView1.Selected)];

{ Скажем Windows, какие параметры надо сменить }

tmpDevMode.dmFields := DM_BITSPERPEL or DM_PELSWIDTH or

   DM_PELSHEIGHT or DM_DISPLAYFLAGS or DM_DISPLAYFREQUENCY;

{ Очень неплохо будет протестировать видеорежим

и записать изменения в реестр}

if ChangeDisplaySettings(tmpDevMode, CDS_TEST) =

DISP_CHANGE_SUCCESSFUL then

   ChangeDisplaySettings(tmpDevMode, CDS_UPDATEREGISTRY);

end;