dxflchrt.pas

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

  if Value <> FBorder then
  begin
    FBorder := Value;
    if (ShapeType = fcsRectangle) and (FEdge <> 0)
      then Owner.NeedRepaintObject(Self);
    Changed;
  end;
end;

procedure TdxFcObject.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if (ALeft = Left) and (ATop = Top) and (AWidth = Width) and (AHeight = Height) then Exit;
  FLeft := ALeft; FTop := ATop;
  FWidth := Word(AWidth); FHeight := Word(AHeight);
  with Owner do
  begin
    NeedRepaintObject(Self);
    SetRealBounds;
    UpdateConnections;
    NeedRepaintObject(Self);
    SetChartSizes;
  end;
end;

procedure TdxFcObject.SetEdge(Value: Word);
begin
  if Value <> FEdge then
  begin
    FEdge := Value;
    if ShapeType = fcsRectangle then Owner.NeedRepaintObject(Self);
    Changed;
  end;
end;

procedure TdxFcObject.SetHeight(Value: Word);
begin
  SetBounds(Left, Top, Width, Value);
end;

procedure TdxFcObject.SetHorzImagePos(Value: TdxFcHorzPos);
begin
  if (FHorzImagePos <> Value) then
  begin
    FHorzImagePos := Value;
    if HasImage then Owner.NeedRepaintObject(Self);
    Changed;
  end;
end;

procedure TdxFcObject.SetHorzTextPos(Value: TdxFcHorzPos);
begin
  if (FHorzTextPos <> Value) then
  begin
    FHorzTextPos := Value;
    if Text <> '' then Owner.NeedRepaintObject(Self);
    Changed;
  end;
end;

procedure TdxFcObject.SetImageIndex(Value: SmallInt);
begin
  if (FImageIndex <> Value) then
  begin
    FImageIndex := Value;
    if Owner.Images <> nil then Owner.NeedRepaintObject(Self);
    Changed;
  end;
end;

procedure TdxFcObject.SetLeft(Value: Integer);
begin
  SetBounds(Value, Top, Width, Height);
end;

procedure TdxFcObject.SetRealBounds;
begin
  FRealLeft := MulDiv(Left, Owner.RealZoom, 100);
  FRealTop := MulDiv(Top, Owner.RealZoom, 100);
  FRealWidth := MulDiv(Width, Owner.RealZoom, 100);
  FRealHeight := MulDiv(Height, Owner.RealZoom, 100);
  CalculateLinkedPoints;
end;

procedure TdxFcObject.SetRealSW;
begin
  FRealSW := (ShapeWidth * Owner.RealZoom + 50) div 100;
  if (RealSW = 0) and (ShapeWidth <> 0) then FRealSW := 1;
end;

procedure TdxFcObject.SetShapeColor(Value: TColor);
begin
  if FShapeColor <> Value then
  begin
    FShapeColor := Value;
    if FShapeBrush <> nil then FShapeBrush.Color := Value;
    if ShapeType <> fcsNone then Owner.NeedRepaintObject(Self);
    Changed;
  end;
end;

procedure TdxFcObject.SetShapeStyle(Value: TPenStyle);
begin
  if FShapeStyle <> Value then
  begin
    FShapeStyle := Value;
    Owner.NeedRepaintObject(Self);
    Changed;
  end;
end;

procedure TdxFcObject.SetShapeType(Value: TdxFcShapeType);
begin
  if FShapeType <> Value then
  begin
    FShapeType := Value;
    CalculateLinkedPoints;
    UpdateConnections;
    Owner.NeedRepaintObject(Self);
  end;
end;

procedure TdxFcObject.SetShapeWidth(Value: Byte);
begin
  if FShapeWidth <> Value then
  begin
    DeleteRgn;
    FShapeWidth := Value;
    SetRealSW;
    if ShapeType <> fcsNone then Owner.NeedRepaintObject(Self);
    Changed;
  end;
end;

procedure TdxFcObject.SetText(Value: string);
begin
  if FText <> Value then
  begin
    FText := Value;
    Owner.NeedRepaintObject(Self);
    Changed;
  end;
end;

procedure TdxFcObject.SetTop(Value: Integer);
begin
  SetBounds(Left, Value, Width, Height);
end;

procedure TdxFcObject.SetTransparent(Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;
    if ShapeType <> fcsNone then Owner.NeedRepaintObject(Self);
    Changed;
  end;
end;

procedure TdxFcObject.SetVertImagePos(Value: TdxFcVertPos);
begin
  if FVertImagePos <> Value then
  begin
    FVertImagePos := Value;
    if HasImage then Owner.NeedRepaintObject(Self);
    Changed;
  end;
end;

procedure TdxFcObject.SetVertTextPos(Value: TdxFcVertPos);
begin
  if FVertTextPos <> Value then
  begin
    FVertTextPos := Value;
    if Text <> '' then Owner.NeedRepaintObject(Self);
    Changed;
  end;
end;

procedure TdxFcObject.SetVisible(Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    Owner.FHitTest := [];
    Owner.NeedRepaintObject(Self);
  end;
end;

procedure TdxFcObject.SetWidth(Value: Word);
begin
  SetBounds(Left, Top, Value, Height);
end;

procedure TdxFcObject.SetZOrder(Value: Word);
begin
  if Value >= Owner.ObjectCount then Value := Owner.ObjectCount - 1;
  if Value <> ZOrder then
    with Owner do
    begin
      FHitTest := [];
      FObjects.Remove(Self);
      FObjects.Insert(Value, Self);
      NeedRepaintObject(Self);
      Changed(Self);
    end;
end;

procedure TdxFcObject.UpdateConnections;
var
  I: Integer;
begin
  Changed;
  for I := 0 to ConnectionCount - 1 do
    with Connections[I] do
    begin
      ConnectionChanged;
      SetObjectPoints;
      SetDisplayRect;
      Changed;
    end;
end;

procedure TdxFcObject.UserLinkedPoints;
begin
end;

function TdxFcObject.UserRegion(R: TRect): HRgn;
begin
  Result := 0;
end;

procedure TdxFcObject.ZoomChanged;
begin
  SetRealBounds;
  SetRealSW;
  ScaleFont;
end;

(*
  0   1   2   3   4
  15              5
  14              6
  13              7
  12  11  10  9   8
*)

{TdxFcConnectionArrow}

{
***************************** TdxFcConnectionArrow *****************************
}
constructor TdxFcConnectionArrow.Create(AOwner: TdxFcConnection);
begin
  FOwner := AOwner;
  FColor := AOwner.Owner.Color;
end;

destructor TdxFcConnectionArrow.Destroy;
begin
  FBrush.Free;
end;

function TdxFcConnectionArrow.Active: Boolean;
begin
  Result := (ArrowType <> fcaNone) and (Owner.RealCount > 1);
end;

procedure TdxFcConnectionArrow.Assign(Source: TPersistent);
begin
  if Source is TdxFcConnectionArrow then
    with TdxFcConnectionArrow(Source) do
    begin
      Self.Width := Width; Self.Height := Height;
      Self.Color := Color; Self.ArrowType := ArrowType;
    end
  else
    inherited Assign(Source);
end;

procedure TdxFcConnectionArrow.ClearPoints;
begin
  if ArrowType = fcaArrow then
  begin
    FPoints[1] := Point(0, 0);
    FPoints[3] := Point(0, 0);
  end;
end;

function TdxFcConnectionArrow.DisplayRect(Ext: Boolean): TRect;
begin
  if ArrowType = fcaArrow then
  begin
    Result.TopLeft := FPoints[1];
    Result.BottomRight := FPoints[1];
    ExtendRect(Result, FPoints[0]);
    ExtendRect(Result, FPoints[2]);
  end
  else
    with Result do
    begin
      Left := FPoints[1].X - FRealWidth shr 1;
      Top := FPoints[1].Y - FRealHeight shr 1;
      Right := Left + FRealWidth;
      Bottom := Top + FRealHeight;
    end;
  ExtSelRect(Result, Ext);
end;

procedure TdxFcConnectionArrow.OffsetPoints(DX, DY: Integer);
var
  I: Integer;
begin
  if not Active then Exit;
  for I := 0 to 3 do
  begin
    Inc(FPoints[I].X, DX);
    Inc(FPoints[I].Y, DY);
  end;
end;

procedure TdxFcConnectionArrow.Paint;
var
  DC: HDC;
  R: TRect;
begin
  if not Active then Exit;
  DC := Owner.Owner.Canvas.Handle;
  if ArrowType = fcaArrow then
    Polyline(DC, FPoints, 3)
  else
  begin
    R := DisplayRect(False);
    InitBrush(FBrush, Color);
    SelectObject(DC, FBrush.Handle);
    if ArrowType = fcaRectangle
      then
      Rectangle(DC, R.Left, R.Top, R.Right, R.Bottom)
    else
      Ellipse(DC, R.Left, R.Top, R.Right, R.Bottom);
  end;
end;

procedure TdxFcConnectionArrow.Paint_(cvs:TCanvas);
var
  DC: HDC;
  R: TRect;
begin
  if not Active then Exit;
  DC := cvs.Handle;
  if ArrowType = fcaArrow then
    Polyline(DC, FPoints, 3)
  else
  begin
    R := DisplayRect(False);
    InitBrush(FBrush, Color);
    SelectObject(DC, FBrush.Handle);
    if ArrowType = fcaRectangle
      then
      Rectangle(DC, R.Left, R.Top, R.Right, R.Bottom)
    else
      Ellipse(DC, R.Left, R.Top, R.Right, R.Bottom);
  end;
end;

procedure TdxFcConnectionArrow.Reset;
begin
  ClearPoints;
  Owner.ArrowChanged(Self);
  Owner.Changed;
end;

procedure TdxFcConnectionArrow.SetArrowType(Value: TdxFcaType);
begin
  if (FArrowType <> Value) then
  begin
    Owner.ArrowChanged(Self);
    FArrowType := Value;
    Reset;
  end;
end;

procedure TdxFcConnectionArrow.SetColor(Value: TColor);
begin
  if (FColor <> Value) then
  begin
    FColor := Value;
    if FBrush <> nil then FBrush.Color := Value;
    if ArrowType in [fcaRectangle, fcaEllipse] then Owner.ArrowChanged(Self);
    Owner.Changed;
  end;
end;

procedure TdxFcConnectionArrow.SetHeight(Value: Byte);
begin
  if (FHeight <> Value) then
  begin
    Owner.ArrowChanged(Self);
    FHeight := Value;
    SetRealBounds;
    Reset;
  end;
end;

procedure TdxFcConnectionArrow.SetPoints(Index: Integer);
var
  DX, DY, DXY, IsRect: Integer;
  P1, P3: TPoint;
  
  procedure Rotate(var P: TPoint);
  var
    X, Y: Integer;
  begin
    X := (P.X * DX - P.Y * DY) div DXY;
    Y := (P.X * DY + P.Y * DX) div DXY;
    P.X := X + FPoints[1].X;
    P.Y := Y + FPoints[1].Y;
  end;
  
begin
  if not Active then Exit;
  IsRect := Ord(Owner.Style) xor Ord(Index <> 0);
  P1 := Owner.InternalGetPoint(Owner.FRealPoints, Index);
  if Index = 0 then
    Inc(Index)
  else
    Dec(Index);
  P3 := Owner.InternalGetPoint(Owner.FRealPoints, Index);
  if (P1.X = FPoints[1].X) and (P1.Y = FPoints[1].Y) and (P3.X = FPoints[3].X) and (P3.Y = FPoints[3].Y)
    then Exit;
  FPoints[1] := P1; FPoints[3] := P3;
  if ArrowType = fcaArrow then
  begin
    DX := P3.X - P1.X; DY := P3.Y - P1.Y;
    if (IsRect = 2) and (DX <> 0) then DY := 0;
    if (IsRect = 3) and (DY <> 0) then DX := 0;
    if (DX = 0) or (DY = 0) then
      DXY := Abs(DX + DY)
    else
      DXY := Round(Sqrt(DX * DX + DY * DY));
    if DXY = 0 then DXY := 1;
    FPoints[0].X := FRealWidth; FPoints[0].Y := (FRealHeight + 1) shr 1;
    FPoints[2].X := FReal