
23.01.2012, 12:35
|
Начинающий
|
|
Регистрация: 30.06.2008
Сообщения: 140
Репутация: 8882
|
|
Код:
{----------------------------------------------------------------------
здесь исправленный алгоритм. От точки (x,y) ищется из 4-ех соседних
наиболее близкая по значению функции и в эту точку проводится вектор
( а не во все как в моем предыд алгоритме).
В качестве функции здесь как пример конус опрокинутый вершиной на коорд плоскость.
Соответственно изолинии- это сечения конуса те окружности.
Рмсует на TImage размером 200х200 пикс
-------------------------------------------------------------------------}
const
Delta=1;
Epsilon=0.8;
var
H:extended;
function Isoln(x,y:extended):extended;
begin
Result:=Sqrt((x-100)*(x-100)+(y-100)*(y-100)); //конус
end;
{--------------------------------------------------------
находит оптимальный путь
возвращает true- путь найден
---------------------------------------------------------}
function FindTrace(x,y:extended;const H,Epsilon:extended; out OutX,OutY:extended):boolean;
begin
Result:=(abs(Isoln(x,y) - H) < Epsilon);
if Result then
begin
OutX:=x-Delta;OutY:=y;
if abs(Isoln(x+Delta,y) - H) < abs(Isoln(OutX,OutY) - H) then
OutX:=X+Delta;
if abs(Isoln(x,y-Delta) - H) < abs(Isoln(OutX,OutY) - H) then
OutY:=Y-Delta;
if abs(Isoln(x,y+Delta) - H) < abs(Isoln(OutX,OutY) - H) then
OutY:=Y+Delta;
end;
end;
{--------------work----------------------------}
procedure TForm1.Button1Click(Sender: TObject);
var
OutX,OutY,x,y:extended;
begin
H:=StrToFloat(Edit1.Text);
x:=0;
with Image1.Canvas do
while x < 200 do
begin
y:=0;
while y < 200 do
begin
if FindTrace(x,y,H,Epsilon,OutX,OutY) then
begin
MoveTo(round(x),round(y));LineTo(round(OutX),round(OutY));
end;
y:=y+Delta;
end;
x:=x+Delta;
end;
end;
end.
|