jvdiagramshape.pas

East make Tray Icon in delphi

      // Set the size of the component to the image size
      SetBounds(Left, Top, FImages.Width, FImages.Height);
  end;
end;

procedure TJvBitmapShape.SetImageIndex(Value: Integer);
begin
  if Value <> FImageIndex then
  begin
    FImageIndex := Value;
    Invalidate;
  end;
end;

procedure TJvBitmapShape.Paint;
var
  OldPen: TPen;
begin
  inherited Paint;
  if (not Assigned(Parent)) or (not Assigned(FImages)) or
    (FImageIndex < 0) or (FImageIndex >= FImages.Count) then
    // The component has not been placed on a form yet, or does not have an
    // associated image
    Exit;

  // Draw a focus rectangle
  OldPen := Canvas.Pen;
  Canvas.Pen.Style := psDot;
  Canvas.Brush.Style := bsClear;

  if Selected then
    Canvas.Pen.Mode := pmNot
  else
    Canvas.Pen.Mode := pmNop;

  // (rom) draws a rectangle
  Canvas.Polyline([Point(0, 0), Point(Width - 1, 0),
      Point(Width - 1, Height - 1), Point(0, Height - 1), Point(0, 0)]);
  Canvas.Pen := OldPen;

  // Draw the bitmap
  {$IFDEF VCL}
  FImages.DrawingStyle := dsTransparent;
  {$ENDIF VCL}
  FImages.Draw(Canvas, 0, 0, FImageIndex);
end;

procedure TJvBitmapShape.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if AComponent = FImages then
      FImages := nil;
end;

//=== { TJvStandardShape } ===================================================

constructor TJvStandardShape.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // Set a default shape and size and colors
  FShapeType := stRectangle;
  Width := 100;
  Height := 60;
  FLineColor := clBlack;
end;

procedure TJvStandardShape.SetShapeType(Value: TShapeType);
begin
  if FShapeType <> Value then
  begin
    FShapeType := Value;
    Invalidate;
  end;
end;

procedure TJvStandardShape.Paint;
var
  TempRect: TRect;
  S: Integer;
begin
  inherited Paint;
  if not Assigned(Parent) then
    Exit;

  TempRect := ClientRect; // So can pass as a var parameter
  InflateRect(TempRect, -SizeRectWidth, -SizeRectHeight);

  // Draw shape outline
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Color := FLineColor;
  S := Min([TempRect.Right - TempRect.Left + 1, TempRect.Bottom - TempRect.Top + 1]);

  if FShapeType in [stSquare, stRoundSquare, stCircle] then
  begin
    TempRect.Right := TempRect.Left + S;
    TempRect.Bottom := TempRect.Top + S;
  end;

  case FShapeType of
    stRectangle, stSquare:
      Canvas.Rectangle(TempRect.Left, TempRect.Top, TempRect.Right, TempRect.Bottom);
    stRoundRect, stRoundSquare:
      Canvas.RoundRect(TempRect.Left, TempRect.Top, TempRect.Right, TempRect.Bottom,
        S div 4, S div 4);
    stCircle, stEllipse:
      Canvas.Ellipse(TempRect.Left, TempRect.Top, TempRect.Right, TempRect.Bottom);
  end;
end;

//=== { TJvConnection } ======================================================

constructor TJvConnection.Create;
begin
  inherited Create;
  FShape := nil;
  FSide := csRight;
  FOffset := 0;
end;

procedure TJvConnection.Assign(Source: TPersistent);
begin
  if Source is TJvConnection then
  begin
    FShape := TJvConnection(Source).FShape;
    FSide := TJvConnection(Source).FSide;
    FOffset := TJvConnection(Source).FOffset;
  end
  else
    inherited Assign(Source);
end;

function TJvConnection.ConnPoint(TerminatorRect: TRect): TPoint;
var
  X, Y, W: Integer;
begin
  Result := Point(0, 0);
  X := 0;
  Y := 0;
  W := TerminatorRect.Right - TerminatorRect.Left;

  if FShape = nil then
    Exit;

  case FSide of
    csLeft:
      begin
        X := FShape.Left - W;
        Y := FShape.Top + FOffset;
      end;
    csRight:
      begin
        X := FShape.Left + FShape.Width - 1 + W;
        Y := FShape.Top + FOffset;
      end;
    csTop:
      begin
        X := FShape.Left + FOffset;
        Y := FShape.Top - W;
      end;
    csBottom:
      begin
        X := FShape.Left + FOffset;
        Y := FShape.Top + FShape.Height - 1 + W;
      end;
  end;
  Result := Point(X, Y);
end;

function TJvConnection.TermPoint(TerminatorRect: TRect): TPoint;
begin
  Result.X := 0;
  Result.Y := 0;
  if Shape = nil then
    Exit;
  with Result do
    case Side of
      csLeft:
        begin
          X := Shape.Left;
          Y := Shape.Top + Offset;
        end;
      csRight:
        begin
          X := Shape.Left + Shape.Width - 1;
          Y := Shape.Top + Offset;
        end;
      csTop:
        begin
          X := Shape.Left + Offset;
          Y := Shape.Top;
        end;
      csBottom:
        begin
          X := Shape.Left + Offset;
          Y := Shape.Top + Shape.Height - 1;
        end;
    else
      X := 0;
      Y := 0;
  end;
end;

function TJvConnection.LeftMost(TerminatorRect: TRect): TPoint;
begin
  Result := TermPoint(TerminatorRect);
  if Shape = nil then
    Exit;
  case Side of
    csLeft:
      Result.X := Shape.Left - RectWidth(TerminatorRect);
    csRight:
      Result.X := Shape.Left + Shape.Width;
    csTop, csBottom:
      Result.X := Shape.Left + Offset - (RectHeight(TerminatorRect) div 2);
  end;
end;

function TJvConnection.RightMost(TerminatorRect: TRect): TPoint;
begin
  Result := TermPoint(TerminatorRect);
  if Shape = nil then
    Exit;
  case Side of
    csLeft:
      Result.X := Shape.Left - 1;
    csRight:
      Result.X := Shape.Left + Shape.Width - 1 + RectWidth(TerminatorRect);
    csTop, csBottom:
      Result.X := Shape.Left + Offset + (RectHeight(TerminatorRect) div 2);
  end;
end;

function TJvConnection.TopMost(TerminatorRect: TRect): TPoint;
begin
  Result := TermPoint(TerminatorRect);
  if Shape = nil then
    Exit;
  case Side of
    csLeft, csRight:
      Result.Y := Shape.Top + Offset - (RectHeight(TerminatorRect) div 2);
    csTop:
      Result.Y := Shape.Top - RectWidth(TerminatorRect) - 1;
    csBottom:
      Result.Y := Shape.Top + Shape.Height;
  end;
end;

function TJvConnection.BottomMost(TerminatorRect: TRect): TPoint;
begin
  Result := TermPoint(TerminatorRect);
  if Shape = nil then
    Exit;
  case Side of
    csLeft, csRight:
      Result.Y := Shape.Top + Offset + (RectHeight(TerminatorRect) div 2);
    csTop:
      Result.Y := Shape.Top - 1;
    csBottom:
      Result.Y := Shape.Top + Shape.Height + RectWidth(TerminatorRect);
  end;
end;

//=== { TJvConnector } =======================================================

constructor TJvConnector.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanProcessMouseMsg := False;
  FLineWidth := 1;
  FLineColor := clBlack;
  FStartTermRect := Rect(0, 0, 0, 0);
  FEndTermRect := Rect(0, 0, 0, 0);
  FStartConn := TJvConnection.Create;
  FEndConn := TJvConnection.Create;
  FMidPoint := Point(0, 0);
end;

destructor TJvConnector.Destroy;
begin
  FreeAndNil(FStartConn);
  FreeAndNil(FEndConn);
  inherited Destroy;
end;

procedure TJvConnector.Paint;
var
  EndPt: TPoint;
begin
  inherited Paint;
  if not Assigned(Parent) then
    Exit;
  if Assigned(FStartConn.Shape) and Assigned(FEndConn.Shape) then
  begin
    // Draw the terminators (arrows etc)
    DrawStartTerminator;
    DrawEndTerminator;
    with Canvas do
    begin
      // Draw the connecting line
      Brush.Style := bsClear;
      Pen.Width := FLineWidth;
      Pen.Color := FLineColor;
      // Convert from Parent coordinates to control coordinates
      PenPos := Convert(FStartConn.ConnPoint(FStartTermRect));
      EndPt := Convert(FEndConn.ConnPoint(FEndTermRect));
      LineTo(EndPt.X, EndPt.Y);
    end;
  end;
end;

procedure TJvConnector.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    // (rom) added Assigned to fix a crash
    if Assigned(FStartConn) and (AComponent = FStartConn.FShape) then
      FStartConn.FShape := nil;
    if Assigned(FEndConn) and (AComponent = FEndConn.FShape) then
      FEndConn.FShape := nil;
  end;
end;

procedure TJvConnector.DrawStartTerminator;
begin
end;

procedure TJvConnector.DrawEndTerminator;
begin
end;

procedure TJvConnector.MoveCaption;
var
  NewMidPoint: TPoint;
  ALeft, ATop, ARight, ABottom: Integer;
begin
  if Assigned(FCaption) then
  begin
    if (FMidPoint.X = 0) and (FMidPoint.Y = 0) then
      FMidPoint := GetMidPoint;
    NewMidPoint := GetMidPoint;
    // Move the caption relative to the mid point of the connector
    // Not resizing anything, just moving an unconnected shape, so can use
    // faster update method than SetBounds
    FCaption.Invalidate;
    ALeft := FCaption.Left + NewMidPoint.X - FMidPoint.X;
    ATop := FCaption.Top + NewMidPoint.Y - FMidPoint.Y;
    ARight := ALeft + FCaption.Width;
    ABottom := ATop + FCaption.Height;
    FCaption.UpdateBoundsRect(Rect(ALeft, ATop, ARight, ABottom));
    // Save the new mid point
    FMidPoint := NewMidPoint;
  end;
end;

procedure TJvConnector.CheckSize(var AWidth, AHeight: Integer);
begin
  // Ensure the control is at least as big as the line width
  NoLessThan(AHeight, FLineWidth);
  NoLessThan(AWidth, FLineWidth);
  // Ensure the control is at least as big as the start terminator rectangle
  NoLessThan(AHeight, RectHeight(FStartTermRect));
  NoLessThan(AWidth, RectWidth(FStartTermRect));
  // Ensure the control is at least as big as the end terminator rectangle
  NoLessThan(AHeight, RectHeight(FEndTermRect));
  NoLessThan(AWidth, RectWidth(FEndTermRect));
end;

procedure TJvConnector.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  CheckSize(AWidth, AHeight);
  // Resize the connector
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  // Move the caption
  MoveCaption;
end;

procedure TJvConnector.SetBoundingRect;
var
  ALeft, ATop, AWidth, AHeight: Integer;
begin
  if (FStartConn.Shape = nil) or (FEndConn.Shape = nil) then
    Exit;
  ALeft := Min([FStartConn.LeftMost(FStartTermRect).X,
    FEndConn.LeftMost(FEndTermRect).X]);
  ATop := Min([FStartConn.TopMost(FStartTermRect).Y,
    FEndConn.TopMost(FEndTermRect).Y]);
  AWidth := Max([FStartConn.RightMost(FStartTermRect).X,
    FEndConn.RightMost(FEndTermRect).X]) - ALeft + 2;
  AHeight := Max([FStartConn.BottomMost(FStartTermRect).Y,
    FEndConn.BottomMost(FEndTermRect).Y]) - ATop + 2;
  CheckSize(AWidth, AHeight);
  Invalidate;
  UpdateBoundsRect(Rect(ALeft, ATop, ALeft + AWidth - 1, ATop + AHeight - 1));
  MoveCaption;
end;

procedure TJvConnector.SetLineWidth(Value: Integer);
begin
  // Ensure that can always see the line!
  if Value >= 1 then
    FLineWidth := Value;
end;

function TJvConnector.GetConn(Index: Integer): TJvConnection;
begin
  case Index of
    1:
      Result := FStartConn;
    2:
      Result := FEndConn;
  else
    Result := nil;
  end;
end;

procedure TJvConnector.SetConn(Index: Integer; Value: TJvConnection);
begin
  case Index of
    1:
      FStartConn.Assign(Value);
    2:
      FEndConn.Assign(Value);
  end;
  SetBoundingRect;
end;