-
Всем привет! В AppConsole изменение видеорежима работает, а в окне на чистом WInApi не работает. Может какое сообщение надо обрабатывать?
-
Вот рабочий код:
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. Есть опытные подсказать?
-
Странно, а вот так заработал. Бред какой-то :(
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;
|