dxflchrt.pas

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

  begin
    OnChange := nil;
    Height := Data.Height;
    Color := Data.Color;
    Pitch := Data.Pitch;
    Style := Data.Style;
    Charset := Data.Charset;
    if FtName <> '' then Name := FtName;
    OnChange := OnFontChange;
  end;
  SetRealFont;
end;

procedure TdxFcItem.OnFontChange(Sender: TObject);
begin
  FParentFont := False;
  SetRealFont;
  if Text <> '' then FontChanged;
  Changed;
end;

procedure TdxFcItem.SaveFont(Stream: TStream);
var
  Data: TdxFcFntData;
  FtName: string;
begin
  if ParentFont then Exit;
  if Font.Name = Owner.Font.Name then
    FtName := ''
  else
    FtName := Font.Name;
  with Data do
  begin
    Height := Font.Height;
    Color := Font.Color;
    Pitch := Font.Pitch;
    Style := Font.Style;
    Charset := Font.Charset;
  end;
  Stream.WriteBuffer(Data, SizeOf(Data));
  WriteStr(Stream, FtName);
end;

procedure TdxFcItem.ScaleFont;
begin
  RealFont.Size := MulDiv(Font.Size, Owner.RealZoom, 100);
end;

procedure TdxFcItem.SetFont(Value: TFont);
begin
  Font.Assign(Value);
end;

procedure TdxFcItem.SetParentFont(Value: Boolean);
begin
  if Value <> ParentFont then
  begin
    if Value then Font.Assign(Owner.Font);
    FParentFont := Value;
    Changed;
  end;
end;

procedure TdxFcItem.SetRealFont;
begin
  RealFont.Assign(Font);
  ScaleFont;
end;

procedure TdxFcItem.SetSelected(Value: Boolean);
begin
  if Selected <> Value then
  begin
    if Value and not Owner.CanSelect(Self) then Exit;
    if Selected then
    begin
      Invalidate;
      SelList.Remove(Self);
    end;
    FSelected := Value;
    if Selected then
    begin
      with Owner do
        if not (fcoMultiSelect in Options) then ClearSelection;
      SelList.Add(Self);
      Invalidate;
    end;
    Owner.Select(Self);
  end;
end;

{TdxFcObject}

{
********************************* TdxFcObject **********************************
}
constructor TdxFcObject.Create(AOwner: TdxCustomFlowChart);
begin
  inherited Create(AOwner);
  FConnections := TList.Create;
  FLinkedObjects := TList.Create;
  FObjects := TList.Create;
  FBkColor := AOwner.Color;
  FVisible := True;
  FImageIndex := -1;
  FShapeWidth := 1;
  FBorder := BF_RECT;
  SetRealSW;
  AOwner.FObjects.Add(Self);
end;

destructor TdxFcObject.Destroy;
var
  I: Integer;
begin
  Owner.Delete(Self);
  DeleteRgn;
  if FPaintRgn <> 0 then DeleteObject(FPaintRgn);
  while ConnectionCount > 0 do
    Connections[0].Free;
  FConnections.Free;
  FConnections := nil;
  FLinkedObjects.Free;
  FLinkedObjects := nil;
  FObjects.Free;
  FObjects := nil;
  FShapeBrush.Free;
  FBkBrush.Free;
  
  Owner.FObjects.Remove(Self);
  
  with Owner do
    for I := 0 to ObjectCount - 1 do
      Objects[I].FObjects.Remove(Self);
  
  Owner.SetChartSizes;
  inherited Destroy;
end;

procedure TdxFcObject.AddToUnion(AObject: TdxFcObject);
begin
  if not HasInUnion(AObject) then FObjects.Add(AObject);
end;

procedure TdxFcObject.Assign(Source: TPersistent);
begin
  if Source is TdxFcObject then
    with TdxFcObject(Source) do
    begin
      Self.Data := Data; Self.Tag := Tag;
      Self.CustomData := CustomData;
      Self.SetBounds(Left, Top, Width, Height);
      Self.EdgeStyle := EdgeStyle; Self.BorderStyle := BorderStyle;
      Self.HorzTextPos := HorzTextPos; Self.VertTextPos := VertTextPos;
      Self.HorzImagePos := HorzImagePos; Self.VertImagePos := VertImagePos;
      Self.BkColor := BkColor; Self.ShapeColor := ShapeColor;
      Self.ImageIndex := ImageIndex; Self.Transparent := Transparent;
      Self.ShapeType := ShapeType; Self.ShapeWidth := ShapeWidth;
    end;
  inherited Assign(Source);
end;

procedure TdxFcObject.BringToFront;
begin
  SetZOrder(Owner.ObjectCount - 1);
end;

procedure TdxFcObject.CalculateLinkedPoints;
var
  qWidth, qHeight, ARight, ABottom: Integer;
  DX, DY: Integer;
  
  procedure IncP(Index, IX, IY: Integer);
  begin
    Inc(LinkedPoints[Index].X, IX);
    Inc(LinkedPoints[Index].Y, IY);
  end;
  procedure Trio(I1, I2, I3: Integer);
  begin
    LinkedPoints[I1].X := LinkedPoints[I2].X;
    LinkedPoints[I1].Y := LinkedPoints[I3].Y;
    LinkedPoints[I2].Y := LinkedPoints[I1].Y;
    LinkedPoints[I3].X := LinkedPoints[I1].X;
  end;
  procedure TrioX(I1, I2, I3, I4: Integer);
  begin
    LinkedPoints[I1].X := LinkedPoints[I2].X + DX;
    LinkedPoints[I3].X := LinkedPoints[I4].X - DX;
  end;
  procedure TrioY(I1, I2, I3, I4: Integer);
  begin
    LinkedPoints[I1].Y := LinkedPoints[I2].Y + DY;
    LinkedPoints[I3].Y := LinkedPoints[I4].Y - DY;
  end;
  function Scale(Value, Coef: Integer): Integer;
  begin
    Result := (Value * Coef + 512) shr 10;
  end;
  
begin
  DeleteRgn;
  Owner.FHitTest := [];
  qWidth := RealWidth div 4;
  qHeight := RealHeight div 4;
  ARight := RealLeft + RealWidth;
  ABottom := RealTop + RealHeight;
  for DX := 4 to 8 do
    LinkedPoints[DX].X := ARight;
  for DX := 12 to 16 do
    LinkedPoints[DX and 15].X := RealLeft;
  for DX := 0 to 4 do
    LinkedPoints[DX].Y := RealTop;
  for DX := 8 to 12 do
    LinkedPoints[DX].Y := ABottom;
  LinkedPoints[1].X := RealLeft + qWidth;
  LinkedPoints[2].X := RealLeft + RealWidth shr 1;
  LinkedPoints[3].X := ARight - qWidth;
  LinkedPoints[5].Y := RealTop + qHeight;
  LinkedPoints[6].Y := RealTop + RealHeight shr 1;
  LinkedPoints[7].Y := ABottom - qHeight;
  LinkedPoints[9].X := LinkedPoints[3].X;
  LinkedPoints[10].X := LinkedPoints[2].X;
  LinkedPoints[11].X := LinkedPoints[1].X;
  LinkedPoints[13].Y := LinkedPoints[7].Y;
  LinkedPoints[14].Y := LinkedPoints[6].Y;
  LinkedPoints[15].Y := LinkedPoints[5].Y;
  for DX := 4 to 8 do
    Dec(LinkedPoints[DX].X);
  for DX := 8 to 12 do
    Dec(LinkedPoints[DX].Y);
  DX := qWidth shr 1; DY := qHeight shr 1;
  case ShapeType of
    fcsUser: UserLinkedPoints;
    fcsNorthTriangle:
      begin
        Trio(0, 1, 14); TrioX(13, 13, 15, 2);
        Trio(4, 3, 6); TrioX(5, 2, 7, 7);
      end;
    fcsSouthTriangle:
      begin
        Trio(12, 11, 14); TrioX(15, 15, 13, 10);
        Trio(8, 9, 6); TrioX(7, 10, 5, 5);
      end;
    fcsEastTriangle:
      begin
        Trio(4, 2, 5); TrioY(1, 1, 3, 6);
        Trio(8, 10, 7); TrioY(9, 6, 11, 11);
      end;
    fcsWestTriangle:
      begin
        Trio(0, 2, 15); TrioY(3, 3, 1, 14);
        Trio(12, 10, 13); TrioY(11, 14, 9, 9);
      end;
    fcsHexagon:
      begin
        IncP(0, DX, qHeight); IncP(4, -DX, qHeight);
        IncP(8, -DX, -qHeight); IncP(12, DX, -qHeight);
        IncP(13, DX, 0); IncP(15, DX, 0); IncP(5, -DX, 0); IncP(7, -DX, 0);
      end;
    fcsDiamond:
      begin
        IncP(0, qWidth, qHeight); IncP(4, -qWidth, qHeight);
        IncP(8, -qWidth, -qHeight); IncP(12, qWidth, -qHeight);
        IncP(1, DX, DY); IncP(3, -DX, DY); IncP(5, -DX, DY); IncP(7, -DX, -DY);
        IncP(9, -DX, -DY); IncP(11, DX, -DY); IncP(13, DX, -DY); IncP(15, DX, DY);
      end;
    fcsRoundRect:
      begin
        DX := Scale(RealWidth, 75); DY := Scale(RealHeight, 75);
        IncP(0, DX, DY); IncP(4, -DX, DY);
        IncP(8, -DX, -DY); IncP(12, DX, -DY);
      end;
    fcsEllipse:
      begin
        DX := Scale(RealWidth, 150); DY := Scale(RealHeight, 150);
        IncP(0, DX, DY); IncP(4, -DX, DY);
        IncP(8, -DX, -DY); IncP(12, DX, -DY);
        DX := Scale(RealWidth, 68); DY := Scale(RealHeight, 68);
        IncP(13, DX, 0); IncP(15, DX, 0); IncP(5, -DX, 0); IncP(7, -DX, 0);
        IncP(1, 0, DY); IncP(3, 0, DY); IncP(9, 0, -DY); IncP(11, 0, -DY);
      end;
  end;
end;

procedure TdxFcObject.ClearUnion;
begin
  FObjects.Clear;
end;

function TdxFcObject.ClientRect: TRect;
begin
  Result.TopLeft := LinkedPoints[0];
  Result.BottomRight := LinkedPoints[8];
  case ShapeType of
    fcsNorthTriangle: Result.Right := LinkedPoints[4].X;
    fcsSouthTriangle: Result.Left := LinkedPoints[1].X;
    fcsEastTriangle: Result.Top := LinkedPoints[15].Y;
    fcsWestTriangle: Result.Bottom := LinkedPoints[7].Y;
  end;
  InflateRect(Result, -RealSW, -RealSW);
  OffsetRect(Result, -Owner.LeftEdge, -Owner.TopEdge);
end;

function TdxFcObject.Create1Rgn(Offset: Integer): HRgn;
var
  NPoints: Integer;
  R: TRect;
  Pts: array[0..5] of TPoint;
  
  procedure SetPolygon(const Indexes: array of Integer);
  var
    I: Integer;
  begin
    NPoints := High(Indexes) + 1;
    for I := 0 to High(Indexes) do
    begin
      Pts[I] := LinkedPoints[Indexes[I]];
      Dec(Pts[I].X, Owner.LeftEdge);
      Dec(Pts[I].Y, Owner.TopEdge);
    end;
  end;
  
begin
  Result := UserRegion(R);
  NPoints := 0;
  R := DisplayRect;
  case ShapeType of
    fcsDiamond:
      SetPolygon([2, 6, 10, 14]);
    fcsHexagon:
      SetPolygon([1, 3, 6, 9, 11, 14]);
    fcsNorthTriangle:
      SetPolygon([2, 8, 12]);
    fcsSouthTriangle:
      SetPolygon([0, 4, 10]);
    fcsEastTriangle:
      SetPolygon([0, 6, 12]);
    fcsWestTriangle:
      SetPolygon([4, 8, 14]);
  end;
  if NPoints <> 0 then
    Result := CreatePolygonRgn(Pts, NPoints, WINDING)
  else
  begin
    InflateRect(R, Offset, Offset);
    case ShapeType of
      fcsUser:
        Result := UserRegion(R);
      fcsNone, fcsRectangle:
        Result := CreateRectRgnIndirect(R);
      fcsEllipse:
        Result := CreateEllipticRgnIndirect(R);
      fcsRoundRect:
        Result := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, RealWidth shr 1, RealHeight shr 1);
    end;
  end;
end;

procedure TdxFcObject.CreateRgn;
  
    procedure AndRgn(DX, DY: Integer);
    begin
      OffsetRgn(FExtRgn, DX, DY);
      CombineRgn(FIntRgn, FIntRgn, FExtRgn, RGN_AND);
      OffsetRgn(FExtRgn, -DX, -DY);
    end;
  var
    W: Integer;
  
begin
  if FIntRgn <> 0 then Exit;
  if (ShapeType = fcsNone) or HasEdge
    then
    W := 1
  else
    W := RealSW;
  FExtRgn := Create1Rgn(0);
  if ShapeType in [fcsEllipse, fcsRoundRect, fcsUser]
    then
    FIntRgn := Create1Rgn(-W)
  else
  begin
    FIntRgn := CreateRectRgn(0, 0, 0, 0);
    CombineRgn(FIntRgn, FExtRgn, FExtRgn, RGN_COPY);
    AndRgn(W, 0); AndRgn(0, W);
    AndRgn(-W, 0); AndRgn(0, -W);
  end;
  CombineRgn(FExtRgn, FExtRgn, FIntRgn, RGN_DIFF);
end;

procedure TdxFcObject.DeleteRgn;
begin
  if FExtRgn <> 0 then DeleteObject(FExtRgn);
  if FIntRgn <> 0 then DeleteObject(FIntRgn);
  FExtRgn := 0; FIntRgn := 0;
end;

function TdxFcObject.DisplayRect: TRect;
begin
  with Result do
  begin
    Left := RealLeft - Owner.LeftEdge;
    Top := RealTop - Owner.TopEdge;
    Right := Left + RealWidth;
    Bottom := Top + RealHeight;
  end;
end;

function TdxFcObject.GetConnection(Index: Integer): TdxFcConnection;
begin
  Result := TdxFcConnection(GetListItem(FConnections, Index));
end;

function TdxFcObject.GetConnectionCount: Integer;
begin
  Result := FConnections.Count;
end;

function TdxFcObject.GetIsUnion: Boolean;
begin
  Result := FObjects.Count > 0;
end;

function TdxFcObject.GetLinkedObject(Index: Integer): TdxFcObject;
begin
  Result := TdxFcObject(GetListItem(FLinkedObjects, Index));
end;

function TdxFcObject.GetLinkedObjectCount: Integer;
begin
  Result := FLinkedObjects.Count;
end;

function TdxFcObject.GetLinkedPoint(X, Y: Integer): Integer;
begin
  Result := GetPoint(LinkedPoints, X, Y, 4);
end;

function TdxFcObject.GetObject(Index: Integer): TdxFcObject;
begin
  Result := TdxFcObject(GetListItem(FObjects, Index));
end;

function TdxFcObject.GetObjectCount: Integer;
begin