Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/MojuUtils.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.4 by yoffy, Mon Mar 8 08:53:40 2004 UTC revision 1.4.2.2 by yoffy, Thu Sep 9 16:20:33 2004 UTC
# Line 1  Line 1 
1  unit MojuUtils;  unit MojuUtils;
2  //******************************************************************************  //******************************************************************************
3  //      今の所、文字列置換関数 CustomStringReplace だけ。  //      文字列置換関数 CustomStringReplace
4  //  使い方は、  //  使い方は、
5  // CustomStringReplace(  // CustomStringReplace(
6  //     元の文字列(StringもしくはTStringList),  //     元の文字列(StringもしくはTStringList),
# Line 16  interface Line 16  interface
16  uses  uses
17          Windows, Classes, SysUtils;          Windows, Classes, SysUtils;
18    
19      function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;          function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
20      function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;          function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
21      function ReplaceString(const S, OldPattern, NewPattern: string): string;          function ReplaceString(const S, OldPattern, NewPattern: string): string;
22      function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;          function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
23    
24      function CustomStringReplace(S , OldPattern: String;const  NewPattern: string): String; overload;          function CustomStringReplace(S , OldPattern: String;const  NewPattern: string): String; overload;
25      function CustomStringReplace(S , OldPattern: String;const  NewPattern: string; IgnoreCase : Boolean): String; overload;          function CustomStringReplace(S , OldPattern: String;const  NewPattern: string; IgnoreCase : Boolean): String; overload;
26      procedure CustomStringReplace(var S : TStringList; OldPattern: String;const  NewPattern: string);overload;          procedure CustomStringReplace(var S : TStringList; OldPattern: String;const  NewPattern: string);overload;
27      procedure CustomStringReplace(var S : TStringList; OldPattern: String;const  NewPattern: string; IgnoreCase : Boolean);overload;          procedure CustomStringReplace(var S : TStringList; OldPattern: String;const  NewPattern: string; IgnoreCase : Boolean);overload;
28    
29            function ZenToHan(const s: string): string;
30            function VaguePos(const Substr, S: string): Integer;
31    
32  implementation  implementation
33    // ポインター&アセンブラによる高速ポス
34  function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;  function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
35  asm  asm
36          PUSH    EBX          PUSH    EBX
37          PUSH    ESI                  PUSH    ESI
38          PUSH    EDI          PUSH    EDI
39    
40          MOV    ESI,ECX        { Point ESI to substr                  }          MOV    ESI,ECX        { Point ESI to substr                  }
# Line 79  asm Line 81  asm
81          POP    ESI          POP    ESI
82          POP    EBX          POP    EBX
83  end;  end;
84    // AnsiPosの高速版
85  function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;  function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
86  var  var
87      L2: Cardinal;      L2: Cardinal;
# Line 105  begin Line 107  begin
107  end;  end;
108    
109  {$R-}  {$R-}
110    //高速文字列置換関数(大文字小文字の違いを無視しない)
111  function ReplaceString(const S, OldPattern, NewPattern: string): string;  function ReplaceString(const S, OldPattern, NewPattern: string): string;
112  var  var
113      ReplaceCount: Integer;      ReplaceCount: Integer;
# Line 143  begin Line 146  begin
146      end;      end;
147      Move(p^, Result[DestIndex], e - p);      Move(p^, Result[DestIndex], e - p);
148  end;  end;
149    //高速文字列置換関数(大文字小文字の違いを無視する)
150  function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;  function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
151  var  var
152      ReplaceCount: Integer;          ReplaceCount: Integer;
153      DestIndex: Integer;          DestIndex: Integer;
154      i, l: Integer;          i, l: Integer;
155      p, e{, ps, pe}: PChar;          p, e{, ps, pe}: PChar;
156      p2, e2, ps2, pe2: PChar;          p2, e2, ps2, pe2: PChar;
157      Count: Integer;          Count: Integer;
158      bufferS : String;          bufferS : String;
159      bufferOldPattern : String;          bufferOldPattern : String;
160  begin  begin
161      Result := S;          Result := S;
162      bufferS := AnsiLowerCase(S);          bufferS := AnsiLowerCase(S);
163      bufferOldPattern := AnsiLowerCase(OldPattern);          bufferOldPattern := AnsiLowerCase(OldPattern);
164    
165      if OldPattern = '' then Exit;          if OldPattern = '' then Exit;
166      p   := PChar(S);          p       := PChar(S);
167      p2  := PChar(bufferS);          p2      := PChar(bufferS);
168      e   := p + Length(S);          e       := p + Length(S);
169      e2  := p2 + Length(bufferS);          e2      := p2 + Length(bufferS);
170      //ps        := PChar(OldPattern);          //ps    := PChar(OldPattern);
171      ps2 := PChar(bufferOldPattern);          ps2     := PChar(bufferOldPattern);
172      //pe        := ps + Length(OldPattern);          //pe    := ps + Length(OldPattern);
173      pe2 := ps2 + Length(bufferOldPattern);          pe2     := ps2 + Length(bufferOldPattern);
174    
175      ReplaceCount := 0;          ReplaceCount := 0;
176      while p2 < e2 do begin          while p2 < e2 do begin
177          p2 := AnsiStrPosEx(p2, e2, ps2, pe2);                  p2 := AnsiStrPosEx(p2, e2, ps2, pe2);
178          if p2 = nil then Break;                  if p2 = nil then Break;
179          Inc(ReplaceCount);                  Inc(ReplaceCount);
180          Inc(p2, Length(bufferOldPattern));                  Inc(p2, Length(bufferOldPattern));
181      end;          end;
182      if ReplaceCount = 0 then Exit;          if ReplaceCount = 0 then Exit;
183      SetString(Result, nil, Length(bufferS) +          SetString(Result, nil, Length(bufferS) +
184      (Length(NewPattern) - Length(bufferOldPattern)) * ReplaceCount);          (Length(NewPattern) - Length(bufferOldPattern)) * ReplaceCount);
185      p2 := PChar(bufferS);          p2 := PChar(bufferS);
186      DestIndex := 1;          DestIndex := 1;
187      l := Length( NewPattern );          l := Length( NewPattern );
188      for i := 0 to ReplaceCount - 1 do begin          for i := 0 to ReplaceCount - 1 do begin
189          Count := AnsiStrPosEx(p2, e2, ps2, pe2) - p2;                  Count := AnsiStrPosEx(p2, e2, ps2, pe2) - p2;
190          Move(p^, Result[DestIndex], Count);                  Move(p^, Result[DestIndex], Count);
191          Inc(p, Count);//p := pp;                  Inc(p, Count);//p := pp;
192          Inc(p2, Count);//p := pp;                  Inc(p2, Count);//p := pp;
193          Inc(DestIndex, Count);                  Inc(DestIndex, Count);
194          Move(NewPattern[1], Result[DestIndex], l);                  Move(NewPattern[1], Result[DestIndex], l);
195          Inc(p, Length(OldPattern));                  Inc(p, Length(OldPattern));
196          Inc(p2, Length(OldPattern));                  Inc(p2, Length(OldPattern));
197          Inc(DestIndex, l);                  Inc(DestIndex, l);
198      end;          end;
199      Move(p^, Result[DestIndex], e - p);          Move(p^, Result[DestIndex], e - p);
200  end;  end;
201  {$IFDEF DEBUG}  {$IFDEF DEBUG}
202  {$R+}  {$R+}
203  {$ENDIF}  {$ENDIF}
204    
205    //高速文字列置換関数(プリミティブ)
206  function CustomStringReplace(  function CustomStringReplace(
207          S ,OldPattern: String;          S ,OldPattern: String;
208      const NewPattern: string          const NewPattern: string
209  ): String;  ): String;
210    
211  begin  begin
212      Result := ReplaceString(S,OldPattern,NewPattern);          Result := ReplaceString(S,OldPattern,NewPattern);
213  end;  end;
214    
215    //高速文字列置換関数(汎用版1)
216  function CustomStringReplace(  function CustomStringReplace(
217          S , OldPattern: String;          S , OldPattern: String;
218      const  NewPattern: string;          const  NewPattern: string;
219      IgnoreCase : Boolean          IgnoreCase : Boolean
220  ): String;  ): String;
221  begin  begin
222      Result := '';          Result := '';
223      if not IgnoreCase then begin          if not IgnoreCase then begin
224          Result := ReplaceString(S,OldPattern,NewPattern);                  Result := ReplaceString(S,OldPattern,NewPattern);
225      end else begin          end else begin
226          Result := IgnoCaseReplaceString(S,OldPattern,NewPattern);                  Result := IgnoCaseReplaceString(S,OldPattern,NewPattern);
227      end;          end;
228  end;  end;
229    
230    //高速文字列置換関数(汎用版2)
231  procedure CustomStringReplace(  procedure CustomStringReplace(
232          var S : TStringList;          var S : TStringList;
233      OldPattern: String;          OldPattern: String;
234      const  NewPattern: string;          const  NewPattern: string;
235      IgnoreCase : Boolean          IgnoreCase : Boolean
236  );  );
237  var  var
238      i : Integer;          i : Integer;
239  begin  begin
240      S.BeginUpdate;          S.BeginUpdate;
241      if not IgnoreCase then begin          if not IgnoreCase then begin
242          for i := 0 to S.Count - 1 do begin                  for i := 0 to S.Count - 1 do begin
243              S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);                          S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);
244          end;                  end;
245      end else begin          end else begin
246          for i := 0 to S.Count - 1 do begin                  for i := 0 to S.Count - 1 do begin
247              S.Strings[i] := IgnoCaseReplaceString(S.Strings[i], OldPattern,NewPattern);                          S.Strings[i] := IgnoCaseReplaceString(S.Strings[i], OldPattern,NewPattern);
248          end;                  end;
249      end;          end;
250      S.EndUpdate;          S.EndUpdate;
251  end;  end;
252    
253    //高速文字列置換関数(汎用版3)
254  procedure CustomStringReplace(  procedure CustomStringReplace(
255          var S : TStringList;          var S : TStringList;
256      OldPattern: String;          OldPattern: String;
257      const  NewPattern: string          const  NewPattern: string
258  );  );
259  var  var
260      i : Integer;          i : Integer;
261  begin  begin
262      S.BeginUpdate;          S.BeginUpdate;
263          for i := 0 to S.Count - 1 do begin          for i := 0 to S.Count - 1 do begin
264                  S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);;                  S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);;
265      end;          end;
266      S.EndUpdate;          S.EndUpdate;
267  end;  end;
268    
269    (*************************************************************************
270     * 全角→半角
271     * from HotZonu
272     *************************************************************************)
273    function ZenToHan(const s: string): string;
274    var
275            //Chr: array [0..1024] of char;
276            Chr: string;
277            ChrLen  : Integer;
278    begin
279            SetLength(Chr, Length(s));
280            ChrLen := Windows.LCMapString(
281                     GetUserDefaultLCID(),
282    //               LCMAP_HALFWIDTH,
283                     LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
284                     PChar(s),
285                     Length(s),
286                     PChar(Chr),
287                     Length(Chr)
288                     );
289            Result := Copy(Chr, 1, ChrLen);
290    end;
291    
292    (*************************************************************************
293     * 全角半角ひらがなかたかなを区別しない凄いPos
294     *************************************************************************)
295    function VaguePos(const Substr, S: string): Integer;
296    begin
297            Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
298    end;
299    
300  end.  end.

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.4.2.2

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26