Графика DirectX в Delphi

if FDDPal <> nil then begin // Палитра перезагружена успешно

// Заново ее устанавливаем

hRet := FDDSPrimary.SetPalette(FDDPal);

if Failed (hRet) then ErrorOut(hRet, 'SetPalette'); end

else ErrorOut(DDERR_PALETTEBUSY, 'DDLoadPalette'); hRet := FDDSBackGround._Restore;

if Failed (hRet) then begin

Result := hRet; Exit;

end;

hRet := DDReLoadBitmap(FDDSBackGround, groundBmp);

if Failed (hRet) then ErrorOut(hRet, 'DDReLoadBitmap'); hRet := FDDSImage._Restore; if Failed (hRet) then begin Result := hRet;

Exit;

end;

Result := DDReLoadBitmap(FDDSImage, imageBmp); end else Result := hRet;

end;

При неудачной перезагрузке и установлении палитры нет смысла продолжать работу приложения. Константу для вывода сообщения о фатальной ошибке я взял произвольно из ряда ошибок, связанных с неудачной работой с палитрами.

Также не имеет смысла продолжать работу приложения, если не удается попытка заново загрузить файл растра. Он ведь может быть просто удален.

Изменился немного и обработчик перемещения курсора. Теперь проблема с положением курсора вблизи границ решена:

procedure TfrmDD.FormMouseMove(Sender: TObject; Shift: TShiftState;

X, Y: Integer);

begin

if X <= ScreenWidth - 64 then mouseX := X

else mouseX := ScreenWidth - 64; // Добавилась эта ветвь

if Y <= ScreenHeight - 64 then mouseY := Y

else mouseY := ScreenHeight - 64; // Этого тоже не было FormPaint (nil);

end;

Новый пример (проект каталога Ех04) позволит нам плавно перейти к теме анимации в приложениях. Изменим предыдущий пример таким образом, чтобы изображение беспрерывно обновлялось.

Для получения максимальной скорости обновления необходим обработчик события Onidie компонента класса TAppiicationEvents. Код, записанный в этом обработчике, будет выполняться беспрерывно, пока приложение находится в режиме ожидания сообщений.

Нам нужно будет в этом обработчике записать код, связанный с перерисовкой первичной поверхности. Однако в ситуации, когда приложение не активно или минимизировано, тратить ресурсы компьютера на заведомо безуспешное и ненужное действо совершенно ни к чему. Поэтому состояние активности будем отслеживать:

FActive : BOOL; // Переменная хранит информацию о текущем состоянии

Устанавливается эта переменная в True при активации окна приложения и при восстановлении его из минимизированного состояния:

procedure TfrmDD.ApplicationEventslRestore(Sender: TObject);

begin

WindowState := wsMaximized;

// После распахивания окна считаем его готовым к воспроизведению

FActive := True; end;

// Появился новый обработчик

procedure TfrmDD.FormActivate(Sender: TObject); begin

FActive := True; // После запуска приложения оно готово к работе

end;

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

function TfrmDD.UpdateFrame : HRESULT; // Функция перерисовки окна

var

hRet : HRESULT;

begin

// Заполняем фон

hRet := FDDSBack.BltFast (0, 0, FDDSBackGround, nil, DDBLTFAST_WAIT);

if hRet = DDERR_SURFACELOST then begin hRet := RestoreAll;

if Failed (hRet) then begin // Полная неудача Result := hRet;

Exit;

end;

end;

// Выводим изображение

hRet := FDDSBack.BltFast (mouseX, mouseY, FDDSImage, nil,

DDBLTFAST WAIT or DDBLTFAST SRCCOLORKEY);

if hRet = DDERR_SURFACELOST then begin hRet := RestoreAll; if Failed (hRet) then begin Result := hRet;

Exit;

end;

end;

Result := DD_OK;

end;

// Функция переключения страниц function TfrmDD.FlipPages : HRESULT;

begin

Result := FDDSPrimary.Flip(nil, DDFLIP_WAIT);

if Result = DDERR_SURFACELOST then Result := RestoreAll;

end;

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

Но особая неприятность состоит в том, что при использовании зацикливания возникает неприятная проблема: после минимизации приложения оно перестает реагировать на сообщения и зацикливается на восстановлении поверхностей.

Последнее, и самое главное, что добавилось - это обработчик события ожидания:

procedure TfrmDD.ApplicationEventslIdle(Sender: TObject;

var Done: Boolean); begin

if FActive then // Только при активном состоянии приложения

if Succeeded (UpdateFrame) // Перерисовка окна прошла успешно

then FlipPages; // Переключаем страницы

// Посмотреть, не появились ли сообщения Done := False;

end;

Я видел немало приложений, использующих DirectDraw, написанных на Delphi. И очень многие из них не могли корректно минимизироваться или восстановиться. Хорошенько "погоняйте" этот пример, убедитесь, что в данных ситуациях он ведет себя корректно.

В примере непрерывно перерисовывается экран, положение образа на нем меняется только после передвижения курсора. Модифицируем проект, заставив двигаться картинку по кругу.