お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"RE:兄弟コンポの一括リネーム"

この発言は
#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蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。

Copyright 1996-2002 Delphi Users' Forum