Новичок
Джуниор
Регистрация: 29.11.2011
Сообщений: 2
|
Построение изолиний по координатной сетке(Delphi)
нужна помощь, в задании необходимо задавать размер ячейки через х и у, я добился изменения ячейки и прорисовки изолиний, но в некоторых случаях график смещается, помогите разобраться
Код:
procedure PutDot(x,y:integer);
procedure TForm1.PrintGreedClick(Sender: TObject);
var i,j:integer;
b1,b2:boolean;
begin
b1:=true;b2:=true;
Image1.Picture:=nil;
ky:=round(Image1.Width/strtoint(GreedScqr.text));
ry:=round(Image1.Width/ky);
kx:=round(Image1.Height/strtoint(LabeledEdit1.text));
rx:=round(Image1.Height/kx);
lft:=(-1)*trunc(ky/2);
rght:=round((ky/2)+0.1);
up:=rght;
down:=lft;
with Image1.Canvas do
begin
for i:=0 to kx do
begin
if (((i)*rx>=round(Image1.Height/2))and b1) then
begin
pen.Width:=2;
pen.Color:=AxisColor.Color;
b1:=false;
end
else
begin
pen.Width:=1;
Pen.Color:=GreedColor.Color;
end;
MoveTo(0,i*rx);
LineTo(Image1.Width,i*rx);
end;
for j:=0 to ky do
begin
if (((j)*ry>=round(Image1.Width/2))and b2) then
begin
pen.Width:=2;
pen.Color:=AxisColor.Color;
b2:=false;
t:=j*ry;
end
else
begin
pen.Width:=1;
Pen.Color:=GreedColor.Color;
end;
MoveTo(j*ry,0);
LineTo(j*ry,Image1.Height);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i,j,ic,k,count,tmp1,colRed,colBlue:integer;
mx,my,mz,graphm:array of extended;
minmx,minmy,maxz,minz:extended;
b,b1,b2,bc:boolean;
begin
b:=true;
ic:=strtoint(IzoCount.Text);
SetLength(datamas,ky+1,ky+1);
setLength(mx,ic*2);
SetLength(my,ic*2);
SetLength(mz,ic);
/// Вычисление значений в узлах сетки координат ///
With Image1.Canvas do
begin
for i:=0 to ky do
begin
for j:=0 to ky do
begin
datamas[i,j]:=f2(j+lft,Up-i,10);
if i=0 then
begin
min:=datamas[i,j];
max:=datamas[i,j];
end
else
begin
if max<datamas[i,j] then
max:=datamas[i,j];
if min>datamas[i,j] then
min:=datamas[i,j];
end;
end;
end;
end;
for i:=1 to ic do
begin
mx[i-1]:=(lft*i/(ic));
end;
for i:=0 to length(mx)-1 do
mx[length(mx)-1-i]:=-1*mx[i];
/// Сортировка ///
while(b)do
begin
b:=false;
for i:=0 to length(mx)-2 do
begin
if mx[i]>mx[i+1] then
begin
minmx:=mx[i];
mx[i]:=mx[i+1];
mx[i+1]:=minmx;
b:=true;
end;
end;
end;//while
/// Вычисление знач.ф. в mx ///
maxz:=-32767;
minz:=32767;
for i:=0 to round(length(mx)/2)-1 do
begin
my[i]:=mx[i];
mz[i]:=f2(mx[i],0,10);
if maxz<mz[i] then
maxz:=mz[i];
if minz>mz[i] then
minz:=mz[i];
end;
Image1.Canvas.Pen.Color:=clred;
//// Линейная интерполяция ///
count:=0;
b:=true;
for k:=0 to length(mz)-1 do
begin
bc:=true;
for i:=0 to ky-1 do
begin
tmp1:=-2;
for J:=0 to ky-1 do
begin
b1:=((mz[k]>datamas[i,j])and(mz[k]>datamas[i+1,j])and(mz[k]>datamas[i,j+1])and(mz[k]>datamas[i+1,j+1]));
b2:=((mz[k]<datamas[i,j])and(mz[k]<datamas[i+1,j])and(mz[k]<datamas[i,j+1])and(mz[k]<datamas[i+1,j+1]));
if not((b1)or(b2)) then
begin
if (((mz[k]-datamas[i+1,j])<=0) and ((mz[k]-datamas[i+1,j+1])>=0))or(((mz[k]-datamas[i+1,j])>=0) and ((mz[k]-datamas[i+1,j+1])<=0)) then
begin
SetLength(graphm,length(graphm)+1);
graphm[length(graphm)-1]:=LinInt(Up-(j),Up-(j+1),mz[k],datamas[i+1,j],datamas[i+1,j+1]);
inc(count);
if (count=1) then
Image1.Canvas.MoveTo((lft+(i+1))*strtoint(greedScqr.text)+300,300-round(graphm[length(graphm)-1]*strtoint(greedScqr.text)))
else
begin
if (tmp1)<>j{b and((300-round(graphm[length(graphm)-1]*strtoint(greedScqr.text)))>300)} then
begin
Image1.Canvas.MoveTo((lft+(i+1))*strtoint(greedScqr.text)+300,300-round(graphm[length(graphm)-1]*strtoint(greedScqr.text)));
end//if
else
begin
if maxz>0 then
begin
colRed:=round((mz[k]*100/maxz)*255/100);
colBlue:=255-colRed;
end
else
begin
colBlue:=round((mz[k]*100/minz)*255/100);
colBlue:=255-colBlue;
end;
Image1.Canvas.Pen.Color:=RGB(colRed,0,colBlue);
Image1.Canvas.LineTo((lft+(i+1))*strtoint(greedScqr.text)+300,300-round(graphm[length(graphm)-1]*strtoint(greedScqr.text)));
end;//else
end;
|