В этой статье мы разберем интересную программу для генерации цифровых облаков, написанную на Lazarus (совместимом с Delphi), и рассмотрим найденные ошибки, а также предложим улучшения кода. Программа позволяет создавать реалистичные облака с настройками резкости и плотности.
Основные параметры программы
Программа предоставляет два основных параметра для настройки внешнего вида облаков:
SHARPNESS (резкость): чем меньше значение, тем более "пушистыми" выглядят облака; чем больше - тем они резче.
DENSITY (плотность):
0.7 - почти чистое небо
0.2 - почти полностью покрыто облаками
Обнаруженные проблемы и их решения
1. Ошибка в расчете цвета
В исходном коде была найдена ошибка в строке:
col := RGBToColor(R + Round(z * (256 - R)), G + Round(z * (256 - G)), B + Round(z * (256 - B)));
Проблема заключается в том, что значения цветовых компонентов (R, G, B) могут выходить за пределы допустимого диапазона (0-255). Правильный вариант:
col := RGBToColor(R + Round(z * (255 - R)), G + Round(z * (255 - G)), B + Round(z * (255 - B)));
2. Утечки памяти
При завершении программы обнаруживались неосвобожденные блоки памяти. Были предложены следующие исправления:
Добавление деструктора для TArray2D
type
TArray2D = class
private
FWidth, FHeight: Integer;
FData: array of Double;
public
constructor Create(AWidth, AHeight: Integer);
destructor Destroy; override;
// ... другие методы
end;
implementation
destructor TArray2D.Destroy;
begin
SetLength(FData, 0); // Освобождаем динамический массив
inherited Destroy;
end;
Освобождение ресурсов в FormDestroy
procedure TForm1.FormDestroy(Sender: TObject);
var
i: Integer;
begin
SkyBmp.Free;
for i := 0 to 3 do
begin
OctavesA[i].Free;
OctavesB[i].Free;
end;
Clouds.Free;
end;
3. Проблема с повторным использованием переменных
Как отметил TRon, основная проблема с утечками памяти связана с тем, что экземпляры TArray2D создаются, сохраняются в переменные, а затем эти же переменные используются для хранения новых экземпляров, возвращаемых методами (например, Smooth).
Альтернативное решение
Для полного устранения утечек памяти можно переработать код, чтобы избежать создания новых экземпляров при операциях. Например, можно модифицировать класс TArray2D, добавив методы, которые изменяют текущий экземпляр вместо возвращения нового.
Пример модифицированного класса:
type
TArray2D = class
private
FWidth, FHeight: Integer;
FData: array of Double;
public
constructor Create(AWidth, AHeight: Integer);
destructor Destroy; override;
procedure Smooth; // Изменяет текущий экземпляр вместо создания нового
procedure AddNoise(Amount: Double);
// ... другие методы
end;
implementation
procedure TArray2D.Smooth;
var
i, j: Integer;
TempData: array of Double;
begin
SetLength(TempData, FWidth * FHeight);
// Копируем исходные данные
for i := 0 to FWidth * FHeight - 1 do
TempData[i] := FData[i];
// Применяем сглаживание
for i := 1 to FWidth - 2 do
for j := 1 to FHeight - 2 do
begin
FData[j * FWidth + i] := (
TempData[(j-1) * FWidth + (i-1)] + TempData[(j-1) * FWidth + i] + TempData[(j-1) * FWidth + (i+1)] +
TempData[j * FWidth + (i-1)] + TempData[j * FWidth + i] + TempData[j * FWidth + (i+1)] +
TempData[(j+1) * FWidth + (i-1)] + TempData[(j+1) * FWidth + i] + TempData[(j+1) * FWidth + (i+1)]
) / 9;
end;
end;
Полный пример улучшенного кода
Вот как может выглядеть улучшенная версия программы:
unit CloudGen;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;
type
TArray2D = class
private
FWidth, FHeight: Integer;
FData: array of Double;
function GetValue(X, Y: Integer): Double;
procedure SetValue(X, Y: Integer; AValue: Double);
public
constructor Create(AWidth, AHeight: Integer);
destructor Destroy; override;
procedure Smooth;
procedure AddNoise(Amount: Double);
procedure Normalize;
property Width: Integer read FWidth;
property Height: Integer read FHeight;
property Value[X, Y: Integer]: Double read GetValue write SetValue; default;
end;
{ TForm1 }
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
SkyBmp: TBitmap;
OctavesA: array[0..3] of TArray2D;
OctavesB: array[0..3] of TArray2D;
Clouds: TArray2D;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TArray2D }
constructor TArray2D.Create(AWidth, AHeight: Integer);
begin
FWidth := AWidth;
FHeight := AHeight;
SetLength(FData, FWidth * FHeight);
end;
destructor TArray2D.Destroy;
begin
SetLength(FData, 0);
inherited Destroy;
end;
function TArray2D.GetValue(X, Y: Integer): Double;
begin
Result := FData[Y * FWidth + X];
end;
procedure TArray2D.SetValue(X, Y: Integer; AValue: Double);
begin
FData[Y * FWidth + X] := AValue;
end;
procedure TArray2D.Smooth;
var
i, j: Integer;
TempData: array of Double;
begin
SetLength(TempData, FWidth * FHeight);
for i := 0 to FWidth * FHeight - 1 do
TempData[i] := FData[i];
for i := 1 to FWidth - 2 do
for j := 1 to FHeight - 2 do
begin
FData[j * FWidth + i] := (
TempData[(j-1) * FWidth + (i-1)] + TempData[(j-1) * FWidth + i] + TempData[(j-1) * FWidth + (i+1)] +
TempData[j * FWidth + (i-1)] + TempData[j * FWidth + i] + TempData[j * FWidth + (i+1)] +
TempData[(j+1) * FWidth + (i-1)] + TempData[(j+1) * FWidth + i] + TempData[(j+1) * FWidth + (i+1)]
) / 9;
end;
end;
procedure TArray2D.AddNoise(Amount: Double);
var
i: Integer;
begin
for i := 0 to FWidth * FHeight - 1 do
FData[i] := FData[i] + (Random - 0.5) * Amount;
end;
procedure TArray2D.Normalize;
var
i: Integer;
MinVal, MaxVal, Range: Double;
begin
MinVal := FData[0];
MaxVal := FData[0];
for i := 1 to FWidth * FHeight - 1 do
begin
if FData[i] < MinVal then MinVal := FData[i];
if FData[i] > MaxVal then MaxVal := FData[i];
end;
Range := MaxVal - MinVal;
if Range > 0 then
for i := 0 to FWidth * FHeight - 1 do
FData[i] := (FData[i] - MinVal) / Range;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
Randomize;
SkyBmp := TBitmap.Create;
SkyBmp.Width := Image1.Width;
SkyBmp.Height := Image1.Height;
for i := 0 to 3 do
begin
OctavesA[i] := TArray2D.Create(Image1.Width, Image1.Height);
OctavesB[i] := TArray2D.Create(Image1.Width, Image1.Height);
end;
Clouds := TArray2D.Create(Image1.Width, Image1.Height);
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
i: Integer;
begin
SkyBmp.Free;
for i := 0 to 3 do
begin
OctavesA[i].Free;
OctavesB[i].Free;
end;
Clouds.Free;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
const
SHARPNESS = 0.5; // Меньше - более пушистые, больше - более резкие
DENSITY = 0.4; // 0.7 - почти чистое небо, 0.2 - почти полностью облака
var
i, j, k, R, G, B: Integer;
z: Double;
col: TColor;
begin
// Генерация облаков
for i := 0 to 3 do
begin
OctavesA[i].AddNoise(1.0);
for j := 0 to i do
OctavesA[i].Smooth;
OctavesA[i].Normalize;
end;
// Комбинирование октав
for i := 0 to Clouds.Width - 1 do
for j := 0 to Clouds.Height - 1 do
begin
Clouds[i, j] := 0;
for k := 0 to 3 do
Clouds[i, j] := Clouds[i, j] + OctavesA[k][i, j] * Power(SHARPNESS, k);
Clouds[i, j] := Power(Clouds[i, j], DENSITY);
end;
// Отрисовка облаков
for i := 0 to SkyBmp.Width - 1 do
for j := 0 to SkyBmp.Height - 1 do
begin
z := Clouds[i, j];
R := 135; // Базовый цвет неба (R компонент)
G := 206; // Базовый цвет неба (G компонент)
B := 235; // Базовый цвет неба (B компонент)
// Корректный расчет цвета без выхода за границы
col := RGBToColor(
R + Round(z * (255 - R)),
G + Round(z * (255 - G)),
B + Round(z * (255 - B))
);
SkyBmp.Canvas.Pixels[i, j] := col;
end;
Image1.Picture.Bitmap := SkyBmp;
end;
end.
Заключение
В этой статье мы рассмотрели программу для генерации цифровых облаков на Lazarus/Delphi, исправили найденные ошибки и предложили улучшенную версию кода. Основные улучшения включают:
Исправление ошибки в расчете цветовых компонентов
Добавление правильного освобождения ресурсов
Модификацию класса TArray2D для уменьшения утечек памяти
Предоставление полного рабочего примера улучшенного кода
Эта программа демонстрирует, как можно создавать интересные визуальные эффекты с помощью простых алгоритмов на Pascal, а также важность правильного управления памятью в приложениях.
В статье рассмотрена программа для генерации цифровых облаков на Lazarus, исправлены ошибки в коде и предложены улучшения для устранения утечек памяти.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Telegram-канал