dxlines.pas

业生产并行开发过程 工作流流程编辑器参考源码 采用dxflowchart编写

{*******************************************************************}
{                                                                   }
{       Developer Express Visual Component Library                  }
{       ExpressFlowChart                                            }
{                                                                   }
{       Copyright (c) 1998-2004 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;

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
  Ax,Bx,Ay,By,A,C: Integer;
  W,B2A,SqA,L0,T,DT: 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 Ax := -Ax;
    if P1.Y < P0.Y then Ay := -Ay;
    Dec(P0.X,Ax); Inc(P0.Y,Ay);
    Inc(P1.X,Ax); Dec(P1.Y,Ay);
  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
  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 shl 2))
      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
      A := LC^.X; C := LC^.Y;
      LC^.X := P^[I].X + MulDiv(P^[I+1].X-P^[I].X,A,C);
      LC^.Y := P^[I].Y + MulDiv(P^[I+1].Y-P^[I].Y,A,C);
    end;
    liRectH,liRectV: begin
      Ax := Abs(P^[I].X - P^[I+1].X) - LC^.X;
      if Ax >= 0 then Ay := 0
      else begin
  Ay := -Ax;
  Ax := 0;
      end;
      RectPoints;
      if LType=liRectH then LC^ := P0 else LC^ := P1;