用矢量变换的方法求两条直线的交点

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } function CalInterPoint(x1, y1, x2, y2, x3, y3, x4, y4: Double; var xj, yj: Double): integer; function calPro(vx1, vy1, vx2, vy2: Double): Double; end; var Form1 : TForm1; implementation {$R *.dfm} function TForm1.CalInterPoint(x1, y1, x2, y2, x3, y3, x4, y4: Double; var xj, yj: Double): integer; {----------------------------------------------------------------------------- 函数名: CalInterPoint 作者　: 陈新中 时间　: 2002-8-28 参数　: (x1,y1,x2,y2)是一条直线 (x3,y3,x4,y4)是另一条直线 返回值: >=0 相交 包含1表示交点在12上包含2表示交点在34上 四种组合 0 两条直线都不通过交点 1 直线12通过 ,直线34不通过 2 直线34通过 ,直线12不通过 3 直线12和34都通过 -1 平行 功能　： 该函数计算直线的交点 -----------------------------------------------------------------------------} var px12, py12, //直线12的方向矢量 px34, py34, //直线34的方向矢量 t12, //12 和34的长度 nx12, ny12, //直线12的单位矢 px13, py13, //13连线矢量 ty, //13连线矢量在直线12上的投影 tysx, tysy, //13连线矢量在直线12上的投影矢量 czsx, czsy, //3到12的垂线矢量 //垂线矢跟直线34方向矢的夹角余弦 czL, //垂线长度 gene : //变换因子 Double; begin px12 := x2 - x1; //12连线矢量 py12 := y2 - y1; px34 := x4 - x3; //34连线矢量 py34 := y4 - y3; //如果矢积为0，则说明平行，置平行标志，返回 if px12 * py34 - px34 * py12 = 0 then begin Result := -1; exit; end; if (x3 - x1) * (y3 - y2) + (x3 - x2) * (y3 - y1) = 0 then begin //如果3正好落在直线12上,交点为 (x3,x4) xj := x3; yj := y3; end else begin t12 := sqrt(px12 * px12 + py12 * py12); //12长度 nx12 := px12 / t12; //12单位矢 ny12 := py12 / t12; px13 := x3 - x1; //13连线矢 py13 := y3 - y1; ty := px13 * nx12 + py13 * ny12; //投影 tysx := ty * nx12; //投影矢量 tysy := ty * ny12; czsx := tysx - px13; //垂线矢 czsy := tysy - py13; czL := sqrt(czsx * czsx + czsy * czsy); //垂线长度 gene := czL / calPro(x4 - x3, y4 - y3, czsx, czsy); //变换因子 xj := x3 + px34 * gene; yj := y3 + py34 * gene; end; Result := 0; if (x1 - xj) * (x2 - xj) + (y1 - yj) * (y2 - yj) < 0 then Result := Result + 1; //判断是否在直线12上 if (x3 - xj) * (x4 - xj) + (y3 - yj) * (y4 - yj) < 0 then Result := Result + 2; //判断是否在直线34上 end; procedure TForm1.Button1Click(Sender: TObject); var x1, y1, x2, y2, x3, y3, x4, y4 : Double; xo, yo : Double; ret : integer; info : string; begin x1 := 100; y1 := 350; x2 := 200; y2 := 200; x3 := 2000; y3 := 100; x4 := 0; y4 := 150; Form1.Canvas.MoveTo(round(x1), round(y1)); Form1.Canvas.LineTo(round(x2), round(y2)); Form1.Canvas.MoveTo(round(x3), round(y3)); Form1.Canvas.LineTo(round(x4), round(y4)); ret := CalInterPoint(x1, y1, x2, y2, x3, y3, x4, y4, xo, yo); Form1.Canvas.Ellipse(round(xo - 10), round(yo - 10), round(xo + 10), round(yo + 10)); info := ''; if (ret and 1) > 0 then begin info := info + '交点在直线12上 '; end else begin info := info + '交点不在直线12上 '; end; if (ret and 2) > 0 then begin info := info + '交点在直线34上 '; end else begin info := info + '交点不在直线34上 '; end; ShowMessage(info); end; function TForm1.calPro(vx1, vy1, vx2, vy2: Double): Double; // 求矢量的投影 矢量v1在v2上的投影 (vx1, vy1)是矢量v1 (vx2, vy2)是矢量v2 begin Result := (vx1 * vx2 + vy1 * vy2) / sqrt(vx2 * vx2 + vy2 * vy2); end; end.

来自：http://blog.youkuaiyun.com/wflishh/archive/2008/04/15/2293071.aspx修改