Функция обрисовки стрелки по координатам на Паскале / Delphi
// Функция обрисовки стрелки по координатам на Паскале / Delphi // для работы функции необходимо подключить модуль Math // все замечания и предложения писать в аську 368254335 // или почту
Procedure DrawStrelka(Cn:Tcanvas;x1,y1,x2,y2:integer;fhs:integer=25;a:integer=30); var ugol:real; begin Cn.MoveTo(x1,y1); Cn.LineTo(x2,y2); if (abs(x2-x1)+abs(y1-y2))>0 then begin if (x2-x1)<>0 then ugol:=arctan(((y2-y1)/((x2-x1)))) else ugol:=pi/2; if x2-x1>0 then ugol:=ugol+pi; if (y2-y1>0) and ((x2-x1)=0) then ugol:=-pi/2; Cn.LineTo(round((x2+(cos(ugol-a*pi/180)*fhs))),round(y2+(sin(ugol-a*pi/180)*fhs))); Cn.MoveTo(x2,y2); Cn.LineTo(round((x2+(cos(ugol+a*pi/180)*fhs))),round(y2+(sin(ugol+a*pi/180)*fhs))); end; end;
Допустим нам нужно нарисовать декартову систему координат в Delphi для этого допишем функцию
заменим блок команд
if (abs(x2-x1)+abs(y1-y2))>0 then begin if (x2-x1)<>0 then ugol:=arctan(((y2-y1)/((x2-x1)))) else ugol:=pi/2; if x2-x1>0 then ugol:=ugol+pi; if (y2-y1>0) and ((x2-x1)=0) then ugol:=-pi/2; на простую функцию arctan2
кстати функция arctan2 представляет вызов к функциям FPU
также полезным будет информация как расчет угла наклона прямой через функции ассемблера function ArcTan2(const Y, X: Extended): Extended; asm FLD Y FLD X FPATAN FWAIT end;
ugol:=arctan2(((y2-y1)),((x2-x1)))-pi; // для нашей функции
// представляем функцию для обрисовки декартовой системы координат // Sh:integer=25;fhs2:integer=10 // добавилось два параметра // Sh шаг между делениями // fhs2 размер делений по высоте / ширине Procedure DrawStrelka_Sh(Cn:Tcanvas;x1,y1,x2,y2:integer;fhs:integer=25;a:integer=30;Sh:integer=25;fhs2:integer=10); var ugol:real; i:integer; rx,ry:integer; begin Cn.MoveTo(x1,y1); Cn.LineTo(x2,y2); if (abs(x2-x1)+abs(y1-y2))>0 then begin ugol:=arctan2(((y2-y1)),((x2-x1)))-pi; Cn.LineTo(round((x2+(cos(ugol-a*pi/180)*fhs))),round(y2+(sin(ugol-a*pi/180)*fhs))); Cn.MoveTo(x2,y2); Cn.LineTo(round((x2+(cos(ugol+a*pi/180)*fhs))),round(y2+(sin(ugol+a*pi/180)*fhs))); ugol:=ugol+pi; fhs:=fhs2; for i:=0 to (Round(dlina(point(x1,y1),point(x2,y2))) div sh)-1 do begin rx:=round(x1+cos(ugol)*i*sh); ry:=round(y1+sin(ugol)*i*sh); Cn.Ellipse(rx-2,ry-2,rx+2,ry+2); // выводим точку Cn.MoveTo(rx,ry); Cn.LineTo(round((rx+(cos(ugol-pi/2)*fhs))),round(ry+(sin(ugol-pi/2)*fhs))); Cn.MoveTo(rx,ry); Cn.LineTo(round((rx+(cos(ugol+pi/2)*fhs))),round(ry+(sin(ugol+pi/2)*fhs))); end; end; end;
в итоге мы получаем полноценную функцию пример использования
Begin DrawStrelka_sh(form1.Image1.Canvas,25,25,form1.Image1.Width-25,25); DrawStrelka_sh(form1.Image1.Canvas,25,25,25,form1.Image1.Height-25); end;
Procedure DrawStrelka(Cn:Tcanvas;x1,y1,x2,y2:integer;fhs:integer=25;a:integer=30); var ugol:real; begin Cn.MoveTo(x1,y1); Cn.LineTo(x2,y2); if (abs(x2-x1)+abs(y1-y2))>0 then begin if (x2-x1)<>0 then ugol:=arctan(((y2-y1)/((x2-x1)))) else ugol:=pi/2; if x2-x1>0 then ugol:=ugol+pi; if (y2-y1>0) and ((x2-x1)=0) then ugol:=-pi/2; Cn.LineTo(round((x2+(cos(ugol-30*pi/180)*fhs))),round(y2+(sin(ugol-30*pi/180)*fhs))); Cn.MoveTo(x2,y2); Cn.LineTo(round((x2+(cos(ugol+30*pi/180)*fhs))),round(y2+(sin(ugol+30*pi/180)*fhs))); end; end;
procedure DrawPole; var x,y:integer; begin DrawStrelka(form1.Canvas,25,25,25,form1.Height-80); DrawStrelka(form1.Canvas,25,25,form1.Width-80,25); for x:=1 to ((form1.Width-80) div 10)-5 do begin form1.canvas.MoveTo(25+x*10,15); form1.canvas.lineTo(25+x*10,35); if x mod 5 = 0 then form1.Canvas.TextOut(10+x*10,5,inttostr(25+x*10));
end; for y:=1 to ((form1.Height-80) div 10)-8 do begin form1.canvas.MoveTo(15,30+10*y); form1.canvas.lineTo(35,30+10*y); if y mod 5 = 0 then form1.Canvas.TextOut(35,30+10*y,inttostr(25+y*10)); end;
