createdesigner.pas

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

end;

procedure TGrabHandles.SetEnabled(Value: Boolean);
begin
  FEnabled:=Value;
  Visible:=FEnabled and FVisible;
end;

function TGrabHandles.GetParentForm: TCustomForm;
begin
  if Assigned(Designer) then Result:=Designer.ParentForm
  else Result:=nil;
end;

function TGrabHandles.GetDesigner: TCustomFormDesigner;
begin
  if Assigned(Owner) then Result:=Owner as TCustomFormDesigner
  else Result:=nil;
end;

constructor TGrabHandles.Create(AOwner: TComponent);
var
  GP: TGrabPosition;
begin
  inherited;
  for GP:=Succ(Low(GP)) to High(GP) do
  begin
    FItems[GP]:=TGrabHandle.Create(Self);
    with FItems[GP] do
    begin
      Position:=GP;
      Visible:=False;
      Parent:=Designer.ParentForm;
    end;
  end;
  FEnabled:=True;
end;

procedure TGrabHandles.Update(MustHide: Boolean);
var
  GP: TGrabPosition;
  VisibleGrabs,EnabledGrabs: TGrabPositions;
begin
  if Designer.Active then
  begin
    VisibleGrabs:=[Low(TGrabPosition)..High(TGrabPosition)];
    EnabledGrabs:=VisibleGrabs;
    if Assigned(Designer.FOnCustomizeGrabs) then
      Designer.FOnCustomizeGrabs(Designer,VisibleGrabs,EnabledGrabs);
    Application.ProcessMessages;
    FVisible:=
      FEnabled and
      Assigned(FControl) and
      // test FControl.Visible and
      not Designer.IsProtected(FControl) and
      (Designer.ControlCount<=1);
    for GP:=Succ(Low(GP)) to High(GP) do
      if Assigned(FItems[GP]) then
        with FItems[GP] do
          if Assigned(FControl) then
          begin
            if MustHide then Visible:=False;
            Parent:=FControl.Parent;
            Rect:=FControl.BoundsRect;
            Locked:=Designer.IsLocked(FControl);
            Visible:=FVisible and (GP in VisibleGrabs);
            Enabled:=GP in EnabledGrabs;
            if FVisible then BringToFront;
          end
          else
          try
            Visible:=False;
            Parent:=Designer.ParentForm;
          except
          end;
    Application.ProcessMessages;
  end;
end;

procedure TGrabHandles.BringToFront;
var
  GP: TGrabPosition;
begin
  for GP:=Succ(Low(GP)) to High(GP) do
    if Assigned(FItems[GP]) then FItems[GP].BringToFront;
end;

function TGrabHandles.FindHandle(AHandle: HWND): TGrabPosition;
var
  GP: TGrabPosition;
begin
  Result:=gpNone;
  for GP:=Succ(Low(GP)) to High(GP) do
    if Assigned(FItems[GP]) and (FItems[GP].Handle=AHandle) then
    begin
      Result:=GP;
      Break;
    end;
end;

function TGrabHandles.FindHandleControl(AHandle: HWND): TGrabHandle;
var
  GP: TGrabPosition;
begin
  GP:=FindHandle(AHandle);
  if GP<>gpNone then Result:=FItems[GP]
  else Result:=nil;
end;

function TGrabHandles.IsGrabHandle(AControl: TControl): Boolean;
var
  GP: TGrabPosition;
begin
  Result:=False;
  for GP:=Succ(Low(GP)) to High(GP) do
    if FItems[GP]=AControl then
    begin
      Result:=True;
      Break;
    end;
end;

{ TCustomFormDesigner }

constructor TCustomFormDesigner.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLockedControls:=TStringList.Create;
  TStringList(FLockedControls).OnChange:=ListChange;
  FProtectedControls:=TStringList.Create;
  TStringList(FProtectedControls).OnChange:=ListChange;
  FTransparentControls:=TStringList.Create;
  FControls:=TList.Create;
  FAlignmentPalette:=[apStayOnTop,apShowHints];
  FGrabSize:=5;
  FClearBeforeLoad:=True;
  FMultiGrabBorder:=clGray;
  FMultiGrabFill:=clGray;
  FLockedGrabFill:=clGray;
  FGridStep:=8;
  FDesignerColor:=clNone;
  FGridColor:=clNone;
  FShowMoveSizeHint:=True;
  FKeySelect:=True;
  FKeyMove:=True;
  FShowNonVisual:=True;
  FShowComponentCaptions:=False;
  FMultiSelect:=True;
  if csDesigning in ComponentState then
    CreateObjects;
end;

destructor TCustomFormDesigner.Destroy;
begin
  if csDesigning in ComponentState then
    DestroyObjects
  else Active:=False;
  FLockedControls.Free;
  FTransparentControls.Free;
  FProtectedControls.Free;
  FControls.Free;
  FControls:=nil;
  if FAPForm<>nil then
    FAPForm.Free;
  if FInspForm<>nil then
    FInspForm.Free;
  inherited;
end;

procedure TCustomFormDesigner.CreateObjects;
begin
//  FAPForm:=TfrmAlignmentPalette.Create(Self);
  FAPForm:=Tfrm_ControlPanel.Create(Self);
  FInspForm:=Tfrm_ObjectInspector.Create(Self);
  FLockedGrab:=TBitmap.Create;
  FMultiGrab:=TBitmap.Create;
  FNormalGrab:=TBitmap.Create;
  FHintWindow:=THintWindow.Create(Self);
  FHintWindow.Color:=clInfoBk;
  FCanvas:=TCanvas.Create;
  FHintTimer:=TTimer.Create(Self);
  FHintTimer.Enabled:=False;
  FHintTimer.OnTimer:=TimerEvent;
  FBkgBitmap:=TBitmap.Create;
  UpdateGrid;
end;

procedure TCustomFormDesigner.DestroyObjects;

  procedure FreeAndNil(var Obj: TObject);
  begin
    if Assigned(Obj) then Obj.Free;
    Obj:=nil;
  end;

begin
  FreeAndNil(TObject(FHintWindow));
  FreeAndNil(TObject(FCanvas));
  FreeAndNil(TObject(FLockedGrab));
  FreeAndNil(TObject(FMultiGrab));
  FreeAndNil(TObject(FNormalGrab));
  FreeAndNil(TObject(FBkgBitmap));
end;

procedure TCustomFormDesigner.Update;
var
  i: Integer;
begin
  UpdateGrabs;
  UpdateContainers;
  if ControlCount>1 then
    for i:=0 to Pred(ControlCount) do DrawMultiSelect(Controls[i]);
end;

function TCustomFormDesigner.IsLocked(AControl: TControl): Boolean;
begin
  if ValidControl(AControl) then
    if AControl=ParentForm then Result:=True
    else
    begin
      case FLockChildren of
        cmNormal: Result:=InTheList(FLockedControls,AControl) or InTheList(FLockedControls,AControl.Parent);
        cmRecurse:
          repeat
            Result:=InTheList(FLockedControls,AControl);
            if Result then Break
            else
              if ValidControl(AControl) then AControl:=AControl.Parent
              else AControl:=nil;
          until (AControl=nil) or (AControl=ParentForm);
      else Result:=InTheList(FLockedControls,AControl);
      end;
      Result:=Result xor FLockedInverse;
    end
  else Result:=False;
end;

function TCustomFormDesigner.IsProtected(AControl: TControl): Boolean;

  function IsTopLevel(AControl: TControl): Boolean;
  var
    i: Integer;
  begin
    Result:=False;
    if Assigned(AControl) then
      with ParentForm do
        for i:=0 to Pred(ComponentCount) do
          if Components[i]=AControl then
          begin
            Result:=True;
            Exit;
          end;
  end;

  function FindTopLevel(AControl: TControl): TControl;
  begin
    Result:=nil;
    while Assigned(AControl) do
    begin
      if IsTopLevel(AControl) then
      begin
        Result:=AControl;
        Exit;
      end;
      AControl:=AControl.Parent;
    end;
  end;

begin
  if ValidControl(AControl) then
  begin
    if Assigned(FDesignControl) then
    begin
      Result:=True;
      while Assigned(AControl.Parent) do
      begin
        AControl:=AControl.Parent;
        if AControl=FDesignControl then
        begin
          Result:=False;
          Exit;
        end;
      end;
    end
    else
    begin
      AControl:=FindTopLevel(AControl);
      if not Assigned(AControl) or (AControl=ParentForm) then Result:=True
      else
      begin
        case FProtectChildren of
          cmNormal: Result:=InTheList(FProtectedControls,AControl) or InTheList(FProtectedControls,AControl.Parent);
          cmRecurse:
            repeat
              Result:=InTheList(FProtectedControls,AControl);
              if Result then Break
              else
                if ValidControl(AControl) then AControl:=AControl.Parent
                else AControl:=nil;
            until (AControl=nil) or (AControl=ParentForm);
        else Result:=InTheList(FProtectedControls,AControl);
        end;
        Result:=Result xor FProtectedInverse;
      end;
    end;
  end
  else Result:=False;
end;

function TCustomFormDesigner.IsTransparent(AControl: TControl): Boolean;
begin
  if ValidControl(AControl) then
    if AControl=ParentForm then Result:=True
    else
    begin
      case FTransparentChildren of
        cmNormal: Result:=InTheList(FTransparentControls,AControl) or InTheList(FTransparentControls,AControl.Parent);
        cmRecurse:
          repeat
            Result:=InTheList(FTransparentControls,AControl);
            if Result then Break
            else
              if ValidControl(AControl) then AControl:=AControl.Parent
              else AControl:=nil;
          until (AControl=nil) or (AControl=ParentForm);
      else Result:=InTheList(FTransparentControls,AControl);
      end;
      Result:=Result xor FTransparentInverse;
    end
  else Result:=False;
end;

function TCustomFormDesigner.GetControlCount: Integer;
begin
  if Assigned(FControls) then Result:=FControls.Count
  else Result:=0;
end;

function TCustomFormDesigner.GetLocked: Boolean;
begin
  Result:=FLockCounter>0;
end;

function TCustomFormDesigner.GetSynchroLocked: Boolean;
begin
  Result:=FSynchroLockCounter>0;
end;

function TCustomFormDesigner.GetParentForm: TCustomForm;
begin
  if Assigned(FForm) then Result:=FForm
  else
    if Assigned(Owner) and (Owner is TCustomForm) then Result:=TCustomForm(Owner)
    else Result:=nil;
end;

procedure TCustomFormDesigner.SetParentForm(const Value: TCustomForm);
begin
  if FForm<>Value then
  begin
    if not (csDesigning in ComponentState) then LeaveMouseAction;
    if Assigned(FDefaultProc) then SetWindowLong(ParentForm.Handle,GWL_WNDPROC,Integer(FDefaultProc));
    {$IFNDEF NOREMOVENOTIFICATION}
    if Assigned(FForm) then FForm.RemoveFreeNotification(Self);
    {$ENDIF}
    if Assigned(FForm) then FForm.Invalidate;
    FForm:=Value;
    if Assigned(FForm) then FForm.Invalidate;
    if Assigned(FForm) then FForm.FreeNotification(Self);
    if Assigned(FWinProc) then SetWindowLong(ParentForm.Handle,GWL_WNDPROC,Integer(FWinProc));
  end;
end;

function TCustomFormDesigner.GetFormData: string;
var
  StringStream: TStringStream;
begin
  StringStream:=TStringStream.Create('');
  try
    SaveToStream(StringStream,dfmText);
    Result:=StringStream.DataString;
  finally
    StringStream.Free;
  end;
end;

procedure TCustomFormDesigner.SetFormData(const Value: string);
var
  StringStream: TStringStream;
begin
  StringStream:=TStringStream.Create(Value);
  try
    LoadFromStream(StringStream,dfmText);
  finally
    StringStream.Free;
  end;
end;

type
  TDesignAccessComponent = class(TComponent)
  public
    procedure SetDesigningPublic(Value: Boolean);
  end;

procedure TDesignAccessComponent.SetDesigningPublic(Value: Boolean);
begin
  {$IFNDEF GFDNOCSDESIGNING}
  SetDesigning(Value);
  {$ENDIF}
end;

procedure TCustomFormDesigner.SetActive(Value: Boolean);

var
  i: Integer;

  function ParentFormOK: Boolean;
  begin
    Result:=Assigned(ParentForm) and ParentForm.HandleAllocated;
  end;

begin
  if Value<>FActive then
  begin
    if Value then
    begin
      CreateObjects;
      if Assigned(Owner) then
      begin
        if Owner is TCustomForm then
        begin
          FGrabHandles:=TGrabHandles.Create(Self);
          Control:=nil;
          UpdateGrabs;
          if Assigned(ParentForm) then
            ParentForm.ActiveControl:=nil;
        end
        else begin
          if GetACP=936 then
            raise EFormDesigner.Create('表单设计器必须放在表单上.')
          else if GetACP=950 then
            raise EFormDesigner.Create('