jvdiagramshape.pas

East make Tray Icon in delphi

procedure TJvConnector.SetConnections(TheStartConn, TheEndConn: TJvConnection);
begin
  StartConn := TheStartConn;
  EndConn := TheEndConn;
end;

function TJvConnector.GetTermRect(Index: Integer): TRect;
begin
  case Index of
    1:
      Result := FStartTermRect;
    2:
      Result := FEndTermRect;
  end;
end;

procedure TJvConnector.SetTermRect(Index: Integer; Value: TRect);
begin
  if (Value.Right - Value.Left >= 0) and (Value.Bottom - Value.Top >= 0) then
  begin
    case Index of
      1:
        FStartTermRect := Value;
      2:
        FEndTermRect := Value;
    end;
  end;
end;

procedure TJvConnector.SetCaption(Value: TJvTextShape);
begin
  inherited SetCaption(Value);
  MoveCaption;
end;

function TJvConnector.Convert(APoint: TPoint): TPoint;
begin
  Result := ScreenToClient(Parent.ClientToScreen(APoint));
end;

function TJvConnector.IsConnected(ConnectedShape: TJvCustomDiagramShape): Boolean;
begin
  Result := (FStartConn <> nil) and (FEndConn <> nil) and (ConnectedShape <> nil) and
    ((FStartConn.Shape = ConnectedShape) or (FEndConn.Shape = ConnectedShape));
end;

function TJvConnector.GetMidPoint: TPoint;
var
  A, B: TPoint;
begin
  Result := Point(0, 0);
  if (not Assigned(FStartConn)) or (not Assigned(FEndConn)) then
    Exit;
  A := FStartConn.ConnPoint(FStartTermRect);
  B := FEndConn.ConnPoint(FEndTermRect);
  Result := Point(Min([A.X, B.X]) + Abs(A.X - B.X) div 2,
    Min([A.Y, B.Y]) + Abs(A.Y - B.Y) div 2);
end;

//=== { TJvSingleHeadArrow } =================================================

constructor TJvSingleHeadArrow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  EndTermRect := Rect(0, 0, 25, 10);
end;

procedure TJvSingleHeadArrow.DrawArrowHead(ConnPt, TermPt: TPoint);
var
  PointPt, Corner1Pt, Corner2Pt: TPoint;
begin
  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := FLineColor;
    Pen.Color := FLineColor;

    // Draw a line connecting the Conn and Term points
    PenPos := ConnPt;
    LineTo(TermPt.X, TermPt.Y);
    // Set the basic points (to be modified depending on arrow head direction
    PointPt := TermPt;
    Corner1Pt := ConnPt;
    Corner2Pt := ConnPt;

    if ConnPt.X < TermPt.X then
    begin
      // Draw a right pointing arrow head
      Inc(Corner1Pt.X, 10);
      Inc(Corner2Pt.X, 10);
      Dec(Corner1Pt.Y, RectHeight(EndTermRect) div 2);
      Inc(Corner2Pt.Y, RectHeight(EndTermRect) div 2);
    end
    else
    if ConnPt.X > TermPt.X then
    begin
      // Draw a left pointing arrow head
      Dec(Corner1Pt.X, 10);
      Dec(Corner2Pt.X, 10);
      Dec(Corner1Pt.Y, RectHeight(EndTermRect) div 2);
      Inc(Corner2Pt.Y, RectHeight(EndTermRect) div 2);
    end
    else
    if ConnPt.Y < TermPt.Y then
    begin
      // Draw a down pointing arrow head
      Inc(Corner1Pt.Y, 10);
      Inc(Corner2Pt.Y, 10);
      Dec(Corner1Pt.X, RectHeight(EndTermRect) div 2);
      Inc(Corner2Pt.X, RectHeight(EndTermRect) div 2);
    end
    else
    begin
      // Draw a up pointing arrow head
      Dec(Corner1Pt.Y, 10);
      Dec(Corner2Pt.Y, 10);
      Dec(Corner1Pt.X, RectHeight(EndTermRect) div 2);
      Inc(Corner2Pt.X, RectHeight(EndTermRect) div 2);
    end;
    Polygon([PointPt, Corner1Pt, Corner2Pt]);
  end;
end;

procedure TJvSingleHeadArrow.DrawEndTerminator;
var
  ConnPt, TermPt: TPoint;
begin
  inherited DrawEndTerminator;
  if Assigned(FEndConn.Shape) then
  begin
    ConnPt := Convert(FEndConn.ConnPoint(EndTermRect));
    TermPt := Convert(FEndConn.TermPoint(EndTermRect));
    DrawArrowHead(ConnPt, TermPt);
  end;
end;

//=== { TJvSingleHeadOpenDashArrow } =========================================

constructor TJvSingleHeadOpenDashArrow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  EndTermRect := Rect(0, 0, 25, 10);
end;

procedure TJvSingleHeadOpenDashArrow.Paint;
begin
  Canvas.Pen.Style := psDash;
  inherited Paint;
  Canvas.Pen.Style := psSolid;
end;

procedure TJvSingleHeadOpenDashArrow.DrawArrowHead(ConnPt, TermPt: TPoint);
var
  PointPt, Corner1Pt, Corner2Pt: TPoint;
begin
  with Canvas do
  begin
    Brush.Style := bsClear;
    Brush.Color := clWindow;
    Pen.Color := FLineColor;

    // Draw a line connecting the Conn and Term points
    PenPos := ConnPt;
    LineTo(TermPt.X, TermPt.Y);
    // Set the basic points (to be modified depending on arrow head direction
    PointPt := TermPt;
    Corner1Pt := ConnPt;
    Corner2Pt := ConnPt;

    if ConnPt.X < TermPt.X then
    begin
      // Draw a right pointing arrow head
      Inc(Corner1Pt.X, 10);
      Inc(Corner2Pt.X, 10);
      Dec(Corner1Pt.Y, RectHeight(EndTermRect) div 2);
      Inc(Corner2Pt.Y, RectHeight(EndTermRect) div 2);
    end
    else
    if ConnPt.X > TermPt.X then
    begin
      // Draw a left pointing arrow head
      Dec(Corner1Pt.X, 10);
      Dec(Corner2Pt.X, 10);
      Dec(Corner1Pt.Y, RectHeight(EndTermRect) div 2);
      Inc(Corner2Pt.Y, RectHeight(EndTermRect) div 2);
    end
    else
    if ConnPt.Y < TermPt.Y then
    begin
      // Draw a down pointing arrow head
      Inc(Corner1Pt.Y, 10);
      Inc(Corner2Pt.Y, 10);
      Dec(Corner1Pt.X, RectHeight(EndTermRect) div 2);
      Inc(Corner2Pt.X, RectHeight(EndTermRect) div 2);
    end
    else
    begin
      // Draw a up pointing arrow head
      Dec(Corner1Pt.Y, 10);
      Dec(Corner2Pt.Y, 10);
      Dec(Corner1Pt.X, RectHeight(EndTermRect) div 2);
      Inc(Corner2Pt.X, RectHeight(EndTermRect) div 2);
    end;
    //    Polyline([Corner1Pt,PointPt,Corner2Pt]);
    MoveTo(PointPt.X, PointPt.Y);
    LineTo(Corner1Pt.X, Corner1Pt.Y);
    MoveTo(PointPt.X, PointPt.Y);
    LineTo(Corner2Pt.X, Corner2Pt.Y);
  end;
end;

procedure TJvSingleHeadOpenDashArrow.DrawEndTerminator;
var
  ConnPt, TermPt: TPoint;
begin
  inherited DrawEndTerminator;
  if Assigned(FEndConn.Shape) then
  begin
    ConnPt := Convert(FEndConn.ConnPoint(EndTermRect));
    TermPt := Convert(FEndConn.TermPoint(EndTermRect));
    DrawArrowHead(ConnPt, TermPt);
  end;
end;

//=== { TJvBluntSingleHeadOpenDashArrow } ====================================

constructor TJvBluntSingleHeadOpenDashArrow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  StartTermRect := Rect(0, 0, 10, 10);
end;

procedure TJvBluntSingleHeadOpenDashArrow.DrawStartTerminator;
var
  ConnPt, TermPt: TPoint;
begin
  inherited DrawStartTerminator;
  if not Assigned(FStartConn.Shape) then
    Exit;
  ConnPt := Convert(FStartConn.ConnPoint(StartTermRect));
  TermPt := Convert(FStartConn.TermPoint(StartTermRect));
  with Canvas do
  begin
    // Draw a line connecting the Conn and Term points
    Pen.Color := FLineColor;
    PenPos := ConnPt;
    LineTo(TermPt.X, TermPt.Y);
  end;
end;

//=== { TJvBluntSingleHeadArrow } ============================================

constructor TJvBluntSingleHeadArrow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  StartTermRect := Rect(0, 0, 10, 10);
end;

procedure TJvBluntSingleHeadArrow.DrawStartTerminator;
var
  ConnPt, TermPt: TPoint;
begin
  inherited DrawStartTerminator;
  if not Assigned(FStartConn.Shape) then
    Exit;
  ConnPt := Convert(FStartConn.ConnPoint(StartTermRect));
  TermPt := Convert(FStartConn.TermPoint(StartTermRect));
  with Canvas do
  begin
    // Draw a line connecting the Conn and Term points
    Pen.Color := FLineColor;
    PenPos := ConnPt;
    LineTo(TermPt.X, TermPt.Y);
  end;
end;

//=== { TJvSubCaseArrow } ====================================================

constructor TJvSubCaseArrow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  EndTermRect := Rect(0, 0, 25, 10);
  StartTermRect := Rect(0, 0, 10, 10);
end;

procedure TJvSubCaseArrow.DrawArrowHead(ConnPt, TermPt: TPoint);
var
  PointPt, Corner1Pt, Corner2Pt: TPoint;
begin
  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := FLineColor;
    Pen.Color := FLineColor;

    // Draw a line connecting the Conn and Term points
    PenPos := ConnPt;
    LineTo(TermPt.X, TermPt.Y);
    // Set the basic points (to be modified depending on arrow head direction
    PointPt := TermPt;
    Corner1Pt := ConnPt;
    Corner2Pt := ConnPt;

    if ConnPt.X < TermPt.X then
    begin
      // Draw a right pointing arrow head
      Inc(Corner1Pt.X, 10);
      Inc(Corner2Pt.X, 10);
      Dec(Corner1Pt.Y, RectHeight(EndTermRect) div 2);
      Inc(Corner2Pt.Y, RectHeight(EndTermRect) div 2);
    end
    else
    if ConnPt.X > TermPt.X then
    begin
      // Draw a left pointing arrow head
      Dec(Corner1Pt.X, 10);
      Dec(Corner2Pt.X, 10);
      Dec(Corner1Pt.Y, RectHeight(EndTermRect) div 2);
      Inc(Corner2Pt.Y, RectHeight(EndTermRect) div 2);
    end
    else
    if ConnPt.Y < TermPt.Y then
    begin
      // Draw a down pointing arrow head
      Inc(Corner1Pt.Y, 10);
      Inc(Corner2Pt.Y, 10);
      Dec(Corner1Pt.X, RectHeight(EndTermRect) div 2);
      Inc(Corner2Pt.X, RectHeight(EndTermRect) div 2);
    end
    else
    begin
      // Draw a up pointing arrow head
      Dec(Corner1Pt.Y, 10);
      Dec(Corner2Pt.Y, 10);
      Dec(Corner1Pt.X, RectHeight(EndTermRect) div 2);
      Inc(Corner2Pt.X, RectHeight(EndTermRect) div 2);
    end;
    Brush.Color := clWindow;
    Polygon([PointPt, Corner1Pt, Corner2Pt]);
  end;
end;

procedure TJvSubCaseArrow.DrawEndTerminator;
var
  ConnPt, TermPt: TPoint;
begin
  inherited DrawEndTerminator;
  if Assigned(FEndConn.Shape) then
  begin
    ConnPt := Convert(FEndConn.ConnPoint(EndTermRect));
    TermPt := Convert(FEndConn.TermPoint(EndTermRect));
    DrawArrowHead(ConnPt, TermPt);
  end;
end;

procedure TJvSubCaseArrow.DrawStartTerminator;
var
  ConnPt, TermPt: TPoint;
begin
  inherited DrawStartTerminator;
  if not Assigned(FStartConn.Shape) then
    Exit;
  ConnPt := Convert(FStartConn.ConnPoint(StartTermRect));
  TermPt := Convert(FStartConn.TermPoint(StartTermRect));
  with Canvas do
  begin
    // Draw a line connecting the Conn and Term points
    Pen.Color := FLineColor;
    PenPos := ConnPt;
    LineTo(TermPt.X, TermPt.Y);
  end;
end;

//=== { TJvDoubleHeadArrow } =================================================

constructor TJvDoubleHeadArrow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  StartTermRect := EndTermRect;
end;

procedure TJvDoubleHeadArrow.DrawStartTerminator;
var
  ConnPt, TermPt: TPoint;
begin
  inherited DrawStartTerminator;
  if Assigned(FStartConn.Shape) then
  begin
    ConnPt := Convert(FStartConn.ConnPoint(StartTermRect));
    TermPt := Convert(FStartConn.TermPoint(StartTermRect));
    DrawArrowHead(ConnPt, TermPt);
  end;
end;

//=== Initialisation and cleanup routines ====================================

procedure RegisterStorageClasses;
begin
  {$IFDEF COMPILER7_UP}
  GroupDescendentsWith(TJvConnection, TControl);
  {$ENDIF COMPILER7_UP}
  RegisterClasses([TJvCustomDiagramShape, TJvMoveableShape,
    TJvSizeableShape, TJvConnection, TJvConnector, TJvSingleHeadArrow,
      TJvBluntSingleHeadArrow, TJvDoubleHeadArrow, TJvBitmapShape,
      TJvTextShape, TJvStandardShape, TJvSingleHeadOpenDashArrow,
      TJvBluntSingleHeadOpenDashArrow, TJvSubCaseArrow]);
end;

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}
  RegisterStorageClasses;

{$IFDEF UNITVERSIONING}
finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.