for Index := 0 to ParticleCount do

with Particle [Index] do begin

Decay := Decay - HalfLife; // Уменьшить время жизни

// Срок существования прошел, появляется новая точка

if Decay <= 0 then begin

Decay := 1;

X := mouseX; // В позиции курсора

Y := mouseY;

end;

Angle := Angle + AngleAdjustment; // Движение по спирали

If Angle >= 2 * Pi then Angle := 0; //От переполнения

X := X + round (cos(Angle) * Speed); // Новая позиция

Y := Y + round (sin(Angle) * Speed);

// Точка, ушедшая за границу экрана

if (X > ScreenWidth - 2) or (X < 2) then begin

X := mouseX; // Переместить в позицию курсора

Y : = mouseY;

Angle := random * 2 * Pi;

end

else if (Y > ScreenHeight - 2) or (Y < 2) then begin

X := mouseX;

Y := mouseY;

Angle := random '* 2 * Pi;

end;

// "Отображение" точки

Pict [X, Y] := Speed * 16 + 186;

end;

// Эффект размытости for Index := 1 to BlurFactor do for X := 2 to ScreenWidth - 2 do

for Y := 2 to (ScreenHeight - 2) do begin

// Усреднение значения девяти соседних элементов Accum := 0;

Accum := Accum + Pict [X, Y] +

Pict[X, Y + 1] + Pict[X, Y - 1] +

Pict[X + 1, Y] + Pict[X - 1, Y] +

Pict[X + 1, Y + 1] + Pict[X - 1, Y - 1] +

Pict[X + 1, Y - 1] + Pict[X - 1, Y + 1];

Accum := Accum div 9; // Усреднение значений

// соседних пикселов

Pict [X, Y] :=' Accum;

end;

Чтобы изображение не съеживалось с течением времени, как в предыдущем примере, закрашиваясь черным цветом, граничные точки экрана заполняются ненулевыми значениями:

for Index := 0 to ScreenWidth - 1 do begin

Pict[Index, 0] := 127;

Pict[Index, ScreenHeight - 1] := 127;

Pict[Index, 1] := 127;

Pict[Index, ScreenHeight - 2] := 127;

end;

for Index := 0 to ScreenHeight - 1 do begin

PictfO, Index] := 127;

Pict[ScreenWidth - 1, Index] := 127;

Pict[l, Index] := 127;

Pict[ScreenWidth - 2, Index] := 127;

end;

С помощью клавиш <Ноте> и <End> можно менять количество частиц, а с помощью клавиш <Page Up> и <Page Down> - управлять степенью усреднения пикселов.

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

ZeroMemory (desc. IpSurface, desc.lPitch * ScreenHeight * (ScreenBitDepth div 8) ) ;

Также здесь нельзя использовать значение ширины экрана вместо lPitch, т. к. из-за выравнивания памяти это могут быть разные значения. Ширина поверхности "подгоняется" к границам параграфов, т. е. должна быть кратна 4-м байтам.

Массивы в видеопамять приходится переносить медленным способом - поэлементно. Одна ячейка массива занимает байт, при разрешении экрана в 16 разрядов на пиксел массив скопируется только в первую половину памяти поверхности. Если же вы в своем приложении не собираетесь менять разрешение, то вполне можете копировать массив целиком, одной командой CopyMemory.

Поскольку значения в массиве pict лежат в пределах диапазона типа Byte, то для 16-битного режима картинка получится не очень выразительной и отображается оттенками одного цвета.

Сохранение растровых изображений

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

Я приведу простейшее решение проблемы, основанное на использовании объекта класса TBitmap. В предыдущем примере обработчик формы нажатия клавиши приведите к следующему виду:

procedure TfrmDD. FormKeyDown (Sender: TObject; var Key: Word

Shift: TShiftState) ; var

BitMap : TBitmap; // Для записи картинок в файл begin

case Key of

VK NEXT : BlurFactor := BlurFactor + 1;

VK_PRIOR : begin

BlurFactor := BlurFactor - 1;

if BlurFactor < 1 then BlurFactor := 1;