fdmain.pas.svn-base

TFormDesigner allows you move and resize any control on your form. You need not prepare your form to

        if ValidControl(TWinControl(Component).Parent) and
          (TWinControl(Component).Handle=Wnd) and
          {$IFNDEF NOCSSUBCOMPONENT}
          not (csSubComponent in Component.ComponentStyle) and
          {$ENDIF}
          not IsTransparent(TControl(Component))
          then Control:=TWinControl(Component)
        else
          with Component do
            for i:=Pred(ComponentCount) downto 0 do
              FindInComponent(Wnd,Components[i],Control);
  end;

begin
  Result:=nil;
  FindInComponent(Wnd,ParentForm,Result);
end;

function TCustomFormDesigner.FindComponentContainer(AComponent: TComponent): TComponentContainer;
var
  i: Integer;
begin
  Result:=nil;
  with ParentForm do
    for i:=0 to Pred(ComponentCount) do
      if (Components[i] is TComponentContainer) and
        (TComponentContainer(Components[i]).Component=AComponent) then
      begin
        Result:=TComponentContainer(Components[i]);
        Break;
      end;
end;

procedure TCustomFormDesigner.SaveToFile(FileName: string);

var
  F: TIniFile;
  SL: TStringList;
  i: Integer;

  procedure SaveControl(AControl: TControl);
  begin
    if (AControl<>ParentForm) and
      not (AControl is TGrabHandle) and
      (AControl.Name<>'') and
      ValidControl(AControl.Parent) then
    begin
      if Assigned(FOnSaveControl) then FOnSaveControl(Self,AControl,F);
      with F,AControl do
      begin
        WriteString(Name,'Class',ClassName);
        WriteString(Name,'Parent',Parent.Name);
        WriteInteger(Name,'Left',Left);
        WriteInteger(Name,'Top',Top);
        WriteInteger(Name,'Width',Width);
        WriteInteger(Name,'Height',Height);
      end;
    end;
  end;

begin
  F:=TIniFile.Create(FileName);
  try
    SL:=TStringList.Create;
    try
      F.ReadSections(SL);
      for i:=0 to Pred(SL.Count) do F.EraseSection(SL[i])
    finally
      SL.Free;
    end;
    if Assigned(FOnSaveControl) then FOnSaveControl(Self,ParentForm,F);
    if Assigned(ParentForm) then
      with ParentForm do
        for i:=Pred(ComponentCount) downto 0 do
          if Components[i] is TControl then
            SaveControl(TControl(Components[i]));
  finally
    F.Free;
  end;
end;

procedure TCustomFormDesigner.LoadFromFile(FileName: string);

var
  F: TIniFile;
  i: Integer;
  SL: TStringList;

  procedure LoadControl(AName: string);
  var
    PC: TPersistentClass;
    C: TComponent;
  begin
    with F do
    begin
      PC:=GetClass(ReadString(AName,'Class',''));
      if Assigned(PC) then
      begin
        C:=TComponentClass(PC).Create(ParentForm);
        if Assigned(C) and (C is TControl) then
        begin
          with TControl(C) do
          begin
            Name:=AName;
            Left:=ReadInteger(AName,'Left',Left);
            Top:=ReadInteger(AName,'Top',Top);
            Width:=ReadInteger(AName,'Width',Width);
            Height:=ReadInteger(AName,'Height',Height);
          end;
        end;
      end;
    end;
  end;

  procedure SetParent(AName: string);
  var
    C,P: TComponent;
  begin
    if Assigned(ParentForm) then
    begin
      C:=TControl(ParentForm.FindComponent(AName));
      if Assigned(C) and (C is TControl) then
      begin
        P:=TWinControl(ParentForm.FindComponent(F.ReadString(AName,'Parent','')));
        if Assigned(P) and (P is TWinControl) then TControl(C).Parent:=TWinControl(P)
        else TControl(C).Parent:=ParentForm;
        if Assigned(FOnLoadControl) then FOnLoadControl(Self,TControl(C),F);
      end;
    end;
  end;

begin
  if Assigned(ParentForm) then
  begin
    with ParentForm do
    begin
      i:=0;
      while i<ComponentCount do
        if Components[i] is TControl then Components[i].Free
        else Inc(i);
    end;
    F:=TIniFile.Create(FileName);
    try
      SL:=TStringList.Create;
      try
        if Assigned(FOnLoadControl) then FOnLoadControl(Self,ParentForm,F);
        F.ReadSections(SL);
        for i:=0 to Pred(SL.Count) do LoadControl(SL[i]);
        for i:=0 to Pred(SL.Count) do SetParent(SL[i]);
      finally
        SL.Free;
      end;
    finally
      F.Free;
    end;
  end;
end;

procedure TCustomFormDesigner.SaveToDFM(FileName: string; DFMFormat: TDFMFormat);
var
  Form: TCustomForm;
  Stream: TFileStream;
  TxtStream,BinStream: TMemoryStream;
begin
  if Assigned(ParentForm) then
  begin
    DestroyContainers;
    try
      Stream:=TFileStream.Create(FileName,fmCreate);
      BinStream:=TMemoryStream.Create;
      try
        with TWriter.Create(BinStream,BufSize) do
        try
          Form:=ParentForm;
          Form.RemoveComponent(Self);
          Form.ActiveControl:=nil;
          try
            WriteRootComponent(Form);
          finally
            Form.InsertComponent(Self);
          end;
        finally
          Free;
        end;
        BinStream.Seek(0,soFromBeginning);
        if DFMFormat=dfmText then ObjectBinaryToText(BinStream,Stream)
        else
        begin
          TxtStream:=TMemoryStream.Create;
          try
            ObjectBinaryToText(BinStream,TxtStream);
            TxtStream.Seek(0,soFromBeginning);
            ObjectTextToResource(TxtStream,Stream);
          finally
            TxtStream.Free;
          end;
        end;
      finally
        Stream.Free;
        BinStream.Free;
      end;
    finally
      if Active then CreateContainers;
    end;
  end;
end;

procedure TCustomFormDesigner.LoadFromDFM(FileName: string; DFMFormat: TDFMFormat);
var
  Stream: TFileStream;
  TxtStream,BinStream: TMemoryStream;
begin
  if Assigned(ParentForm) then
  begin
    DestroyContainers;
    try
      if FClearBeforeLoad or FMustClear then ClearForm;
      Stream:=TFileStream.Create(FileName,fmOpenRead);
      BinStream:=TMemoryStream.Create;
      try
        if DFMFormat=dfmText then ObjectTextToBinary(Stream,BinStream)
        else
        begin
          TxtStream:=TMemoryStream.Create;
          try
            ObjectResourceToText(Stream,TxtStream);
            TxtStream.Seek(0,soFromBeginning);
            ObjectTextToBinary(TxtStream,BinStream);
          finally
            TxtStream.Free;
          end;
        end;
        BinStream.Seek(0,soFromBeginning);
        ParentForm.Name:='';
        with TFDReader.Create(BinStream,Self) do
        try
          ReadRootComponent(ParentForm);
        finally
          Free;
        end;
      finally
        Stream.Free;
        BinStream.Free;
      end;
    finally
      if Active then CreateContainers;
    end;
  end;
end;

procedure TCustomFormDesigner.SaveToStream(Stream: TStream; DFMFormat: TDFMFormat);
var
  Form: TCustomForm;
  BinStream: TMemoryStream;
begin
  if Assigned(ParentForm) then
  begin
    DestroyContainers;
    try
      BinStream:=TMemoryStream.Create;
      try
        with TWriter.Create(BinStream,BufSize) do
        try
          Form:=ParentForm;
          Form.RemoveComponent(Self);
          try
            WriteRootComponent(Form);
          finally
            Form.InsertComponent(Self);
          end;
        finally
          Free;
        end;
        BinStream.Seek(0,soFromBeginning);
        if DFMFormat=dfmText then ObjectBinaryToText(BinStream,Stream)
        else Stream.CopyFrom(BinStream,BinStream.Size);
      finally
        BinStream.Free;
      end;
    finally
      if Active then CreateContainers;
    end;
  end;
end;

procedure TCustomFormDesigner.LoadFromStream(Stream: TStream; DFMFormat: TDFMFormat);
var
  BinStream: TMemoryStream;
begin
  if Assigned(ParentForm) then
  begin
    DestroyContainers;
    try
      if FClearBeforeLoad or FMustClear then ClearForm;
      BinStream:=TMemoryStream.Create;
      try
        if DFMFormat=dfmText then ObjectTextToBinary(Stream,BinStream)
        else BinStream.CopyFrom(Stream,Stream.Size);
        BinStream.Seek(0,soFromBeginning);
        with TFDReader.Create(BinStream,Self) do
        try
          ReadRootComponent(ParentForm);
        finally
          Free;
        end;
      finally
        BinStream.Free;
      end;
    finally
      if Active then CreateContainers;
    end;
  end;
end;

procedure TCustomFormDesigner.CopyToClipboard;
var
  i: Integer;
  BinStream: TMemoryStream;
  StringStream: TStringStream;
begin
  if (Assigned(ParentForm)) and (ControlCount>0) then
  begin
    DestroyContainers;
    try
      i:=0;
      while i<ControlCount do
        if ValidControl(Controls[i].Parent) and (ControlIndex(Controls[i].Parent)<>-1) then
          DeleteControl(Controls[i])
        else Inc(i);
      BinStream:=TMemoryStream.Create;
      try
        with TWriter.Create(BinStream,BufSize) do
        try
          Root:=ParentForm;
          for i:=0 to Pred(ControlCount) do
          begin
            WriteSignature;
            if Controls[i] is TComponentContainer then WriteComponent(TComponentContainer(Controls[i]).Component)
            else WriteComponent(Controls[i]);
          end;
        finally
          Free;
        end;
        BinStream.Seek(0,soFromBeginning);
        StringStream:=TStringStream.Create('');
        try
          while BinStream.Position<BinStream.Size do
            ObjectBinaryToText(BinStream,StringStream);
          Clipboard.AsText:=StringStream.DataString;
        finally
          StringStream.Free;
        end;
      finally
        BinStream.Free;
      end;
    finally
      if Active then CreateContainers;
    end;
  end;
end;

procedure TCustomFormDesigner.CutToClipboard;
begin
  CopyToClipboard;
  while ControlCount>0 do Controls[0].Free;
end;

procedure TCustomFormDesigner.PasteFromClipboard;
var
  BinStream: TMemoryStream;
  StringStream: TStringStream;
  ParentControl: TWinControl;
  NewComponent: TComponent;
  NewComponents: TList;
  I: Integer;

  procedure DeleteNames(AComponent: TComponent);
  var
    Index: Integer;
  begin
    AComponent.Name:='';
    with AComponent do
      for Index:=0 to Pred(ComponentCount) do DeleteNames(Components[Index]);
  end;

  procedure RenameComponent(AComponent: TComponent);
  var
    Index: Integer;
    AName: string;
  begin
    Index:=1;
    AName:=Copy(AComponent.ClassName,2,Length(AComponent.ClassName))+IntToStr(Index);
    while Assigned(ParentForm.FindComponent(AName)) do
    begin
      Inc(Index);
      AName:=Copy(AComponent.ClassName,2,Length(AComponent.ClassName))+IntToStr(Index);
    end;
    AComponent.Name:=AName;
    if NewComponent is TWinControl then
      with TWinControl(AComponent) do
        for Index:=0 to Pred(ControlCount) do RenameComponent(Controls[Index]);
  end;

  procedure SetOwner(Control: TControl);
  var
    i: Integer;
  begin
    if Assigned(ParentForm) then
      with Control do
        if Owner<>ParentForm then
        begin
          if Assigned(Owner) then Owner.RemoveComponent(Control);
          ParentForm.InsertComponent(Control);
          if Control is TWinControl then
            with TWinControl(Control) do
              for i:=0 to Pred(ControlCount) do SetOwner(Controls[i]);
        end;
  end;

begin
  if (Assigned(ParentForm)) and (Clipboard.AsText<>'') then
  begin
    StringStream:=TStringStream.Create(Clipboard.AsText);
    try
      if ValidControl(Control) then
        if Control is TWinControl then ParentControl:=TWinControl(Control)
        else ParentControl:=Control.Parent
      else ParentControl:=ParentForm;
      while ValidControl(ParentControl) and not (csAcceptsControls in ParentControl.ControlStyle) do
        ParentControl:=ParentControl.Parent;
      if not ValidControl(ParentControl) then ParentControl:=ParentForm;
      BinStream:=TMemoryStream.Create;
      NewComponents := TList.Create;
      try
        while StringStream.Position<StringStream.Size do
        begin
          BinStream.Seek(0,soFromBeginning);
          ObjectTextToBinary(StringStream,BinStream);
          BinStream.Seek(0,soFromBeginning);
          with TFDReader.Create(BinStream,Self) do
          try
            Owner:=ParentForm;
            Parent:=ParentControl;
            NewComponent:=ReadRootComponent(nil);
            DeleteNames(NewComponent);
            if NewComponent is TControl then
            begin