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     procedure SetPairs(const Value: TReplacePairCollection);
  68     procedure SetShortCut(const Value: TShortCut);
  69     procedure SetTitle(const Value: string);
  70   public
  71     constructor Create(Collection: TCollection); override;
  72     destructor Destroy; override;
  73     procedure Assign(Source: TPersistent); override;
  74   published
  75     property Pairs: TReplacePairCollection read FPairs write SetPairs;
  76     property Title: string read FTitle write SetTitle;
  77     property ShortCut: TShortCut read FShortCut write SetShortCut;
  78   end;
  79
  80   TReplacePresetCollection = class(TCollection)
  81   private
  82     function GetItem(Index: Integer): TReplacePreset;
  83   public
  84     function Add: TReplacePreset;
  85     property Items[Index: Integer]: TReplacePreset read GetItem; default;
  86   end;
  87
  88   // \8dÅ\8fI\93I\82É\82±\82ê\82ð\83V\83\8a\83A\83\89\83C\83Y\82·\82é
  89   TReplacePresets = class(TComponent)
  90   private
  91     FPresets: TReplacePresetCollection;
  92     procedure SetPresets(const Value: TReplacePresetCollection);
  93   public
  94     constructor Create(AOwner: TComponent); override;
  95     destructor Destroy; override;
  96     procedure Assign(Source: TPersistent); override;
  97   published
  98     property Presets: TReplacePresetCollection read FPresets write SetPresets;
  99   end;
 100
 101 implementation
 102
 103 { TReplacePair }
 104
 105 procedure TReplacePair.Assign(Source: TPersistent);
 106 begin
 107   if not (Source is TReplacePair) then
 108     inherited
 109   else
 110     FPairRec := (Source as TReplacePair).FPairRec;
 111 end;
 112
 113 procedure TReplacePair.Clear;
 114 begin
 115   with FPairRec do
 116   begin
 117     BeforeStr := '';
 118     AfterStr := '';
 119     UseRegExp := false;
 120     IgnoreCase := false;
 121   end;
 122 end;
 123
 124 constructor TReplacePair.Create(Collection: TCollection);
 125 begin
 126   inherited;
 127   IgnoreCase := true;
 128 end;
 129
 130 function TReplacePair.ExecuteReplace(TargetStr: string): string;
 131 var
 132   Options: TReplaceFlags;
 133 begin
 134   // 1\82Â\82Ì\92u\8a·\82ð\8eÀ\91\95\82·\82é
 135   Result := TargetStr;
 136   Options := [rfReplaceAll];
 137   if IgnoreCase then
 138     Options := Options + [rfIgnoreCase];
 139   if UseRegExp then
 140     Result := StringReplaceRegExp(Result, BeforeStr, AfterStr, Options)
 141   else
 142     Result := StringReplace(Result, BeforeStr, AfterStr, Options);
 143 end;
 144
 145 function TReplacePair.GetAfterStr: string;
 146 begin
 147   Result := FPairRec.AfterStr;
 148 end;
 149
 150 function TReplacePair.GetBeforeStr: string;
 151 begin
 152   Result := FPairRec.BeforeStr;
 153 end;
 154
 155 function TReplacePair.GetIgnoreCase: boolean;
 156 begin
 157   Result := FPairRec.IgnoreCase;
 158 end;
 159
 160 function TReplacePair.GetUseRegExp: boolean;
 161 begin
 162   Result := FPairRec.UseRegExp;
 163 end;
 164
 165 function TReplacePair.IsValidPair: Boolean;
 166 begin
 167   Result := true;
 168   if BeforeStr = '' then
 169     Result := false
 170   else
 171     try
 172       ExecuteReplace(' ')
 173     except
 174       Result := false;
 175     end;
 176 end;
 177
 178 procedure TReplacePair.SetAfterStr(const Value: string);
 179 begin
 180   FPairRec.AfterStr := Value;
 181 end;
 182
 183 procedure TReplacePair.SetBeforeStr(const Value: string);
 184 begin
 185   FPairRec.BeforeStr := Value;
 186 end;
 187
 188 procedure TReplacePair.SetIgnoreCase(const Value: boolean);
 189 begin
 190   FPairRec.IgnoreCase := Value;
 191 end;
 192
 193 procedure TReplacePair.SetUseRegExp(const Value: boolean);
 194 begin
 195   FPairRec.UseRegExp := Value;
 196 end;
 197
 198 { TReplacePreset }
 199
 200 procedure TReplacePreset.Assign(Source: TPersistent);
 201 var
 202   Src: TReplacePreset;
 203 begin
 204   if not (Source is TReplacePreset) then
 205     inherited
 206   else
 207   begin
 208     Src := Source as TReplacePreset;
 209     Pairs.Assign(Src.Pairs);
 210     Title := Src.Title;
 211     ShortCut := Src.ShortCut;
 212   end;
 213 end;
 214
 215 constructor TReplacePreset.Create(Collection: TCollection);
 216 begin
 217   inherited;
 218   FPairs := TReplacePairCollection.Create(TReplacePair);
 219 end;
 220
 221 destructor TReplacePreset.Destroy;
 222 begin
 223   FPairs.Free;
 224   inherited;
 225 end;
 226
 227 procedure TReplacePreset.SetPairs(const Value: TReplacePairCollection);
 228 begin
 229   FPairs.Assign(Value);
 230 end;
 231
 232 procedure TReplacePreset.SetShortCut(const Value: TShortCut);
 233 begin
 234   FShortCut := Value;
 235 end;
 236
 237 procedure TReplacePreset.SetTitle(const Value: string);
 238 begin
 239   FTitle := Value;
 240 end;
 241
 242 { TReplacePresets }
 243
 244 procedure TReplacePresets.Assign(Source: TPersistent);
 245 begin
 246   if not (Source is TReplacePresets) then
 247     inherited
 248   else
 249   begin
 250     FPresets.Assign((Source as TReplacePresets).FPresets);
 251   end;
 252 end;
 253
 254 constructor TReplacePresets.Create(AOwner: TComponent);
 255 begin
 256   inherited;
 257   FPresets := TReplacePresetCollection.Create(TReplacePreset);
 258 end;
 259
 260 destructor TReplacePresets.Destroy;
 261 begin
 262   FPresets.Free;
 263   inherited;
 264 end;
 265
 266 procedure TReplacePresets.SetPresets(
 267   const Value: TReplacePresetCollection);
 268 begin
 269   FPresets.Assign(Value);
 270 end;
 271
 272 { TReplacePairCollection }
 273
 274 function TReplacePairCollection.Add: TReplacePair;
 275 begin
 276   Result := inherited Add as TReplacePair;
 277 end;
 278
 279 function TReplacePairCollection.ExecuteReplace(TargetStr: string): string;
 280 var
 281   i: Integer;
 282 begin
 283   Result := TargetStr;
 284   for i := 0 to Count-1 do
 285   begin
 286     Result := (Items[i] as TReplacePair).ExecuteReplace(Result);
 287   end;
 288 end;
 289
 290 function TReplacePairCollection.GetItem(Index: Integer): TReplacePair;
 291 begin
 292   Result := (inherited GetItem(Index)) as TReplacePair;
 293 end;
 294
 295 function TReplacePairCollection.StringExpression: string;
 296 var
 297   i: Integer;
 298 begin
 299   Result := '';
 300   for i := 0 to Count-1 do
 301   begin
 302     if i > 0 then
 303       Result := Result + '\81A';
 304     Result := Result + Format('\81u%s\81v\81¨\81u%s\81v',
 305       [Items[i].BeforeStr, Items[i].AfterStr]);
 306   end;
 307 end;
 308
 309 { TReplacePresetCollection }
 310
 311 function TReplacePresetCollection.Add: TReplacePreset;
 312 begin
 313   Result := inherited Add as TReplacePreset;
 314 end;
 315
 316 function TReplacePresetCollection.GetItem(Index: Integer): TReplacePreset;
 317 begin
 318   Result := inherited GetItem(Index) as TReplacePreset;
 319 end;
 320
 321 initialization
 322
 323 Classes.RegisterClass(TReplacePresets);
 324
 325 end.