2,
procedure GetClipRgn(GeoRect : TGeoRect;var BufList : TList;
ShpType : integer);
var
I,Side : integer; {Side指定剪切边的左、上、右、下}
TempList : TList;
PP : PGeoPoint;
XX,YY :do
uble;
X1,Y1,X2,Y2 :do
uble;
Accepted : Boolean;
BufPArray : PXYArray;
IsFirstPointCalc : Integer; //第一点是否是求出来的,1：初始值，2：原来链表值，3：求出的值
begin
for Side := 1 to 4do
begin
TempList := BufList;
BufList := TList.Create;
Accepted := FALSE;
IsFirstPointCalc := 1;
for I := 0 to TempList.Count - 1do
begin
//判断点是否该被取得}
Case Side of
1 : begin
Accepted := PGeoPoint(TempList.Items)^.X > GeoRect.Left;
end;
2 : begin
Accepted := PGeoPoint(TempList.Items)^.Y > GeoRect.Top;
end;
3 : begin
Accepted := PGeoPoint(TempList.Items)^.X < GeoRect.Right;
end;
4 : begin
Accepted := PGeoPoint(TempList.Items)^.Y < GeoRect.Bottom;
end;
end;
if Accepted then
begin
GetMem(PP,SizeOf(TGeoPoint));
PP^.X := PGeoPoint(TempList.Items)^.X;
PP^.Y := PGeoPoint(TempList.Items)^.Y;
BufList.Add(PP);
if IsFirstPointCalc = 1 then
IsFirstPointCalc := 2;
end;
if I < TempList.Count - 1 then
begin
case Side of
1 : begin
{左}
X1 := GeoRect.Left; Y1 := GeoRect.Top;
X2 := GeoRect.Left; Y2 := GeoRect.Bottom;
end;
2 : begin
{上}
X1 := GeoRect.Left; Y1 := GeoRect.Top;
X2 := GeoRect.Right; Y2 := GeoRect.Top;
end;
3 : begin
{右}
X1 := GeoRect.Right; Y1 := GeoRect.Top;
X2 := GeoRect.Right; Y2 := GeoRect.Bottom;
end;
4 : begin
X1 := GeoRect.Left; Y1 := GeoRect.Bottom;
X2 := GeoRect.Right; Y2 := GeoRect.Bottom;
end;
end;
if GetIntersectedPoint(X1,Y1,X2,Y2,PGeoPoint(TempList.Items)^.X,PGeoPoint(TempList.Items)^.Y,PGeoPoint(TempList.Items[I+1])^.X,PGeoPoint(TempList.Items[I+1])^.Y,XX,YY,2) then
begin
GetMem(PP,SizeOf(TGeoPoint));
PP^.X := XX;
PP^.Y := YY;
BufList.Add(PP);
if IsFirstPointCalc = 1 then
IsFirstPointCalc := 3;
end;
end
else
begin
//将多边形封闭}
if ShpType = 3 then
begin
if (BufList.Count > 0) and (IsFirstPointCalc = 3) then
begin
GetMem(PP,SizeOf(TGeoPoint));
PP^.X := PGeoPoint(BufList.Items[0])^.X;
PP^.Y := PGeoPoint(BufList.Items[0])^.Y;
BufList.Add(PP);
end;
end;
end;
end;
{for I}
for I := 0 to TempList.Count - 1do
begin
FreeMem(TempList.Items,SizeOf(TGeoPoint));
end;
TempList.Free;
end;
{for Side}
//test
if BufList.Count < 0 then
ShowMessage('Error 3!');
//
end;
//获得X1,Y1,X2,Y2的交点，无交点时返回FALSE,Flag为1时交点必须位于两个矩形交叉区域内，Flag为2时交点为广义交点，即直线的延长线有效
//注意：Flag为2时前四个参数一定为剪切线}
function GetIntersectedPoint(X1,Y1,X2,Y2,X3,Y3,X4,Y4 :do
uble;var XX,YY :do
uble;Flag : integer):Boolean;
var
K1,K2,B1,B2 :do
uble; {二条直线的斜率}
V1,V2 : Boolean; {有斜率为无穷大的线存在}
// V1,V2 : integer; {1 :初始值,2:TRUE, 3 : FALSE}
begin
//X1,Y1,X2,Y2 为第一条直线,X3,Y3,X4,Y4 为第二条直线}
V1 := FALSE;
V2 := FALSE;
K1 := 1.7 * 10e308;
K2 := 5 * 10 - 324;
B1 := K1;
B2 := K2;
if Abs(X2-X1)>0.00000000001 then
begin
K1 := (Y2-Y1)/(X2-X1);
B1 := Y1-K1*X1;
end
else
begin
XX := X1;
V1 := TRUE;
end;
if Abs(X4-X3)>0.00000000001 then
begin
K2 := (Y4-Y3)/(X4-X3);
B2 := Y3-K2*X3;
end
else
begin
XX := X3;
V2 := TRUE;
end;
if (Abs(K1 - K2) < 0.000000000000001) or (V1 and V2) then
begin
Result := FALSE;
Exit;
end;
if (not V1) and (not V2) then
begin
XX := (B1-B2)/(K2-K1);
YY := K1*XX+B1;
end
else
if V2 then
begin
YY := K1*XX+B1;
end else
begin
YY := K2*XX+B2;
end;
if Flag = 1 then
begin
//如果计算出来的交点位于两个矩形的公共区域，则为真交点}
if (IsPtInRect(XX,YY,X1,Y1,X2,Y2)) and (IsPtInRect(XX,YY,X3,Y3,X4,Y4)) then
result := TRUE
else
result := FALSE;
end
else
if Flag = 2 then
begin
if (IsPtInRect(XX,YY,X3,Y3,X4,Y4)) then
result := TRUE
else
result := FALSE;
end;
end;
//TList的成员指针为以下类型
PGeoPoint = ^TGeoPoint;
TGeoPoint = record
X,Y :do
uble;
end;
