jvdiagramshape.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDiagramShape.PAS, released on 2002-03-22.

Original Developer: Jim Cooper <jcooper att tabdee dott ltd dott uk>
Contributor(s): Michael Beck <mbeck1 att compuserve dott com>

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvDiagramShape.pas,v 1.28 2005/02/17 10:20:23 marquardt Exp $

unit JvDiagramShape;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, 
  {$IFDEF VisualCLX}
  QTypes, 
  {$ENDIF VisualCLX}
  Classes, Graphics, Controls, ExtCtrls, ImgList,
  JvComponent;

type
  TJvTextShape = class;

  // All controls descend from this, to help with streaming and unique naming
  TJvCustomDiagramShape = class(TJvGraphicControl)
  private
    FCanProcessMouseMsg: Boolean;
    FCaption: TJvTextShape;
    FSelected: Boolean;
    FWasCovered: Boolean;
    FMultiSelect: Boolean;
    FRightClickSelect: Boolean;
    FAlignment: TAlignment;
  protected
    procedure SetCaption(Value: TJvTextShape); virtual;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    function GetCustomShapeAtPos(X, Y: Integer): TJvCustomDiagramShape;
    property CanProcessMouseMsg: Boolean read FCanProcessMouseMsg
      write FCanProcessMouseMsg;
    {$IFDEF VCL}
    procedure SetParent(AParent: TWinControl); override;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    procedure SetParent(const AParent: TWidgetControl); override;
    {$ENDIF VisualCLX}
    procedure SetSelected(Value: Boolean); virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    property MultiSelect: Boolean read FMultiSelect write FMultiSelect;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure AlignCaption(Alignment: TAlignment);
    // Class methods to save and load all TJvCustomDiagramShape components
    // that are children of a given control. They are class methods so that an
    // instance of TJvCustomDiagramShape is not required
    class procedure SaveToFile(const FileName: string; ParentControl: TWinControl);
    class procedure LoadFromFile(const FileName: string; ParentControl: TWinControl);
    class procedure DeleteAllShapes(ParentControl: TWinControl);
    class procedure DeleteSelectedShapes(ParentControl: TWinControl);
    class procedure UnselectAllShapes(ParentControl: TWinControl);
    class procedure SetMultiSelected(ParentControl: TWinControl; Value: Boolean);
    property Selected: Boolean read FSelected write SetSelected;
    property Caption: TJvTextShape read FCaption write SetCaption;
    property RightClickSelect: Boolean read FRightClickSelect write FRightClickSelect default True;
    property OnDblClick;
  end;

  TJvMoveableShape = class(TJvCustomDiagramShape)
  private
    FOrigin: TPoint;
    FMoving: Boolean;
  protected
    procedure StartMove(X, Y: Integer);
    procedure Move(DeltaX, DeltaY: Integer);
    procedure EndMove;
    function ValidMove(DeltaX, DeltaY: Integer): Boolean;
    procedure MoveShapes(DeltaX, DeltaY: Integer);
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    property Moving: Boolean read FMoving write FMoving;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Caption;
    property RightClickSelect;
    // Make these properties available
    property OnClick;
    property OnDblClick;
  end;

  TJvSizingMode = (smTopLeft, smTop, smTopRight, smLeft, smRight,
    smBottomLeft, smBottom, smBottomRight, smNone);

  TJvSizeableShape = class(TJvMoveableShape)
  private
    FSizingMode: TJvSizingMode;
    FSizeOrigin: TPoint;
    FSizeRectHeight: Integer;
    FSizeRectWidth: Integer;
    FMinHeight: Integer;
    FMinWidth: Integer;
  protected
    procedure SetSelected(Value: Boolean); override;
    procedure Paint; override;
    procedure DrawSizingRects;
    function GetSizeRect(SizeRectType: TJvSizingMode): TRect;
    procedure CheckForSizeRects(X, Y: Integer);
    procedure ResizeControl(X, Y: Integer);
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    property SizingMode: TJvSizingMode read FSizingMode write FSizingMode;
    property SizeRectHeight: Integer read FSizeRectHeight write FSizeRectHeight;
    property SizeRectWidth: Integer read FSizeRectWidth write FSizeRectWidth;
    property MinHeight: Integer read FMinHeight write FMinHeight;
    property MinWidth: Integer read FMinWidth write FMinWidth;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  end;

  TJvTextShape = class(TJvSizeableShape)
  private
    FText: TCaption;
    FAutoSize: Boolean;
    FFont: TFont;
    {$IFDEF VCL}
    procedure SetText(const Value: TCaption);
    {$ENDIF VCL}
    procedure SetFont(Value: TFont);
    procedure FontChange(Sender: TObject);
  protected
    procedure SetAutoSize(Value: Boolean); {$IFDEF VCL} override; {$ENDIF}
    procedure RefreshText;
    {$IFDEF VCL}
    procedure SetParent(AParent: TWinControl); override;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    procedure SetParent(const AParent: TWidgetControl); override;
    procedure SetText(const Value: TCaption); override;
    function GetText: TCaption; override;
    {$ENDIF VisualCLX}
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  published
    property Text: TCaption read FText write SetText;
    property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
    property Font: TFont read FFont write SetFont;
  end;

  TJvBitmapShape = class(TJvMoveableShape)
  private
    FImages: TImageList;
    FImageIndex: Integer;
    procedure SetImages(Value: TImageList);
    procedure SetImageIndex(Value: Integer);
  protected
    procedure SetSelected(Value: Boolean); override;
    procedure Paint; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Images: TImageList read FImages write SetImages;
    property ImageIndex: Integer read FImageIndex write SetImageIndex;
    // Make these properties available
    property PopupMenu;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
    property OnClick;
    property OnDblClick;
  end;

  TJvStandardShape = class(TJvSizeableShape)
  private
    FShapeType: TShapeType;
    FLineColor: TColor;
    procedure SetShapeType(Value: TShapeType);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ShapeType: TShapeType read FShapeType write SetShapeType;
    // (rom) renamed from LineColour
    property LineColor: TColor read FLineColor write FLineColor default clBlack;
  end;

  TJvConnectionSide = (csLeft, csRight, csTop, csBottom);

  TJvConnection = class(TPersistent)
  private
    FShape: TJvCustomDiagramShape;
    FSide: TJvConnectionSide; // Side to connect to
    FOffset: Integer; // Distance from top or left of side
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    // Gets connection point in parent's coordinates
    function ConnPoint(TerminatorRect: TRect): TPoint;
    // Gets terminator connection point in parent's coordinates
    function TermPoint(TerminatorRect: TRect): TPoint;
    // Functions to get boundaries of the terminators
    function LeftMost(TerminatorRect: TRect): TPoint;
    function RightMost(TerminatorRect: TRect): TPoint;
    function TopMost(TerminatorRect: TRect): TPoint;
    function BottomMost(TerminatorRect: TRect): TPoint;
  published
    property Shape: TJvCustomDiagramShape read FShape write FShape;
    property Side: TJvConnectionSide read FSide write FSide;
    property Offset: Integer read FOffset write FOffset;
  end;

  TJvConnector = class(TJvCustomDiagramShape)
  private
    FLineWidth: Integer;
    FLineColor: TColor;
    // The shapes connected by this control
    FStartConn: TJvConnection;
    FEndConn: TJvConnection;
    // Area of the terminator symbol to be drawn (in horizontal position)
    FStartTermRect: TRect;
    FEndTermRect: TRect;
    // Used to track required movement of the caption
    FMidPoint: TPoint;
    procedure SetLineWidth(Value: Integer);
    function GetConn(Index: Integer): TJvConnection;
    procedure SetConn(Index: Integer; Value: TJvConnection);
    function GetTermRect(Index: Integer): TRect;
    procedure SetTermRect(Index: Integer; Value: TRect);
    procedure CheckSize(var AWidth, AHeight: Integer);
    function GetMidPoint: TPoint;
  protected
    procedure SetCaption(Value: TJvTextShape); override;
    procedure Paint; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    // For drawing arrows etc. Called from Paint.
    procedure DrawStartTerminator; virtual;
    procedure DrawEndTerminator; virtual;
    procedure MoveCaption;
    // Converts point from parent's coordinates to own coordinates
    function Convert(APoint: TPoint): TPoint;
    function IsConnected(ConnectedShape: TJvCustomDiagramShape): Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    // Restrict the minimum size
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    // Called when moving one of the connected shapes
    procedure SetBoundingRect;
    procedure SetConnections(TheStartConn, TheEndConn: TJvConnection);
    property StartTermRect: TRect index 1 read GetTermRect write SetTermRect;
    property EndTermRect: TRect index 2 read GetTermRect write SetTermRect;
  published
    // Publish these properties so that component streaming can be used to
    // store them in a file
    property LineWidth: Integer read FLineWidth write SetLineWidth default 1;
    property LineColor: TColor read FLineColor write FLineColor default clBlack;
    property StartConn: TJvConnection index 1 read GetConn write SetConn;
    property EndConn: TJvConnection index 2 read GetConn write SetConn;
    property MidPoint: TPoint read GetMidPoint;
    property Caption;
    property RightClickSelect;
    // Make these properties available
    property OnClick;
    property OnDblClick;
  end;

  TJvSingleHeadArrow = class(TJvConnector)
  protected
    procedure DrawArrowHead(ConnPt, TermPt: TPoint);
    procedure DrawEndTerminator; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TJvSingleHeadOpenDashArrow = class(TJvConnector)
  protected
    procedure Paint; override;
    procedure DrawArrowHead(ConnPt, TermPt: TPoint);
    procedure DrawEndTerminator; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TJvBluntSingleHeadOpenDashArrow = class(TJvSingleHeadOpenDashArrow)
  protected
    procedure DrawStartTerminator; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TJvBluntSingleHeadArrow = class(TJvSingleHeadArrow)
  protected
    procedure DrawStartTerminator; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TJvSubCaseArrow = class(TJvConnector)
  protected
    procedure DrawArrowHead(ConnPt, TermPt: TPoint);
    procedure DrawEndTerminator; override;
    procedure DrawStartTerminator; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TJvDoubleHeadArrow = class(TJvSingleHeadArrow)
  protected
    procedure DrawStartTerminator; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvDiagramShape.pas,v $';
    Revision: '$Revision: 1.28 $';
    Date: '$Date: 2005/02/17 10:20:23 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils, 
  JvTypes, JvConsts;

type
  // This type is solely for the acccess to the protected MouseDown method
  TCrackTControl = class(TControl);

var
  // Used in unique naming scheme. It is global in this unit to enable a
  // 'memory' of the component names used during the lifetime of this unit.
  GlobalShapeCount: Integer = 1;

procedure NoLessThan(var Value: Integer; Limit: Integer);
begin
  if Value < Limit then
    Value := Limit;
end;

function RectHeight(ARect: TRect): Integer;
begin
  Result := ARect.Bottom - ARect.Top;
end;

function RectWidth(ARect: TRect): Integer;
begin
  Result := ARect.Right - ARect.Left;
end;

function InRect(X, Y: Integer; ARect: TRect): Boolean;
begin
  Result := (X >= ARect.Left) and (X <= ARect.Right) and
    (Y >= ARect.Top) and (Y <= ARect.Bottom);
end;

function Min(A: array of Integer): Integer;
var
  I: Integer;
begin
  // (rom) the "Purely" comment is wrong
  // (rom) the function explicitly handles empty arrays
  Result := 0; // Purely to stop compiler warnings
  for I := Low(A) to High(A) do
    if I = Low(A) then
      Result := A[I]
    else
    if A[I] < Result then
      Result := A[I];
end;

function Max(A: array of Integer): Integer;
var
  I: Integer;
begin
  Result := 0; // Purely to stop compiler warnings
  for I := Low(A) to High(A) do
    if I = Low(A) then
      Result := A[I]
    else
    if A[I] > Result then
      Result := A[I];
end;

//=== { TJvCustomDiagramShape } ==============================================

constructor TJvCustomDiagramShape.Create(AOwner: TComponent);
var
  AlreadyUsed: Boolean;