dcmain.pas.svn-base

来自「TFormDesigner allows you move and resize」· SVN-BASE 代码 · 共 2,066 行 · 第 1/5 页

(*  GREATIS FORM DESIGNER COMPONENT PRO  *)
(*  unit version 0.00.085                *)
(*  Copyright (C) 2003 Greatis Software  *)
(*  http://www.greatis.com/formdes.htm   *)
(*  [e-mail]                   *)

unit DCMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus,
  Clipbrd, StdCtrls;

type

  TGrabType = (gtNormal,gtLocked,gtMulti);

  TGrabPosition = (
    gpNone,
    gpLeftTop,
    gpLeftMiddle,
    gpLeftBottom,
    gpMiddleTop,
    gpMiddleBottom,
    gpRightTop,
    gpRightMiddle,
    gpRightBottom);

  TCustomDesignerComponent = class;

  TGrabHandle = class(TCustomControl)
  private
    FPosition: TGrabPosition;
    FRect: TRect;
    FLocked: Boolean;
    procedure SetPosition(const Value: TGrabPosition);
    procedure SetRect(const Value: TRect);
    procedure SetLocked(const Value: Boolean);
    procedure UpdateCoords;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    property Position: TGrabPosition read FPosition write SetPosition;
    property Rect: TRect read FRect write SetRect;
    property Locked: Boolean read FLocked write SetLocked;
  end;

  TGrabHandles = class(TComponent)
  private
    FItems: array[TGrabPosition] of TGrabHandle;
    FControl: TControl;
    FVisible: Boolean;
    procedure SetControl(const Value: TControl);
    procedure SetVisible(const Value: Boolean);
    function GetDesigner: TCustomDesignerComponent;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Update;
    procedure UpdateCoords;
    procedure BringToFront;
    function FindHandle(AComponent: TComponent): TGrabPosition;
    function IsGrabHandle(AComponent: TComponent): Boolean;
    property Control: TControl read FControl write SetControl;
    property Visible: Boolean read FVisible write SetVisible;
    property Designer: TCustomDesignerComponent read GetDesigner;
  end;

  {$IFDEF VER100}
  {$DEFINE DESIGNERASCLASS}
  {$ENDIF}
  {$IFDEF VER110}
  {$DEFINE DESIGNERASCLASS}
  {$ENDIF}
  {$IFDEF VER150}
  {$DEFINE DESIGNERHOOK}
  {$ENDIF}

  {$IFNDEF VER150}
  {$DEFINE NOCSSUBCOMPONENT}
  {$ENDIF}

  {$IFDEF VER100}
  {$DEFINE NOFRAMES}
  {$ENDIF}
  {$IFDEF VER110}
  {$DEFINE NOFRAMES}
  {$ENDIF}
  {$IFDEF VER120}
  {$DEFINE NOFRAMES}
  {$DEFINE NODESIGNERHOOK}
  {$ENDIF}
  {$IFDEF VER125}
  {$DEFINE NOFRAMES}
  {$DEFINE NODESIGNERHOOK}
  {$ENDIF}
  {$IFDEF VER130}
  {$DEFINE NODESIGNERHOOK}
  {$ENDIF}

  {$IFDEF DESIGNERASCLASS}
  TDesignerInterface = class(TDesigner)
  {$ELSE}
  {$IFDEF NODESIGNERHOOK}
  TDesignerInterface = class(TInterfacedObject,IDesigner)
  {$ELSE}
  TDesignerInterface = class(TInterfacedObject,IDesignerHook)
  {$ENDIF}
  {$ENDIF}
  private
    { Private declarations }
    FDesignerComponent: TCustomDesignerComponent;
    {$IFNDEF DESIGNERASCLASS}
    function GetCustomForm: TCustomForm;
    procedure SetCustomForm(Value: TCustomForm);
    function GetIsControl: Boolean;
    procedure SetIsControl(Value: Boolean);
    {$ENDIF}
    function IsDesignMsg(Sender: TControl; var Message: TMessage): Boolean; {$IFDEF DESIGNERASCLASS} override; {$ENDIF}
    procedure PaintGrid; {$IFDEF DESIGNERASCLASS} override; {$ENDIF}
    procedure ValidateRename(AComponent: TComponent; const CurName, NewName: string); {$IFDEF DESIGNERASCLASS} override; {$ENDIF}
    {$IFDEF DESIGNERASCLASS}
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    {$ELSE}
    procedure Notification(AnObject: TPersistent; Operation: TOperation);
    {$ENDIF}
    procedure Modified; {$IFDEF DESIGNERASCLASS} override; {$ENDIF}
    {$IFNDEF DESIGNERASCLASS}
    function UniqueName(const BaseName: string): string;
    function GetRoot: TComponent;
    property Form: TCustomForm read GetCustomForm write SetCustomForm;
    {$ENDIF}
  public
    { Public declarations }
    constructor Create(ADesignerComponent: TCustomDesignerComponent);
  end;

  TMouseAction = (maNone,maDragging,maSelecting);
  THintMode = (hmMove,hmSize);
  TComponentAttribute = (caInvalid,caEditable,caLocked,caTransparent,caProtected,caDefaultCursor,caDefaultMenu);
  TComponentAttributes = set of TComponentAttribute;
  TDFMFormat = (dfmBinary,dfmText);
  TAlignMode = (amNoChange,amLeftTop,amCenters,amRightBottom,amSpace,amWindowCenter);
  TSizeMode = (smNoChange,smToSmallest,smToLargest,smValue);
  TAlignmentPaletteOption = (apAutoShow,apStayOnTop,apShowHints,apFlatButtons);
  TAlignmentPaletteOptions = set of TAlignmentPaletteOption;

  TMessageEvent = procedure(Sender: TObject; AControl: TControl; var Message: TMessage; var Processed: Boolean) of object;
  TComponentAttributesEvent = procedure(Sender: TObject; AComponent: TComponent; var Attributes: TComponentAttributes) of object;
  TComponentEvent = procedure(Sender: TObject; AComponent: TComponent) of object;
  TComponentAllowEvent = procedure(Sender: TObject; AComponent: TComponent; var Allow: Boolean) of object;
  TChangeNameEvent = procedure(Sender: TObject; AComponent: TComponent; var AName: string) of object;
  TChangeOwnerEvent = procedure(Sender: TObject; AComponent,OldOwner: TComponent; var AOwner: TComponent) of object;
  TAlignmentPaletteEvent = procedure(Sender: TObject; Form: TForm) of object;

  TComponentContainer = class(TCustomControl)
  private
    FComponent: TComponent;
    FBitmap: TBitmap;
  protected
    procedure Paint; override;
    procedure WndProc(var Msg: TMessage); override;
  public
    constructor CreateWithComponent(AOwner,AComponent: TComponent);
    destructor Destroy; override;
    property Component: TComponent read FComponent write FComponent;
  end;

  TCustomDesignerComponent = class(TComponent)
  private
    { Private declarations }
    FDesignTime: Boolean;
    FInternalDestroy: Boolean;
    FAPForm: TForm;
    FHintWindow: THintWindow;
    FActiveHandle: TGrabPosition;
    FMouseAction: TMouseAction;
    FDragRect: TRect;
    FDragPoint: TPoint;
    FSelectRect: TRect;
    FSelected: TList;
    FSelect: TWinControl;
    FActive: Boolean;
    FShowNonVisual: Boolean;
    FShowMoveSizeHint: Boolean;
    FAlignmentPalette: TAlignmentPaletteOptions;
    FGridStep: Integer;
    FSnapToGrid: Boolean;
    FDisplayGrid: Boolean;
    FGridColor: TColor;
    FDesignerColor: TColor;
    FGrabSize: Integer;
    FGrabHandles: TGrabHandles;
    FNormalGrabBorder: TColor;
    FNormalGrabFill: TColor;
    FLockedGrabBorder: TColor;
    FLockedGrabFill: TColor;
    FMultiGrabBorder: TColor;
    FMultiGrabFill: TColor;
    FPopupMenu: TPopupMenu;
    FOnBeforeMessage: TMessageEvent;
    FOnAfterMessage: TMessageEvent;
    FOnComponentAttributes: TComponentAttributesEvent;
    FOnDblClick: TComponentEvent;
    FOnBeforeSelect: TComponentAllowEvent;
    FOnAfterSelect: TComponentEvent;
    FOnBeforeDeselect: TComponentAllowEvent;
    FOnAfterDeselect: TComponentEvent;
    FOnBeforeDrag: TComponentAllowEvent;
    FOnAfterDrag: TComponentEvent;
    FOnChangeName: TChangeNameEvent;
    FOnChangeOwner: TChangeOwnerEvent;
    FOnShowAlignmentPalette: TAlignmentPaletteEvent;
    FOnHideAlignmentPalette: TAlignmentPaletteEvent;
    function GetControl: TControl;
    procedure SetControl(const Value: TControl);
    function GetSelectedControlCount: Integer;
    function GetSelectedControl(Index: Integer): TControl;
    function GetComponent: TComponent;
    procedure SetComponent(const Value: TComponent);
    function GetSelectedCount: Integer;
    function GetSelected(Index: Integer): TComponent;
    function GetParentForm: TCustomForm;
    procedure SetActive(const Value: Boolean);
    procedure SetShowNonVisual(const Value: Boolean);
    procedure SetAlignmentPalette(Value: TAlignmentPaletteOptions);
    procedure SetDisplayGrid(const Value: Boolean);
    procedure SetGridStep(const Value: Integer);
    procedure SetGridColor(const Value: TColor);
    procedure SetDesignerColor(const Value: TColor);
    procedure SetGrabSize(const Value: Integer);
    procedure SetNormalGrabBorder(const Value: TColor);
    procedure SetNormalGrabFill(const Value: TColor);
    procedure SetLockedGrabBorder(const Value: TColor);
    procedure SetLockedGrabFill(const Value: TColor);
    procedure SetMultiGrabBorder(const Value: TColor);
    procedure SetMultiGrabFill(const Value: TColor);
    function FindHandle(AComponent: TComponent): TGrabPosition;
    function IsGrabHandle(AComponent: TComponent): Boolean;
    procedure HideGrabs;
    procedure ShowGrabs;
    procedure ShowHint(AHint: string; Mode: THintMode);
    procedure HideHint;
    procedure DrawDragRects;
    procedure DrawSelectRect;
    procedure DrawMultiSelect(AControl: TControl);
    procedure RemoveMultiSelect(AControl: TControl);
    procedure CheckParent(MainControl: TControl);
    procedure ProcessProtected(ARoot: TComponent);
    function IsPressed(Key: Word): Boolean;
    procedure CreateContainers;
    procedure DestroyContainers;
    function SelectControl(AControl: TControl): Boolean;
    function DeselectControl(AControl: TControl): Boolean;
    procedure DeselectAllControls;
    function IsSelectedControl(AControl: TControl): Boolean;
    function IsSelectableControl(AControl: TControl): Boolean;
    function ComponentToControl(AComponent: TComponent): TControl;
    function ControlToComponent(AComponent: TComponent): TComponent;
    procedure ClearForm;
    property Control: TControl read GetControl write SetControl;
    property SelectedControlCount: Integer read GetSelectedControlCount;
    property SelectedControls[Index: Integer]: TControl read GetSelectedControl;
  protected
    procedure PaintGrid(Canvas: TCanvas; R: TRect); virtual;
    procedure PaintGrab(Canvas: TCanvas; R: TRect; GrabType: TGrabType; GrabPosition: TGrabPosition); virtual;
    function MessageProcessor(Sender: TControl; var Message: TMessage): Boolean; virtual;
    procedure NotificationProcessor(AComponent: TComponent; Operation: TOperation); virtual;
    function NameProcessor(AComponent,AOwner: TComponent; AName: string): string;
    function ComponentAttributes(AComponent: TComponent): TComponentAttributes; virtual;
    procedure DoDblClick(AControl: TControl); virtual;
    procedure DoBeforeSelect(AControl: TControl; var Allow: Boolean); virtual;
    procedure DoAfterSelect(AControl: TControl); virtual;
    procedure DoBeforeDeselect(AControl: TControl; var Allow: Boolean); virtual;
    procedure DoAfterDeselect(AControl: TControl); virtual;
    procedure DoBeforeDrag(AControl: TControl; var Allow: Boolean); virtual;
    procedure DoAfterDrag(AControl: TControl); virtual;
    procedure DoChangeName(AComponent: TComponent; var AName: string); virtual;
    procedure DoChangeOwner(AComponent,OldOwner: TComponent; var AOwner: TComponent); virtual;
    procedure DoShowAlignmentPalette(Form: TForm); virtual;
    procedure DoHideAlignmentPalette(Form: TForm); virtual;
    property ShowNonVisual: Boolean read FShowNonVisual write SetShowNonVisual default True;
    property ShowMoveSizeHint: Boolean read FShowMoveSizeHint write FShowMoveSizeHint default True;
    property GridStep: Integer read FGridStep write SetGridStep default 8;
    property SnapToGrid: Boolean read FSnapToGrid write FSnapToGrid default True;
    property DisplayGrid: Boolean read FDisplayGrid write SetDisplayGrid default True;
    property GridColor: TColor read FGridColor write SetGridColor default clBlack;
    property DesignerColor: TColor read FDesignerColor write SetDesignerColor default clBtnFace;
    property GrabSize: Integer read FGrabSize write SetGrabSize default 5;
    property NormalGrabBorder: TColor read FNormalGrabBorder write SetNormalGrabBorder default clBlack;
    property NormalGrabFill: TColor read FNormalGrabFill write SetNormalGrabFill default clBlack;
    property LockedGrabBorder: TColor read FLockedGrabBorder write SetLockedGrabBorder default clBlack;
    property LockedGrabFill: TColor read FLockedGrabFill write SetLockedGrabFill default clGray;
    property MultiGrabBorder: TColor read FMultiGrabBorder write SetMultiGrabBorder default clGray;
    property MultiGrabFill: TColor read FMultiGrabFill write SetMultiGrabFill default clGray;
    property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
    property OnBeforeMessage: TMessageEvent read FOnBeforeMessage write FOnBeforeMessage;
    property OnAfterMessage: TMessageEvent read FOnAfterMessage write FOnAfterMessage;
    property OnDblClick: TComponentEvent read FOnDblClick write FOnDblClick;
    property OnComponentAttributes: TComponentAttributesEvent read FOnComponentAttributes write FOnComponentAttributes;
    property OnBeforeSelect: TComponentAllowEvent read FOnBeforeSelect write FOnBeforeSelect;
    property OnAfterSelect: TComponentEvent read FOnAfterSelect write FOnAfterSelect;
    property OnBeforeDeselect: TComponentAllowEvent read FOnBeforeDeselect write FOnBeforeDeselect;
    property OnAfterDeselect: TComponentEvent read FOnAfterDeselect write FOnAfterDeselect;
    property OnBeforeDrag: TComponentAllowEvent read FOnBeforeDrag write FOnBeforeDrag;
    property OnAfterDrag: TComponentEvent read FOnAfterDrag write FOnAfterDrag;
    property OnChangeName: TChangeNameEvent read FOnChangeName write FOnChangeName;
    property OnChangeOwner: TChangeOwnerEvent read FOnChangeOwner write FOnChangeOwner;
    property OnShowAlignmentPalette: TAlignmentPaletteEvent read FOnShowAlignmentPalette write FOnShowAlignmentPalette;
    property OnHideAlignmentPalette: TAlignmentPaletteEvent read FOnHideAlignmentPalette write FOnHideAlignmentPalette;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Update; virtual;
    procedure LeaveMouseAction;
    function FindComponentContainer(AComponent: TComponent): TComponentContainer;
    function Select(AComponent: TComponent): Boolean;
    function Deselect(AComponent: TComponent): Boolean;
    procedure DeselectAll;
    function IsSelected(AComponent: TComponent): Boolean;
    function IsSelectable(AComponent: TComponent): Boolean;
    procedure CopyToClipboard;
    procedure CutToClipboard;
    procedure PasteFromClipboard;
    procedure Delete;
    procedure SaveToDFM(FileName: string; DFMFormat: TDFMFormat);
    procedure LoadFromDFM(FileName: string; DFMFormat: TDFMFormat);
    procedure SaveToStream(Stream: TStream; DFMFormat: TDFMFormat);
    procedure LoadFromStream(Stream: TStream; DFMFormat: TDFMFormat);
    procedure AlignToGrid;
    procedure AlignControls(Hor,Ver: TAlignMode);
    procedure SizeControls(WMode: TSizeMode; WValue: Integer; HMode: TSizeMode; HValue: Integer);
    procedure AlignDialog;
    procedure SizeDialog;
    procedure ShowAlignmentPalette;
    procedure HideAlignmentPalette;
    procedure TabOrderDialog;
    procedure CreationOrderDialog;
    property Active: Boolean read FActive write SetActive default False;
    property AlignmentPalette: TAlignmentPaletteOptions read FAlignmentPalette write SetAlignmentPalette;
    property ParentForm: TCustomForm read GetParentForm;
    property Component: TComponent read GetComponent write SetComponent;
    property SelectedCount: Integer read GetSelectedCount;
    property Selected[Index: Integer]: TComponent read GetSelected;
  end;

  TDesignerComponent = class(TCustomDesignerComponent)
  published
    { Published declarations }
    property AlignmentPalette;
    property ShowNonVisual;
    property ShowMoveSizeHint;
    property GridStep;
    property SnapToGrid;
    property DisplayGrid;
    property GridColor;
    property DesignerColor;
    property GrabSize;
    property NormalGrabBorder;
    property NormalGrabFill;
    property LockedGrabBorder;
    property LockedGrabFill;
    property MultiGrabBorder;
    property MultiGrabFill;
    property PopupMenu;
    property OnBeforeMessage;
    property OnAfterMessage;
    property OnDblClick;
    property OnComponentAttributes;
    property OnBeforeSelect;
    property OnAfterSelect;
    property OnBeforeDeselect;
    property OnAfterDeselect;
    property OnBeforeDrag;
    property OnAfterDrag;
    property OnChangeName;
    property OnChangeOwner;
    property OnShowAlignmentPalette;
    property OnHideAlignmentPalette;
  end;

implementation

uses DCAlign, DCSize, DCAlPal, DCTab, DCCreate;

const
  WM_DRAWMULTISELECT = WM_USER+WM_PAINT;

function GetGrabCursor(GP: TGrabPosition): TCursor;
begin
  case GP of
    gpLeftTop,gpRightBottom: Result:=crSizeNWSE;
    gpLeftMiddle,gpRightMiddle: Result:=crSizeWE;
    gpLeftBottom,gpRightTop: Result:=crSizeNESW;
    gpMiddleTop,gpMiddleBottom: Result:=crSizeNS;
  else Result:=crArrow;
  end;
end;

{ TDesignerReader }

type
  TDesignerReader = class(TReader)
  protected
    function Error(const Message: string): Boolean; override;
  end;

function TDesignerReader.Error(const Message: string): Boolean;
begin
  Result:=True;
end;