Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.06.2012, 14:39   #1
gblpokoJl
Новичок
Джуниор
 
Регистрация: 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;
gblpokoJl вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
построение координатной сетки невнимательный Помощь студентам 5 17.11.2020 00:17
Вопрос по сетке lecko Свободное общение 13 12.08.2010 15:19
построение изолиний cherkasenok Паскаль, Turbo Pascal, PascalABC.NET 7 19.05.2009 19:23
рисование изолиний Alar Паскаль, Turbo Pascal, PascalABC.NET 0 30.10.2006 14:17