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

Запуск приложения в полноэкранном режиме означает, что окно приложения полностью занимает рабочий стол. Это бывает необходимо для обеспечения поддержки функции акселератора видеокарты, которая может ускорить работу только полной области экрана, но не только, к примеру, если вам необходимо сделать только вашу программу видимой для пользователя. Кстати: Полноэкранный запуск в общих чертах имеет отношение не только к OpenGL, DirectX и 3D. Строго говоря полноэкранный режим требует только установки флага состояния окна wsMaximize, и все.

Но есть другой вопрос, подразумеваемый требованиями для полноэкранных приложений. Это наличие возможности выбора пользователем специфического разрешения экрана и глубины цвета или возможность запуска приложения в фиксированном разрешении. Последнее важно в каждом конкретном случае, поскольку не все видеокарты поддерживают все разрешения и часто игра или другое 3D-приложение хотят работать в другом разрешении (в основном на более низком), чем пользователь использует в каждодневной работе.

Так что полностью вопрос читается так: как запустить полноэкранное приложение в специфичном разрешении экрана и глубине цвета (без перезагрузки)? Ключевым пунктом является функция ChangeDisplaySettings. В зависимости от видеодрайвера, вы можете динамически установить один из множества режимов, не перегружая компьютер:


function SetFullscreenMode(ModeIndex: Integer): Boolean;
// изменение видеорежима, задаваемого 'ModeIndex'
var
  DeviceMode: TDevMode;
begin
  with DeviceMode do
  begin
    dmSize := SizeOf(DeviceMode);
    dmBitsPerPel := VideoModes[ModeIndex].ColorDepth;
    dmPelsWidth := VideoModes[ModeIndex].Width;
    dmPelsHeight := VideoModes[ModeIndex].Height;
    dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
    // при неудачной смене режима переходим в режим текущего разрешения
    Result := ChangeDisplaySettings(DeviceMode, CDS_FULLSCREEN) =
      DISP_CHANGE_SUCCESSFUL;
    if Result then
      ScreenModeChanged := True;
    if ModeIndex = 0 then
      ScreenModeChanged := False;
  end;
end;

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


const MaxVideoModes = 200; // это не очень актуально
type TVideoMode = record
Width,
Height,
ColorDepth  : Word;
Description : String[20];
end;
var VideoModes    : array[0..MaxVideoModes] of TVideoMode;
NumberVideomodes  : Integer = 1; // 1, поскольку есть режим по умолчанию

Как вы видите, это делает наш пример более функциональным для использования. При необходимомости, вы можете заменить в вышеуказанной функции VideoModes на фиксированные значения (скажем, на 640, 480, 16). Перечисление всех видеорежимов осуществляется при помощи EnumDisplaySettings:


procedure ReadVideoModes;
var
  I, ModeNumber: Integer;

  done: Boolean;
  DeviceMode: TDevMode;
  DeskDC: HDC;

begin

  // создание режима "по умолчанию"
  with VideoModes[0] do
  try
    DeskDC := GetDC(0);
    ColorDepth := GetDeviceCaps(DeskDC, BITSPIXEL);
    Width := Screen.Width;
    Height := Screen.Height;
    Description := 'default';
  finally
    ReleaseDC(0, DeskDC);
  end;

  // перечисляем все доступные видеорежимы
  ModeNumber := 0;
  done := False;
  repeat
    done := not EnumDisplaySettings(nil, ModeNumber, DeviceMode);
    TryToAddToList(DeviceMode);
    Inc(ModeNumber);
  until (done or (NumberVideomodes >= MaxVideoModes));

  // режимы низкого разрешения не всегда перечислимы, о них запрашивают явно
  with DeviceMode do
  begin
    dmBitsPerPel := 8;
    dmPelsWidth := 42;
    dmPelsHeight := 37;
    dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
    // тест видеодрайвера: убедимся, что он справится со всеми видеорежимами
    if ChangeDisplaySettings(DeviceMode, CDS_TEST or CDS_FULLSCREEN) <>
      DISP_CHANGE_SUCCESSFUL then
    begin
      I := 0;
      while (I < NumberLowResModes - 1) and (NumberVideoModes < MaxVideoModes)
        do
      begin
        dmSize := Sizeof(DeviceMode);
        dmBitsPerPel := LowResModes[I].ColorDepth;
        dmPelsWidth := LowResModes[I].Width;
        dmPelsHeight := LowResModes[I].Height;
        dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
        TryToAddToList(DeviceMode);
        Inc(I);
      end;
    end;
  end;
end;

Я думаю эта функция не тяжела для понимания. Есть две части, которые нужно рассмотреть. Сначала - стандартный путь перечисления видеорежимов. Потом проверям, что все режимы низкого разрешения также протестированы. Это все-таки потребует список режимов низкого разрешения:


type TLowResMode = record

Width,
Height,
ColorDepth  : Word;
end;

const NumberLowResModes = 60;

LowResModes       : array[0..NumberLowResModes-1] of TLowResMode =
((Width:320;Height:200;ColorDepth: 8),(Width:320;Height:200;ColorDepth:15),
(Width:320;Height:200;ColorDepth:16),(Width:320;Height:200;ColorDepth:24),
(Width:320;Height:200;ColorDepth:32),(Width:320;Height:240;ColorDepth: 8),
(Width:320;Height:240;ColorDepth:15),(Width:320;Height:240;ColorDepth:16),
(Width:320;Height:240;ColorDepth:24),(Width:320;Height:240;ColorDepth:32),
(Width:320;Height:350;ColorDepth: 8),(Width:320;Height:350;ColorDepth:15),
(Width:320;Height:350;ColorDepth:16),(Width:320;Height:350;ColorDepth:24),
(Width:320;Height:350;ColorDepth:32),(Width:320;Height:400;ColorDepth: 8),
(Width:320;Height:400;ColorDepth:15),(Width:320;Height:400;ColorDepth:16),
(Width:320;Height:400;ColorDepth:24),(Width:320;Height:400;ColorDepth:32),
(Width:320;Height:480;ColorDepth: 8),(Width:320;Height:480;ColorDepth:15),
(Width:320;Height:480;ColorDepth:16),(Width:320;Height:480;ColorDepth:24),
(Width:320;Height:480;ColorDepth:32),(Width:360;Height:200;ColorDepth: 8),
(Width:360;Height:200;ColorDepth:15),(Width:360;Height:200;ColorDepth:16),
(Width:360;Height:200;ColorDepth:24),(Width:360;Height:200;ColorDepth:32),
(Width:360;Height:240;ColorDepth: 8),(Width:360;Height:240;ColorDepth:15),
(Width:360;Height:240;ColorDepth:16),(Width:360;Height:240;ColorDepth:24),
(Width:360;Height:240;ColorDepth:32),(Width:360;Height:350;ColorDepth: 8),
(Width:360;Height:350;ColorDepth:15),(Width:360;Height:350;ColorDepth:16),
(Width:360;Height:350;ColorDepth:24),(Width:360;Height:350;ColorDepth:32),
(Width:360;Height:400;ColorDepth: 8),(Width:360;Height:400;ColorDepth:15),
(Width:360;Height:400;ColorDepth:16),(Width:360;Height:400;ColorDepth:24),
(Width:360;Height:400;ColorDepth:32),(Width:360;Height:480;ColorDepth: 8),
(Width:360;Height:480;ColorDepth:15),(Width:360;Height:480;ColorDepth:16),
(Width:360;Height:480;ColorDepth:24),(Width:360;Height:480;ColorDepth:32),
(Width:400;Height:300;ColorDepth: 8),(Width:400;Height:300;ColorDepth:15),
(Width:400;Height:300;ColorDepth:16),(Width:400;Height:300;ColorDepth:24),
(Width:400;Height:300;ColorDepth:32),(Width:512;Height:384;ColorDepth: 8),
(Width:512;Height:384;ColorDepth:15),(Width:512;Height:384;ColorDepth:16),
(Width:512;Height:384;ColorDepth:24),(Width:512;Height:384;ColorDepth:32));

И остается функция TryToAddToList:


procedure TryToAddToList(DeviceMode: TDevMode);
// Добавление видеорежима к списку, это это не дубликат
// и режим действительно может быть установлен.
var
  I: Integer;
begin
  // Смотрим на предмет дублирования видеорежима (такое может быть из-за показателя
  // частоты смены кадров или из-за того, что мы явно пробуем все режимы низкого разрешения)
  for I := 1 to NumberVideomodes - 1 do
    with DeviceMode do
      if ((dmBitsPerPel = VideoModes[I].ColorDepth) and
        (dmPelsWidth = VideoModes[I].Width) and
        (dmPelsHeight = VideoModes[I].Height)) then
        Exit; // повтор видеорежима (дубликат)

  // устанавливаем тестируемый режим (на самом деле мы не устанавливаем данный режим,
  // а хотим получить сообщение о его поддержке видеокартой).
  if ChangeDisplaySettings(DeviceMode, CDS_TEST or CDS_FULLSCREEN) <>
    DISP_CHANGE_SUCCESSFUL then
    Exit;

  // если это новый, поддерживаемый режим, то добавляем его к списку
  with DeviceMode do
  begin
    VideoModes[NumberVideomodes].ColorDepth := dmBitsPerPel;
    VideoModes[NumberVideomodes].Width := dmPelsWidth;
    VideoModes[NumberVideomodes].Height := dmPelsHeight;
    VideoModes[NumberVideomodes].Description := Format('%d x %d, %d bpp',
      [dmPelsWidth, dmPelsHeight, dmBitsPerPel]);
  end;
  Inc(NumberVideomodes);
end;

Для завершения реализации вашего проекта необходима функция, восстанавливающий видеорежим по умолчанию при завершении работы вашего приложения:


procedure RestoreDefaultMode;
// восстанавливаем видеорежим по умолчанию
var T : TDevMode absolute 0; // маленькая хитрость: создаем указатель на ноль
begin
// Так как первый параметр является переменной, мы не можем использовать ноль
// непосредственно. Взамен мы используем переменную с абсолютным адресом нуля.
ChangeDisplaySettings(T,CDS_FULLSCREEN);
end;

Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay