david
47aaf11578
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@38 05c56307-c608-d34a-929d-697000501d7a
718 lines
20 KiB
ObjectPascal
718 lines
20 KiB
ObjectPascal
{*******************************************************************}
|
|
{ }
|
|
{ Developer Express Visual Component Library }
|
|
{ ExpressFlowChart }
|
|
{ }
|
|
{ Copyright (c) 1998-2009 Developer Express Inc. }
|
|
{ ALL RIGHTS RESERVED }
|
|
{ }
|
|
{ The entire contents of this file is protected by U.S. and }
|
|
{ International Copyright Laws. Unauthorized reproduction, }
|
|
{ reverse-engineering, and distribution of all or any portion of }
|
|
{ the code contained in this file is strictly prohibited and may }
|
|
{ result in severe civil and criminal penalties and will be }
|
|
{ prosecuted to the maximum extent possible under the law. }
|
|
{ }
|
|
{ RESTRICTIONS }
|
|
{ }
|
|
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
|
|
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
|
|
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
|
|
{ LICENSED TO DISTRIBUTE THE EXPRESSFLOWCHART AND ALL ACCOMPANYING}
|
|
{ VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
|
|
{ }
|
|
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
|
|
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
|
|
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
|
|
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
|
|
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
|
|
{ }
|
|
{ CONSULT THE end USER LICENSE AGREEMENT FOR INFORMATION ON }
|
|
{ ADDITIONAL RESTRICTIONS. }
|
|
{ }
|
|
{*******************************************************************}
|
|
|
|
unit dxLines;
|
|
|
|
{$I cxVer.inc}
|
|
|
|
interface
|
|
|
|
uses Windows,Classes;
|
|
|
|
type TLineType = (liStraight, liQSpline, liRectH, liRectV);
|
|
|
|
procedure QSpline(DC: HDC; var Points; Count: Integer);
|
|
procedure RectHLine(DC: HDC; var Points; Count: Integer);
|
|
procedure RectVLine(DC: HDC; var Points; Count: Integer);
|
|
procedure ExtendRect(var R: TRect; const P: TPoint);
|
|
function Distance(const A,B: TPoint): Integer;
|
|
function LineLength(LType: TLineType; var Points; Count: Integer): Integer;
|
|
function LineCenter(LType: TLineType; var Points; Count: Integer): TPoint;
|
|
function MassCenter(LType: TLineType; var Points; Count: Integer): TPoint;
|
|
function PtOnLine(LType: TLineType; var Points; Count,Delta,X,Y: Integer): Boolean;
|
|
function RectOnLine(LType: TLineType; var Points; Count: Integer; const R: TRect): Boolean;
|
|
function PointIndex: Integer;
|
|
|
|
implementation
|
|
|
|
type
|
|
|
|
TQSData = packed record
|
|
P0,P1,P2: TPoint;
|
|
Px2,DPx2,Qx: TPoint;
|
|
Result: Integer;
|
|
Step,Limit: Word;
|
|
Mode,Last: Byte;
|
|
case Integer of
|
|
0: (Source,Prev: TPoint);
|
|
1: (Rect: TRect);
|
|
end;
|
|
|
|
TPointArray = array[0..$FFFFFF] of TPoint;
|
|
PPointArray = ^TPointArray;
|
|
PPoint = ^TPoint;
|
|
TPointFunc = function(LType:TLineType;P:PPointArray;I,Count:Integer;var Data: TQSData): Boolean;
|
|
|
|
var LastIndex: Integer;
|
|
|
|
{ Service public routines }
|
|
|
|
procedure ExtendRect(var R: TRect; const P: TPoint);
|
|
begin
|
|
if P.X < R.Left then R.Left := P.X;
|
|
if P.X > R.Right then R.Right := P.X;
|
|
if P.Y < R.Top then R.Top := P.Y;
|
|
if P.Y > R.Bottom then R.Bottom := P.Y;
|
|
end;
|
|
|
|
function Distance(const A,B: TPoint): Integer;
|
|
var
|
|
DX, DY: Extended;
|
|
begin
|
|
try
|
|
DX := A.X - B.X;
|
|
DY := A.Y - B.Y;
|
|
if (DX=0) or (DY=0) then
|
|
Result := Round(Abs(DX+DY))
|
|
else
|
|
Result := Round(Sqrt(DX * DX + DY * DY));
|
|
except
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
{ Internal routines }
|
|
|
|
procedure QSPoints(var Data: TQSData); register;
|
|
asm
|
|
JMP @MAIN
|
|
|
|
@ABSMAX: MOV EAX,[EBX]
|
|
SUB EAX,[ECX]
|
|
JNS @@A1
|
|
NEG EAX
|
|
@@A1: MOV EDX,[EBX].4
|
|
SUB EDX,[ECX].4
|
|
JNS @@A2
|
|
NEG EDX
|
|
@@A2: CMP EAX,EDX
|
|
JAE @@A3
|
|
XCHG EAX,EDX
|
|
@@A3: RET
|
|
|
|
@INIT: XOR EBX,EBX
|
|
MOV EBP,EBX
|
|
MOV BP,AX
|
|
CALL @@I1
|
|
INC EBX
|
|
@@I1: MOV EAX,[ESI+EBX*4].TQSData.P0.X
|
|
ADD EAX,[ESI+EBX*4].TQSData.P2.X
|
|
SUB EAX,[ESI+EBX*4].TQSData.P1.X
|
|
SUB EAX,[ESI+EBX*4].TQSData.P1.X
|
|
IMUL EBP
|
|
IMUL EBP
|
|
SHRD EAX,EDX,15
|
|
ADC EAX,0
|
|
MOV [ESI+EBX*4].TQSData.DPx2.X,EAX
|
|
SAR EAX,1
|
|
ADC EAX,0
|
|
MOV [ESI+EBX*4].TQSData.Px2.X,EAX
|
|
MOV EAX,[ESI+EBX*4].TQSData.P1.X
|
|
SUB EAX,[ESI+EBX*4].TQSData.P0.X
|
|
SAL EAX,1
|
|
IMUL EBP
|
|
ADD [ESI+EBX*4].TQSData.Px2.X,EAX
|
|
MOV [ESI+EBX*4].TQSData.Qx.X,0
|
|
MOV EAX,[ESI+EBX*4].TQSData.P0.X
|
|
MOV [ESI+EBX*4].TQSData.P1.X,EAX
|
|
RET
|
|
|
|
@NEXT: XOR EBX,EBX
|
|
CALL @@N1
|
|
INC EBX
|
|
@@N1: MOV EAX,[ESI+EBX*4].TQSData.Px2.X
|
|
ADD EAX,[ESI+EBX*4].TQSData.Qx.X
|
|
MOV [ESI+EBX*4].TQSData.Qx.X,EAX
|
|
SAR EAX,16
|
|
ADC EAX,[ESI+EBX*4].TQSData.P1.X
|
|
MOV [ESI+EBX*4].TQSData.P0.X,EAX
|
|
MOV EAX,[ESI+EBX*4].TQSData.DPx2.X
|
|
ADD [ESI+EBX*4].TQSData.Px2.X,EAX
|
|
RET
|
|
|
|
@DO_PTS: MOV EAX,[ESI].TQSData.P0.X
|
|
STOSD
|
|
MOV EAX,[ESI].TQSData.P0.Y
|
|
STOSD
|
|
RET
|
|
|
|
@MAIN: PUSH EBX
|
|
PUSH EBP
|
|
PUSH ESI
|
|
PUSH EDI
|
|
MOV ESI,EAX
|
|
LEA EBX,[ESI].TQSData.P0
|
|
LEA ECX,[ESI].TQSData.P1
|
|
CALL @ABSMAX
|
|
MOV EBP,EAX
|
|
LEA EBX,[ESI].TQSData.P2
|
|
CALL @ABSMAX
|
|
ADD EBP,EAX
|
|
JZ @@END
|
|
XOR EAX,EAX
|
|
CDQ
|
|
MOV DL,8
|
|
@@1: CMP DX,BP
|
|
JB @@2
|
|
SAL EBP,1
|
|
JMP @@1
|
|
@@2: DIV BP
|
|
MOV [ESI].TQSData.Step,AX
|
|
MOV [ESI].TQSData.Limit,0
|
|
CALL @INIT
|
|
MOV EDI,[ESI].TQSData.Result
|
|
@@3: CALL @DO_PTS
|
|
CALL @NEXT
|
|
MOV AX,[ESI].TQSData.Step
|
|
ADD [ESI].TQSData.Limit,AX
|
|
JNC @@3
|
|
MOV EAX,[ESI].TQSData.P2.X
|
|
MOV [ESI].TQSData.P0.X,EAX
|
|
MOV EAX,[ESI].TQSData.P2.Y
|
|
MOV [ESI].TQSData.P0.Y,EAX
|
|
CMP [ESI].TQSData.Last,0
|
|
JZ @@4
|
|
CALL @DO_PTS
|
|
@@4: MOV [ESI].TQSData.Result,EDI
|
|
@@END: POP EDI
|
|
POP ESI
|
|
POP EBP
|
|
POP EBX
|
|
end;
|
|
|
|
function StackAlloc(Size: Integer): Pointer; register;
|
|
asm
|
|
POP ECX
|
|
MOV EDX,ESP
|
|
ADD EAX,3
|
|
AND AL,NOT 3
|
|
@@1: CMP EAX,4092
|
|
JBE @@2
|
|
SUB ESP,4092
|
|
PUSH EAX
|
|
SUB EAX,4096
|
|
JMP @@1
|
|
@@2: SUB ESP,EAX
|
|
MOV EAX,ESP
|
|
PUSH EDX
|
|
PUSH ECX
|
|
end;
|
|
|
|
procedure StackFree(P: Pointer); register;
|
|
asm
|
|
POP ECX
|
|
MOV ESP,[EAX].-4
|
|
PUSH ECX
|
|
end;
|
|
|
|
procedure MiddlePoint(var Dst: TPoint; const Src: TPoint);
|
|
begin
|
|
Dst.X := Src.X + (Dst.X - Src.X) div 2;
|
|
Dst.Y := Src.Y + (Dst.Y - Src.Y) div 2;
|
|
end;
|
|
|
|
procedure DoQSPoints(const Points: array of TPoint; Count: Integer; var Data: TQSData);
|
|
var I: Integer;
|
|
begin
|
|
with Data do begin
|
|
P0 := Points[0];
|
|
Last := 0;
|
|
for I:=1 to Count-2 do begin
|
|
P1 := Points[I];
|
|
P2 := Points[I+1];
|
|
if I = Count-2 then Last := 1
|
|
else MiddlePoint(P2,P1);
|
|
QSPoints(Data);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$O-}
|
|
procedure RectLine(DC: HDC; var Points; Count: Integer; Vertical: Boolean);
|
|
var
|
|
I,J: Integer;
|
|
P1,P2: ^TPointArray;
|
|
begin
|
|
if Count < 2 then Exit;
|
|
P1 := @Points; P2 := StackAlloc(Count shl 4);
|
|
J := 0; P2^[0] := P1^[0];
|
|
for I:=1 to Count-1 do begin
|
|
Inc(J); P2^[J] := P2^[J-1];
|
|
if Vertical then P2^[J].Y := P1^[I].Y
|
|
else P2^[J].X := P1^[I].X;
|
|
Inc(J); P2^[J] := P1^[I];
|
|
end;
|
|
Polyline(DC,P2^,Count shl 1 - 1);
|
|
StackFree(P2);
|
|
end;
|
|
{$O+}
|
|
|
|
function PartLen(LType: TLineType; P: PPointArray; I,Count: Integer; LC,MC: PPoint): Integer;
|
|
var
|
|
X, Y: Integer;
|
|
Ax,Bx,Ay,By: Extended;
|
|
W,B2A,SqA,L0,T,DT,A,C: Extended;
|
|
P0,P1,P2: TPoint;
|
|
|
|
procedure RectPoints;
|
|
begin
|
|
P0 := Point(P^[I+1].X,P^[I].Y);
|
|
P1 := Point(P^[I].X,P^[I+1].Y);
|
|
if P0.X < P1.X then X := -X;
|
|
if P1.Y < P0.Y then Y := -Y;
|
|
Dec(P0.X,X); Inc(P0.Y,Y);
|
|
Inc(P1.X,X); Dec(P1.Y,Y);
|
|
end;
|
|
|
|
function Limits(X: Extended): Extended;
|
|
var S: Extended;
|
|
begin
|
|
if W=0 then Result := X * Abs(X)
|
|
else begin
|
|
S := Sqrt(X*X + W);
|
|
Result := X*S + W*Ln(X+S);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Ax := 0;
|
|
Ay := 0;
|
|
Bx := 0;
|
|
By := 0;
|
|
B2A := 0;
|
|
Result := 0;
|
|
SqA := 0;
|
|
L0 := 0;
|
|
case LType of
|
|
liStraight:
|
|
Result := Distance(P^[I],P^[I+1]);
|
|
liRectH, liRectV:
|
|
Result := Abs(P^[I].X - P^[I+1].X) + Abs(P^[I].Y - P^[I+1].Y);
|
|
liQSpline:
|
|
begin
|
|
P0 := P^[I];
|
|
P1 := P^[I+1];
|
|
P2 := P^[I+2];
|
|
if I > 0 then MiddlePoint(P0,P1);
|
|
if I < Count-2 then MiddlePoint(P2,P1);
|
|
|
|
Ax := P0.X + P2.X - P1.X shl 1;
|
|
Bx := P1.X - P0.X;
|
|
Ay := P0.Y + P2.Y - P1.Y shl 1;
|
|
By := P1.Y - P0.Y;
|
|
|
|
A := Ax*Ax + Ay*Ay;
|
|
C := Bx*Bx + By*By;
|
|
W := 0;
|
|
|
|
if A=0 then
|
|
Result := Round(Sqrt(C * 4))
|
|
else
|
|
begin
|
|
B2A := (Ax*Bx + Ay*By) / A;
|
|
W := C/A - B2A*B2A;
|
|
SqA := Sqrt(A);
|
|
L0 := Limits(B2A);
|
|
Result := Round(SqA*(Limits(B2A+1)-L0));
|
|
end;
|
|
end;
|
|
end;
|
|
if LC <> nil then
|
|
case LType of
|
|
liStraight:
|
|
begin
|
|
X := LC^.X; Y := LC^.Y;
|
|
LC^.X := P^[I].X + MulDiv(P^[I+1].X-P^[I].X,X,Y);
|
|
LC^.Y := P^[I].Y + MulDiv(P^[I+1].Y-P^[I].Y,X,Y);
|
|
end;
|
|
liRectH, liRectV:
|
|
begin
|
|
X := Abs(P^[I].X - P^[I+1].X) - LC^.X;
|
|
if X >= 0 then
|
|
Y := 0
|
|
else
|
|
begin
|
|
Y := -X;
|
|
X := 0;
|
|
end;
|
|
RectPoints;
|
|
if LType=liRectH then LC^ := P0 else LC^ := P1;
|
|
end;
|
|
liQSpline:
|
|
begin
|
|
T := 0.5; DT := 0.25;
|
|
if W<>0 then while true do begin
|
|
C := Round(SqA*(Limits(B2A+T)-L0)) - LC^.X;
|
|
if C = 0 then Break;
|
|
if C > 0 then T := T - DT else T := T + DT;
|
|
DT := DT / 2;
|
|
end;
|
|
if T >= 0.5 then Inc(LastIndex);
|
|
LC^.X := Round(T*(Ax*T + Bx * 2)) + P0.X;
|
|
LC^.Y := Round(T*(Ay*T + By * 2)) + P0.Y;
|
|
end;
|
|
end;
|
|
if MC <> nil then
|
|
case LType of
|
|
liStraight:
|
|
begin
|
|
MC^.X := (P^[I].X + P^[I+1].X) div 2;
|
|
MC^.Y := (P^[I].Y + P^[I+1].Y) div 2;
|
|
end;
|
|
liRectH,liRectV:
|
|
begin
|
|
X := Abs(P^[I].X - P^[I+1].X) shr 2;
|
|
Y := Abs(P^[I].Y - P^[I+1].Y) shr 2;
|
|
RectPoints;
|
|
if LType=liRectH then MC^ := P0 else MC^ := P1;
|
|
end;
|
|
liQSpline:
|
|
begin
|
|
MC^.X := (P0.X + P1.X + P2.X) div 3;
|
|
MC^.Y := (P0.Y + P1.Y + P2.Y) div 3;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function PartDistance(const PS,PE,Src: TPoint): Integer;
|
|
var
|
|
DX,DY,Tmp: Integer;
|
|
begin
|
|
DX := PE.X - PS.X;
|
|
DY := PE.Y - PS.Y;
|
|
if DX+DY = 0 then begin
|
|
DX := PS.Y - Src.Y;
|
|
DY := Src.X - PS.X;
|
|
if DX+DY = 0 then DX := 1;
|
|
end;
|
|
if Abs(DX) <= Abs(DY)
|
|
then Result := Src.X - PS.X - MulDiv(Src.Y-PS.Y,DX,DY)
|
|
else Result := Src.Y - PS.Y - MulDiv(Src.X-PS.X,DY,DX);
|
|
if Result=0 then Exit;
|
|
Result := Abs(Result);
|
|
DX := Abs(DX); DY := Abs(DY);
|
|
if DX < DY then begin
|
|
Tmp := DX; DX := DY; DY := Tmp;
|
|
end;
|
|
DX := DX * 181 shr 7;
|
|
Result := MulDiv(Result,DX,DX+DY);
|
|
end;
|
|
|
|
procedure ChkType(var LType: TLineType; var Count: Integer);
|
|
begin
|
|
if (LType=liQSpline) and (Count < 3) then LType := liStraight;
|
|
if LType=liQSpline then Dec(Count);
|
|
end;
|
|
|
|
function DoPoints(LType:TLineType;var Points;Count:Integer;var Data:TQSData;Action:TPointFunc): Boolean;
|
|
var
|
|
I: Integer;
|
|
P: PPointArray;
|
|
begin
|
|
P := @Points; Result := False;
|
|
ChkType(LType,Count);
|
|
for I:=0 to Count-2 do begin
|
|
LastIndex := I;
|
|
Result := Action(LType,P,I,Count,Data);
|
|
if Result then Exit;
|
|
end;
|
|
LastIndex := -1;
|
|
end;
|
|
|
|
function DoLineLength(LType:TLineType;P:PPointArray;I,Count:Integer;var Data: TQSData): Boolean;
|
|
begin
|
|
Inc(Data.Result,PartLen(LType,P,I,Count,nil,nil));
|
|
Result := False;
|
|
end;
|
|
|
|
function DoMassCenter(LType:TLineType;P:PPointArray;I,Count:Integer;var Data: TQSData): Boolean;
|
|
var PL: Integer;
|
|
begin
|
|
with Data do begin
|
|
PL := PartLen(LType,P,I,Count,nil,@Prev);
|
|
Inc(Result,PL);
|
|
Inc(Source.X,PL*Prev.X);
|
|
Inc(Source.Y,PL*Prev.Y);
|
|
end;
|
|
Result := False;
|
|
end;
|
|
|
|
function DoPtOnLine(LType:TLineType;P:PPointArray;I,Count:Integer;var Data:TQSData): Boolean;
|
|
var
|
|
D1,D2,Delta: Integer;
|
|
R: TRect;
|
|
begin
|
|
Delta := Data.Prev.X;
|
|
Data.P0 := P^[I]; Data.P1 := P^[I+1];
|
|
R.TopLeft := Data.P1; R.BottomRight := Data.P1;
|
|
with Data do case LType of
|
|
liRectH: begin
|
|
P2.X := P1.X;
|
|
P2.Y := P0.Y;
|
|
end;
|
|
liRectV: begin
|
|
P2.X := P0.X;
|
|
P2.Y := P1.Y;
|
|
end;
|
|
liQSpline: begin
|
|
P2 := P^[I+2];
|
|
if I > 0 then MiddlePoint(P0,P1);
|
|
if I < Count-2 then MiddlePoint(P2,P1);
|
|
ExtendRect(R,P2);
|
|
end;
|
|
end;
|
|
ExtendRect(R,Data.P0);
|
|
InflateRect(R,Delta,Delta);
|
|
Result := PtInRect(R,Data.Source);
|
|
if Result then case LType of
|
|
liStraight: Result := PartDistance(Data.P0,Data.P1,Data.Source) <= Delta;
|
|
liRectH,liRectV: begin
|
|
D1 := Abs(Data.P2.X - Data.Source.X);
|
|
D2 := Abs(Data.P2.Y - Data.Source.Y);
|
|
if D1 > D2 then D1 := D2;
|
|
Result := D1 <= Delta;
|
|
end;
|
|
liQSpline: begin
|
|
D1 := Data.Result; D2 := LastIndex;
|
|
QSPoints(Data);
|
|
Result := PtOnLine(liStraight,Pointer(D1)^,(Data.Result-D1) shr 3,Delta,Data.Source.X,Data.Source.Y);
|
|
if LastIndex >= (Data.Result-D1) shr 4 then Inc(D2);
|
|
Data.Result := D1; LastIndex := D2;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function PtCode(const P: TPoint; const R: TRect): Integer;
|
|
begin
|
|
Result := 0;
|
|
if P.X < R.Left then Result := Result or 1;
|
|
if P.Y < R.Top then Result := Result or 2;
|
|
if P.X > R.Right then Result := Result or 4; // Fix: by Kirill
|
|
if P.Y > R.Bottom then Result := Result or 8; // Fix: by Kirill
|
|
end;
|
|
|
|
function LineInRect(P1,P2: TPoint; const R: TRect): Boolean;
|
|
label Start;
|
|
var
|
|
D1,D2: Integer;
|
|
begin
|
|
D2 := PtCode(P2,R);
|
|
Start: D1 := PtCode(P1,R);
|
|
Result := D1 and D2 = 0;
|
|
if not Result then Exit;
|
|
Result := (D1=0) or (D2=0) or (D1 or D2 = 5) or (D1 or D2 = 10);
|
|
if Result then Exit;
|
|
if D1 and 1 <> 0 then begin
|
|
P1.Y := P1.Y + MulDiv(P2.Y-P1.Y,R.Left-P1.X,P2.X-P1.X);
|
|
P1.X := R.Left; goto Start;
|
|
end;
|
|
if D1 and 2 <> 0 then begin
|
|
P1.X := P1.X + MulDiv(P2.X-P1.X,R.Top-P1.Y,P2.Y-P1.Y);
|
|
P1.Y := R.Top; goto Start;
|
|
end;
|
|
if D1 and 4 <> 0 then begin
|
|
P1.Y := P1.Y + MulDiv(P2.Y-P1.Y,R.Right-P1.X,P2.X-P1.X);
|
|
P1.X := R.Right; goto Start;
|
|
end;
|
|
if D1 and 8 <> 0 then begin // Fix: by Kirill
|
|
P1.X := P1.X + MulDiv(P2.X-P1.X,R.Bottom-P1.Y,P2.Y-P1.Y);
|
|
P1.Y := R.Bottom; goto Start;
|
|
end;
|
|
end;
|
|
|
|
function DoRectOnLine(LType:TLineType;P:PPointArray;I,Count:Integer;var Data:TQSData): Boolean;
|
|
var
|
|
D0,D1,D2: Integer;
|
|
begin
|
|
Result := False;
|
|
Data.P0 := P^[I]; Data.P1 := P^[I+1];
|
|
case LType of
|
|
liStraight: Result := LineInRect(Data.P0,Data.P1,Data.Rect);
|
|
liRectH: begin
|
|
with Data do begin P2.X := P1.X; P2.Y := P0.Y; end;
|
|
Result := LineInRect(Data.P0,Data.P2,Data.Rect) or LineInRect(Data.P2,Data.P1,Data.Rect);
|
|
end;
|
|
liRectV: begin
|
|
with Data do begin P2.X := P0.X; P2.Y := P1.Y; end;
|
|
Result := LineInRect(Data.P0,Data.P2,Data.Rect) or LineInRect(Data.P2,Data.P1,Data.Rect);
|
|
end;
|
|
liQSpline: begin
|
|
with Data do begin
|
|
P2 := P^[I+2];
|
|
if I > 0 then MiddlePoint(P0,P1);
|
|
if I < Count-2 then MiddlePoint(P2,P1);
|
|
D0 := PtCode(P0,Rect); D1 := PtCode(P1,Rect); D2 := PtCode(P2,Rect);
|
|
end;
|
|
Result := D0 and D1 and D2 = 0;
|
|
if not Result then Exit;
|
|
Result := (D0=0) or (D1=0) or (D2=0);
|
|
if Result then Exit;
|
|
D1 := Data.Result; D2 := LastIndex;
|
|
QSPoints(Data);
|
|
Result := RectOnLine(liStraight,Pointer(D1)^,(Data.Result-D1) shr 3,Data.Rect);
|
|
if LastIndex >= (Data.Result-D1) shr 4 then Inc(D2);
|
|
Data.Result := D1; LastIndex := D2;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ Public routines }
|
|
|
|
{$O-}
|
|
procedure QSpline(DC: HDC; var Points; Count: Integer);
|
|
var
|
|
I,Sum: Integer;
|
|
POut: Pointer;
|
|
PIn: PPointArray;
|
|
QSData: TQSData;
|
|
begin
|
|
if Count < 3 then Exit;
|
|
PIn := @Points; Sum := 0;
|
|
for I:=0 to Count-2 do Sum := Sum + Abs(PIn^[I+1].X-PIn^[I].X) + Abs(PIn^[I+1].Y-PIn^[I].Y);
|
|
POut := StackAlloc(Sum shl 3);
|
|
QSData.Result := Integer(POut);
|
|
QSData.Mode := 0;
|
|
DoQSPoints(PIn^,Count,QSData);
|
|
Polyline(DC,POut^,(QSData.Result - Integer(POut)) shr 3);
|
|
StackFree(POut);
|
|
end;
|
|
{$O+}
|
|
|
|
procedure RectHLine(DC: HDC; var Points; Count: Integer);
|
|
begin
|
|
RectLine(DC,Points,Count,False);
|
|
end;
|
|
|
|
procedure RectVLine(DC: HDC; var Points; Count: Integer);
|
|
begin
|
|
RectLine(DC,Points,Count,True);
|
|
end;
|
|
|
|
function LineLength(LType: TLineType; var Points; Count: Integer): Integer;
|
|
var QSD: TQSData;
|
|
begin
|
|
QSD.Result := 0;
|
|
DoPoints(LType,Points,Count,QSD,DoLineLength);
|
|
Result := QSD.Result;
|
|
end;
|
|
|
|
function MassCenter(LType: TLineType; var Points; Count: Integer): TPoint;
|
|
var QSD: TQSData;
|
|
begin
|
|
Result := TPointArray(Points)[0];
|
|
QSD.Result := 0;
|
|
QSD.Source := Point(0,0);
|
|
DoPoints(LType,Points,Count,QSD,DoMassCenter);
|
|
if QSD.Result > 0 then begin
|
|
Result.X := QSD.Source.X div QSD.Result;
|
|
Result.Y := QSD.Source.Y div QSD.Result;
|
|
end;
|
|
end;
|
|
|
|
function LineCenter(LType: TLineType; var Points; Count: Integer): TPoint;
|
|
var Pts: PPointArray;
|
|
function PartialLength(OldLen,Index: Integer; var Center: TPoint): Integer;
|
|
var NewLen: Integer;
|
|
begin
|
|
Result := PartLen(LType,Pts,Index,Count,nil,nil);
|
|
if Index = Count-2 then NewLen := 0
|
|
else NewLen := PartialLength(OldLen+Result,Index+1,Center);
|
|
if (OldLen+Result >= NewLen) and (NewLen+Result >= OldLen) then begin
|
|
Center.X := (NewLen+Result-OldLen) shr 1;
|
|
Center.Y := Result;
|
|
LastIndex := Index;
|
|
PartLen(LType,Pts,Index,Count,@Center,nil);
|
|
end;
|
|
Inc(Result,NewLen);
|
|
end;
|
|
begin
|
|
Pts := @Points; Result := Pts^[0];
|
|
ChkType(LType,Count);
|
|
if Count > 1 then PartialLength(0,0,Result);
|
|
end;
|
|
|
|
function PointIndex: Integer;
|
|
begin
|
|
Result := LastIndex;
|
|
end;
|
|
|
|
{$O-}
|
|
function PtOnLine(LType: TLineType; var Points; Count,Delta,X,Y: Integer): Boolean;
|
|
var
|
|
I,D1,D2: Integer;
|
|
Pt0,Pt1: PPointArray;
|
|
QSD: TQSData;
|
|
begin
|
|
Pt0 := @Points; Pt1 := nil;
|
|
QSD.Source := Point(X,Y);
|
|
QSD.Prev.X := Delta;
|
|
if (LType=liQSpline) and (Count > 2) then begin
|
|
QSD.Last := 1; D2 := 0;
|
|
for I:=0 to Count-3 do begin
|
|
D1 := Abs(Pt0^[I+1].X-Pt0^[I].X)+Abs(Pt0^[I+1].Y-Pt0^[I].Y);
|
|
D1 := D1+Abs(Pt0^[I+2].X-Pt0^[I+1].X)+Abs(Pt0^[I+2].Y-Pt0^[I+1].Y);
|
|
if D1 > D2 then D2 := D1;
|
|
end;
|
|
Pt1 := StackAlloc(D2 shl 3);
|
|
QSD.Result := Integer(Pt1);
|
|
end;
|
|
Result := DoPoints(LType,Points,Count,QSD,DoPtOnLine);
|
|
if Pt1 <> nil then StackFree(Pt1);
|
|
end;
|
|
|
|
function RectOnLine(LType: TLineType; var Points; Count: Integer; const R: TRect): Boolean;
|
|
var
|
|
I,D1,D2: Integer;
|
|
Pt0,Pt1: PPointArray;
|
|
QSD: TQSData;
|
|
begin
|
|
Pt0 := @Points; Pt1 := nil;
|
|
QSD.Rect := R;
|
|
if (LType=liQSpline) and (Count > 2) then begin
|
|
QSD.Last := 1; D2 := 0;
|
|
for I:=0 to Count-3 do begin
|
|
D1 := Abs(Pt0^[I+1].X-Pt0^[I].X)+Abs(Pt0^[I+1].Y-Pt0^[I].Y);
|
|
D1 := D1+Abs(Pt0^[I+2].X-Pt0^[I+1].X)+Abs(Pt0^[I+2].Y-Pt0^[I+1].Y);
|
|
if D1 > D2 then D2 := D1;
|
|
end;
|
|
Pt1 := StackAlloc(D2 shl 3);
|
|
QSD.Result := Integer(Pt1);
|
|
end;
|
|
Result := DoPoints(LType,Points,Count,QSD,DoRectOnLine);
|
|
if Pt1 <> nil then StackFree(Pt1);
|
|
end;
|
|
{$O+}
|
|
|
|
end.
|