Краснов Михаил
Шрифт:
if Failed(hRet) then ErrorOut (hRet, 'SetPalette');
Растр намеренно выбран с подходящими размерами, чтобы не пришлось его масштабировать. Поэтому последние два аргумента DDLoadBitmap равны нулю:
FDDSBackGround := DDLoadBitmap (FDD, groundBmp, 0, 0) ;
if FDDSBackGround = nil then ErrorOut (DD_FALSE, 'DDLoadBitmap');
Дракон нарисован с черным контуром. Для цветового ключа берется цвет фона:
hRet := DDSetColorKey (FDDSImage, RGB(0, 255, 255)); if Failed (hRet) then ErrorOut (hRet, 'DDSetColorKey');
Поскольку фон не масштабируется, при восстановлении поверхностей перезагрузка фонового рисунка не приведет к зернистости. При восстановлении поверхностей следует также заново загружать и устанавливать палитру лишь при успешном восстановлении первичной поверхности:
function TfrmDD.RestoreAll : HRESULT;
var
hRet : HRESULT;
begin
hRet := FDDSPrimary._Restore;
if Succeeded (hRet) then begin
FDDPal := nil; // Удаляем старую палитру
FDDPal := DDLoadPalette (FDD, groundBmp); // Перезагружаем ее
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 нам теперь не нужен, а код, связанный с перерисовкой окна, разделим для удобства на две функции, отвечающие за непосредственную перерисовку окна и за переключение страниц: