createdesigner.pas

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

    property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu default nil;
    property GridStep: Integer read FGridStep write SetGridStep default 8;
    property SnapToGrid: Boolean read FSnapToGrid write FSnapToGrid default False;
    property DisplayGrid: Boolean read FDisplayGrid write SetDisplayGrid default False;
    property DesignerColor: TColor read FDesignerColor write SetDesignerColor default clNone;
    property GridColor: TColor read FGridColor write SetGridColor default clNone;
    property ShowMoveSizeHint: Boolean read FShowMoveSizeHint write SetMoveSizeHint default True;
    property ShowComponentHint: Boolean read FShowComponentHint write SetComponentHint default False;
    property GrabSize: Integer read FGrabSize write SetGrabSize default 5;
    property AlignmentPalette: TAlignmentPaletteOptions read FAlignmentPalette write SetAlignmentPalette default [apStayOnTop,apShowHints];
    property NormalGrabBorder: TColor read FNormalGrabBorder write SetNormalGrabBorder default clBlack;
    property NormalGrabFill: TColor read FNormalGrabFill write SetNormalGrabFill default clBlack;
    property MultiGrabBorder: TColor read FMultiGrabBorder write SetMultiGrabBorder default clGray;
    property MultiGrabFill: TColor read FMultiGrabFill write SetMultiGrabFill default clGray;
    property LockedGrabBorder: TColor read FLockedGrabBorder write SetLockedGrabBorder default clBlack;
    property LockedGrabFill: TColor read FLockedGrabFill write SetLockedGrabFill default clGray;
    property KeySelect: Boolean read FKeySelect write FKeySelect default True;
    property KeyMove: Boolean read FKeyMove write FKeyMove default True;
    property ShowNonVisual: Boolean read FShowNonVisual write SetShowNonVisual default True;
    property ShowComponentCaptions: Boolean read FShowComponentCaptions write SetShowComponentCaptions default False;
    property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default True;
    property DesignControl: TWinControl read FDesignControl write SetDesignControl;
    property InspForm: TForm read FInspForm write FInspForm;
  end;

  TFormDesigner = class(TCustomFormDesigner)
  published
    { Published declarations }
    property ClearBeforeLoad;
    property MessageProcessor;
    {$IFDEF TFD1COMPATIBLE}
    property FixedControls;
    property FixedInverse;
    property FixChildren;
    {$ELSE}
    property LockedControls;
    property LockedInverse;
    property LockChildren;
    {$ENDIF}
    property ProtectedControls;
    property ProtectedInverse;
    property ProtectChildren;
    property ProtectMode;
    property TransparentControls;
    property TransparentInverse;
    property TransparentChildren;
    property PopupMenu;
    property GridStep;
    property SnapToGrid;
    property DisplayGrid;
    property DesignerColor;
    property GridColor;
    property ShowMoveSizeHint;
    property ShowComponentHint;
    property GrabSize;
    property AlignmentPalette;
    property NormalGrabBorder;
    property NormalGrabFill;
    property MultiGrabBorder;
    property MultiGrabFill;
    property LockedGrabBorder;
    property LockedGrabFill;
    property KeySelect;
    property KeyMove;
    property ShowNonVisual;
    property ShowComponentCaptions;
    property MultiSelect;
    property DesignControl;
    {$IFDEF TFD1COMPATIBLE}
    property OnDragControl;
    {$ELSE}
    property OnMoveSizeControl;
    {$ENDIF}
    property OnChange;
    property OnLoadControl;
    property OnSaveControl;
    property OnSelectControl;
    property OnSelectionChange;
    property OnAddControl;
    property OnDeleteControl;
    property OnControlDblClick;
    property OnActivate;
    property OnDeactivate;
    property OnKeyDown;
    property OnKeyUp;
    property OnMessage;
    property OnMoveLimit;
    property OnSizeLimit;
    property OnReadError;
    property OnCustomizeGrabs;
    property OnComponentHint;
    property OnComponentCaption;
    property OnComponentBitmap;
    property OnComponentEditable;
    property OnCopyComponent;
    property OnPasteComponent;
    property OnContextPopup;
  end;

  // exception class for TCustomFormDesigner
  EFormDesigner = class(Exception);

function Designing: Boolean;

implementation

{$R FDMAIN.RES}
{$IFNDEF FDNOSTDICONS}
{$R STD.RES}
{$ENDIF}

{$BOOLEVAL OFF}
{$RANGECHECKS OFF}

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

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

uses CreateDesignerEditor, CreateAlign, CreateSize, CreateAlignPanel, CreateOrder,ObjectInspector,CreatePalette;

var
  SavedApplicationMessage: TMessageEvent = nil;
  SavedApplicationIdle: TIdleEvent = nil;
  Designers: TList;
  HookID: HHook = 0;
const
  WM_SECONDARYPAINT = WM_USER + 1000;
  BufSize = 2048;

function HookProc(Code,WParam,LParam: Integer): LResult; stdcall;
var
  i,ILockCounter: Integer;
begin
  if Assigned(Designers) then
    for i:=0 to Pred(Designers.Count) do
      with TCustomFormDesigner(Designers[i]) do
      begin
        ILockCounter:=FLockCounter;
        try
          MessageProc(PMsg(LParam)^);
        finally
          if FLockCounter>ILockCounter then FLockCounter:=ILockCounter;
          if Locked then
            case PMsg(LParam)^.Message of
              WM_LBUTTONUP,WM_NCLBUTTONUP,WM_RBUTTONUP,WM_NCRBUTTONUP:
              begin
                Unlock;
                MessageProc(PMsg(LParam)^);
              end;
            end;
        end;
      end;
  Result:=CallNextHookEx(HookID,Code,WParam,LParam);
end;

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;

{ TComponentContainer }

procedure TComponentContainer.Paint;
begin
  with Canvas do
  begin
    Brush.Color:=clBtnFace;
    FillRect(ClientRect);
    Pen.Color:=clBtnHighlight;
    MoveTo(0,Pred(Height));
    LineTo(0,0);
    LineTo(Width,0);
    Pen.Color:=clBtnShadow;
    MoveTo(0,Pred(Height));
    LineTo(Pred(Width),Pred(Height));
    LineTo(Pred(Width),0);
    Draw(2,2,FBitmap);
  end;
end;

procedure TComponentContainer.WndProc(var Msg: TMessage);
begin
  with Msg do
    case Msg of
      WM_SIZE:
      begin
        Width:=28;
        Height:=28;
      end;
      WM_MOVE:
      begin
        inherited;
        if Assigned(FComponent) then
        begin
          FComponent.DesignInfo:=Left+Top shl 16;
          UpdateContainer;
        end;
      end;
    else inherited;
    end;
end;

constructor TComponentContainer.CreateWithComponent(AOwner,AComponent: TComponent; ADesigner: TCustomFormDesigner);
begin
  inherited Create(AOwner);
  FDesigner:=ADesigner;
  FComponent:=AComponent;
  FBitmap:=TBitmap.Create;
  with FBitmap do
  begin
    if Assigned(FDesigner) and Assigned(FDesigner.OnComponentBitmap) then
      FDesigner.OnComponentBitmap(FDesigner,FComponent,FBitmap)
    else Handle:=LoadBitmap(HInstance,PChar(AnsiUpperCase(AComponent.ClassName)));
    if Handle=0 then Handle:=LoadBitmap(HInstance,'CONTAINER');
    Transparent:=True;
  end;
  Visible:=Assigned(FComponent);
  Width:=28;
  Height:=28;
  ShowHint:=True;
  with FComponent do
    if HandleAllocated then
      SetWindowPos(Handle,0,LoWord(DesignInfo),HiWord(DesignInfo),0,0,SWP_NOSIZE or SWP_NOZORDER)
    else
    begin
      Left:=LoWord(DesignInfo);
      Top:=HiWord(DesignInfo);
    end;
  FCaption:=TStaticText.Create(Self);
  UpdateContainer;
  with FCaption do
  begin
    if Assigned(FDesigner) and FDesigner.ShowComponentCaptions then
      FCaption.Parent:=AOwner as TWinControl;
    Alignment:=taCenter;
  end;
  Parent:=AOwner as TWinControl;
end;

destructor TComponentContainer.Destroy;
begin
  FBitmap.Free;
  inherited;
end;

procedure TComponentContainer.UpdateContainer;
begin
  with FCaption do
  begin
    if Assigned(FDesigner) then Caption:=FDesigner.GetComponentCaption(FComponent)
    else Caption:='';
    Top:=Self.Top+Self.Height+2;
    Left:=(Self.Left)+Self.Width div 2-Width div 2;
  end;
end;

{ TFDReader }

function TFDReader.Error(const Message: string): Boolean;
begin
  Result:=True;
  if Assigned(Designer) and Assigned(Designer.FOnReadError) then
    Designer.FOnReadError(Self,Message,Result);
end;

procedure TFDReader.SetName(Component: TComponent; var Name: string);

  procedure RenameComponent(AComponent: TComponent);
  var
    Index: Integer;
    AName: string;
  begin
    Index:=1;
    if Name<>'' then
    begin
      AName:=Name;
      while Assigned(AComponent.Owner.FindComponent(AName)) do
      begin
        Inc(Index);
        AName:=Copy(AComponent.ClassName,2,Length(AComponent.ClassName))+IntToStr(Index);
      end;
      try
        AComponent.Name:=AName;
      except
        AComponent.Name:='';
      end;
      with AComponent do
        for Index:=0 to Pred(ComponentCount) do RenameComponent(Components[Index]);
    end;
  end;

begin
  if Assigned(Component) and Assigned(Component.Owner) and Assigned(Designer) and Assigned(Designer.ParentForm) then
    RenameComponent(Component);
end;

constructor TFDReader.Create(AStream: TStream; ADesigner: TCustomFormDesigner);
begin
  inherited Create(AStream,BufSize);
  Designer:=ADesigner;
end;

{ TGrabHandle }

constructor TGrabHandle.Create(AOwner: TComponent);
begin
  inherited;
  with (Owner as TGrabHandles).Designer do
  begin
    Width:=FGrabSize;
    Height:=FGrabSize;
  end;
  ControlStyle:=ControlStyle+[csReplicatable];
end;

procedure TGrabHandle.Paint;
begin
  if Assigned(Parent) then
    with Canvas,(Owner as TGrabHandles).Designer do
      if FLocked then Draw(Self.Width-FGrabSize,Self.Height-FGrabSize,FLockedGrab)
      else Draw(Self.Width-FGrabSize,Self.Height-FGrabSize,FNormalGrab);
end;

procedure TGrabHandle.WndProc(var Msg: TMessage);
begin
  inherited;
  if not FLocked then
    case Msg.Msg of
      CM_MOUSEENTER: Screen.Cursor:=crDefault;
      CM_MOUSELEAVE: SetArrowCursor;
    end;
end;

procedure TGrabHandle.SetPosition(Value: TGrabPosition);
begin
  if Value<>FPosition then
  begin
    FPosition:=Value;
    Cursor:=GetGrabCursor(FPosition);
    UpdateCoords;
  end;
end;

procedure TGrabHandle.SetRect(Value: TRect);
begin
  FRect:=Value;
  UpdateCoords;
end;

procedure TGrabHandle.SetLocked(Value: Boolean);
begin
  if Value<>FLocked then
  begin
    FLocked:=Value;
    if Visible then Invalidate;
  end;
end;

procedure TGrabHandle.UpdateCoords;
var
  ALeft,ATop: Integer;
  R: TRect;
begin
  if Assigned(Parent) then
    with (Owner as TGrabHandles).Designer do
    begin
      case FPosition of
        gpLeftTop,gpLeftMiddle,gpLeftBottom: ALeft:=FRect.Left-FGrabSize div 2;
        gpMiddleTop,gpMiddleBottom: ALeft:=(FRect.Left+FRect.Right-FGrabSize) div 2;
        gpRightTop,gpRightMiddle,gpRightBottom: ALeft:=Pred(FRect.Right-FGrabSize div 2);
      else ALeft:=0;
      end;
      case FPosition of
        gpLeftTop,gpMiddleTop,gpRightTop: ATop:=FRect.Top-FGrabSize div 2;
        gpLeftMiddle,gpRightMiddle: ATop:=(FRect.Top+FRect.Bottom-FGrabSize) div 2;
        gpLeftBottom,gpMiddleBottom,gpRightBottom: ATop:=Pred(FRect.Bottom-FGrabSize div 2);
      else ATop:=0;
      end;
      R:=Classes.Rect(ALeft,ATop,ALeft+FGrabSize,ATop+FGrabSize);
      IntersectRect(R,R,Parent.ClientRect);
      with R do SetWindowPos(Handle,0,Left,Top,Right-Left,Bottom-Top,SWP_NOZORDER);
    end;
end;

procedure TGrabHandle.SetArrowCursor;
begin
  {$IFNDEF STDCURSORS}
  Screen.Cursor:=crArrow;
  {$ELSE}
  Screen.Cursor:=crDefault;
  {$ENDIF}
end;

{ TGrabHandles }

procedure TGrabHandles.SetControl(Value: TControl);
begin
  FControl:=Value;
  if FEnabled then Update(False);
end;

procedure TGrabHandles.SetVisible(Value: Boolean);
var
  GP: TGrabPosition;
begin
  if Value<>FVisible then
  begin
    FVisible:=Value;
    for GP:=Succ(Low(GP)) to High(GP) do
      FItems[GP].Visible:=FEnabled and FVisible;
  end;