Delphi World - Установка и изменение разрешения и глубины цвета из программы

Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...

Установка и изменение разрешения и глубины цвета из программы

Оформил: DeeCo

Иногда бывает полезно изменять режим видеоадаптера прямо из программы. Для этого можно воспользоваться функциями EnumDisplaySettings и ChangeDisplaySettings Windows API.

1. Получение списка доступных режимов.
Воспользуемся функцией EnumDisplaySettings. В качестве параметров этой функции передаются номер режима и переменная типа TDevMode, куда записывается информация о допустимых режимах монитора. В частности, тип TDevMode содержит поля, хранящие разрешение (dmPelsWidth, dmPelsHeight), глубину цвета (dmBitsPerPel), частоту (dmDisplayFrequency) и другие. Итак,

var
  m1, m2, m3: word; { флаги процедур выделения памяти: }
    { 4 - успешно, 5 - ошибка, 2 - не выделялась }

procedure GetSBMem; {выделение буфера нижней памяти} {для SB/DMA}
var
  j: word;
begin
  j := (longint(maxlen) + 15) div 16; {длина блока} {в параграфах}
  m1 := 2;
  m2 := 2;
  m3 := 2;
  asm
      mov ax,$0100
      mov bx,j
      int $31      {запрашиваем память}
      rcl m1,1     {запоминаем CF}


      mov bx,$1000
      mov cx,ax
      and cx,$fff
      sub bx,bc      {вычисляем размер до конца сегмента}
      cmp j,bx
      jb @l1       {если достаточно места, уходим}

      push bx
      mov ax,$0101
      int $31      {возвращаем память}

      pop bx
      mov ax,$0100
      int $31      {забираем память до конца 64k-сегмента}
      rcl m2,1     {запоминаем CF}
      mov word ptr [arr1+2],dx  {сохраняем селектор}

      mov ax,$0100
      mov bx,j
      int $31    {запрашиваем память для звукового буфера}
      rcl m3,1   {запоминаем CF}
     mov bx,ax
      mov ax,0
      adc ax,ax
      mov m3,ax   {запоминаем CF}
 @l1:
      mov word ptr [sndp+2],dx    {сохраняем селектор}
      xor dx,dx
      mov word ptr [sndp],dx      {сохраняем смещение}
      mov ax,bx
      shl ax,4
      mov DMAOfs,ax
      shr bx,12
      mov DMAPage,bl
  end;
  if ((m1 and 1) or (m2 and 1) or (m3 and 1)) <> 0 then
    halt;
end;

procedure FreeSBMem; {возвращение нижней памяти в систему}
begin
  asm
      mov ax,$0101
      mov dx,word ptr[sndp+2]
      int $31
  end;
  if m2 = 4 then
    asm
      mov ax,$0101
      mov dx,word ptr[arr1+2]
      int $31
    end;
end;

2. Установка нужных режимов.
Теперь, когда у нас есть список допустимых режимов, можно попробовать установить один из них. Для этого в Windows API существует функция ChangeDisplaySettings, изменяющая режим видеоадаптера и обеспечивающая изменения в реестре Windows. Для того, чтобы уже запущенные программы узнали об изменении видеорежима, пошлем об этом сообщение (SendMessage)

procedure TForm1.Button1Click(Sender: TObject);
var
  DevMode: TDeviceMode;
  liRetValue: Longint;
begin
  if EnumDisplaySettings(nil, Listbox1.ItemIndex, Devmode) then
    liRetValue := ChangeDisplaySettings(DevMode, CDS_UPDATEREGISTRY);
  SendMessage(HWND_BROADCAST,
    WM_DISPLAYCHANGE,
    SPI_SETNONCLIENTMETRICS,
    0);
end;

Замечание: иногда, особенно если у вас старые драйвера, может потребоваться перезагрузка компьютера.

3. Наша программа тоже должна обнаруживать изменения видеорежима.
Особенно это важно для графических программ. Создадим обработчик сообщения WM_DISPLAYCHANGE

...
type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    ...
    private
    procedure WMDisplayChange(var Message: TMessage);
      message WM_DISPLAYCHANGE;
    ...
      procedure
      TForm1.WMDisplayChange(var Message: TMessage);
    begin
      ShowMessage('Changes in display detected!');
      inherited;
    end;