ddoc.pas

KSDev.BlockEngine.v3.03.rar 界面控件

unit ddoc;

{$I be_define.inc}

interface

uses Windows, Classes, Controls, Contnrs, Graphics, SysUtils, GdipObj,
  Gdipapi, GdipUtil;

const

  SnapPointHalfWidth = 2;
  GripperHalfWidth   = 6; // in pixel
  MinSize            = 0.000001;

var
  GridStep: single           = 10; // pixels

type

  Float = double;

  FloatPoint = TGPPointF;

  FloatRect = record
    Left, Top, Right, Bottom: Float;
  end;

  UnitType = (
    Inch,
    Pt,
    Pixel,
    Millimeter,
    Centimeter
  );

  BlockAlign = (
    salScale,
    salLeft,
    salRight,
    salTop,
    salBottom
  );

  Block = class;

  BlockList = class(TList)
  private
    function GetBlock(Index: integer): Block;
  public
    destructor Destroy; override;
    property Blocks[Index: integer]: Block read GetBlock; default;
  end;

  ColorType = cardinal;

  FillStyleType = (
    FillSolid,
    FillPattern,
    FillLinearGradient,
    FillPathGradient,
    FillTexture,
    FillNone
  );

  FillPatternType = (
    FillPatternHorizontal,                  // = 0,
    FillPatternVertical,                    // = 1,
    FillPatternForwardDiagonal,             // = 2,
    FillPatternBackwardDiagonal,            // = 3,
    FillPatternCross,                       // = 4,
    FillPatternDiagonalCross,               // = 5,
    FillPattern05Percent,                   // = 6,
    FillPattern10Percent,                   // = 7,
    FillPattern20Percent,                   // = 8,
    FillPattern25Percent,                   // = 9,
    FillPattern30Percent,                   // = 10,
    FillPattern40Percent,                   // = 11,
    FillPattern50Percent,                   // = 12,
    FillPattern60Percent,                   // = 13,
    FillPattern70Percent,                   // = 14,
    FillPattern75Percent,                   // = 15,
    FillPattern80Percent,                   // = 16,
    FillPattern90Percent,                   // = 17,
    FillPatternLightDownwardDiagonal,       // = 18,
    FillPatternLightUpwardDiagonal,         // = 19,
    FillPatternDarkDownwardDiagonal,        // = 20,
    FillPatternDarkUpwardDiagonal,          // = 21,
    FillPatternWideDownwardDiagonal,        // = 22,
    FillPatternWideUpwardDiagonal,          // = 23,
    FillPatternLightVertical,               // = 24,
    FillPatternLightHorizontal,             // = 25,
    FillPatternNarrowVertical,              // = 26,
    FillPatternNarrowHorizontal,            // = 27,
    FillPatternDarkVertical,                // = 28,
    FillPatternDarkHorizontal,              // = 29,
    FillPatternDashedDownwardDiagonal,      // = 30,
    FillPatternDashedUpwardDiagonal,        // = 31,
    FillPatternDashedHorizontal,            // = 32,
    FillPatternDashedVertical,              // = 33,
    FillPatternSmallConfetti,               // = 34,
    FillPatternLargeConfetti,               // = 35,
    FillPatternZigZag,                      // = 36,
    FillPatternWave,                        // = 37,
    FillPatternDiagonalBrick,               // = 38,
    FillPatternHorizontalBrick,             // = 39,
    FillPatternWeave,                       // = 40,
    FillPatternPlaid,                       // = 41,
    FillPatternDivot,                       // = 42,
    FillPatternDottedGrid,                  // = 43,
    FillPatternDottedDiamond,               // = 44,
    FillPatternShingle,                     // = 45,
    FillPatternTrellis,                     // = 46,
    FillPatternSphere,                      // = 47,
    FillPatternSmallGrid,                   // = 48,
    FillPatternSmallCheckerBoard,           // = 49,
    FillPatternLargeCheckerBoard,           // = 50,
    FillPatternOutlinedDiamond,             // = 51,
    FillPatternSolidDiamond                // = 52,
  );

  FillStyle = class(TPersistent)
  private
    FColor: ColorType;
    FPattern: FillPatternType;
    FStyle: FillStyleType;
    FPatternColor: ColorType;
    FGradientColor: ColorType;
    FGradientAngle: Float;
    FTexture: TBitmap;
    procedure SetTexture(const Value: TBitmap);
  public
    constructor Create;
    destructor Destroy; override;
    function GetBrush(Left, Top, Right, Bottom: Float): TGPBrush;
    procedure Assign(Source: TPersistent); override;
  published
    property Color: ColorType read FColor write FColor;
    property Style: FillStyleType read FStyle write FStyle;
    property Pattern: FillPatternType read FPattern write FPattern;
    property PatternColor: ColorType read FPatternColor write FPatternColor;
    property GradientColor: ColorType read FGradientColor write FGradientColor;
    property GradientAngle: Float read FGradientAngle write FGradientAngle;
    property Texture: TBitmap read FTexture write SetTexture;
  end;

  LinePatternType = (
    LinePaternSolid,
    LinePaternDash,
    LinePaternDot,
    LinePaternDashDot,
    LinePaternDashDotDot
  );

  LineCapType = (
    CapFlat,
    CapRound,
    CapSquare,
    CapTriangle
  );

  StrokeStyle = class(TPersistent)
  private
    FColor: ColorType;
    FWidth: Float;
    FPattern: LinePatternType;
    FCap: LineCapType;
    FClear: boolean;
  public
    constructor Create;
    destructor Destroy; override;
    function GetPen: TGPPen;
    procedure Assign(Source: TPersistent); override;
  published
    property Clear: boolean read FClear write FClear;
    property Cap: LineCapType read FCap write FCap;
    property Color: ColorType read FColor write FColor;
    property Pattern: LinePatternType read FPattern write FPattern;
    property Width: Float read FWidth write FWidth;
  end;

  PointKind = (
    pkLeft,
    pkRight,
    pkTop,
    pkBottom,
    pkLeftTop,
    pkRightTop,
    pkLeftBottom,
    pkRightBottom,
    pkRotateLeftTop,
    pkRotateRightTop,
    pkRotateRightBottom,
    pkRotateLeftBottom,
    pkRotate,
    pkLeftRotate,
    pkTopRotate,
    pkRightRotate,
    pkBottomRotate,
    pkRotateCenter,
    pkFreePoint,
    pkSnapPoint,
    pkBlockSnapPoint,
    pkBlockPoint
  );

  PointStyle = (
    psConnect
  );

  PointStyles = set of PointStyle;

  PointAlign = (
    paScale,
    paLeft,
    paTop,
    paRight,
    paBottom,
    paLeftTop,
    paLeftBottom,
    paRightTop,
    paRightBottom,
    paNone
  );

  MoveStyle = (
    msFree,
    msVertical,
    msHorizontal,
    msEllipse
  );

  BlockPoint = class(TCollectionItem)
  private
    FX: Float;
    FY: Float;
    FKind: PointKind;
    FStyle: PointStyles;
    FMoveStyle: MoveStyle;
    FCenterPoint: BlockPoint;
    FEnabled: boolean;
    FAlign: PointAlign;
    FSnapHighlight: boolean;
    FDockBlock: Block;
    FConnectedPoints: TList;
    FConnectedPointsStr: string;
    FPointMovePos: FloatPoint;
    FName: string;
    FCenterPointName: string;
    FDisableAlign: boolean;
    FHot: boolean;
    FScreenUpdate: boolean;
    function GetOwnerBlock: Block;
    procedure SetConnectedPointsList(const Value: string);
    function GetConnectedPointsList: string;
    procedure SetCenterPointName(const Value: string);
    function GetCenterPointName: string;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure CopyFrom(Source: BlockPoint);
    property SnapHighlight: boolean read FSnapHighlight write FSnapHighlight;
    property ConnectedPoints: TList read FConnectedPoints write FConnectedPoints;
    property Owner: Block read GetOwnerBlock;
    property CenterPoint: BlockPoint read FCenterPoint write FCenterPoint;
    property DisableAlign: boolean read FDisableAlign write FDisableAlign;
    property Hot: boolean read FHot write FHot;
    property ScreenUpdate: boolean read FScreenUpdate write FScreenUpdate;
  published
    property X: Float read FX write FX;
    property Y: Float read FY write FY;
    property Name: string read FName write FName;
    property Align: PointAlign read FAlign write FAlign;
    property Kind: PointKind read FKind write FKind;
    property Style: PointStyles read FStyle write FStyle;
    property MoveStyle: MoveStyle read FMoveStyle write FMoveStyle;
    property Enabled: boolean read FEnabled write FEnabled;
    property CenterPointName: string read GetCenterPointName write FCenterPointName;
    property ConnectedPointsList: string read GetConnectedPointsList write FConnectedPointsStr;
  end;

  BlockPoints = class(TCollection)
  private
    FBlock: Block;
    function GetPoint(Index: integer): BlockPoint;
  public
    property Points[Index: integer]: BlockPoint read GetPoint; default;
  end;

  { Desgin mode }

  DesignState = (
    dsFocused,
    dsSelected,
    dsCaptureMouse,
    dsLeftButtonDown,
    dsRightButtonDown,
    dsDesignMode,
    dsCanResize,
    dsCanRotate,
    dsCanEditSegment,
    dsUndoStream
  );

  DesignStates = set of DesignState;

  DesignEvent = (
    deRepaint,
    deRepaintRect,
    deUpdateLink,
    deRemoved,
    deRemoveFocus,
    deFocusToSelected,
    deSetCursor,
    deDragConnect,
    deDropConnect,
    deRemoveConnect,
    deGetFocused,
    deGetGraphics,
    deGetRoot,
    deSelectBlockByRect,
    deDrawSelected,
    deMoveSelected,
    deFindBlockByName,
    deCorrectAllConection,
    deAddSelectedToList,
    deEditText,
    deEditImage,
    deChangeFocus,
    deNewBlockAdded,
    deNewBlockInsert,
    deGetPointRect,
    deDrawPoint,
    deRedrawPoint,
    deUndoSaveState,
    deUndo
  );

  TEditMode = (
    emResize,
    emRotate,
    emSegment,
    emResizeAndRotate
  );

  TNotificationResult = array of Double;

  Root = class;
  TextBlock = class;
  Line = class;

  Block = class(TComponent)
  private
    FParent: Block;
    FBlockAlign: BlockAlign;
    FBlocks: BlockList;
    FBlockName: WideString;
    FFill: FillStyle;
    FStroke: StrokeStyle;
    FPoints: BlockPoints;
    FDesignState: DesignStates;
    FLeft, FTop, FWidth, FHeight, FAngle: Float;
    FRotateCenter: FloatPoint;
    { }
    FDownPoint: BlockPoint;
    FMovePos: FloatPoint;
    FSnapToGrid: boolean;
    FGrouped: boolean;
    FLocked: boolean;
    FShowSnapPoint: boolean;
    FEditMode: TEditMode;
    FData: Cardinal;
    function GetBounds: FloatRect; virtual;
    function GetOnlyBounds: FloatRect; virtual;
    procedure SetHeight(const Value: Float);
    procedure SetWidth(const Value: Float);
    procedure SetAngle(const Value: Float);
    procedure SetEditMode(const Value: TEditMode);
    function GetFocused: Block;
    function GetRoot: Root;
    procedure SetDesignState(const Value: DesignStates);
    procedure SetShowSnapPoint(const Value: boolean);
    procedure SetSnapToGrid(const Value: boolean);
    function GetTextBlock: TextBlock;
    function GetText: WideString;
    procedure SetText(const Value: WideString);
    function GetExtBounds: FloatRect;
    procedure SetExtBounds(const Value: FloatRect);
    procedure SetLeft(const Value: Float);
    procedure SetTop(const Value: Float);
  protected
    procedure Loaded; override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure SetParentComponent(Value: TComponent); override;
    procedure SetName(const NewName: TComponentName); override;
    procedure UpdateConnection(UpdateDock: boolean = false);
    procedure RepaintRect(R: FloatRect);
    procedure SetCursor(Cursor: TCursor);
    function CapturedBlock: Block;
    function GetGraphics: TGPGraphics;
    procedure DrawDesign(G: TGPGraphics); virtual;
    procedure DrawBlock(G: TGPGraphics); virtual;
    { convertion }
    function ToBlockCoordFromParent(X, Y: Float): FloatPoint;
    function FromBlockCoordToParent(X, Y: Float): FloatPoint;
    function PixelatePoint(X, Y: Float): FloatPoint;
    function PixelateValue(Value: Float): Float;
    function SnapToGridValue(Value: Float): Float;
    function PtOnBlock(X, Y: Float): boolean; virtual;
    { points }
    function PointByPoint(X, Y: Float): BlockPoint;
    function PointByName(AName: string): BlockPoint;
    function PointXByName(AName: string): Float;
    function PointYByName(AName: string): Float;
    function EditPointByPoint(X, Y: Float): BlockPoint;
    function PointByKind(Kind: PointKind): BlockPoint;
    procedure MovePoint(APoint: BlockPoint; X, Y: Float); virtual;
    { events }
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Float); virtual;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Float); virtual;
    procedure MouseMove(Shift: TShiftState; X, Y: Float); virtual;
    procedure UpdateBounds;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight, AAngle: Float; NeedRedraw: boolean);
    property IntBounds: FloatRect read GetBounds;
  public
    constructor Create(AOwner: TComponent); override;
    constructor CreateNew(AOwner: TComponent;
      CreateTextBlock: boolean; CreatePoints: boolean); virtual;
    destructor Destroy; override;
    { VCL }
    function GetParentComponent: TComponent; override;
    function HasParent: Boolean; override;
    { childs }
    procedure AddDesignStateToAll(const Value: DesignStates);
    procedure RemoveDesignStateToAll(const Value: DesignStates);
    procedure SetGraphics(G: TGPGraphics);
    procedure AddBlock(ABlock: Block); virtual;
    procedure RemoveBlock(ABlock: Block);
    function BlockByPoint(X, Y: Float): Block;
    procedure Aligning(ANewWidth, ANewHeight: Float);
    procedure CopyFrom(Source: Block); virtual;
    { manipulation }
    function ToBlockCoord(X, Y: Float): FloatPoint;
    function FromBlockCoord(X, Y: Float): FloatPoint;
    procedure BringToFront;
    procedure SendToBack;
    procedure FlipHorz;
    procedure FlipVert;
    function Connect(ABlock: Block): Line;
    function BlockByName(AName: WideString): Block;
    { group }
    function GroupSelected: Block;
    function CanUngroup: boolean;
    procedure Ungroup;
    procedure SaveUndoState;
    { drawing }
    procedure Draw(G: TGPGraphics); virtual;
    { units }
    procedure ChangeUnit(SrcUnit, DstUnit: UnitType); virtual;
    { props }
    property Blocks: BlockList read FBlocks;
    property Parent: Block read FParent;
    property Bounds: FloatRect read GetExtBounds write SetExtBounds;
    property Focused: Block read GetFocused;
    { visual }
    procedure Repaint;
    { events }
    function PerformNotification(Event: DesignEvent; Sender: Block; Data: array of Float): TNotificationResult; virtual;
    function HandleNotification(Event: DesignEvent; Sender: Block; Data: array of Float): TNotificationResult; virtual;
    { props }