bottleclient/StrReplace.pas

   1 unit StrReplace;
   2
   3 {
   4   StrReplace.pas
   5   GUI\82©\82ç\93Æ\97§\82µ\82½\81A\95¶\8e\9a\97ñ\92u\8a·\8aÖ\98A\83\8d\83W\83b\83N\83N\83\89\83X\82Ì\8eÀ\91\95
   6 }
   7
   8 interface
   9
  10 uses Classes, SysUtils, Forms, Menus, RegexUtils, Contnrs;
  11
  12 type
  13   // \88È\89º\82Ì5\82Â\82Ì\83N\83\89\83X\82Ì\92è\8b`\82Í\81A\8f¬\82³\82¢\95û\82©\82ç\81¨\91å\82«\82¢\95û\82Ö\81A\82Æ
  14   // \8bL\8fq\82µ\82Ä\82 \82é(\8aÜ\82Ü\82ê\82é\95û\82©\82ç\8aÜ\82Þ\95û\81A\82Ì\8f\87\94Ô)
  15
  16   // \8c\9f\8dõ\8cê\82Æ\92u\8a·\8cê\82Ì\83y\83A\82Æ\82»\82Ì\83I\83v\83V\83\87\83\93\82ð\8bL\98^\82·\82é\8d\\91¢\91Ì
  17   TReplacePairRec = record
  18     BeforeStr: string;
  19     AfterStr:  string;
  20     IgnoreCase: boolean;
  21     UseRegExp: boolean;
  22   end;
  23
  24   // \8c\9f\8dõ\8cê\82Æ\92u\8a·\8cê\82Ì\83y\83A\82Æ\82»\82Ì\83I\83v\83V\83\87\83\93\82ð\8bL\98^\82·\82é\83N\83\89\83X
  25   TReplacePair = class(TCollectionItem)
  26   private
  27     FPairRec: TReplacePairRec;
  28     procedure SetAfterStr(const Value: string);
  29     procedure SetBeforeStr(const Value: string);
  30     procedure SetIgnoreCase(const Value: boolean);
  31     procedure SetUseRegExp(const Value: boolean);
  32     function GetAfterStr: string;
  33     function GetBeforeStr: string;
  34     function GetIgnoreCase: boolean;
  35     function GetUseRegExp: boolean;
  36   public
  37     constructor Create(Collection: TCollection); override;
  38     function ExecuteReplace(TargetStr: string): string;
  39     procedure Assign(Source: TPersistent); override;
  40     procedure Clear;
  41     function IsValidPair: Boolean;
  42   published
  43     property BeforeStr: string read GetBeforeStr write SetBeforeStr;
  44     property AfterStr: string read GetAfterStr write SetAfterStr;
  45     property IgnoreCase: boolean read GetIgnoreCase write SetIgnoreCase default false;
  46     property UseRegExp: boolean read GetUseRegExp write SetUseRegExp default false;
  47   end;
  48
  49   // TReplacePair\82Ì\83R\83\8c\83N\83V\83\87\83\93\83N\83\89\83X\81B
  50   TReplacePairCollection = class(TCollection)
  51   private
  52     function GetItem(Index: Integer): TReplacePair;
  53   public
  54     function Add: TReplacePair;
  55     property Items[Index: Integer]: TReplacePair read GetItem; default;
  56     function ExecuteReplace(TargetStr: string): string;
  57     function StringExpression: string;
  58   end;
  59
  60   // TReplacePair\82Ì\83R\83\8c\83N\83V\83\87\83\93\82ð\95Û\8e\9d\82µ\81A\83^\83C\83g\83\8b\82È\82Ç\82ð\82Ü\82Æ\82ß\82Ä
  61   // 1\82Â\82Ì\83v\83\8a\83Z\83b\83g\90Ý\92è\8d\80\96Ú\82ð\95\\8c»\82·\82é\83N\83\89\83X
  62   TReplacePreset = class(TCollectionItem)
  63   private
  64     FTitle: string;
  65     FPairs: TReplacePairCollection;
  66     FShortCut: TShortCut;
  67     FConfirmAfterReplace: Boolean;
  68     procedure SetPairs(const Value: TReplacePairCollection);
  69     procedure SetShortCut(const Value: TShortCut);
  70     procedure SetTitle(const Value: string);
  71     procedure SetConfirmAfterReplace(const Value: Boolean);
  72   public
  73     constructor Create(Collection: TCollection); override;
  74     destructor Destroy; override;
  75     procedure Assign(Source: TPersistent); override;
  76   published
  77     property Pairs: TReplacePairCollection read FPairs write SetPairs;
  78     property Title: string read FTitle write SetTitle;
  79     property ShortCut: TShortCut read FShortCut write SetShortCut;
  80     property ConfirmAfterReplace: Boolean read FConfirmAfterReplace write SetConfirmAfterReplace;
  81   end;
  82
  83   TReplacePresetCollection = class(TCollection)
  84   private
  85     function GetItem(Index: Integer): TReplacePreset;
  86   public
  87     function Add: TReplacePreset;
  88     property Items[Index: Integer]: TReplacePreset read GetItem; default;
  89   end;
  90
  91   // \8dÅ\8fI\93I\82É\82±\82ê\82ð\83V\83\8a\83A\83\89\83C\83Y\82·\82é
  92   TReplacePresets = class(TComponent)
  93   private
  94     FPresets: TReplacePresetCollection;
  95     procedure SetPresets(const Value: TReplacePresetCollection);
  96   public
  97     constructor Create(AOwner: TComponent); override;
  98     destructor Destroy; override;
  99     procedure Assign(Source: TPersistent); override;
 100   published
 101     property Presets: TReplacePresetCollection read FPresets write SetPresets;
 102   end;
 103
 104 implementation
 105
 106 { TReplacePair }
 107
 108 procedure TReplacePair.Assign(Source: TPersistent);
 109 begin
 110   if not (Source is TReplacePair) then
 111     inherited
 112   else
 113     FPairRec := (Source as TReplacePair).FPairRec;
 114 end;
 115
 116 procedure TReplacePair.Clear;
 117 begin
 118   with FPairRec do
 119   begin
 120     BeforeStr := '';
 121     AfterStr := '';
 122     UseRegExp := false;
 123     IgnoreCase := false;
 124   end;
 125 end;
 126
 127 constructor TReplacePair.Create(Collection: TCollection);
 128 begin
 129   inherited;
 130   IgnoreCase := true;
 131 end;
 132
 133 function TReplacePair.ExecuteReplace(TargetStr: string): string;
 134 var
 135   Options: TReplaceFlags;
 136 begin
 137   // 1\82Â\82Ì\92u\8a·\82ð\8eÀ\91\95\82·\82é
 138   Result := TargetStr;
 139   Options := [rfReplaceAll];
 140   if IgnoreCase then
 141     Options := Options + [rfIgnoreCase];
 142   if UseRegExp then
 143     Result := StringReplaceRegExp(Result, BeforeStr, AfterStr, Options)
 144   else
 145     Result := StringReplace(Result, BeforeStr, AfterStr, Options);
 146 end;
 147
 148 function TReplacePair.GetAfterStr: string;
 149 begin
 150   Result := FPairRec.AfterStr;
 151 end;
 152
 153 function TReplacePair.GetBeforeStr: string;
 154 begin
 155   Result := FPairRec.BeforeStr;
 156 end;
 157
 158 function TReplacePair.GetIgnoreCase: boolean;
 159 begin
 160   Result := FPairRec.IgnoreCase;
 161 end;
 162
 163 function TReplacePair.GetUseRegExp: boolean;
 164 begin
 165   Result := FPairRec.UseRegExp;
 166 end;
 167
 168 function TReplacePair.IsValidPair: Boolean;
 169 begin
 170   Result := true;
 171   if BeforeStr = '' then
 172     Result := false
 173   else
 174     try
 175       ExecuteReplace(' ')
 176     except
 177       Result := false;
 178     end;
 179 end;
 180
 181 procedure TReplacePair.SetAfterStr(const Value: string);
 182 begin
 183   FPairRec.AfterStr := Value;
 184 end;
 185
 186 procedure TReplacePair.SetBeforeStr(const Value: string);
 187 begin
 188   FPairRec.BeforeStr := Value;
 189 end;
 190
 191 procedure TReplacePair.SetIgnoreCase(const Value: boolean);
 192 begin
 193   FPairRec.IgnoreCase := Value;
 194 end;
 195
 196 procedure TReplacePair.SetUseRegExp(const Value: boolean);
 197 begin
 198   FPairRec.UseRegExp := Value;
 199 end;
 200
 201 { TReplacePreset }
 202
 203 procedure TReplacePreset.Assign(Source: TPersistent);
 204 var
 205   Src: TReplacePreset;
 206 begin
 207   if not (Source is TReplacePreset) then
 208     inherited
 209   else
 210   begin
 211     Src := Source as TReplacePreset;
 212     Pairs.Assign(Src.Pairs);
 213     Title := Src.Title;
 214     ShortCut := Src.ShortCut;
 215     ConfirmAfterReplace := Src.ConfirmAfterReplace;
 216   end;
 217 end;
 218
 219 constructor TReplacePreset.Create(Collection: TCollection);
 220 begin
 221   inherited;
 222   FPairs := TReplacePairCollection.Create(TReplacePair);
 223 end;
 224
 225 destructor TReplacePreset.Destroy;
 226 begin
 227   FPairs.Free;
 228   inherited;
 229 end;
 230
 231 procedure TReplacePreset.SetPairs(const Value: TReplacePairCollection);
 232 begin
 233   FPairs.Assign(Value);
 234 end;
 235
 236 procedure TReplacePreset.SetShortCut(const Value: TShortCut);
 237 begin
 238   FShortCut := Value;
 239 end;
 240
 241 procedure TReplacePreset.SetTitle(const Value: string);
 242 begin
 243   FTitle := Value;
 244 end;
 245
 246 procedure TReplacePreset.SetConfirmAfterReplace(const Value: Boolean);
 247 begin
 248   FConfirmAfterReplace := Value;
 249 end;
 250
 251 { TReplacePresets }
 252
 253 procedure TReplacePresets.Assign(Source: TPersistent);
 254 begin
 255   if not (Source is TReplacePresets) then
 256     inherited
 257   else
 258   begin
 259     FPresets.Assign((Source as TReplacePresets).FPresets);
 260   end;
 261 end;
 262
 263 constructor TReplacePresets.Create(AOwner: TComponent);
 264 begin
 265   inherited;
 266   FPresets := TReplacePresetCollection.Create(TReplacePreset);
 267 end;
 268
 269 destructor TReplacePresets.Destroy;
 270 begin
 271   FPresets.Free;
 272   inherited;
 273 end;
 274
 275 procedure TReplacePresets.SetPresets(
 276   const Value: TReplacePresetCollection);
 277 begin
 278   FPresets.Assign(Value);
 279 end;
 280
 281 { TReplacePairCollection }
 282
 283 function TReplacePairCollection.Add: TReplacePair;
 284 begin
 285   Result := inherited Add as TReplacePair;
 286 end;
 287
 288 function TReplacePairCollection.ExecuteReplace(TargetStr: string): string;
 289 var
 290   i: Integer;
 291 begin
 292   Result := TargetStr;
 293   for i := 0 to Count-1 do
 294   begin
 295     Result := (Items[i] as TReplacePair).ExecuteReplace(Result);
 296   end;
 297 end;
 298
 299 function TReplacePairCollection.GetItem(Index: Integer): TReplacePair;
 300 begin
 301   Result := (inherited GetItem(Index)) as TReplacePair;
 302 end;
 303
 304 function TReplacePairCollection.StringExpression: string;
 305 var
 306   i: Integer;
 307 begin
 308   Result := '';
 309   for i := 0 to Count-1 do
 310   begin
 311     if i > 0 then
 312       Result := Result + '\81A';
 313     Result := Result + Format('\81u%s\81v\81¨\81u%s\81v',
 314       [Items[i].BeforeStr, Items[i].AfterStr]);
 315   end;
 316 end;
 317
 318 { TReplacePresetCollection }
 319
 320 function TReplacePresetCollection.Add: TReplacePreset;
 321 begin
 322   Result := inherited Add as TReplacePreset;
 323 end;
 324
 325 function TReplacePresetCollection.GetItem(Index: Integer): TReplacePreset;
 326 begin
 327   Result := inherited GetItem(Index) as TReplacePreset;
 328 end;
 329
 330 initialization
 331
 332 Classes.RegisterClass(TReplacePresets);
 333
 334 end.