dxflchrt.pas

流程控制,Delhi 工业生产并行开发过程PICTURE.pf

{*******************************************************************}
{                                                                   }
{       Developer Express Visual Component Library                  }
{       ExpressFlowChart                                            }
{                                                                   }
{       Copyright (c) 1998-2004 Developer Express Inc.              }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{   The entire contents of this file is protected by U.S. and       }
{   International Copyright Laws. Unauthorized reproduction,        }
{   reverse-engineering, and distribution of all or any portion of  }
{   the code contained in this file is strictly prohibited and may  }
{   result in severe civil and criminal penalties and will be       }
{   prosecuted to the maximum extent possible under the law.        }
{                                                                   }
{   RESTRICTIONS                                                    }
{                                                                   }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES           }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE    }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS   }
{   LICENSED TO DISTRIBUTE THE EXPRESSFLOWCHART AND ALL ACCOMPANYING}
{   VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY.             }
{                                                                   }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED      }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE        }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE       }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT  }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                      }
{                                                                   }
{   CONSULT THE end USER LICENSE AGREEMENT FOR INFORMATION ON       }
{   ADDITIONAL RESTRICTIONS.                                        }
{                                                                   }
{*******************************************************************}

unit dxflchrt;

{$I dxFCver.inc}

interface

uses
  SysUtils, Classes, Windows, Graphics, Messages, StdCtrls, Forms,
  dxLines{$IFDEF DELPHI4}, ImgList{$ENDIF}, Controls;

const
  TO_HOME = $8000000;
  TO_END = $7FFFFFF;

type

  TdxCustomFlowChart = class;
  TdxFcItem = class;
  TdxFcObject = class;
  TdxFcConnection = class;

  TdxFcShapeType = (fcsNone, fcsRectangle, fcsEllipse, fcsRoundRect, fcsDiamond,
    fcsNorthTriangle, fcsSouthTriangle, fcsEastTriangle, fcsWestTriangle,
    fcsHexagon, fcsUser);

  TdxFclStyle = (fclStraight, fclCurved, fclRectH, fclRectV);
  TdxFcaType = (fcaNone, fcaArrow, fcaEllipse, fcaRectangle);

  TdxFcHorzPos = (fchpLeft, fchpCenter, fchpRight);
  TdxFcVertPos = (fcvpUp, fcvpCenter, fcvpDown);
  TdxFcHitTest = set of (htNowhere, htByObject, htOnObject, htOnConnection,
    htOnConLabel, htOnArrowSrc, htOnArrowDst, htOnSelPoint);
  TdxFcOptions = set of (fcoCanDelete, fcoCanDrag, fcoCanSelect,
    fcoMultiSelect, fcoHideSelection, fcoDelOnClick);

  TdxFcDragHandler = procedure (X, Y: Integer; State: TDragState) of object;
  TdxFcEvent = procedure (Sender: TdxCustomFlowChart; Item: TdxFcItem) of
          object;
  TdxFcAllowEvent = procedure (Sender: TdxCustomFlowChart; Item: TdxFcItem; var
          Allow: Boolean) of object;
  TdxFcEditEvent = procedure (Sender: TdxCustomFlowChart; AObject: TdxFcObject;
          var S: string) of object;
  TdxFcDrawEvent = procedure (Sender: TdxCustomFlowChart; AObject: TdxFcObject;
          R: TRect) of object;
  TdxFcObjData = packed record
    Left: Integer;
    Top: Integer;
    Width: Word;
    Height: Word;
    Edge: Word;
    Border: Word;
    HTPos: TdxFcHorzPos;
    VTPos: TdxFcVertPos;
    HIPos: TdxFcHorzPos;
    VIPos: TdxFcVertPos;
    BkColor: TColor;
    ShColor: TColor;
    Tag: Integer;
    ObjCnt: Word;
    Image: SmallInt;
    Shape: TdxFcShapeType;
    ShWidth: Byte;
    ParFont: Boolean;
    Transparent: Boolean;
  end;
  
  TdxFcArwData = packed record
    AType: TdxFcaType;
    Width: Byte;
    Height: Byte;
    Color: TColor;
  end;
  
  TdxFcConData = packed record
    ObjSrc: SmallInt;
    ObjDst: SmallInt;
    PtCount: Word;
    Color: TColor;
    PtSrc: Byte;
    PtDst: Byte;
    Style: TdxFclStyle;
    ParFont: Boolean;
    ArwSrc: TdxFcArwData;
    ArwDst: TdxFcArwData;
  end;
  
  TdxFcFntData = packed record
    Height: SmallInt;
    Color: TColor;
    Pitch: TFontPitch;
    Style: TFontStyles;
    Charset: TFontCharset;
  end;
  
  TdxFcDragData = packed record
    Index: Word;
    Base: TPoint;
    Mobile: TPoint;
    case Integer of
      0: (Rgn: HRgn);
      1: (Connect: TdxFcConnection);
  end;

  TdxFcItem = class(TPersistent)
  private
    FDestroying: Boolean;
    FFont: TFont;
    FOwner: TdxCustomFlowChart;
    FParentFont: Boolean;
    FRealFont: TFont;
    FRepainted: Boolean;
    FSelected: Boolean;
    FText: string;
    procedure OnFontChange(Sender: TObject);
    procedure SetFont(Value: TFont);
    procedure SetParentFont(Value: Boolean);
    procedure SetRealFont;
    procedure SetSelected(Value: Boolean);
  protected
    procedure Changed;
    procedure FontChanged; virtual;
    procedure Invalidate; virtual; abstract;
    procedure LoadFont(Stream: TStream);
    procedure SaveFont(Stream: TStream);
    procedure ScaleFont;
    function SelList: TList; virtual; abstract;
    procedure SetText(Value: string); virtual; abstract;
    property RealFont: TFont read FRealFont;
  public
    constructor Create(AOwner: TdxCustomFlowChart);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property Destroying: Boolean read FDestroying;
    property Font: TFont read FFont write SetFont;
    property Owner: TdxCustomFlowChart read FOwner;
    property ParentFont: Boolean read FParentFont write SetParentFont;
    property Selected: Boolean read FSelected write SetSelected;
    property Text: string read FText write SetText;
  end;
  
  TdxFcObject = class(TdxFcItem)
  private
    FBkBrush: TBrush;
    FBkColor: TColor;
    FBorder: Word;
    FConnections: TList;
    FCustomData: string;
    FData: Pointer;
    FEdge: Word;
    FExtRgn: HRgn;
    FHeight: Word;
    FHorzImagePos: TdxFcHorzPos;
    FHorzTextPos: TdxFcHorzPos;
    FImageIndex: SmallInt;
    FIntRgn: HRgn;
    FLeft: Integer;
    FLinkedObjects: TList;
    FObjects: TList;
    FPaintRgn: HRgn;
    FRealHeight: Integer;
    FRealLeft: Integer;
    FRealSW: Word;
    FRealTop: Integer;
    FRealWidth: Integer;
    FShapeBrush: TBrush;
    FShapeColor: TColor;
    FShapeStyle: TPenStyle;
    FShapeType: TdxFcShapeType;
    FShapeWidth: Byte;
    FTag: Integer;
    FTop: Integer;
    FTransparent: Boolean;
    FVertImagePos: TdxFcVertPos;
    FVertTextPos: TdxFcVertPos;
    FVisible: Boolean;
    FWidth: Word;
    procedure CalculateLinkedPoints;
    function ClientRect: TRect;
    function Create1Rgn(Offset: Integer): HRgn;
    procedure CreateRgn;
    procedure DeleteRgn;
    function DisplayRect: TRect;
    function GetConnection(Index: Integer): TdxFcConnection;
    function GetConnectionCount: Integer;
    function GetIsUnion: Boolean;
    function GetLinkedObject(Index: Integer): TdxFcObject;
    function GetLinkedObjectCount: Integer;
    function GetObject(Index: Integer): TdxFcObject; virtual;
    function GetObjectCount: Integer;
    function GetPoint(const P: array of TPoint; X, Y, Cnt: Integer): Integer;
    function GetZOrder: Word;
    function HasEdge: Boolean;
    function HasImage: Boolean;
    procedure IsRepainted(Rgn: HRgn);
    function Opaque: Boolean;
    procedure Paint;
    procedure Paint_(cvs:TCanvas);
    procedure PaintFrame;
    procedure PaintFrame_(cvs:TCanvas);
    function Quadrant(X, Y: Integer): Integer;
    procedure ResolveObjRefs;
    procedure SelPoints(var Pts: array of TPoint);
    procedure SetBkColor(Value: TColor);
    procedure SetBorder(Value: Word);
    procedure SetEdge(Value: Word);
    procedure SetHeight(Value: Word);
    procedure SetHorzImagePos(Value: TdxFcHorzPos);
    procedure SetHorzTextPos(Value: TdxFcHorzPos);
    procedure SetImageIndex(Value: SmallInt);
    procedure SetLeft(Value: Integer);
    procedure SetRealBounds;
    procedure SetRealSW;
    procedure SetShapeColor(Value: TColor);
    procedure SetShapeStyle(Value: TPenStyle);
    procedure SetShapeType(Value: TdxFcShapeType);
    procedure SetShapeWidth(Value: Byte);
    procedure SetTop(Value: Integer);
    procedure SetTransparent(Value: Boolean);
    procedure SetVertImagePos(Value: TdxFcVertPos);
    procedure SetVertTextPos(Value: TdxFcVertPos);
    procedure SetVisible(Value: Boolean);
    procedure SetWidth(Value: Word);
    procedure SetZOrder(Value: Word);
    procedure UpdateConnections;
    procedure ZoomChanged;
  protected
    LinkedPoints: array[0..15] of TPoint;
    procedure Invalidate; override;
    procedure Load(Stream: TStream); virtual;
    procedure Save(Stream: TStream); virtual;
    function SelList: TList; override;
    procedure SetText(Value: string); override;
    procedure UserLinkedPoints; virtual;
    function UserRegion(R: TRect): HRgn; virtual;
    property RealSW: Word read FRealSW;
  public
    constructor Create(AOwner: TdxCustomFlowChart);
    destructor Destroy; override;
    procedure AddToUnion(AObject: TdxFcObject);
    procedure Assign(Source: TPersistent); override;
    procedure BringToFront;
    procedure ClearUnion;
    function GetLinkedPoint(X, Y: Integer): Integer;
    function GetSelPoint(X, Y: Integer): Integer;
    function HasInUnion(AObject: TdxFcObject): Boolean;
    function InRect(const R: TRect): Boolean;
    procedure MakeVisible;
    procedure PaintImage(R: TRect);
    procedure PaintImage_(R: TRect;cvs:TCanvas);
    procedure PaintText(R: TRect);
    procedure PaintText_(R: TRect;cvs:TCanvas);
    procedure PutInFrontOf(Value: TdxFcObject);
    procedure RemoveFromUnion(AObject: TdxFcObject);
    procedure SelectUnion;
    procedure SendToBack;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
    property BkColor: TColor read FBkColor write SetBkColor;
    property BorderStyle: Word read FBorder write SetBorder;
    property ConnectionCount: Integer read GetConnectionCount;
    property Connections[Index: Integer]: TdxFcConnection read GetConnection;
    property CustomData: string read FCustomData write FCustomData;
    property Data: Pointer read FData write FData;
    property EdgeStyle: Word read FEdge write SetEdge;
    property Height: Word read FHeight write SetHeight;
    property HorzImagePos: TdxFcHorzPos read FHorzImagePos write
            SetHorzImagePos;
    property HorzTextPos: TdxFcHorzPos read FHorzTextPos write SetHorzTextPos;
    property ImageIndex: SmallInt read FImageIndex write SetImageIndex;
    property IsUnion: Boolean read GetIsUnion;
    property Left: Integer read FLeft write SetLeft;
    property LinkedObjectCount: Integer read GetLinkedObjectCount;
    property LinkedObjects[Index: Integer]: TdxFcObject read GetLinkedObject;
    property ObjectCount: Integer read GetObjectCount;
    property Objects[Index: Integer]: TdxFcObject read GetObject;
    property RealHeight: Integer read FRealHeight;
    property RealLeft: Integer read FRealLeft;
    property RealTop: Integer read FRealTop;
    property RealWidth: Integer read FRealWidth;
    property ShapeColor: TColor read FShapeColor write SetShapeColor;
    property ShapeStyle: TPenStyle read FShapeStyle write SetShapeStyle;
    property ShapeType: TdxFcShapeType read FShapeType write SetShapeType;
    property ShapeWidth: Byte read FShapeWidth write SetShapeWidth;
    property Tag: Integer read FTag write FTag;
    property Top: Integer read FTop write SetTop;
    property Transparent: Boolean read FTransparent write SetTransparent;
    property VertImagePos: TdxFcVertPos read FVertImagePos write
            SetVertImagePos;
    property VertTextPos: TdxFcVertPos read FVertTextPos write SetVertTextPos;
    property Visible: Boolean read FVisible write SetVisible;
    property Width: Word read FWidth write SetWidth;
    property ZOrder: Word read GetZOrder write SetZOrder;
  end;
  
  TdxFcConnectionArrow = class(TPersistent)
  private
    FArrowType: TdxFcaType;
    FBrush: TBrush;
    FColor: TColor;
    FHeight: Byte;
    FOwner: TdxFcConnection;
    FPoints: array[0..3] of TPoint;
    FRealHeight: Word;
    FRealWidth: Word;
    FWidth: Byte;
    function Active: Boolean;
    procedure ClearPoints;
    function DisplayRect(Ext: Boolean): TRect;
    procedure OffsetPoints(DX, DY: Integer);
    procedure Paint;
    procedure Paint_(cvs:TCanvas);
    procedure Reset;
    procedure SetArrowType(Value: TdxFcaType);
    procedure SetColor(Value: TColor);
    procedure SetHeight(Value: Byte);
    procedure SetPoints(Index: Integer);
    procedure SetRealBounds;
    procedure SetWidth(Value: Byte);
  public
    constructor Create(AOwner: TdxFcConnection);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property ArrowType: TdxFcaType read FArrowType write SetArrowType;
    property Color: TColor read FColor write SetColor;
    property Height: Byte read FHeight write SetHeight;
    property Owner: TdxFcConnection read FOwner;
    property Width: Byte read FWidth write SetWidth;
  end;
  
(*
  Point1 and Point2 properties is the linked point type.
  It may have value from 0..15.
  0   1   2   3   4
  15              5
  14              6
  13              7
  12  11  10  9   8
*)

  TdxFcConnection = class(TdxFcItem)
  private
    FArrowDest: TdxFcConnectionArrow;
    FArrowSource: TdxFcConnectionArrow;
    FDisplayRect: TRect;
    FMassCenter: TPoint;
    FObjectDest: TdxFcObject;
    FObjectSource: TdxFcObject;
    FPointDest: Byte;
    FPoints: TList;
    FPointSource: Byte;
    FRealPoints: TList;
    FStyle: TdxFclStyle;
    FTextRect: TRect;
    FTransparent: Boolean;
    procedure DelObj(AObj, Partneur: TdxFcObject; Index: Integer);
    function DisplayRect: TRect;
    function GetColor: TColor;
    function GetPenStyle: TPenStyle;
    function GetPoint(Index: Integer): TPoint;
    function GetPointCount: Integer;
    function GetRealPoint(Index: Integer): TPoint;
    function HasPoint(X, Y: Integer): Boolean;
    function IndexValid(var Index: Integer; AMax: Integer): Boolean;
    procedure InsObj(AObj, Partneur: TdxFcObject; Index: Integer);
    function InternalGetPoint(List: TList; Index: Integer): TPoint;
    procedure InternalInsertPoint(List: TList; Index: Integer; Value: TPoint);
    procedure InternalPutPoint(List: TList; Index: Integer; Value: TPoint);
    procedure InternalRemovePoint(List: TList; Index: Integer);
    procedure InvalidateText;
    procedure InvertColor;
    procedure IsRepainted;
    procedure NewPoint(X, Y: Integer; Handler: TdxFcDragHandler);
    procedure OffsetPoints(List: TList; DX, DY: Integer);
    procedure Paint(Upper: Boolean);
    procedure Paint_(Upper: Boolean;cvs:TCanvas);
    procedure PaintLine(DC: HDC);
    procedure PlaceText;
    procedure PutPoint(Index: Integer; Value: TPoint);
    function RealCount: Integer;
    function RealStyle: TdxFclStyle;
    function ScreenPoint(Index: Integer): TPoint;
    procedure SetArrowDest(Value: TdxFcConnectionArrow);
    procedure SetArrowSource(Value: TdxFcConnectionArrow);
    procedure SetColor(Value: TColor);
    procedure SetDisplayRect;
    procedure SetObjectPoints;
    procedure SetPenStyle(Value: TPenStyle);
    procedure SetStyle(Value: TdxFclStyle);
    procedure SetTextRect;
    procedure SetTransparent(Value: Boolean);
    procedure ZoomChanged;
  protected
    FPen: TPen;
    procedure ArrowChanged(Value: TdxFcConnectionArrow);
    procedure ConnectionChanged;
    procedure FontChanged; override;
    procedure Invalidate; override;
    procedure Load(Stream: TStream); virtual;
    procedure Save(Stream: TStream); virtual;
    function SelList: TList; override;
    procedure SetText(Value: string); override;
    property RealPoints[Index: Integer]: TPoint read GetRealPoint;
  public
    constructor Create(AOwner: TdxCustomFlowChart);
    destructor Destroy; override;
    procedure AddPoint(Pt: TPoint);
    procedure Assign(Source: TPersistent); override;
    function GetNearestPoint(X, Y: Integer): Integer;
    function InRect(const R: TRect): Boolean;
    procedure InsertPoint(Index: Integer; Pt: TPoint);
    procedure RemovePoint(Index: Integer);
    procedure SetObjectDest(AObject: TdxFcObject; APoint: Byte);