矢量图如何绘制？ ( 积分: 65 )

问题如题！

问题如题！

很简单的，举个例子，
绘制一条直线时你用动态数组可以保存两个端点的坐标

用API
你去看这本书:《delphi核心win32 Api 参考手册》

搜搜
如话题906455的标题是： 300分相求：失量图的绘制和操作方法

{本源码是自由程序，你可以把它用在任何地方，但不允许以任何形式把它单独用作商业用途。

本人是一个普通的打工仔，为了给朋友们献上更好的源码和控件，我需要你的支持，如果你认为本程序对你有帮助，希望你寄任意你愿意数额的RMB给我以资鼓励和支持，如果你认为不值，也希望你寄一张PostCard或者一封Email对我予以支持。

深圳市福田区联合广场41楼恒星威电子有限公司GPS部 艾真保 收
518026

mailto:Aizb@163.net

HomePage:
http://www.aidelphi.com}
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Spin;

type
TOperatorType=(otNone,otDrawLine,otSelect);
TAPoint=Array of TPoint;
TLine=Class//线对象.
Public
Selected:Boolean;
PointList:TAPoint;//线对象的点列表.
constructor Create;
end;

TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
SpinEdit1: TSpinEdit;
Button3: TButton;
Button4: TButton;
Button5: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormPaint(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button3Click(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
FOperatorType:TOperatorType;
LineList:TList;
FPointList:TAPoint;
procedure ClearLine;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
Const
Minimal=5;

////////////////////////////////////////////////////////////////////
//计算两点间的距离。
//参数：x1,x2,y1,y2:Integer，需要计算的两个点的X和Y坐标。
//返回值是两个点的距离。
////////////////////////////////////////////////////////////////////
function DotDis(x1,x2,y1,y2:Integer)ouble;Overload;
Var X,youble;
//需要先将整形数据转换成双精度浮点型才不容易溢出。
begin
x:=(x1-x2)/5000000;
y:=(y1-y2)/5000000;
Result:=(SQRT(SQR(x)+SQR))*5000000;
end;

////////////////////////////////////////////////////////////////////
//计算两点间的距离。
//参数：Dot1,Dot2:TPoint，需要计算的两个点。
//返回值是两个点的距离。
////////////////////////////////////////////////////////////////////
function DotDis(Dot1,Dot2:TPoint)ouble; Overload;
begin
Result:=DotDis(Dot1.x,Dot2.x,Dot1.y,Dot2.y);
end;

////////////////////////////////////////////////////////////////////
//点到线段的距离。如果点与直线的垂足不在线段上，则取点到线段最近点的距离。
//参数：pFrom, pTo:TPoint，线段的端点。
// pDot，第三点。
//返回值是第三点与线段的距离。
////////////////////////////////////////////////////////////////////
function Dot2Line(pFrom, pTo, pDot: Tpoint)ouble;
var
F2T_Dis,D2T_Dis,D2F_Dis,souble;
begin
F2T_Dis:=DotDis(pFrom,pTo);
D2T_Dis:=DotDis(pDot,pTo);
D2F_Dis:=DotDis(pDot,pFrom);
if (D2F_Dis>SQRT(SQR(D2T_Dis)+SQR(F2T_Dis))) then
Result:=D2T_Dis
else if (D2T_Dis>SQRT(SQR(D2F_Dis)+SQR(F2T_Dis))) then
Result:=D2F_Dis
else if (Trunc(D2F_Dis)=Trunc(SQRT(SQR(D2T_Dis)+SQR(F2T_Dis)))) then
Result:=D2T_Dis
else if (Trunc(D2T_Dis)=Trunc(SQRT(SQR(D2F_Dis)+SQR(F2T_Dis)))) then
Result:=D2F_Dis
else if F2T_Dis<0.0001 then
begin
if D2T_Dis>D2F_Dis then
Result:=D2F_Dis
else
Result:=D2T_Dis;
end else
begin
s:=(D2F_Dis+D2T_Dis+F2T_Dis)/2;
Result:=SQRT(ABS(s*(s-D2F_Dis)*(s-D2T_Dis)*(s-F2T_Dis)))*2/F2T_Dis;
end;
end;

////////////////////////////////////////////////////////////////////
//判断点是否在一个条线上或一定距离内。
//参数：PointArray:Array of TPoint组成区域的点列表。
// Dot，第三点。
// Var Contrastouble指定的距离，如果点与线的距离小于这个值，则用这个值来返回最近的距离。
// Var PointIndex:Integer返回与该点最近的线上的点的序号。
//返回第三点是否在线上或距线一定距离。
////////////////////////////////////////////////////////////////////
function MyPTInLine(PointArray:TAPoint;Dot:TPoint;Var Contrastouble;Var PointIndex:Integer):Boolean;
Var MaxX,MaxY,MinX,MinY,i,Count:Integer;
dDot2LineValueouble;
Dis1,Dis2ouble;
begin
Result:=False;
Count:=High(PointArray)+1;
PointIndex:=-1;
if Count<=1 then
Exit;
MaxX:=0;
MaxY:=0;
MinX:=MaxInt;
MinY:=MaxInt;
For i:=0 to Count-1 do
begin
if MaxX<PointArray.x then
MaxX:=PointArray.x;
if MaxY<PointArray.y then
MaxY:=PointArray.y;
if MinX>PointArray.x then
MinX:=PointArray.x;
if MinY>PointArray.y then
MinY:=PointArray.y;
end;
if (Dot.x>MaxX+Contrast)
or (Dot.x<MinX-Contrast)
or (Dot.Y>MaxY+Contrast)
or (Dot.Y<MinY-Contrast)
then
Exit;
For i:=0 to Count-2 do
begin
dDot2LineValue:=Dot2Line(PointArray,PointArray[i+1],Dot);
if dDot2LineValue<=Contrast then
begin
Result:=True;
Contrast:=dDot2LineValue;
Dis1:=DotDis(PointArray,Dot);
Dis2:=DotDis(PointArray[i+1],Dot);
if (Dis1<Dis2) and (Dis1<=Minimal) then
PointIndex:=i
else if (Dis2<Dis1) and (Dis2<=Minimal) then
PointIndex:=i+1;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
LineList:=TList.Create; //创建列表保存对象.
FOperatorType:=otNone; //是否在画线.
end;

procedure TForm1.ClearLine;//清除线对象.
Var i:Integer;
Line:TLine;
begin
For i:=LineList.Count-1 downto 0 do//释放每一个对象.
begin
Line:=LineList;
Line.Free;
LineList.Delete(i);
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ClearLine;//先清除线对象.
LineList.Free;//释放列表.
end;

procedure TForm1.FormPaint(Sender: TObject);
Var i,j:Integer;
Line:TLine;
P:TPoint;
begin
For i:=0 to LineList.Count-1 do
begin
Canvas.Brush.Color:=Color;
Line:=LineList;
Canvas.Polyline(Line.PointList);//画每一条线对象.
if Line.Selected then
begin
Canvas.Brush.Color:=clRed;
For j:=0 to High(Line.PointList) do
begin
p:=Line.PointList[j];
Canvas.FillRect(Rect(P.X-2,P.Y-2,P.x+2,P.Y+2));
end;
end;
end;
if FOperatorType=otDrawLine then
begin
if High(FPointList)>=1 then
Canvas.Polyline(FPointList);//如果正在画线,则把未完成的线也画出来.
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
FOperatorType:=otDrawLine;
SetLength(FPointList,0); //开始画线清除临时线的点列表.
end;

procedure TForm1.Button2Click(Sender: TObject);
Var Line:TLine;
begin
FOperatorType:=otNone;
if High(FPointList)>=1 then//如果已经有两个以上的点
begin
Line:=TLine.Create;//创建一个线对象.
SetLength(Line.PointList,0);//初始化线对象的点列表.
Line.PointList:=Copy(FPointList,0,Sizeof(TPoint)*(High(FPointList)+1));
//复制当前画好的临时点列表.
LineList.Add(Line);//把对象加入到列表.
Invalidate;//重画Form
end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Var Count,i,PoiIDX:Integer;
Line:TLine;
Contrastouble;
begin
if FOperatorType=otDrawLine then//如果正在画线.
begin
Count:=High(FPointList)+1;
SetLength(FPointList,Count+1);
FPointList[Count]:=Point(x,y);//增加一个点.
Invalidate;
end else if FOperatorType=otSelect then
begin
For i:=0 to LineList.Count-1 do
begin
Line:=LineList;
Contrast:=Minimal;
if MyPTInLine(Line.PointList,Point(x,y),Contrast,PoiIDX) then
begin
Line.Selected:=not Line.Selected;
Invalidate;
Break;
end;
end;
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
Var OldLine,NewLine:TLine;
i,j:Integer;
begin
if (SpinEdit1.Value>0) and (LineList.Count>0) then//如果需要复制数大于0并且已经存在一个以上的线条.
begin
OldLine:=LineList[LineList.Count-1];//取出旧线条.
For i:=0 to SpinEdit1.Value-1 do//复制需要的份数.
begin
NewLine:=TLine.Create;//创建新线条.
SetLength(NewLine.PointList,0);//初始化点列表.
NewLine.PointList:=Copy(OldLine.PointList,0,Sizeof(TPoint)*(High(OldLine.PointList)+1));
//复制点列表.
For j:=0 to High(NewLine.PointList) do//对点进行移位.
begin
NewLine.PointList[j].X:=NewLine.PointList[j].X+40*(i+1);
NewLine.PointList[j].y:=NewLine.PointList[j].y+40*(i+1);
end;
LineList.Add(NewLine);//加和到列表.
end;
Invalidate;//重画.
end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (FOperatorType=otDrawLine) and (High(FPointList)>=0) then//这种方法简单不过鼠标移动时会造成闪动.
begin
Invalidate;
Canvas.MoveTo(FPointList[High(FPointList)].x,FPointList[High(FPointList)].y);
Canvas.LineTo(x,y);
end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
FOperatorType:=otSelect;
end;

{ TLine }

constructor TLine.Create;
begin
inherited;
Selected:=False;
end;

procedure TForm1.Button5Click(Sender: TObject);
Var i:Integer;
Line:TLine;
bDeleted:Boolean;
begin
bDeleted:=False;
For i:=LineList.Count-1 downto 0 do//释放每一个对象.
begin
Line:=LineList;
if Line.Selected then
begin
Line.Free;
LineList.Delete(i);
bDeleted:=True;
end;
end;
if bDeleted then
Invalidate;
end;

end.

接受答案了.