Конференция "WinAPI" » ChangeDisplaySettings
 
  • dmk © (07.01.19 15:18) [0]
    Всем привет!
    В 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;
 
Конференция "WinAPI" » ChangeDisplaySettings
Есть новые Нет новых   [96151   +66][b:0.001][p:0.001]