Designer: allow to change text (Caption, Lines etc.) in AskCompNameDlg as well.

git-svn-id: trunk@58246 -
2025-08-28 15:40:41 +02:00 · 2018-06-13 17:33:42 +00:00 · 2018-06-13 17:33:42 +00:00 · fa0239f62e
commit fa0239f62e
parent 862ceccf8c
4 changed files with 210 additions and 43 deletions
--- a/designer/askcompnamedlg.lfm
+++ b/designer/askcompnamedlg.lfm
@ -1,34 +1,34 @@
 object AskCompNameDialog: TAskCompNameDialog
  Left = 299
-  Height = 140
+  Height = 224
  Top = 177
-  Width = 389
+  Width = 393
  BorderIcons = [biSystemMenu]
  BorderStyle = bsDialog
  Caption = 'AskCompNameDialog'
-  ClientHeight = 140
-  ClientWidth = 389
+  ClientHeight = 224
+  ClientWidth = 393
  OnCreate = FormCreate
  Position = poScreenCenter
-  LCLVersion = '1.5'
-  object Label1: TLabel
+  LCLVersion = '1.9.0.0'
+  object NameLabel: TLabel
    Left = 6
-    Height = 17
+    Height = 15
    Top = 6
-    Width = 377
+    Width = 381
    Align = alTop
    BorderSpacing.Around = 6
-    Caption = 'Label1'
+    Caption = 'NameLabel'
    ParentColor = False
    WordWrap = True
  end
  object NameEdit: TEdit
-    AnchorSideTop.Control = Label1
+    AnchorSideTop.Control = NameLabel
    AnchorSideRight.Side = asrBottom
    Left = 6
-    Height = 27
-    Top = 29
-    Width = 377
+    Height = 23
+    Top = 27
+    Width = 381
    Align = alTop
    BorderSpacing.Around = 6
    OnChange = NameEditChange
@ -39,9 +39,9 @@ object AskCompNameDialog: TAskCompNameDialog
  end
  object ButtonPanel1: TButtonPanel
    Left = 6
-    Height = 29
-    Top = 105
-    Width = 377
+    Height = 26
+    Top = 192
+    Width = 381
    OKButton.Name = 'OKButton'
    OKButton.DefaultCaption = True
    HelpButton.Name = 'HelpButton'
@ -50,21 +50,21 @@ object AskCompNameDialog: TAskCompNameDialog
    CloseButton.DefaultCaption = True
    CancelButton.Name = 'CancelButton'
    CancelButton.DefaultCaption = True
-    TabOrder = 2
+    TabOrder = 3
    ShowButtons = [pbOK, pbCancel]
    ShowBevel = False
  end
  object InfoPanel: TPanel
    AnchorSideLeft.Control = NameEdit
-    AnchorSideTop.Control = NameEdit
+    AnchorSideTop.Control = TextMemo
    AnchorSideTop.Side = asrBottom
    AnchorSideRight.Control = NameEdit
    AnchorSideRight.Side = asrBottom
    AnchorSideBottom.Control = ButtonPanel1
    Left = 6
-    Height = 37
-    Top = 62
-    Width = 377
+    Height = 50
+    Top = 136
+    Width = 381
    Anchors = [akTop, akLeft, akRight, akBottom]
    BorderSpacing.Top = 6
    BorderSpacing.Bottom = 6
@ -74,6 +74,36 @@ object AskCompNameDialog: TAskCompNameDialog
    Font.Color = clInfoText
    ParentColor = False
    ParentFont = False
+    TabOrder = 2
+  end
+  object TextLabel: TLabel
+    AnchorSideTop.Control = NameEdit
+    AnchorSideTop.Side = asrBottom
+    Left = 6
+    Height = 15
+    Top = 56
+    Width = 49
+    Caption = 'TextLabel'
+    ParentColor = False
+    WordWrap = True
+  end
+  object TextMemo: TMemo
+    AnchorSideLeft.Control = NameLabel
+    AnchorSideTop.Control = TextLabel
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = NameLabel
+    AnchorSideRight.Side = asrBottom
+    Left = 6
+    Height = 53
+    Top = 77
+    Width = 381
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Top = 6
+    BorderSpacing.Bottom = 6
+    OnChange = NameEditChange
+    ParentShowHint = False
+    ScrollBars = ssAutoBoth
+    ShowHint = True
    TabOrder = 1
  end
 end
--- a/designer/askcompnamedlg.pas
+++ b/designer/askcompnamedlg.pas
@ -21,12 +21,14 @@
 unit AskCompNameDlg;

 {$mode objfpc}{$H+}
+{$modeswitch advancedrecords}

 interface

 uses
  Classes, SysUtils, LCLProc, FileUtil, Forms, Controls, Graphics,
-  Dialogs, StdCtrls, ButtonPanel, ExtCtrls, PropEdits, LazarusIDEStrConsts;
+  Dialogs, StdCtrls, ButtonPanel, ExtCtrls, PropEdits, LazarusIDEStrConsts,
+  TypInfo;

 type

@ -34,56 +36,178 @@ type

  TAskCompNameDialog = class(TForm)
    ButtonPanel1: TButtonPanel;
+    TextMemo: TMemo;
    InfoPanel: TPanel;
+    TextLabel: TLabel;
    NameEdit: TEdit;
-    Label1: TLabel;
+    NameLabel: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure NameEditChange(Sender: TObject);
  private
    FLookupRoot: TComponent;
    FNewComponent: TComponent;
+    FNewTextPropertyName: string;
+    function GetNewText: string;
+    function GetNewTextEnabled: Boolean;
    function GetNewName: TComponentName;
-    procedure SetNewName(const AValue: TComponentName);
+    procedure SetNewComponent(const ANewComponent: TComponent);
  public
    function IsValidName(AName: TComponentName; out ErrorMsg: string): boolean;
    property LookupRoot: TComponent read FLookupRoot write FLookupRoot;
-    property NewName: TComponentName read GetNewName write SetNewName;
-    property NewComponent: TComponent read FNewComponent write FNewComponent;
-  end; 
+    property NewName: TComponentName read GetNewName;
+    property NewText: string read GetNewText;
+    property NewTextPropertyName: string read FNewTextPropertyName;
+    property NewTextEnabled: Boolean read GetNewTextEnabled;
+    property NewComponent: TComponent read FNewComponent write SetNewComponent;
+  end;

-function ShowComponentNameDialog(ALookupRoot: TComponent; ANewComponent: TComponent): string;
+  TAskCompNameDialogResult = record
+    NameChanged: Boolean;
+    TextChanged: Boolean;
+    TextPropertyName: string;
+
+    function Changed: Boolean;
+  end;
+
+function ShowComponentNameDialog(ALookupRoot: TComponent; ANewComponent: TComponent): TAskCompNameDialogResult;

 implementation

 {$R *.lfm}

-function ShowComponentNameDialog(ALookupRoot: TComponent; ANewComponent: TComponent): string;
+function TryGetComponentText(AComponent: TComponent; out AText, ATextPropertyName: string): Boolean;
+var
+  PInfo: PPropInfo;
+  Lines: TObject;
+const
+  StringProperties: array[0..0] of string = ('Caption');
+  TStringsProperties: array[0..2] of string = ('Lines', 'Items', 'SQL');
 begin
+  // first check simple string properties
+  for ATextPropertyName in StringProperties do
+  begin
+    PInfo := GetPropInfo(AComponent, ATextPropertyName);
+    Result := (PInfo<>nil) and (PInfo^.SetProc<>nil) and (PInfo^.PropType^.Kind in [tkSString,tkLString,tkAString,tkWString]);
+    if Result then
+    begin
+      AText := GetPropValue(AComponent, PInfo, True);
+      Exit;
+    end;
+  end;
+
+  // then check TStrings properties
+  for ATextPropertyName in TStringsProperties do
+  begin
+    PInfo := GetPropInfo(AComponent, ATextPropertyName);
+    Result := (PInfo<>nil) and (PInfo^.SetProc<>nil) and (PInfo^.PropType^.Kind in [tkClass]);
+    if Result then
+    begin
+      Lines := GetObjectProp(AComponent, PInfo);
+      Result := Lines is TStrings;
+      if Result then
+      begin
+        AText := TStrings(Lines).Text;
+        Exit;
+      end;
+    end;
+  end;
+
+  // add more properties here
+
+  ATextPropertyName := '';
+  AText := '';
+end;
+
+procedure SetComponentText(AComponent: TComponent; AText, ATextPropertyName: string);
+var
+  PInfo: PPropInfo;
+  Obj: TObject;
+  StrL: TStringList;
+begin
+  PInfo := GetPropInfo(AComponent, ATextPropertyName);
+  case PInfo^.PropType^.Kind of
+    tkSString,tkLString,tkAString,tkWString: SetPropValue(AComponent, PInfo, AText);
+    tkClass:
+    begin
+      Obj := GetObjectProp(AComponent, PInfo);
+      if Obj is TStrings then
+      begin
+        StrL := TStringList.Create;
+        try
+          StrL.Text := AText;
+          SetObjectProp(AComponent, PInfo, StrL);
+        finally
+          StrL.Free;
+        end;
+      end else
+        raise Exception.CreateFmt('Unhandled object %s', [Obj.ClassName]);
+    end;
+  else
+    raise Exception.CreateFmt('Unhandled property type %d', [PInfo^.PropType^.Kind]);
+  end;
+end;
+
+function ShowComponentNameDialog(ALookupRoot: TComponent; ANewComponent: TComponent): TAskCompNameDialogResult;
+var
+  OldName: TComponentName;
+  OldText: string;
+begin
+  Result := Default(TAskCompNameDialogResult);
  with TAskCompNameDialog.Create(nil) do
  try
    LookupRoot:=ALookupRoot;
    NewComponent:=ANewComponent;
-    NewName:=NewComponent.Name;
-    Result:=NewComponent.Name; // Default name is the component's current name.
+    OldName := NewName;
+    OldText := NewText;
    if ShowModal=mrOk then
-      Result:=NewName;
+    begin
+      if OldName<>NewName then
+      begin
+        Result.NameChanged := True;
+        ANewComponent.Name := NewName;
+      end;
+      if NewTextEnabled and (OldText<>NewText) then
+      begin
+        Result.TextChanged := True;
+        Result.TextPropertyName := NewTextPropertyName;
+        SetComponentText(ANewComponent, NewText, NewTextPropertyName);
+      end;
+    end;
  finally
    Free;
  end;
 end;

+{ TAskCompNameDialogResult }
+
+function TAskCompNameDialogResult.Changed: Boolean;
+begin
+  Result := NameChanged or TextChanged;
+end;
+
 { TAskCompNameDialog }

 procedure TAskCompNameDialog.FormCreate(Sender: TObject);
 begin
-  Caption:=lisChooseName;
-  Label1.Caption:=lisChooseANameForTheComponent;
+  Caption:=lisChooseNameAndText;
+  NameLabel.Caption:=lisChooseANameForTheComponent;
  NameEdit.Hint:=lisTheComponentNameMustBeUniqueInAllComponentsOnTheFo;
+  TextLabel.Caption:=lisMenuEditorCaption;
  ButtonPanel1.OKButton.Caption:=lisOk;
  ButtonPanel1.CancelButton.Caption:=lisCancel;
  ButtonPanel1.OKButton.Enabled:=false;
 end;

+function TAskCompNameDialog.GetNewText: string;
+begin
+  Result := TextMemo.Text;
+end;
+
+function TAskCompNameDialog.GetNewTextEnabled: Boolean;
+begin
+  Result := TextMemo.Enabled;
+end;
+
 procedure TAskCompNameDialog.NameEditChange(Sender: TObject);
 var
  Ok: boolean;
@ -100,10 +224,22 @@ begin
  Result:=NameEdit.Text;
 end;

-procedure TAskCompNameDialog.SetNewName(const AValue: TComponentName);
+procedure TAskCompNameDialog.SetNewComponent(const ANewComponent: TComponent);
+var
+  ReadText: string;
 begin
-  NameEdit.Text:=AValue;
+  if FNewComponent = ANewComponent then Exit;
+  FNewComponent := ANewComponent;
+  NameEdit.Text := FNewComponent.Name;
  NameEditChange(nil);
+  TextMemo.Enabled := TryGetComponentText(FNewComponent, ReadText, FNewTextPropertyName);
+  TextLabel.Enabled := TextMemo.Enabled;
+  if TextMemo.Enabled then
+  begin
+    TextMemo.Text := ReadText;
+    TextLabel.Caption:=FNewTextPropertyName;
+  end else
+    TextMemo.Text := '';
 end;

 function TAskCompNameDialog.IsValidName(AName: TComponentName; out
--- a/designer/designer.pp
+++ b/designer/designer.pp
@ -760,7 +760,7 @@ begin

  if EnvironmentOptions.CreateComponentFocusNameProperty then
    // ask user for name
-    NewComponent.Name:=ShowComponentNameDialog(LookupRoot,NewComponent);
+    ShowComponentNameDialog(LookupRoot,NewComponent);

  // tell IDE about the new component (e.g. add it to the source)
  NotifyPersistentAdded(NewComponent);
@ -2782,7 +2782,7 @@ var
  Command: word;
  Handled: boolean;
  Current: TComponent;
-  NewName: String;
+  NameRes: TAskCompNameDialogResult;
  UTF8Char: TUTF8Char;

  procedure Nudge(x, y: integer);
@ -2875,12 +2875,13 @@ begin
      VK_F2:
        if (Selection.Count=1) and Selection[0].IsTComponent then begin
          Current := TComponent(Selection[0].Persistent);
-          NewName := ShowComponentNameDialog(LookupRoot, Current);
-          if NewName <> Current.Name then begin
-            Current.Name:=NewName;
+          NameRes := ShowComponentNameDialog(LookupRoot, Current);
+          if NameRes.NameChanged then
            GlobalDesignHook.ComponentRenamed(Current);
+          if NameRes.TextChanged then
+            GlobalDesignHook.Modified(Current, NameRes.TextPropertyName);
+          if NameRes.Changed then
            Modified;
-          end;
        end; // don't forget the semicolon before else !!!

      else
--- a/ide/lazarusidestrconsts.pas
+++ b/ide/lazarusidestrconsts.pas
@ -5864,7 +5864,7 @@ resourcestring
  lisTheOwnerHasThisName = 'The owner has this name';
  lisTheOwnerClassHasThisName = 'The owner class has this name';
  lisTheUnitHasThisName = 'The unit has this name';
-  lisChooseName = 'Choose name';
+  lisChooseNameAndText = 'Choose name and text';
  lisTheComponentNameMustBeUniqueInAllComponentsOnTheFo = 'The component name '
    +'must be unique in all components on the form/datamodule.The name is '
    +'compared case insensitive like a normal Pascal identifier.';