mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-08 02:19:57 +02:00
Merged revision(s) 61973-61974 #c32570a990-#c32570a990 from trunk:
Designer: Explode a big WITH block in TDesigner.ExecuteUndoItem. Use another temp variable. ........ Designer: Support Undo for properties of subcomponents like 'LabeledEdit1.SubLabel'. Issue #36071. ........ git-svn-id: branches/fixes_2_0@61993 -
This commit is contained in:
parent
0bfecba09a
commit
6706333a0b
@ -1421,81 +1421,82 @@ procedure TDesigner.ExecuteUndoItem(IsActUndo: boolean);
|
||||
|
||||
procedure SetPropVal(AVal: variant);
|
||||
var
|
||||
tmpStr, str: string;
|
||||
tmpCompName: TComponentName;
|
||||
tmpStr, tmpFieldN, str: string;
|
||||
tmpCompN: TComponentName;
|
||||
tmpObj: TObject;
|
||||
tmpInt: integer;
|
||||
aPropType: PTypeInfo;
|
||||
begin
|
||||
tmpCompName := FUndoList[FUndoCurr].compName;
|
||||
if FUndoList[FUndoCurr].fieldName = 'Name' then
|
||||
tmpCompN := FUndoList[FUndoCurr].compName;
|
||||
tmpFieldN := FUndoList[FUndoCurr].fieldName;
|
||||
if tmpFieldN = 'Name' then
|
||||
begin
|
||||
if IsActUndo then
|
||||
tmpCompName := FUndoList[FUndoCurr].newVal
|
||||
tmpCompN := FUndoList[FUndoCurr].newVal
|
||||
else
|
||||
tmpCompName := FUndoList[FUndoCurr].oldVal;
|
||||
tmpCompN := FUndoList[FUndoCurr].oldVal;
|
||||
end;
|
||||
|
||||
if FForm.Name <> tmpCompName then
|
||||
tmpObj := TObject(FForm.FindComponent(tmpCompName))
|
||||
if FForm.Name <> tmpCompN then
|
||||
tmpObj := TObject(FForm.FindSubComponent(tmpCompN))
|
||||
else
|
||||
tmpObj := TObject(FForm);
|
||||
|
||||
if VarIsError(AVal) or VarIsEmpty(AVal) or VarIsNull(AVal) then
|
||||
ShowMessage('error: invalid var type');
|
||||
tmpStr := VarToStr(AVal);
|
||||
//DebugLn(['TDesigner.ExecuteUndoItem: FForm=', FForm.Name, ', CompName=', tmpCompN,
|
||||
// ', FieldName=', tmpFieldN, ', tmpObj=', tmpObj, ', tmpStr=', tmpStr, ', IsActUndo=', IsActUndo]);
|
||||
|
||||
with FUndoList[FUndoCurr] do begin
|
||||
if propInfo<>nil then
|
||||
begin
|
||||
aPropType:=propInfo^.propType;
|
||||
case aPropType^.Kind of
|
||||
tkInteger, tkInt64:
|
||||
begin
|
||||
if (aPropType^.Name = 'TColor') or
|
||||
(aPropType^.Name = 'TGraphicsColor') then
|
||||
SetOrdProp(tmpObj, fieldName, StringToColor(tmpStr))
|
||||
else if aPropType^.Name = 'TCursor' then
|
||||
SetOrdProp(tmpObj, fieldName, StringToCursor(tmpStr))
|
||||
else
|
||||
SetOrdProp(tmpObj, fieldName, StrToInt(tmpStr));
|
||||
end;
|
||||
tkChar, tkWChar, tkUChar:
|
||||
begin
|
||||
if Length(tmpStr) = 1 then
|
||||
SetOrdProp(tmpObj, FUndoList[FUndoCurr].fieldName, Ord(tmpStr[1]))
|
||||
else if (tmpStr[1] = '#') then
|
||||
begin
|
||||
str := Copy(tmpStr, 2, Length(tmpStr) - 1);
|
||||
if TryStrToInt(str, tmpInt) and (tmpInt >= 0) and (tmpInt <= High(Byte)) then
|
||||
SetOrdProp(tmpObj, FUndoList[FUndoCurr].fieldName, tmpInt);
|
||||
end;
|
||||
end;
|
||||
tkEnumeration:
|
||||
SetEnumProp(tmpObj, FUndoList[FUndoCurr].fieldName, tmpStr);
|
||||
tkFloat:
|
||||
SetFloatProp(tmpObj, fieldName, StrToFloat(tmpStr));
|
||||
tkBool:
|
||||
SetOrdProp(tmpObj, FUndoList[FUndoCurr].fieldName, Integer(StrToBoolOI(tmpStr)));
|
||||
tkString, tkLString, tkAString, tkUString, tkWString:
|
||||
SetStrProp(tmpObj, fieldName, tmpStr);
|
||||
tkSet:
|
||||
SetSetProp(tmpObj, FUndoList[FUndoCurr].fieldName, tmpStr);
|
||||
tkVariant:
|
||||
SetVariantProp(tmpObj, fieldName, AVal);
|
||||
else
|
||||
ShowMessage(Format('error: unknown TTypeKind(%d)', [Integer(aPropType^.Kind)]));
|
||||
end;
|
||||
end else begin
|
||||
// field is not published
|
||||
if tmpObj is TComponent then
|
||||
if FUndoList[FUndoCurr].propInfo<>nil then
|
||||
begin
|
||||
aPropType:=FUndoList[FUndoCurr].propInfo^.propType;
|
||||
case aPropType^.Kind of
|
||||
tkInteger, tkInt64:
|
||||
begin
|
||||
// special case: TComponent.Left,Top
|
||||
if CompareText(fieldName,'Left')=0 then
|
||||
SetDesignInfoLeft(TComponent(tmpObj),StrToInt(tmpStr))
|
||||
else if CompareText(fieldName,'Top')=0 then
|
||||
SetDesignInfoTop(TComponent(tmpObj),StrToInt(tmpStr));
|
||||
if (aPropType^.Name = 'TColor') or
|
||||
(aPropType^.Name = 'TGraphicsColor') then
|
||||
SetOrdProp(tmpObj, tmpFieldN, StringToColor(tmpStr))
|
||||
else if aPropType^.Name = 'TCursor' then
|
||||
SetOrdProp(tmpObj, tmpFieldN, StringToCursor(tmpStr))
|
||||
else
|
||||
SetOrdProp(tmpObj, tmpFieldN, StrToInt(tmpStr));
|
||||
end;
|
||||
tkChar, tkWChar, tkUChar:
|
||||
begin
|
||||
if Length(tmpStr) = 1 then
|
||||
SetOrdProp(tmpObj, tmpFieldN, Ord(tmpStr[1]))
|
||||
else if (tmpStr[1] = '#') then
|
||||
begin
|
||||
str := Copy(tmpStr, 2, Length(tmpStr) - 1);
|
||||
if TryStrToInt(str, tmpInt) and (tmpInt >= 0) and (tmpInt <= High(Byte)) then
|
||||
SetOrdProp(tmpObj, tmpFieldN, tmpInt);
|
||||
end;
|
||||
end;
|
||||
tkEnumeration:
|
||||
SetEnumProp(tmpObj, tmpFieldN, tmpStr);
|
||||
tkFloat:
|
||||
SetFloatProp(tmpObj, tmpFieldN, StrToFloat(tmpStr));
|
||||
tkBool:
|
||||
SetOrdProp(tmpObj, tmpFieldN, Integer(StrToBoolOI(tmpStr)));
|
||||
tkString, tkLString, tkAString, tkUString, tkWString:
|
||||
SetStrProp(tmpObj, tmpFieldN, tmpStr);
|
||||
tkSet:
|
||||
SetSetProp(tmpObj, tmpFieldN, tmpStr);
|
||||
tkVariant:
|
||||
SetVariantProp(tmpObj, tmpFieldN, AVal);
|
||||
else
|
||||
ShowMessage(Format('error: unknown TTypeKind(%d)', [Integer(aPropType^.Kind)]));
|
||||
end;
|
||||
end else begin
|
||||
// field is not published
|
||||
if tmpObj is TComponent then
|
||||
begin
|
||||
// special case: TComponent.Left,Top
|
||||
if CompareText(tmpFieldN,'Left')=0 then
|
||||
SetDesignInfoLeft(TComponent(tmpObj),StrToInt(tmpStr))
|
||||
else if CompareText(tmpFieldN,'Top')=0 then
|
||||
SetDesignInfoTop(TComponent(tmpObj),StrToInt(tmpStr));
|
||||
end;
|
||||
end;
|
||||
PropertyEditorHook.Modified(tmpObj);
|
||||
@ -1802,6 +1803,7 @@ var
|
||||
SaveControlSelection: TControlSelection;
|
||||
AStream: TStringStream;
|
||||
APropInfo: PPropInfo;
|
||||
Comp: TComponent;
|
||||
begin
|
||||
Result := (FUndoLock = 0);
|
||||
if not Result then Exit;
|
||||
@ -1857,9 +1859,12 @@ begin
|
||||
compName := '';
|
||||
parentName := '';
|
||||
if aPersistent is TComponent then begin
|
||||
compName := TComponent(aPersistent).Name;
|
||||
if TComponent(aPersistent).HasParent then
|
||||
parentName := TComponent(aPersistent).GetParentComponent.Name;
|
||||
Comp := TComponent(aPersistent);
|
||||
compName := Comp.Name;
|
||||
if Comp.Owner <> LookupRoot then // This is a subcomponent.
|
||||
compName := Comp.Owner.Name + '.' + compName; // Add owner to the name.
|
||||
if Comp.HasParent then
|
||||
parentName := Comp.GetParentComponent.Name;
|
||||
end;
|
||||
opType := aOpType;
|
||||
isValid := true;
|
||||
|
@ -1616,6 +1616,7 @@ type
|
||||
function GetParentComponent: TComponent; override;
|
||||
function IsParentOf(AControl: TControl): boolean; virtual;
|
||||
function GetTopParent: TControl;
|
||||
function FindSubComponent(AName: string): TComponent;
|
||||
function IsVisible: Boolean; virtual;// checks parents too
|
||||
function IsControlVisible: Boolean; virtual;// does not check parents
|
||||
function IsEnabled: Boolean; // checks parent too
|
||||
|
@ -5244,10 +5244,6 @@ begin
|
||||
Result := Parent;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function TControl.IsParentOf(AControl: TControl): boolean;
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
function TControl.IsParentOf(AControl: TControl): boolean;
|
||||
begin
|
||||
Result := False;
|
||||
@ -5266,6 +5262,25 @@ begin
|
||||
Result := Result.Parent;
|
||||
end;
|
||||
|
||||
function TControl.FindSubComponent(AName: string): TComponent;
|
||||
// Like TComponent.FindComponent but finds also a subcomponent which name is
|
||||
// separated by a dot. For example 'LabeledEdit1.SubLabel'.
|
||||
var
|
||||
i: Integer;
|
||||
SubName: String;
|
||||
begin
|
||||
i := Pos('.', AName);
|
||||
if i > 0 then begin
|
||||
SubName := Copy(AName, i+1, Length(AName));
|
||||
Delete(AName, i, Length(AName));
|
||||
end
|
||||
else
|
||||
SubName := '';
|
||||
Result := FindComponent(AName);
|
||||
if Assigned(Result) and (SubName<>'') then
|
||||
Result := Result.FindComponent(SubName);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TControl.SendToBack
|
||||
Params: None
|
||||
|
Loading…
Reference in New Issue
Block a user