この発言は
#01412　tach            さんの兄弟コンポの一括リネーム
に対するコメントです




続きです。


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

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;


{ TComponentRenamer }

const
  EMessages: Array[0..2] of String
    = ('OldName must have format NameXX. XX:Number',
    'Can''t Find Component: %s',
    'StraightCount must be Bigger than 1');


constructor TCompoRenamer.Create(AOwner: TComponent);
begin
  Inherited;
  FStartNo := 1;
  if not (csDesigning in ComponentState) then 
    ShowMessage('TCompoRenamerは設計時専用のコンポーネントです。'+
    'リリース版を構築する前にこのコンポーネントを削除して下さい。');
end;

function TCompoRenamer.CanRename: boolean;
begin
  Result := CanRelocate and (FNewName <> '');
end;

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

function TCompoRenamer.TargetSuffixNum: Integer;
var
  i, Len: Integer;
begin
  Result := 1; Len := Length(FTargetName);
  while Result <= Len do
  begin
    if FTargetName[Result] in ['0'..'9'] then break
    else if Result = Len then raise Exception.Create(EMessages[0]);
    Inc(Result);
  end;

  i := Result;
  while i < Len do
  begin
    if not (FTargetName[i] in ['0'..'9']) then
      raise Exception.Create(EMessages[0]);
    Inc(i);
  end;
  Result := StrToInt(String(PChar(FTargetName) + Result - 1));
end;

function TCompoRenamer.TargetBody: String;
var
  X: Integer;
begin
  X := TargetSuffixNum;
  Result := 
    Copy(FTargetName, 1, Length(FTargetName) - Length(IntToStr(X)));
end;


procedure TCompoRenamer.DoRenameTarget;
var
  i, N, Count: Integer;
  OldNameBody, 
  OldName, NewName: String;
  Compo: TComponent;
  List: TPairedNameList;
begin
  if CanRename then
  begin
    i := TargetSuffixNum;
    List := TPairedNameList.Create; // エラー時復帰用
    try
      Count := i;
      OldNameBody := TargetBody;
      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.DoResizeTarget;
var
  Body: String;
  i, j, n: Integer;
  Compo: TComponent;
begin
  j := TargetSuffixNum;
  n := j + FRepCount - 1;
  Body := TargetBody;
  for i := j to n do
  begin
    Compo := Owner.FindComponent(Body + IntToStr(i));
    if (Compo <> nil) and (Compo is TControl) then
      with Compo as TControl do
      SetBounds(Left, Top, FTargetWidth, FTargetHeight);
  end;
end;

procedure TCompoRenamer.DoRelocateTarget;
var
  Body: String;
  i, j, n: Integer;
  Compo: TComponent;
  XBase, YBase, X, Y, dx, dy: Integer;
begin
  if ((FTargetAlign in [taRowByCount, taColByCount]) and 
    (FStraightCount < 1)) then
    raise Exception.Create(EMessages[2]);
  j := TargetSuffixNum;
  n := j + FRepCount - 1;
  Body := TargetBody;
  Compo := Owner.FindComponent(Body + IntToStr(j));
  if (Compo <> nil) and (Compo is TControl) then
  begin
    with Compo as TControl do
    begin
      XBase := Left; YBase := Top;
      dx := Width + FXClearance;
      dy := Height + FYClearance;
    end;
    X := XBase; Y := YBase;
    for i := j + 1to n do
    begin
      case FTargetAlign of
      taRow: Inc(Y, dy);
      taRowByCount:
        begin
          if ((i - j) mod FStraightCount) = 0 then
          begin
            Inc(X, dx); Y := YBase;
          end else
            Inc(Y, dy);
        end;
      taCol: Inc(X, dx);
      taColByCount:
        begin
          if ((i - j) mod FStraightCount) = 0 then
          begin
            Inc(Y, dy);  X := XBase;
          end else
            Inc(X, dx);
        end;
      end;
      Compo := Owner.FindComponent(Body + IntToStr(i));
      if (Compo <> nil) and (Compo is TControl) then
        with Compo as TControl do
        SetBounds(X, Y, FTargetWidth, FTargetHeight);
    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;
const
  Verbs: Array[0..2] of String = ('Rename', 'Resize', 'Relocate');
begin
  Index := Index mod 3;
  Result := Verbs[Index] + ': ' + (Component as 
TCompoRenamer).FTargetName;
end;

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

procedure TCompoRenamerEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
  0: (Component as TCompoRenamer).DoRenameTarget;
  1: (Component as TCompoRenamer).DoResizeTarget;
  2: (Component as TCompoRenamer).DoRelocateTarget;
  end;
end;

procedure TCompoRenamerEditor.Edit;
begin
  (Component as TCompoRenamer).DoRenameTarget;
end;

end.

// ----------- End of ソース ---------------

tach  YIU01245

 


Original document by tach            氏 ID:(YIU01245)

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