Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

ChangeDisplaySettings


dmk ©   (07.01.19 15:18

Всем привет!
В AppConsole изменение видеорежима работает, а в окне на чистом WInApi не работает. Может какое сообщение надо обрабатывать?


dmk ©   (07.01.19 15:20[1]

Вот рабочий код:
program VideoMode;

{$APPTYPE CONSOLE}

{$R *.res}

uses
 System.SysUtils, Winapi.Windows;

const
 VX = 1280;
 VY = 800;

var
 FDevMode: DEVMODE;

procedure StringToArray(const ASrc: string; ADest: Pointer);
var
 i: Integer;
 A, B: UInt64;

begin
 A := UInt64(@ASrc[1]);
 B := UInt64(ADest);

 for i := 1 to ByteLength(ASrc) do
 begin
   if (PByte(A)^ = 0) then Break else PByte(B)^ := PByte(A)^;
   Inc(A);
   Inc(B);
 end;
end;

function ArrayToString(ASrc: array of Char; MaxLen: Integer): string;
var
 i: Integer;
 C: Char;

begin
 Result := '';

 for i := 0 to (MaxLen - 1) do
 begin
   C := ASrc[i];
   if (C = #0) then Break else Result := (Result + C);
 end;
end;

function GetDisplayDevice(var ADevice: string): Boolean;
var
 i: DWord;
 Device: _DISPLAY_DEVICE;

begin
 Result := False;
 ADevice := '';

 i := 0;

 ZeroMemory(@Device, SizeOf(Device));
 Device.cb := SizeOf(Device);
 Device.StateFlags := (DISPLAY_DEVICE_ATTACHED_TO_DESKTOP or DISPLAY_DEVICE_PRIMARY_DEVICE);

 while EnumDisplayDevices(nil, i, Device, 0) do
 begin
   ADevice := ArrayToString(Device.DeviceName, 32);
   if (ADevice <> '') then
   begin
     Result := True;
     Break;
   end;

   Inc(i);
 end;
end;

function GetVideoMode(const ADevice: string; const AWidth, AHeight, ABpp: Integer; var AMode: DEVMODE): Boolean;
var
 DevMode: _devicemodeW;
 i: DWord;

begin
 Result := False;

 ZeroMemory(@DevMode, SizeOf(DevMode));
 DevMode.dmSize := SizeOf(DevMode);

 i := 0;

 while EnumDisplaySettings(PWideChar(ADevice), i, DevMode) do
 begin
   if (DevMode.dmPelsWidth = DWord(AWidth)) and
      (DevMode.dmPelsHeight = DWord(AHeight)) and
      (DevMode.dmBitsPerPel = DWord(ABpp)) then
      begin
        AMode := DevMode;
        Result := True;
        Break;
      end;

   ZeroMemory(@DevMode, SizeOf(DevMode));
   DevMode.dmSize := SizeOf(DevMode);

   Inc(i);
 end;//while
end;

procedure ChangeVideoMode;
var
 E: Integer;
 Device: string;

begin
 ZeroMemory(@FDevMode, SizeOf(FDevMode));
 FDevMode.dmSize := SizeOf(FDevMode);

 if GetDisplayDevice(Device) then
 if GetVideoMode(Device, VX, VY, 32, FDevMode) then
 begin
   E := ChangeDisplaySettings(FDevMode, CDS_FULLSCREEN);

   if (E = DISP_CHANGE_SUCCESSFUL) then
   begin
     MessageBox(0, 'Видеорежим зарегестрирован', 'Videomode', MB_OK or MB_ICONERROR);
   end
   else
   begin
     case E of
     DISP_CHANGE_BADMODE: MessageBox(0, 'Видеорежим не поддерживается', 'Ошибка', MB_OK or MB_ICONERROR);
     DISP_CHANGE_BADPARAM: MessageBox(0, 'Неверные параметры', 'Ошибка', MB_OK or MB_ICONERROR);
     DISP_CHANGE_BADFLAGS: MessageBox(0, 'Передан неверный набор флагов', 'Ошибка', MB_OK or MB_ICONERROR);
     DISP_CHANGE_FAILED: MessageBox(0, 'Драйвер не смог установить видеорежим', 'Ошибка', MB_OK or MB_ICONERROR);
     DISP_CHANGE_NOTUPDATED: MessageBox(0, 'Ошибка записи в реестр', 'Ошибка', MB_OK or MB_ICONERROR);
     DISP_CHANGE_RESTART: MessageBox(0, 'Необходима перезагрузка', 'Ошибка', MB_OK or MB_ICONERROR);
     end;
   end;
 end;
end;

begin
 try
   { TODO -oUser -cConsole Main : Insert code here }
   ChangeVideoMode;
 except
   on E: Exception do
     Writeln(E.ClassName, ': ', E.Message);
 end;
end.


Тоже самое в WinApi не хочет работать. Выдает DISP_CHANGE_BADMODE.
Есть опытные подсказать?


dmk ©   (07.01.19 17:39[2]

Странно, а вот так заработал. Бред какой-то :(

procedure TRenderForm.ChangeVideoMode;
var
 X, Y, Bpp: DWord;
 Device: string;
 DMode: _devicemodeW;
 E: Integer;

begin
 ZeroMemory(@FDevMode, SizeOf(FDevMode));
 FDevMode.dmSize := SizeOf(FDevMode);

 //Половинное разрешение
 if gLoMode then
 begin
   X := gScreenX;
   Y := gScreenY;
   gLoMode := False;
 end
 else
 begin
   X := gMinSX;
   Y := gMinSY;
   gLoMode := True;
 end;

 Bpp := 32;

 if GetDisplayDevice(Device) then
 if GetVideoMode(Device, X, Y, Bpp, DMode) then
 begin
   DMode.dmSpecVersion := 0;
   DMode.dmDriverVersion := 0;
   DMode.dmSize := SizeOf(DMode);
   DMode.dmPelsWidth := X;
   DMode.dmPelsHeight := Y;
   DMode.dmBitsPerPel := Bpp;
   DMode.dmDisplayFrequency := 60;
   DMode.dmFields := (DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL or DM_DISPLAYFREQUENCY);

   E := ChangeDisplaySettingsEx(PWideChar(Device), DMode, 0, CDS_FULLSCREEN, nil);

   if (E = DISP_CHANGE_SUCCESSFUL) then
   begin
     ExitFullScreen;
     UpdateViewport;
     SetFullScreen;
   end
   else
   begin
     case E of
     DISP_CHANGE_BADMODE: MessageBox(0, 'Видеорежим не поддерживается', 'Ошибка', MB_OK or MB_ICONERROR);
     DISP_CHANGE_BADPARAM: MessageBox(0, 'Неверные параметры', 'Ошибка', MB_OK or MB_ICONERROR);
     DISP_CHANGE_BADFLAGS: MessageBox(0, 'Передан неверный набор флагов', 'Ошибка', MB_OK or MB_ICONERROR);
     DISP_CHANGE_FAILED: MessageBox(0, 'Драйвер не смог установить видеорежим', 'Ошибка', MB_OK or MB_ICONERROR);
     DISP_CHANGE_NOTUPDATED: MessageBox(0, 'Ошибка записи в реестр', 'Ошибка', MB_OK or MB_ICONERROR);
     DISP_CHANGE_RESTART: MessageBox(0, 'Необходима перезагрузка', 'Ошибка', MB_OK or MB_ICONERROR);
     end;
   end;
 end;
end;


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо