createdesigner.pas

类似Delphi Ide的对象查看器 可以在RUNTIME时使用

unit CreateDesigner;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, IniFiles, AXCtrls, Clipbrd, ExtCtrls, CommCtrl, ComCtrls, StdCtrls,
  MyPanel, MyRadGrp, MyButton, MyLstBox;

type

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

  TGrabPositions = set of TGrabPosition;

  TCustomFormDesigner = class;

  // container component for non-visual components
  TComponentContainer = class(TCustomControl)
  private
    FDesigner: TCustomFormDesigner;
    FComponent: TComponent;
    FBitmap: TBitmap;
    FCaption: TStaticText;
  protected
    procedure Paint; override;
    procedure WndProc(var Msg: TMessage); override;
  public
    constructor CreateWithComponent(AOwner,AComponent: TComponent; ADesigner: TCustomFormDesigner);
    destructor Destroy; override;
    procedure UpdateContainer;
    property Component: TComponent read FComponent write FComponent;
  end;

  // special reader class
  TFDReader = class(TReader)
  private
    Designer: TCustomFormDesigner;
  protected
    function Error(const Message: string): Boolean; override;
    procedure SetName(Component: TComponent; var Name: string); override;
  public
    constructor Create(AStream: TStream; ADesigner: TCustomFormDesigner);
  end;

  // resize handle
  TGrabHandle = class(TCustomControl)
  private
    FPosition: TGrabPosition;
    FRect: TRect;
    FLocked: Boolean;
    procedure SetPosition(Value: TGrabPosition);
    procedure SetRect(Value: TRect);
    procedure SetLocked(Value: Boolean);
    procedure UpdateCoords;
    procedure SetArrowCursor;
  protected
    procedure Paint; override;
    procedure WndProc(var Msg: TMessage); 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;

  // resize handles group
  TGrabHandles = class(TComponent)
  private
    FItems: array[TGrabPosition] of TGrabHandle;
    FControl: TControl;
    FVisible: Boolean;
    FEnabled: Boolean;
    procedure SetControl(Value: TControl);
    procedure SetVisible(Value: Boolean);
    procedure SetEnabled(Value: Boolean);
    function GetParentForm: TCustomForm;
    function GetDesigner: TCustomFormDesigner;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Update(MustHide: Boolean);
    procedure BringToFront;
    function FindHandle(AHandle: HWND): TGrabPosition;
    function FindHandleControl(AHandle: HWND): TGrabHandle;
    function IsGrabHandle(AControl: TControl): Boolean;
    property Control: TControl read FControl write SetControl;
    property Visible: Boolean read FVisible write SetVisible;
    property Enabled: Boolean read FEnabled write SetEnabled;
    property ParentForm: TCustomForm read GetParentForm;
    property Designer: TCustomFormDesigner read GetDesigner;
  end;

  // type for controls list editor
  TListType = (ltLocked,ltProtected,ltTransparent);

  // mode type for LockedControls and ProtectedControls
  TChildrenMode = (cmNone,cmNormal,cmRecurse);

  // type for protect mode
  TProtectMode = (pmUnselect,pmLockKeyboard);

  // message processing type
  TMessageProcessor = (mpEvent,mpHook);

  // internal type for mouse action
  TMouseAction = (maNone,maDragging,maSelecting);

  // internal type for hint window offset
  THintMode = (hmCustom,hmMove,hmSize);

  // grab type for DrawGrab procedure
  TGrabType = (gtNormal,gtMulti,gtLocked);

  // align mode for AlignControls procedure
  TAlignMode = (amNoChange,amLeftTop,amCenters,amRightBottom,amSpace,amWindowCenter,amOneLine);

  // size mode for SizeControls procedure
  TSizeMode = (smNoChange,smToSmallest,smToLargest,smValue);

  // alignment palette modes
  TAlignmentPaletteOption = (apAutoShow,apStayOnTop,apShowHints,apFlatButtons);
  TAlignmentPaletteOptions = set of TAlignmentPaletteOption;

  // DFM formats
  TDFMFormat = (dfmBinary,dfmText);

  // TCustomFormDesigner event types
  TControlNotifyEvent = procedure(Sender: TObject; TheControl: TControl) of object;
  TLoadSaveEvent = procedure(Sender: TObject; TheControl: TControl; IniFile: TIniFile) of object;
  TDesignerMessageEvent = procedure(Sender: TObject; var Msg: TMsg) of object;
  TMoveLimitEvent = procedure(Sender: TObject; TheControl: TControl; var LimitRect: TRect) of object;
  TSizeLimitEvent = procedure(Sender: TObject; TheControl: TControl; var MinSize,MaxSize: TPoint) of object;
  TCustomizeGrabsEvent = procedure(Sender: TObject; var VisibleGrabs,EnabledGrabs: TGrabPositions) of object;
  TComponentTextEvent = procedure(Sender: TObject; TheComponent: TComponent; var Text: string) of object;
  TComponentBitmapEvent = procedure(Sender: TObject; TheComponent: TComponent; const Bitmap: TBitmap) of object;
  TComponentEditableEvent = procedure(Sender: TObject; TheComponent: TComponent; var Editable: Boolean) of object;
  TComponentClipboardEvent = procedure(Sender: TObject; TheComponent: TComponent) of object;
  TComponentPopupEvent = procedure(Sender: TObject; var Handled: Boolean) of object;

  // main class
  TCustomFormDesigner = class(TComponent)
  private
    { Private declarations }
    FDefaultProc: TFarProc;
    FWinProc: Pointer;
    FBkgBitmap: TBitmap;
    FForm: TCustomForm;
    FAPForm: TForm;
    FInspForm: TForm;
    FHintControl: TControl;
    FHintTimer: TTimer;
    FKeySelect: Boolean;
    FKeyMove: Boolean;
    FClearBeforeLoad: Boolean;
    FMustClear: Boolean;
    FGrabSize: Integer;
    FNormalGrabBorder: TColor;
    FNormalGrabFill: TColor;
    FMultiGrabBorder: TColor;
    FMultiGrabFill: TColor;
    FLockedGrabBorder: TColor;
    FLockedGrabFill: TColor;
    FNormalGrab: TBitmap;
    FMultiGrab: TBitmap;
    FLockedGrab: TBitmap;
    FHintWindow: THintWindow;
    FCanvas: TCanvas;
    FClickPos: TPoint;
    FDefaultColor: TColor;
    FActive: Boolean;
    FMessageProcessor: TMessageProcessor;
    FLockCounter: Integer;
    FSynchroLockCounter: Integer;
    FControls: TList;
    FDesignControl: TWinControl;
    FSelectControl: TWinControl;
    FMenuControl: TControl;
    FGrabHandles: TGrabHandles;
    FGridStep: Integer;
    FSnapToGrid: Boolean;
    FDisplayGrid: Boolean;
    FDesignerColor: TColor;
    FGridColor: TColor;
    FPopupMenu: TPopupMenu;
    FLockedControls: TStrings;
    FLockedInverse: Boolean;
    FLockChildren: TChildrenMode;
    FProtectedControls: TStrings;
    FProtectedInverse: Boolean;
    FProtectChildren: TChildrenMode;
    FProtectMode: TProtectMode;
    FTransparentControls: TStrings;
    FTransparentInverse: Boolean;
    FTransparentChildren: TChildrenMode;
    FShowMoveSizeHint: Boolean;
    FShowComponentHint: Boolean;
    FAlignmentPalette: TAlignmentPaletteOptions;
    FMouseAction: TMouseAction;
    FDragPoint: TPoint;
    FDragRect: TRect;
    FSelectRect: TRect;
    FSelectCounter: Integer;
    FDragHandle: TGrabPosition;
    FShowNonVisual: Boolean;
    FShowComponentCaptions: Boolean;
    FMultiSelect: Boolean;
    FModified: Boolean;
    FOnMoveSizeControl: TControlNotifyEvent;
    FOnChange: TNotifyEvent;
    FOnLoadControl: TLoadSaveEvent;
    FOnSaveControl: TLoadSaveEvent;
    FOnSelectControl: TControlNotifyEvent;
    FOnSelectionChange: TNotifyEvent;
    FOnControlDblClick: TControlNotifyEvent;
    FOnAddControl: TControlNotifyEvent;
    FOnDeleteControl: TControlNotifyEvent;
    FOnActivate: TNotifyEvent;
    FOnDeactivate: TNotifyEvent;
    FOnKeyDown: TKeyEvent;
    FOnKeyUp: TKeyEvent;
    FOnMessage: TDesignerMessageEvent;
    FOnMoveLimit: TMoveLimitEvent;
    FOnSizeLimit: TSizeLimitEvent;
    FOnReadError: TReaderError;
    FOnCustomizeGrabs: TCustomizeGrabsEvent;
    FOnComponentHint: TComponentTextEvent;
    FOnComponentCaption: TComponentTextEvent;
    FOnComponentBitmap: TComponentBitmapEvent;
    FOnComponentEditable: TComponentEditableEvent;
    FOnCopyComponent: TComponentClipboardEvent;
    FOnPasteComponent: TComponentClipboardEvent;
    FOnContextPopup: TComponentPopupEvent;
    // properties access methods
    function GetControlCount: Integer;
    function GetLocked: Boolean;
    function GetSynchroLocked: Boolean;
    function GetParentForm: TCustomForm;
    procedure SetParentForm(const Value: TCustomForm);
    function GetFormData: string;
    procedure SetFormData(const Value: string);
    procedure SetActive(Value: Boolean);
    procedure SetMessageProcessor(Value: TMessageProcessor);
    function GetControl: TControl;
    procedure SetControl(Value: TControl);
    function GetControlByIndex(Index: Integer): TControl;
    function GetComponent: TComponent;
    procedure SetComponent(Value: TComponent);
    function GetComponentByIndex(Index: Integer): TComponent;
    procedure SetGridStep(Value: Integer);
    procedure SetDisplayGrid(Value: Boolean);
    procedure SetDesignerColor(Value: TColor);
    procedure SetGridColor(Value: TColor);
    procedure SetLockedControls(Value: TStrings);
    procedure SetLockedInverse(Value: Boolean);
    procedure SetLockChildren(Value: TChildrenMode);
    procedure SetProtectedControls(Value: TStrings);
    procedure SetProtectedInverse(Value: Boolean);
    procedure SetProtectChildren(Value: TChildrenMode);
    procedure SetProtectMode(Value: TProtectMode);
    procedure SetTransparentControls(Value: TStrings);
    procedure SetTransparentInverse(Value: Boolean);
    procedure SetTransparentChildren(Value: TChildrenMode);
    procedure SetMoveSizeHint(Value: Boolean);
    procedure SetComponentHint(Value: Boolean);
    procedure SetGrabSize(Value: Integer);
    procedure SetAlignmentPalette(Value: TAlignmentPaletteOptions);
    procedure SetNormalGrabBorder(Value: TColor);
    procedure SetNormalGrabFill(Value: TColor);
    procedure SetMultiGrabBorder(Value: TColor);
    procedure SetMultiGrabFill(Value: TColor);
    procedure SetLockedGrabBorder(Value: TColor);
    procedure SetLockedGrabFill(Value: TColor);
    procedure SetShowNonVisual(const Value: Boolean);
    procedure SetShowComponentCaptions(const Value: Boolean);
    procedure SetMultiSelect(const Value: Boolean);
    procedure SetDesignControl(const Value: TWinControl);
    // internal methods
    procedure ApplicationIdle(Sender: TObject; var Done: Boolean);
    procedure ApplicationMessage(var Msg: TMsg; var Handled: Boolean);
    procedure TimerEvent(Sender: TObject);
    procedure StartTimer(AInterval: Integer);
    procedure StopTimer;
    procedure DrawDragRects;
    procedure DrawSelectRect;
    procedure DrawMultiSelect(AControl: TControl);
    function InTheList(List: TStrings; AControl: TControl): Boolean;
    procedure UpdateGrid;
    procedure ShowHint(AHint: string; Mode: THintMode);
    procedure HideHint;
    function GetControlsOrigin: TPoint;
    function CheckParent(AControl: TControl; DisableLocked: Boolean): Boolean;
    procedure SetArrowCursor;
    function ValidControl(AControl: TControl): Boolean;
    procedure CreateContainers;
    procedure DestroyContainers;
    procedure UpdateContainers;
    function InParentForm(WND: HWND): Boolean;
//    {$IFDEF TFDTRIAL}
//    procedure ShowTrialWarning;
//    {$ENDIF}
    // event handler for TStringList.OnChange
    procedure ListChange(Sender: TObject);
    // the new window procedure
    procedure WinProc(var Message: TMessage);
  protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure MessageProc(var Msg: TMSG); virtual;
    procedure DoMoveSizeControl; virtual;
    procedure DoChange; virtual;
    procedure DoSelectControl(AControl: TControl); virtual;
    procedure DoSelectionChange; virtual;
    procedure DoAddControl(AControl: TControl); virtual;
    procedure DoDeleteControl(AControl: TControl); virtual;
    {$IFDEF TFD1COMPATIBLE}
    property OnDragControl: TControlNotifyEvent read FOnMoveSizeControl write FOnMoveSizeControl;
    {$ELSE}
    property OnMoveSizeControl: TControlNotifyEvent read FOnMoveSizeControl write FOnMoveSizeControl;
    {$ENDIF}
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnLoadControl: TLoadSaveEvent read FOnLoadControl write FOnLoadControl;
    property OnSaveControl: TLoadSaveEvent read FOnSaveControl write FOnSaveControl;
    property OnSelectControl: TControlNotifyEvent read FOnSelectControl write FOnSelectControl;
    property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange;
    property OnControlDblClick: TControlNotifyEvent read FOnControlDblClick write FOnControlDblClick;
    property OnAddControl: TControlNotifyEvent read FOnAddControl write FOnAddControl;
    property OnDeleteControl: TControlNotifyEvent read FOnDeleteControl write FOnDeleteControl;
    property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
    property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
    property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
    property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
    property OnMessage: TDesignerMessageEvent read FOnMessage write FOnMessage;
    property OnMoveLimit: TMoveLimitEvent read FOnMoveLimit write FOnMoveLimit;
    property OnSizeLimit: TSizeLimitEvent read FOnSizeLimit write FOnSizeLimit;
    property OnReadError: TReaderError read FOnReadError write FOnReadError;
    property OnCustomizeGrabs: TCustomizeGrabsEvent read FOnCustomizeGrabs write FOnCustomizeGrabs;
    property OnComponentHint: TComponentTextEvent read FOnComponentHint write FOnComponentHint;
    property OnComponentCaption: TComponentTextEvent read FOnComponentCaption write FOnComponentCaption;
    property OnComponentBitmap: TComponentBitmapEvent read FOnComponentBitmap write FOnComponentBitmap;
    property OnComponentEditable: TComponentEditableEvent read FOnComponentEditable write FOnComponentEditable;
    property OnCopyComponent: TComponentClipboardEvent read FOnCopyComponent write FOnCopyComponent;
    property OnPasteComponent: TComponentClipboardEvent read FOnPasteComponent write FOnPasteComponent;
    property OnContextPopup: TComponentPopupEvent read FOnContextPopup write FOnContextPopup;
  public
    { Public declarations }
    procedure ClearForm;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Update; virtual;
    procedure CreateObjects;
    procedure DestroyObjects;
    function IsLocked(AControl: TControl): Boolean;
    function IsProtected(AControl: TControl): Boolean;
    function IsTransparent(AControl: TControl): Boolean;
    function FindNextControl(GoForward: Boolean): TControl;
    function ControlAtPos(AParent: TWinControl; P: TPoint): TControl;
    function FindWinControl(Wnd: HWND): TWinControl;
    function FindComponentContainer(AComponent: TComponent): TComponentContainer;
    procedure SaveToFile(FileName: string);
    procedure LoadFromFile(FileName: string);
    procedure SaveToDFM(FileName: string; DFMFormat: TDFMFormat);
    procedure LoadFromDFM(FileName: string; DFMFormat: TDFMFormat);
    procedure SaveComponentToStream(Stream: TStream; Component: TComponent; DFMFormat: TDFMFormat);
    function LoadComponentFromStream(Stream: TStream; Component: TComponent; DFMFormat: TDFMFormat): TComponent;
    procedure SaveToStream(Stream: TStream; DFMFormat: TDFMFormat);
    procedure LoadFromStream(Stream: TStream; DFMFormat: TDFMFormat);
    function CanCopy: Boolean;
    function CanPaste: Boolean;
    procedure CopyToClipboard;
    procedure CutToClipboard;
    procedure PasteFromClipboard;
    function GetComponentProperties(AComponent: TComponent): string;
    procedure SetComponentProperties(AComponent: TComponent; Props: string);
    procedure AlignToGrid(TheControl: TControl);
    function EditControlLists(DefaultList: TListType): Boolean;
    function AlignDialog: Boolean;
    function SizeDialog: Boolean;
    function TabOrderDialog: Boolean;
    procedure ShowAlignmentPalette;
    procedure HideAlignmentPalette;
    procedure ShowInspForm;
    procedure HideInspForm;
    procedure AlignControls(Hor,Ver: TAlignMode);
    procedure SizeControls(WMode: TSizeMode; WValue: Integer; HMode: TSizeMode; HValue: Integer);
    procedure Lock;
    procedure Unlock;
    procedure SynchroLock;
    procedure SynchroUnlock;
    procedure LeaveMouseAction;
    procedure AddControl(AControl: TControl);
    procedure DeleteControl(AControl: TControl);
    procedure AddComponent(AComponent: TComponent);
    procedure DeleteComponent(AComponent: TComponent);
    procedure SelectAll;
    procedure UnselectAll;
    procedure ClearControls;
    function ControlIndex(AControl: TControl): Integer;
    procedure DrawGrab(Canvas: TCanvas; R: TRect; GrabType: TGrabType); virtual;
    procedure UpdateGrabs;
    function GetComponentHint(AComponent: TComponent): string; virtual;
    function GetComponentCaption(AComponent: TComponent): string;
    property Modified: Boolean read FModified write FModified;
    property ControlCount: Integer read GetControlCount;
    property Locked: Boolean read GetLocked;
    property SynchroLocked: Boolean read GetSynchroLocked;
    property MouseAction: TMouseAction read FMouseAction;
    property Active: Boolean read FActive write SetActive;
    property MessageProcessor: TMessageProcessor read FMessageProcessor write SetMessageProcessor default mpEvent;
    property Control: TControl read GetControl write SetControl;
    property Controls[Index: Integer]: TControl read GetControlByIndex;
    property Component: TComponent read GetComponent write SetComponent;
    property Components[Index: Integer]: TComponent read GetComponentByIndex;
    property ParentForm: TCustomForm read GetParentForm write SetParentForm;
    property AlignmentPaletteForm: TForm read FAPForm;
    property MenuControl: TControl read FMenuControl;
    property FormData: string read GetFormData write SetFormData;
    property ClearBeforeLoad: Boolean read FClearBeforeLoad write FClearBeforeLoad default True;
    {$IFDEF TFD1COMPATIBLE}
    property FixedControls: TStrings read FLockedControls write SetLockedControls;
    property FixedInverse: Boolean read FLockedInverse write SetLockedInverse;
    property FixChildren: TChildrenMode read FLockChildren write SetLockChildren;
    {$ELSE}
    property LockedControls: TStrings read FLockedControls write SetLockedControls;
    property LockedInverse: Boolean read FLockedInverse write SetLockedInverse default False;
    property LockChildren: TChildrenMode read FLockChildren write SetLockChildren default cmNone;
    {$ENDIF}
    property ProtectedControls: TStrings read FProtectedControls write SetProtectedControls;
    property ProtectedInverse: Boolean read FProtectedInverse write SetProtectedInverse default False;
    property ProtectChildren: TChildrenMode read FProtectChildren write SetProtectChildren default cmNone;
    property ProtectMode: TProtectMode read FProtectMode write SetProtectMode default pmUnselect;
    property TransparentControls: TStrings read FTransparentControls write SetTransparentControls;
    property TransparentInverse: Boolean read FTransparentInverse write SetTransparentInverse default False;
    property TransparentChildren: TChildrenMode read FTransparentChildren write SetTransparentChildren default cmNone;