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

Delphi , Графика и Игры , Цвета и Палитра

Оформил: DeeCo

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;

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;

...
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;

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

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Цвета и Палитра ::