diff --git a/components/synedit/synedit.pp b/components/synedit/synedit.pp index 4124e5de95..ba20ba4eb5 100644 --- a/components/synedit/synedit.pp +++ b/components/synedit/synedit.pp @@ -7670,7 +7670,6 @@ begin {begin} //mh 2000-10-30 ecDeleteLastChar: if not ReadOnly then begin - debugln('ecDeleteLastChar A'); if SelAvail then SetSelectedTextEmpty else begin diff --git a/designer/changeclassdialog.pas b/designer/changeclassdialog.pas index df0fa26bac..1069293213 100644 --- a/designer/changeclassdialog.pas +++ b/designer/changeclassdialog.pas @@ -115,6 +115,7 @@ var LFMBuffer: TCodeBuffer; LFMTree: TLFMTree; UnitInfo: TUnitInfo; + OldParents: TStrings; // Name=OldParent pairs procedure ShowAbortMessage(const Msg: string); begin @@ -129,6 +130,13 @@ var Result:=false; // select only this persistent GlobalDesignHook.SelectOnlyThis(APersistent); + if (APersistent is TControl) + and (TControl(APersistent).Parent<>nil) then begin + if OldParents=nil then + OldParents:=TStringList.Create; + OldParents.Values[TControl(APersistent).Name]:= + TControl(APersistent).Parent.Name; + end; // stream selection ComponentStream:=TMemoryStream.Create; @@ -215,6 +223,10 @@ var function InsertStreamedSelection: boolean; var MemStream: TMemoryStream; + LFMType, LFMComponentName, LFMClassName: string; + AComponent: TComponent; + NewParent: TWinControl; + NewParentName: string; begin Result:=false; if LFMBuffer.SourceLength=0 then exit; @@ -225,7 +237,21 @@ var debugln('ChangePersistentClass-After--------------------------------------------'); LFMBuffer.SaveToStream(MemStream); MemStream.Position:=0; - Result:=FormEditingHook.InsertFromStream(MemStream,nil,[cpsfReplace]); + NewParent:=nil; + if OldParents<>nil then begin + ReadLFMHeader(MemStream,LFMType,LFMComponentName,LFMClassName); + MemStream.Position:=0; + if LFMComponentName<>'' then begin + NewParentName:=OldParents.Values[LFMComponentName]; + if NewParentName<>'' then begin + AComponent:=GlobalDesignHook.GetComponent(NewParentName); + if AComponent is TWinControl then + NewParent:=TWinControl(AComponent); + end; + end; + end; + Result:=FormEditingHook.InsertFromStream(MemStream,NewParent, + [cpsfReplace]); if not Result then ShowAbortMessage(lisReplacingSelectionFailed); finally @@ -248,6 +274,7 @@ begin end; ComponentStream:=nil; LFMTree:=nil; + OldParents:=nil; try if not StreamSelection then exit; if not ParseLFMStream then exit; @@ -257,6 +284,7 @@ begin finally ComponentStream.Free; LFMTree.Free; + OldParents.Free; end; Result:=mrOk; end; diff --git a/lcl/lresources.pp b/lcl/lresources.pp index a758fe026d..ed06c1bc51 100644 --- a/lcl/lresources.pp +++ b/lcl/lresources.pp @@ -266,6 +266,9 @@ function CreateLRSReader(s: TStream; var DestroyDriver: boolean): TReader; function CreateLRSWriter(s: TStream; var DestroyDriver: boolean): TWriter; function GetClassNameFromLRSStream(s: TStream; out IsInherited: Boolean): shortstring; +procedure GetComponentInfoFromLRSStream(s: TStream; + out ComponentName, ComponentClassName: string; + out IsInherited: Boolean); procedure WriteComponentAsBinaryToStream(AStream: TStream; AComponent: TComponent); procedure ReadComponentFromBinaryStream(AStream: TStream; var RootComponent: TComponent; @@ -277,9 +280,9 @@ procedure BinaryToLazarusResourceCode(BinStream, ResStream: TStream; function LFMtoLRSfile(const LFMfilename: string): boolean;// true on success function LFMtoLRSstream(LFMStream, LRSStream: TStream): boolean;// true on success function FindLFMClassName(LFMStream: TStream):AnsiString; -procedure ReadLFMHeader(LFMStream: TStream; out LFMClassName: String; - out LFMType: String); -procedure ReadLFMHeader(LFMSource: string; out LFMClassName: String; +procedure ReadLFMHeader(LFMStream: TStream; + out LFMType, LFMComponentName, LFMClassName: String); +procedure ReadLFMHeader(const LFMSource: string; out LFMClassName: String; out LFMType: String); function CreateLFMFile(AComponent: TComponent; LFMStream: TStream): integer; @@ -466,7 +469,7 @@ begin NameLen:=0; s.Read(NameLen,1); if (NameLen and $f0) = $f0 then begin - { Read Flag Byte } + // Read Flag Byte s.Read(NameLen,1); IsInherited := (NameLen and 1) = 1; end else @@ -479,6 +482,45 @@ begin s.Position:=OldPosition; end; +procedure GetComponentInfoFromLRSStream(s: TStream; out ComponentName, + ComponentClassName: string; out IsInherited: Boolean); +var + Signature: shortstring; + NameLen: byte; + OldPosition: Int64; +begin + ComponentName:=''; + ComponentClassName:=''; + OldPosition:=s.Position; + // read signature + Signature:='1234'; + s.Read(Signature[1],length(Signature)); + if Signature<>'TPF0' then exit; + // read classname length + NameLen:=0; + s.Read(NameLen,1); + if (NameLen and $f0) = $f0 then begin + // Read Flag Byte + s.Read(NameLen,1); + IsInherited := (NameLen and 1) = 1; + end else + IsInherited := False; + // read classname + if NameLen>0 then begin + SetLength(ComponentClassName,NameLen); + s.Read(ComponentClassName[1],NameLen); + end; + // read component name length + NameLen:=0; + s.Read(NameLen,1); + // read componentname + if NameLen>0 then begin + SetLength(ComponentName,NameLen); + s.Read(ComponentName[1],NameLen); + end; + s.Position:=OldPosition; +end; + procedure WriteComponentAsBinaryToStream(AStream: TStream; AComponent: TComponent); var @@ -1348,8 +1390,8 @@ begin FStream.Write(Buf,Count); end; -procedure ReadLFMHeader(LFMStream:TStream; out LFMClassName: String; - out LFMType: String); +procedure ReadLFMHeader(LFMStream: TStream; + out LFMType, LFMComponentName, LFMClassName: String); var c:char; Token: String; @@ -1357,31 +1399,31 @@ begin { examples: object Form1: TForm1 inherited AboutBox2: TAboutBox2 - - - LFMClassName is the last word of the first line - - LFMType is the first word on the line } + LFMComponentName:=''; LFMClassName := ''; LFMType := ''; Token := ''; - while (LFMStream.Read(c,1)=1) and (LFMStream.Position<1000) - and (not (c in [#10,#13])) do begin + while (LFMStream.Read(c,1)=1) and (LFMStream.Position<1000) do begin if c in ['a'..'z','A'..'Z','0'..'9','_'] then Token := Token + c else begin - if LFMType = '' then - LFMType := Token; - if Token <> '' then - LFMClassName := Token; - Token := ''; + if Token<>'' then begin + if LFMType = '' then + LFMType := Token + else if LFMComponentName='' then + LFMComponentName:=Token + else if LFMClassName = '' then + LFMClassName := Token; + Token := ''; + end; + if c in [#10,#13] then break; end; end; - if Token <> '' then - LFMClassName := Token; LFMStream.Position:=0; end; -procedure ReadLFMHeader(LFMSource: string; out LFMClassName: String; +procedure ReadLFMHeader(const LFMSource: string; out LFMClassName: String; out LFMType: String); var p: Integer;