Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/MojuUtils.pas

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


Revision 1.8 - (hide annotations) (download) (as text)
Fri Aug 6 08:26:36 2004 UTC (19 years, 8 months ago) by yoffy
Branch: MAIN
CVS Tags: b49, b48, bv1_49_0_564, bv1_49_0_563, v1_50_0_557, v1_49_0_548, v1_49_0_540, v1_49_0_542, v1_49_0_545, v1_49_0_544, v1_49_0_547, v1_48_0_530, v1_49_0_554, v1_49_0_551, bv1_49_0_565, v1_48_0_535, v1_49_0_552, v1_49_0_553, v1_49_0_546, v1_48_0_539, v1_48_0_538, v1_48_0_533, v1_48_0_537, v1_49_2_569, v1_48_0_536, v1_49_0_541, v1_50_0_561
Branch point for: Bb49
Changes since 1.7: +5 -8 lines
File MIME type: text/x-pascal
- ZenToHan の確保する領域が倍のサイズあったので修正。
 ※Length() が返すのは byte 数で、2 byte 文字の濁音を半角にしても byte 数は同じ為。
- ZenToHan の戻り値が文字列の存在しない領域まで指していたバグを修正。

1 h677 1.1 unit MojuUtils;
2 h677 1.3 //******************************************************************************
3 h677 1.5 // ??絖???臀???∽? CustomStringReplace
4 h677 1.3 // 篏帥???鴻????
5     //??CustomStringReplace(
6     //?? ??????絖???鐚?String???????StringList),
7     //?? 罎?膣∽??絖???鐚?String),
8     // 臀????絖???鐚?String),
9     // 紊ф??絖?絨??絖?鐚?Boolean)True:?阪?ャ????????false or ?????阪?ャ????
10     //
11     // Delphi-ML???篋?69334????c???????潟?若????筝吾?????????障??????
12     //******************************************************************************
13 h677 1.1
14     interface
15    
16     uses
17 h677 1.2 Windows, Classes, SysUtils;
18    
19 h677 1.5 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
20     function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
21     function ReplaceString(const S, OldPattern, NewPattern: string): string;
22     function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
23    
24     function CustomStringReplace(S , OldPattern: String;const NewPattern: string): String; overload;
25     function CustomStringReplace(S , OldPattern: String;const NewPattern: string; IgnoreCase : Boolean): String; overload;
26     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;
28 h677 1.1
29 h677 1.5 function ZenToHan(const s: string): string;
30     function VaguePos(const Substr, S: string): Integer;
31 h677 1.1
32     implementation
33 h677 1.5 // ???ゃ?潟?帥?種??≪?祉?潟??????????蕭???????/span>
34 h677 1.2 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
35     asm
36     PUSH EBX
37 h677 1.5 PUSH ESI
38 h677 1.2 PUSH EDI
39    
40     MOV ESI,ECX { Point ESI to substr }
41     MOV EDI,EAX { Point EDI to s }
42    
43     MOV ECX,EDX { ECX = search length }
44     SUB ECX,EAX
45    
46     MOV EDX,SubstrEnd
47     SUB EDX,ESI
48    
49     DEC EDX { EDX = Length(substr) - 1 }
50     JS @@fail { < 0 ? return 0 }
51     MOV AL,[ESI] { AL = first char of substr }
52     INC ESI { Point ESI to 2'nd char of substr }
53    
54     SUB ECX,EDX { #positions in s to look at }
55     { = Length(s) - Length(substr) + 1 }
56     JLE @@fail
57     @@loop:
58     REPNE SCASB
59     JNE @@fail
60     MOV EBX,ECX { save outer loop counter }
61     PUSH ESI { save outer loop substr pointer }
62     PUSH EDI { save outer loop s pointer }
63    
64     MOV ECX,EDX
65     REPE CMPSB
66     POP EDI { restore outer loop s pointer }
67     POP ESI { restore outer loop substr pointer }
68     JE @@found
69     MOV ECX,EBX { restore outer loop counter }
70     JMP @@loop
71    
72     @@fail:
73     XOR EAX,EAX
74     JMP @@exit
75    
76     @@found:
77     MOV EAX,EDI { EDI points of char after match }
78     DEC EAX
79     @@exit:
80     POP EDI
81     POP ESI
82     POP EBX
83     end;
84 h677 1.5 //??AnsiPos???????
85 h677 1.2 function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
86     var
87 h677 1.3 L2: Cardinal;
88     ByteType : TMbcsByteType;
89 h677 1.2 begin
90 h677 1.3 Result := nil;
91     if (StrStart = nil) or (StrStart^ = #0) or
92     (SubstrStart = nil) or (SubstrStart^ = #0) then Exit;
93    
94     L2 := SubstrEnd - SubstrStart;
95     Result := StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd);
96    
97     while (Result <> nil) and (StrEnd - Result >= L2) do begin
98     ByteType := StrByteType(StrStart, Integer(Result-StrStart));
99     if (ByteType <> mbTrailByte) and
100     (CompareString(LOCALE_USER_DEFAULT, SORT_STRINGSORT, Result, L2, SubstrStart, L2) = 2)
101     then Exit;
102     if (ByteType = mbLeadByte) then Inc(Result);
103     Inc(Result);
104     Result := StrPosEx(Result, StrEnd, SubStrStart, SubStrEnd);
105     end;
106     Result := nil;
107 h677 1.2 end;
108    
109 yoffy 1.4 {$R-}
110 h677 1.5 //蕭?????絖???臀???∽?逸?紊ф??絖?絨??絖??????????∴???????鐚?
111 h677 1.2 function ReplaceString(const S, OldPattern, NewPattern: string): string;
112     var
113 h677 1.3 ReplaceCount: Integer;
114     DestIndex: Integer;
115 yoffy 1.4 i, l: Integer;
116 h677 1.3 p, e, ps, pe: PChar;
117     Count: Integer;
118 h677 1.2 begin
119 h677 1.3 Result := S;
120     if OldPattern = '' then Exit;
121 h677 1.2 p := PChar(S);
122     e := p + Length(S);
123     ps := PChar(OldPattern);
124     pe := ps + Length(OldPattern);
125     ReplaceCount := 0;
126     while p < e do begin
127 h677 1.3 p := AnsiStrPosEx(p, e, ps, pe);
128     if p = nil then Break;
129     Inc(ReplaceCount);
130     Inc(p, Length(OldPattern));
131 h677 1.1 end;
132 h677 1.2 if ReplaceCount = 0 then Exit;
133     SetString(Result, nil, Length(S) +
134 h677 1.3 (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);
135 h677 1.2 p := PChar(S);
136     DestIndex := 1;
137 yoffy 1.4 l := Length( NewPattern );
138 h677 1.2 for i := 0 to ReplaceCount - 1 do begin
139 h677 1.3 Count := AnsiStrPosEx(p, e, ps, pe) - p;
140     Move(p^, Result[DestIndex], Count);
141     Inc(p, Count);//p := pp;
142     Inc(DestIndex, Count);
143 yoffy 1.4 Move(NewPattern[1], Result[DestIndex], l);
144 h677 1.3 Inc(p, Length(OldPattern));
145 yoffy 1.4 Inc(DestIndex, l);
146 h677 1.2 end;
147     Move(p^, Result[DestIndex], e - p);
148 h677 1.1 end;
149 h677 1.5 //蕭?????絖???臀???∽?逸?紊ф??絖?絨??絖??????????∴?????鐚?
150 h677 1.3 function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
151     var
152 h677 1.5 ReplaceCount: Integer;
153     DestIndex: Integer;
154     i, l: Integer;
155     p, e{, ps, pe}: PChar;
156     p2, e2, ps2, pe2: PChar;
157     Count: Integer;
158     bufferS : String;
159     bufferOldPattern : String;
160 h677 1.3 begin
161 h677 1.5 Result := S;
162     bufferS := AnsiLowerCase(S);
163     bufferOldPattern := AnsiLowerCase(OldPattern);
164    
165     if OldPattern = '' then Exit;
166     p := PChar(S);
167     p2 := PChar(bufferS);
168     e := p + Length(S);
169     e2 := p2 + Length(bufferS);
170     //ps := PChar(OldPattern);
171     ps2 := PChar(bufferOldPattern);
172     //pe := ps + Length(OldPattern);
173     pe2 := ps2 + Length(bufferOldPattern);
174    
175     ReplaceCount := 0;
176     while p2 < e2 do begin
177     p2 := AnsiStrPosEx(p2, e2, ps2, pe2);
178     if p2 = nil then Break;
179     Inc(ReplaceCount);
180     Inc(p2, Length(bufferOldPattern));
181     end;
182     if ReplaceCount = 0 then Exit;
183     SetString(Result, nil, Length(bufferS) +
184     (Length(NewPattern) - Length(bufferOldPattern)) * ReplaceCount);
185     p2 := PChar(bufferS);
186     DestIndex := 1;
187     l := Length( NewPattern );
188     for i := 0 to ReplaceCount - 1 do begin
189     Count := AnsiStrPosEx(p2, e2, ps2, pe2) - p2;
190     Move(p^, Result[DestIndex], Count);
191     Inc(p, Count);//p := pp;
192     Inc(p2, Count);//p := pp;
193     Inc(DestIndex, Count);
194     Move(NewPattern[1], Result[DestIndex], l);
195     Inc(p, Length(OldPattern));
196     Inc(p2, Length(OldPattern));
197     Inc(DestIndex, l);
198     end;
199     Move(p^, Result[DestIndex], e - p);
200 h677 1.3 end;
201 yoffy 1.4 {$IFDEF DEBUG}
202     {$R+}
203     {$ENDIF}
204 h677 1.3
205 h677 1.5 //蕭?????絖???臀???∽?逸??????????c??鐚?
206 h677 1.3 function CustomStringReplace(
207     S ,OldPattern: String;
208 h677 1.5 const NewPattern: string
209 h677 1.3 ): String;
210    
211     begin
212 h677 1.5 Result := ReplaceString(S,OldPattern,NewPattern);
213 h677 1.3 end;
214    
215 h677 1.5 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
216 h677 1.3 function CustomStringReplace(
217     S , OldPattern: String;
218 h677 1.5 const NewPattern: string;
219     IgnoreCase : Boolean
220 h677 1.3 ): String;
221     begin
222 h677 1.5 Result := '';
223     if not IgnoreCase then begin
224     Result := ReplaceString(S,OldPattern,NewPattern);
225     end else begin
226     Result := IgnoCaseReplaceString(S,OldPattern,NewPattern);
227     end;
228 h677 1.3 end;
229    
230 h677 1.5 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
231 h677 1.3 procedure CustomStringReplace(
232     var S : TStringList;
233 h677 1.5 OldPattern: String;
234     const NewPattern: string;
235     IgnoreCase : Boolean
236 h677 1.3 );
237     var
238 h677 1.5 i : Integer;
239 h677 1.3 begin
240 h677 1.5 S.BeginUpdate;
241     if not IgnoreCase then begin
242     for i := 0 to S.Count - 1 do begin
243     S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);
244     end;
245     end else begin
246     for i := 0 to S.Count - 1 do begin
247     S.Strings[i] := IgnoCaseReplaceString(S.Strings[i], OldPattern,NewPattern);
248     end;
249     end;
250     S.EndUpdate;
251 h677 1.3 end;
252    
253 h677 1.5 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
254 h677 1.3 procedure CustomStringReplace(
255     var S : TStringList;
256 h677 1.5 OldPattern: String;
257     const NewPattern: string
258 h677 1.3 );
259     var
260 h677 1.5 i : Integer;
261 h677 1.3 begin
262 h677 1.5 S.BeginUpdate;
263 h677 1.3 for i := 0 to S.Count - 1 do begin
264     S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);;
265 h677 1.5 end;
266     S.EndUpdate;
267     end;
268    
269     (*************************************************************************
270     * ???????茹?
271     * from HotZonu
272     *************************************************************************)
273     function ZenToHan(const s: string): string;
274     var
275 h677 1.6 //Chr: array [0..1024] of char;
276     Chr: string;
277 yoffy 1.8 ChrLen : Integer;
278 h677 1.5 begin
279 yoffy 1.8 SetLength(Chr, Length(s));
280     ChrLen := Windows.LCMapString(
281 h677 1.5 GetUserDefaultLCID(),
282     // LCMAP_HALFWIDTH,
283     LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
284     PChar(s),
285 yoffy 1.8 Length(s),
286 h677 1.6 PChar(Chr),
287     Length(Chr)
288 h677 1.5 );
289 yoffy 1.8 Result := Copy(Chr, 1, ChrLen);
290 h677 1.3 end;
291    
292 h677 1.5 (*************************************************************************
293     * ?????茹??蚊?????????????????阪?ャ??????????Pos
294     *************************************************************************)
295     function VaguePos(const Substr, S: string): Integer;
296     begin
297     Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
298     end;
299 h677 1.2
300 h677 1.1 end.

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