この発言に対し以下のコメントが寄せられています

#01413　tach            さん　RE:兄弟コンポの一括リネーム

#01414　tach            さん　RE:兄弟コンポの一括リネーム






こんにちは tachです。

Mes17#312 かつぽーさんの発言から思いついたものです。
利用法はソースの先頭にあります。
あまり利用価値無いかも(-_-;)

---------------以下ソース-----------

unit CompoRen;

{
  コンポーネントエディタを利用して、　
  設計時に兄弟コンポの一括リネームを行う
　使用法：
    eg. Edit1..Edit9の内、Edit5..Edit9を UserName1..UserName5に
        変更する場合。
    TargetName = 'Edit5'
    NewName = 'UserName'
    StartNo = 1
    RepCount = 5
    を設定した後このコンポーネントをダブルクリックする
    またはポップアップメニューから 'Rename XXXX'を選択する

    tach YIU01245
}

interface

uses
    Classes, SysUtils, DsgnIntf, Dialogs;

type
  TCompoRenamer = class(TComponent)
  private
    FTargetName: String;
    FNewName: String;
    FStartNo: Integer;
    FRepCount: Integer;
    procedure SetTargetName(AName: String);
    procedure DoRename;
  public
    constructor Create(AOwner: TComponent); override;
    function CanRename: boolean;
  published
    property TargetName: String read FTargetName write SetTargetName;
    property NewName: String read FNewName write FNewName;
    property StartNo: Integer read FStartNo write FStartNo;
    property RepCount: Integer read FRepCount write FRepCount;
  end;

  TCompoRenamerEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): String; override;
    function GetVerbCount: Integer; override;
    procedure Edit; override;
  end;

  procedure Register;

implementation


procedure Register;
begin
  RegisterComponents('samples', [TCompoRenamer]);
  RegisterComponentEditor(TCompoRenamer, TCompoRenamerEditor);
end;


{ Utils }

type
  { エラー復帰時のリストで使用 }
  PPairedNames = ^TPairedNames;
  TPairedNames = record
    OldName, NewName: String;
  end;

  TPairedNameList = class(TList)
    function Add(AOld, ANew: String): Integer;
    function PairNames(Index: Integer): PPairedNames;
    procedure Clear; override;
  end;

function TPairedNameList.Add(AOld, ANew: String): Integer;
var
  P: PPairedNames;
begin
  New(P);
  P.OldName := AOld;
  P.NewName := ANew;
  Result := Inherited Add(P);
end;

procedure TPairedNameList.Clear;
var
  i: Integer;
begin
  for i := Count - 1 downto 0 do
  begin
    DisPose(Items[i]);
    Items[i] := nil;
  end;
  inherited;
end;

function TPairedNameList.PairNames(Index: Integer): PPairedNames;
begin
  Result := Items[Index];
end;


constructor TCompoRenamer.Create(AOwner: TComponent);
begin
  Inherited;
  FStartNo := 1;
end;

function TCompoRenamer.CanRename: boolean;
begin
  Result := (FTargetName <> '') and
            (FNewName <> '') and
            (Owner <> nil) and
            (Owner.FindComponent(FTargetName) <> nil);
end;

procedure TCompoRenamer.DoRename;
const
  EMessages: Array[0..1] of String
    = ('OldName must have format NameXX. XX:Number',
    'Can''t Find Component: %s');
var
  i, N, Len, Count: Integer;
  OldNameBody, 
  OldName, NewName: String;
  Compo: TComponent;
  List: TPairedNameList;
begin
  if csDesigning in ComponentState then
  begin
    { 名前のチェック }
    i := 1; Len := Length(FTargetName);
    while i <= Len do
    begin
      if FTargetName[i] in ['0'..'9'] then break
      else if i = Len then raise Exception.Create(EMessages[0]);
      Inc(i);
    end;

    { ここもチェック }
    Count := i;
    while Count < Len do
    begin
      if not (FTargetName[Count] in ['0'..'9']) then
        raise Exception.Create(EMessages[0]);
      Inc(Count);
    end;

    List := TPairedNameList.Create; // エラー時復帰用
    try
      Count := StrToInt(PChar(FTargetName) + i - 1);
      OldNameBody := Copy(FTargetName, 1, i - 1);
      N := FStartNo;
      try
        for i := Count to Count + FRepCount - 1 do
        begin
          OldName := OldNameBody + IntToStr(i);
          NewName := FNewName + IntToStr(N);
          Compo := Owner.FindComponent(OldName);
          if (Compo <> nil) then
          begin
            Compo.Name := NewName;
            Inc(N);
            List.Add(OldName, NewName);
          end else
            raise Exception.CreateFmt(EMessages[1], [OldName]);
        end;
      except
        for i := List.Count - 1 downto 0 do
        begin
          with List.PairNames(i)^ do
          begin
            Compo := Owner.FindComponent(NewName);
            if (Compo <> nil) then
              Compo.Name := OldName;
          end;
        end;
        raise;
      end;
    finally
      List.Free;
    end;
  end;
end;

procedure TCompoRenamer.SetTargetName(AName: String);
begin
  if (AName <> FTargetName) and 
     (Owner <> nil) and 
     (Owner.FindComponent(AName) <> nil) then
    FTargetName := AName;
end;

function TCompoRenamerEditor.GetVerb(Index: Integer): String;
begin
  if (Component as TCompoRenamer).CanRename then
    Result := 'Rename: ' + (Component as TCompoRenamer).FTargetName
  else
    Result := 'Can''t Rename';
end;

function TCompoRenamerEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;

procedure TCompoRenamerEditor.ExecuteVerb(Index: Integer);
begin
  Edit
end;

procedure TCompoRenamerEditor.Edit;
begin
  ShowMessage('Edit Start');
  (Component as TCompoRenamer).DoRename;
  ShowMessage('Edit End');
end;


end.
 


Original document by tach            氏 ID:(YIU01245)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。