jvdiagramshape.pas

East make Tray Icon in delphi

  I: Integer;
  TempName: string;
begin
  inherited Create(AOwner);
  FCanProcessMouseMsg := True;
  FCaption := nil;
  FSelected := False;
  FWasCovered := False;

  // (rom) this was removed, but should be handled
  //if AOwner = nil then
    //Exit;
  // Give the component a name and ensure that it is unique
  repeat
    // Use a local variable to hold the name, so that don't get exceptions
    // raised on duplicate names
    TempName := 'Shape' + IntToStr(GlobalShapeCount);
    Inc(GlobalShapeCount);
    AlreadyUsed := False;

    // Loop through all the components on the form to ensure that this name
    // is not already in use
    for I := 0 to Owner.ComponentCount - 1 do
      if Owner.Components[I].Name = TempName then
      begin
        // Try the next component name as this one is used already
        AlreadyUsed := True;
        Break;
      end;
  until not AlreadyUsed;
  Name := TempName;
end;

destructor TJvCustomDiagramShape.Destroy;
var
  I: Integer;
begin
  FreeAndNil(FCaption);
  // First check that this control has been placed on a form
  if Assigned(Parent) then
  begin
    // Search parent control for TJvConnector components that connect
    // to this component
    I := 0;
    while I < Parent.ControlCount do
      if (Parent.Controls[I] is TJvConnector) and
        (TJvConnector(Parent.Controls[I]).IsConnected(Self)) then
        Parent.Controls[I].Free
      else
        Inc(I);
  end;
  inherited Destroy;
end;

procedure TJvCustomDiagramShape.SetCaption(Value: TJvTextShape);
begin
  if (Value = nil) and Assigned(FCaption) then
  begin
    FCaption.Free;
    FCaption := nil;
  end
  else
  if Value <> FCaption then
  begin
    FCaption := Value;
    FCaption.Parent := Self.Parent;
    // Ensure the caption gets aligned correctly. Ths only needs to happen if
    // the caption has not already been set in place (it will already be in the
    // right place if we are loading this from a file).
    if (FCaption.Left = 0) and (FCaption.Top = 0) then
      AlignCaption(taCenter);
  end;
end;

{$IFDEF VisualCLX}
procedure TJvCustomDiagramShape.SetParent(const AParent: TWidgetControl);
{$ENDIF VisualCLX}
{$IFDEF VCL}
procedure TJvCustomDiagramShape.SetParent(AParent: TWinControl);
{$ENDIF VCL}
begin
  inherited SetParent(AParent);
  if Assigned(FCaption) then
    FCaption.Parent := AParent;
end;

procedure TJvCustomDiagramShape.SetSelected(Value: Boolean);
begin
  FSelected := Value;
  if Assigned(FCaption) then
    FCaption.SetSelected(Value);
end;

procedure TJvCustomDiagramShape.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  I: Integer;
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if not Assigned(Parent) then
    Exit;
  // Search parent control for TJvConnector components
  for I := 0 to Parent.ControlCount - 1 do
    if Parent.Controls[I] is TJvConnector then
      if TJvConnector(Parent.Controls[I]).IsConnected(Self) then
        // Resize the connector, but don't draw it yet
        TJvConnector(Parent.Controls[I]).SetBoundingRect;
  AlignCaption(FAlignment);
end;

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

procedure TJvCustomDiagramShape.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  TempPt: TPoint;
  CoveredShape: TJvCustomDiagramShape;
begin
  if CanProcessMouseMsg then
  begin
    BringToFront;
    MouseCapture := True;
    inherited MouseDown(Button, Shift, X, Y);
    Exit;
  end;

  // Pass message on to any covered control capable of handling it
  CoveredShape := GetCustomShapeAtPos(X, Y);
  TempPt := Point(X, Y);
  MouseCapture := False;

  if CoveredShape <> nil then
  begin
    SendToBack;
    // Convert coordinates to covered shape's coordinates
    TempPt := CoveredShape.ScreenToClient(ClientToScreen(TempPt));
    // Send the mouse down message to the covered shape
    CoveredShape.MouseDown(Button, Shift, TempPt.X, TempPt.Y);
    // Flag the control as having been covered because we lose a mouse click
    CoveredShape.FWasCovered := True;
  end
  else
  if Assigned(Parent) then
  begin
    // Send mouse down message to Parent. The typecast is purely to gain access
    // to the Parent.MouseDown method. Need to convert coordinates to parent's
    // coordinates
    TempPt := Parent.ScreenToClient(ClientToScreen(TempPt));
    TCrackTControl(Parent).MouseDown(Button, Shift, TempPt.X, TempPt.Y);
  end;
end;

procedure TJvCustomDiagramShape.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FWasCovered then
  begin
    // We will lose a mouse click, so replace it
    Click;
    FWasCovered := False;
  end;
end;

function TJvCustomDiagramShape.GetCustomShapeAtPos(X, Y: Integer): TJvCustomDiagramShape;
var
  I: Integer;
  Pt: TPoint;
begin
  Result := nil;
  if not Assigned(Parent) then
    Exit;

  Pt := Parent.ScreenToClient(ClientToScreen(Point(X, Y)));

  for I := 0 to Parent.ControlCount - 1 do
    if (Parent.Controls[I] <> Self) and
      (Parent.Controls[I] is TJvCustomDiagramShape) and
      TJvCustomDiagramShape(Parent.Controls[I]).CanProcessMouseMsg and
      InRect(Pt.X, Pt.Y, Parent.Controls[I].BoundsRect) then
    begin
      Result := TJvCustomDiagramShape(Parent.Controls[I]);
      Exit;
    end;
end;

procedure TJvCustomDiagramShape.AlignCaption(Alignment: TAlignment);
var
  ALeft, ATop, AWidth, AHeight: Integer;
begin
  FAlignment := Alignment;
  if not Assigned(FCaption) then
    Exit;

  ALeft := Left;
  ATop := Top + Height + 5;
  AWidth := FCaption.Width;
  AHeight := FCaption.Height;

  case Alignment of
    taLeftJustify:
      ALeft := Left;
    taRightJustify:
      ALeft := Left + Width - 1;
    taCenter:
      ALeft := Left + ((Width - FCaption.Width) div 2);
  end;
  FCaption.SetBounds(ALeft, ATop, AWidth, AHeight);
end;

class procedure TJvCustomDiagramShape.SaveToFile(const FileName: string;
  ParentControl: TWinControl);
var
  FS: TFileStream;
  Writer: TWriter;
  RealName: string;
begin
  FS := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
  Writer := TWriter.Create(FS, 1024);
  try
    Writer.Root := ParentControl.Owner;
    RealName := ParentControl.Name;
    ParentControl.Name := '';
    Writer.WriteComponent(ParentControl);
    ParentControl.Name := RealName;
  finally
    Writer.Free;
    FS.Free;
  end;
end;

class procedure TJvCustomDiagramShape.LoadFromFile(const FileName: string;
  ParentControl: TWinControl);
var
  FS: TFileStream;
  Reader: TReader;
  RealName: string;
begin
  DeleteAllShapes(ParentControl);
  FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  Reader := TReader.Create(FS, 1024);
  try
    // Save the parent's name, in case we are reading into a different
    // control than we saved the diagram from
    RealName := ParentControl.Name;
    Reader.Root := ParentControl.Owner;
    Reader.BeginReferences;
    Reader.ReadComponent(ParentControl);
    Reader.FixupReferences;
    // Restore the parent's name
    ParentControl.Name := RealName;
  finally
    Reader.EndReferences;
    Reader.Free;
    FS.Free;
  end;
end;

class procedure TJvCustomDiagramShape.DeleteAllShapes(ParentControl: TWinControl);
var
  I: Integer;
begin
  // Delete controls from ParentControl
  I := 0;
  // (rom) added Assigned for security
  if Assigned(ParentControl) then
    while I < ParentControl.ControlCount do
      if ParentControl.Controls[I] is TJvCustomDiagramShape then
        ParentControl.Controls[I].Free
        // Note that there is no need to increment the counter, because the
        // next component (if any) will now be at the same position in Controls[]
      else
        Inc(I);
end;

class procedure TJvCustomDiagramShape.DeleteSelectedShapes(ParentControl: TWinControl);
var
  I: Integer;
begin
  // Delete controls from ParentControl if they are flagged as selected
  I := 0;
  // (rom) added Assigned for security
  if Assigned(ParentControl) then
    while I < ParentControl.ControlCount do
      if (ParentControl.Controls[I] is TJvCustomDiagramShape) and
        (TJvCustomDiagramShape(ParentControl.Controls[I]).Selected) then
        ParentControl.Controls[I].Free
        // Note that there is no need to increment the counter, because the
        // next component (if any) will now be at the same position in Controls[]
      else
        Inc(I);
end;

class procedure TJvCustomDiagramShape.UnselectAllShapes(ParentControl: TWinControl);
var
  I: Integer;
begin
  // (rom) added Assigned for security
  if Assigned(ParentControl) then
    for I := 0 to ParentControl.ControlCount - 1 do
      if ParentControl.Controls[I] is TJvCustomDiagramShape then
        TJvCustomDiagramShape(ParentControl.Controls[I]).Selected := False;
end;

class procedure TJvCustomDiagramShape.SetMultiSelected(ParentControl: TWinControl;
  Value: Boolean);
var
  I: Integer;
begin
  if Assigned(ParentControl) then
    for I := 0 to ParentControl.ControlCount - 1 do
      if ParentControl.Controls[I] is TJvCustomDiagramShape then
        TJvCustomDiagramShape(ParentControl.Controls[I]).MultiSelect := Value;
end;

//=== { TJvMoveableShape } ===================================================

constructor TJvMoveableShape.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Selected := False;
  Moving := False;
  FOrigin := Point(0, 0);
end;

procedure TJvMoveableShape.StartMove(X, Y: Integer);
begin
  Selected := True;
  Moving := True;
  FOrigin := Point(X, Y);
end;

procedure TJvMoveableShape.Move(DeltaX, DeltaY: Integer);
begin
  SetBounds(Left + DeltaX, Top + DeltaY, Width, Height);
end;

procedure TJvMoveableShape.EndMove;
begin
  Moving := False;
  FOrigin := Point(0, 0);
end;

function TJvMoveableShape.ValidMove(DeltaX, DeltaY: Integer): Boolean;
begin
  Result := True;
  if not Assigned(Parent) then
    Exit;

  if Selected then
    Result := (Left + DeltaX >= 0) and (Top + DeltaY >= 0) and
      (Left + DeltaX + Width - 1 < Parent.ClientRect.Right - Parent.ClientRect.Left) and
      (Top + DeltaY + Height - 1 < Parent.ClientRect.Bottom - Parent.ClientRect.Top);
end;

procedure TJvMoveableShape.MoveShapes(DeltaX, DeltaY: Integer);
var
  I, Pass: Integer;
  TempControl: TControl;
begin
  if not Assigned(Parent) then
    Exit;

  // Do 2 passes through controls. The first one is to check that all
  // movements are valid
  for Pass := 1 to 2 do
  begin
    for I := 0 to Parent.ControlCount - 1 do
    begin
      TempControl := Parent.Controls[I];
      if TempControl is TJvMoveableShape then
      begin
        if (Pass = 1) and
          (not TJvMoveableShape(TempControl).ValidMove(DeltaX, DeltaY)) then
          Exit
        else
        if (Pass = 2) and TJvMoveableShape(TempControl).Selected then
          TJvMoveableShape(TempControl).Move(DeltaX, DeltaY);
      end;
    end;
  end;
end;

procedure TJvMoveableShape.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  // Only respond to left mouse button events
  if Button <> mbLeft then
    Exit;
  // If not holding down the shift key then not doing multiple selection
  if not (ssShift in Shift) then
    UnselectAllShapes(Parent);
  // Start moving the component
  StartMove(X, Y);
end;

procedure TJvMoveableShape.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  // Only need to move the component if the left mouse button is being held down
  if not (ssLeft in Shift) then
  begin
    Moving := False;
    Exit;
  end;

  if Moving then
    // Move all the selected shapes
    MoveShapes(X - FOrigin.X, Y - FOrigin.Y);
end;

procedure TJvMoveableShape.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  I: Integer;
  TempControl: TControl;
begin
  inherited MouseUp(Button, Shift, X, Y);
  // Only interested in left mouse button events
  if Button <> mbLeft then
    Exit;