source: cprs/branches/tmg-cprs/TntWare/Delphi Unicode Controls/Source/TntFormatStrUtils.pas@ 1742

Last change on this file since 1742 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 13.9 KB
Line 
1
2{*****************************************************************************}
3{ }
4{ Tnt Delphi Unicode Controls }
5{ http://www.tntware.com/delphicontrols/unicode/ }
6{ Version: 2.3.0 }
7{ }
8{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
9{ }
10{*****************************************************************************}
11
12unit TntFormatStrUtils;
13
14{$INCLUDE TntCompilers.inc}
15
16interface
17
18// this unit provides functions to work with format strings
19
20uses
21 TntSysUtils;
22
23function GetCanonicalFormatStr(const _FormatString: WideString): WideString;
24{$IFNDEF COMPILER_9_UP}
25function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString;
26 const Args: array of const
27 {$IFDEF COMPILER_7_UP}; FormatSettings: PFormatSettings{$ENDIF}): WideString;
28{$ENDIF}
29procedure CompareFormatStrings(FormatStr1, FormatStr2: WideString);
30function FormatStringsAreCompatible(FormatStr1, FormatStr2: WideString): Boolean;
31
32type
33 EFormatSpecError = class(ETntGeneralError);
34
35implementation
36
37uses
38 SysUtils, Math, TntClasses;
39
40resourcestring
41 SInvalidFormatSpecifier = 'Invalid Format Specifier: %s';
42 SMismatchedArgumentTypes = 'Argument types for index %d do not match. (%s <> %s)';
43 SMismatchedArgumentCounts = 'Number of format specifiers do not match.';
44
45type
46 TFormatSpecifierType = (fstInteger, fstFloating, fstPointer, fstString);
47
48function GetFormatSpecifierType(const FormatSpecifier: WideString): TFormatSpecifierType;
49var
50 LastChar: WideChar;
51begin
52 LastChar := TntWideLastChar(FormatSpecifier);
53 case LastChar of
54 'd', 'D', 'u', 'U', 'x', 'X':
55 result := fstInteger;
56 'e', 'E', 'f', 'F', 'g', 'G', 'n', 'N', 'm', 'M':
57 result := fstFloating;
58 'p', 'P':
59 result := fstPointer;
60 's', 'S':
61 result := fstString
62 else
63 raise ETntInternalError.CreateFmt('Internal Error: Unexpected format type (%s)', [LastChar]);
64 end;
65end;
66
67type
68 TFormatStrParser = class(TObject)
69 private
70 ParsedString: TBufferedWideString;
71 PFormatString: PWideChar;
72 LastIndex: Integer;
73 ExplicitCount: Integer;
74 ImplicitCount: Integer;
75 procedure RaiseInvalidFormatSpecifier;
76 function ParseChar(c: WideChar): Boolean;
77 procedure ForceParseChar(c: WideChar);
78 function ParseDigit: Boolean;
79 function ParseInteger: Boolean;
80 procedure ForceParseType;
81 function PeekDigit: Boolean;
82 function PeekIndexSpecifier(out Index: Integer): Boolean;
83 public
84 constructor Create(const _FormatString: WideString);
85 destructor Destroy; override;
86 function ParseFormatSpecifier: Boolean;
87 end;
88
89constructor TFormatStrParser.Create(const _FormatString: WideString);
90begin
91 inherited Create;
92 PFormatString := PWideChar(_FormatString);
93 ExplicitCount := 0;
94 ImplicitCount := 0;
95 LastIndex := -1;
96 ParsedString := TBufferedWideString.Create;
97end;
98
99destructor TFormatStrParser.Destroy;
100begin
101 FreeAndNil(ParsedString);
102 inherited;
103end;
104
105procedure TFormatStrParser.RaiseInvalidFormatSpecifier;
106begin
107 raise EFormatSpecError.CreateFmt(SInvalidFormatSpecifier, [ParsedString.Value + PFormatString]);
108end;
109
110function TFormatStrParser.ParseChar(c: WideChar): Boolean;
111begin
112 result := False;
113 if PFormatString^ = c then begin
114 result := True;
115 ParsedString.AddChar(c);
116 Inc(PFormatString);
117 end;
118end;
119
120procedure TFormatStrParser.ForceParseChar(c: WideChar);
121begin
122 if not ParseChar(c) then
123 RaiseInvalidFormatSpecifier;
124end;
125
126function TFormatStrParser.PeekDigit: Boolean;
127begin
128 result := False;
129 if (PFormatString^ <> #0)
130 and (PFormatString^ >= '0')
131 and (PFormatString^ <= '9') then
132 result := True;
133end;
134
135function TFormatStrParser.ParseDigit: Boolean;
136begin
137 result := False;
138 if PeekDigit then begin
139 result := True;
140 ForceParseChar(PFormatString^);
141 end;
142end;
143
144function TFormatStrParser.ParseInteger: Boolean;
145const
146 MAX_INT_DIGITS = 6;
147var
148 digitcount: integer;
149begin
150 digitcount := 0;
151 While ParseDigit do begin
152 inc(digitcount);
153 end;
154 result := (digitcount > 0);
155 if digitcount > MAX_INT_DIGITS then
156 RaiseInvalidFormatSpecifier;
157end;
158
159procedure TFormatStrParser.ForceParseType;
160begin
161 if PFormatString^ = #0 then
162 RaiseInvalidFormatSpecifier;
163
164 case PFormatString^ of
165 'd', 'u', 'x', 'e', 'f', 'g', 'n', 'm', 'p', 's',
166 'D', 'U', 'X', 'E', 'F', 'G', 'N', 'M', 'P', 'S':
167 begin
168 // do nothing
169 end
170 else
171 RaiseInvalidFormatSpecifier;
172 end;
173 ForceParseChar(PFormatString^);
174end;
175
176function TFormatStrParser.PeekIndexSpecifier(out Index: Integer): Boolean;
177var
178 SaveParsedString: WideString;
179 SaveFormatString: PWideChar;
180begin
181 SaveParsedString := ParsedString.Value;
182 SaveFormatString := PFormatString;
183 try
184 ParsedString.Clear;
185 Result := False;
186 Index := -1;
187 if ParseInteger then begin
188 Index := StrToInt(ParsedString.Value);
189 if ParseChar(':') then
190 Result := True;
191 end;
192 finally
193 ParsedString.Clear;
194 ParsedString.AddString(SaveParsedString);
195 PFormatString := SaveFormatString;
196 end;
197end;
198
199function TFormatStrParser.ParseFormatSpecifier: Boolean;
200var
201 ExplicitIndex: Integer;
202begin
203 Result := False;
204 // Parse entire format specifier
205 ForceParseChar('%');
206 if (PFormatString^ <> #0)
207 and (not ParseChar(' '))
208 and (not ParseChar('%')) then begin
209 if PeekIndexSpecifier(ExplicitIndex) then begin
210 Inc(ExplicitCount);
211 LastIndex := Max(LastIndex, ExplicitIndex);
212 end else begin
213 Inc(ImplicitCount);
214 Inc(LastIndex);
215 ParsedString.AddString(IntToStr(LastIndex));
216 ParsedString.AddChar(':');
217 end;
218 if ParseChar('*') then
219 begin
220 Inc(ImplicitCount);
221 Inc(LastIndex);
222 ParseChar(':');
223 end else if ParseInteger then
224 ParseChar(':');
225 ParseChar('-');
226 if ParseChar('*') then begin
227 Inc(ImplicitCount);
228 Inc(LastIndex);
229 end else
230 ParseInteger;
231 if ParseChar('.') then begin
232 if not ParseChar('*') then
233 ParseInteger;
234 end;
235 ForceParseType;
236 Result := True;
237 end;
238end;
239
240//-----------------------------------
241
242function GetCanonicalFormatStr(const _FormatString: WideString): WideString;
243var
244 PosSpec: Integer;
245begin
246 with TFormatStrParser.Create(_FormatString) do
247 try
248 // loop until no more '%'
249 PosSpec := Pos('%', PFormatString);
250 While PosSpec <> 0 do begin
251 try
252 // delete everything up until '%'
253 ParsedString.AddBuffer(PFormatString, PosSpec - 1);
254 Inc(PFormatString, PosSpec - 1);
255 // parse format specifier
256 ParseFormatSpecifier;
257 finally
258 PosSpec := Pos('%', PFormatString);
259 end;
260 end;
261 if ((ExplicitCount = 0) and (ImplicitCount = 1)) {simple expression}
262 or ((ExplicitCount > 0) and (ImplicitCount = 0)) {nothing converted} then
263 result := _FormatString {original}
264 else
265 result := ParsedString.Value + PFormatString;
266 finally
267 Free;
268 end;
269end;
270
271{$IFNDEF COMPILER_9_UP}
272function ReplaceFloatingArgumentsInFormatString(const _FormatString: WideString;
273 const Args: array of const
274 {$IFDEF COMPILER_7_UP}; FormatSettings: PFormatSettings{$ENDIF}): WideString;
275{ This function replaces floating point format specifiers with their actual formatted values.
276 It also adds index specifiers so that the other format specifiers don't lose their place.
277 The reason for this is that WideFormat doesn't correctly format floating point specifiers.
278 See QC#4254. }
279var
280 Parser: TFormatStrParser;
281 PosSpec: Integer;
282 Output: TBufferedWideString;
283begin
284 Output := TBufferedWideString.Create;
285 try
286 Parser := TFormatStrParser.Create(_FormatString);
287 with Parser do
288 try
289 // loop until no more '%'
290 PosSpec := Pos('%', PFormatString);
291 While PosSpec <> 0 do begin
292 try
293 // delete everything up until '%'
294 Output.AddBuffer(PFormatString, PosSpec - 1);
295 Inc(PFormatString, PosSpec - 1);
296 // parse format specifier
297 ParsedString.Clear;
298 if (not ParseFormatSpecifier)
299 or (GetFormatSpecifierType(ParsedString.Value) <> fstFloating) then
300 Output.AddBuffer(ParsedString.BuffPtr, MaxInt)
301 {$IFDEF COMPILER_7_UP}
302 else if Assigned(FormatSettings) then
303 Output.AddString(Format{TNT-ALLOW Format}(ParsedString.Value, Args, FormatSettings^))
304 {$ENDIF}
305 else
306 Output.AddString(Format{TNT-ALLOW Format}(ParsedString.Value, Args));
307 finally
308 PosSpec := Pos('%', PFormatString);
309 end;
310 end;
311 Output.AddString(PFormatString);
312 finally
313 Free;
314 end;
315 Result := Output.Value;
316 finally
317 Output.Free;
318 end;
319end;
320{$ENDIF}
321
322procedure GetFormatArgs(const _FormatString: WideString; FormatArgs: TTntStrings);
323var
324 PosSpec: Integer;
325begin
326 with TFormatStrParser.Create(_FormatString) do
327 try
328 FormatArgs.Clear;
329 // loop until no more '%'
330 PosSpec := Pos('%', PFormatString);
331 While PosSpec <> 0 do begin
332 try
333 // delete everything up until '%'
334 Inc(PFormatString, PosSpec - 1);
335 // add format specifier to list
336 ParsedString.Clear;
337 if ParseFormatSpecifier then
338 FormatArgs.Add(ParsedString.Value);
339 finally
340 PosSpec := Pos('%', PFormatString);
341 end;
342 end;
343 finally
344 Free;
345 end;
346end;
347
348function GetExplicitIndex(const FormatSpecifier: WideString): Integer;
349var
350 IndexStr: WideString;
351 PosColon: Integer;
352begin
353 result := -1;
354 PosColon := Pos(':', FormatSpecifier);
355 if PosColon <> 0 then begin
356 IndexStr := Copy(FormatSpecifier, 2, PosColon - 2);
357 result := StrToInt(IndexStr);
358 end;
359end;
360
361function GetMaxIndex(FormatArgs: TTntStrings): Integer;
362var
363 i: integer;
364 RunningIndex: Integer;
365 ExplicitIndex: Integer;
366begin
367 result := -1;
368 RunningIndex := -1;
369 for i := 0 to FormatArgs.Count - 1 do begin
370 ExplicitIndex := GetExplicitIndex(FormatArgs[i]);
371 if ExplicitIndex <> -1 then
372 RunningIndex := ExplicitIndex
373 else
374 inc(RunningIndex);
375 result := Max(result, RunningIndex);
376 end;
377end;
378
379procedure UpdateTypeList(FormatArgs, TypeList: TTntStrings);
380var
381 i: integer;
382 f: WideString;
383 SpecType: TFormatSpecifierType;
384 ExplicitIndex: Integer;
385 MaxIndex: Integer;
386 RunningIndex: Integer;
387begin
388 // set count of TypeList to accomodate maximum index
389 MaxIndex := GetMaxIndex(FormatArgs);
390 TypeList.Clear;
391 for i := 0 to MaxIndex do
392 TypeList.Add('');
393
394 // for each arg...
395 RunningIndex := -1;
396 for i := 0 to FormatArgs.Count - 1 do begin
397 f := FormatArgs[i];
398 ExplicitIndex := GetExplicitIndex(f);
399 SpecType := GetFormatSpecifierType(f);
400
401 // determine running arg index
402 if ExplicitIndex <> -1 then
403 RunningIndex := ExplicitIndex
404 else
405 inc(RunningIndex);
406
407 if TypeList[RunningIndex] <> '' then begin
408 // already exists in list, check for compatibility
409 if TypeList.Objects[RunningIndex] <> TObject(SpecType) then
410 raise EFormatSpecError.CreateFmt(SMismatchedArgumentTypes,
411 [RunningIndex, TypeList[RunningIndex], f]);
412 end else begin
413 // not in list so update it
414 TypeList[RunningIndex] := f;
415 TypeList.Objects[RunningIndex] := TObject(SpecType);
416 end;
417 end;
418end;
419
420procedure CompareFormatStrings(FormatStr1, FormatStr2: WideString);
421var
422 ArgList1: TTntStringList;
423 ArgList2: TTntStringList;
424 TypeList1: TTntStringList;
425 TypeList2: TTntStringList;
426 i: integer;
427begin
428 ArgList1 := nil;
429 ArgList2 := nil;
430 TypeList1 := nil;
431 TypeList2 := nil;
432 try
433 ArgList1 := TTntStringList.Create;
434 ArgList2 := TTntStringList.Create;
435 TypeList1 := TTntStringList.Create;
436 TypeList2 := TTntStringList.Create;
437
438 GetFormatArgs(FormatStr1, ArgList1);
439 UpdateTypeList(ArgList1, TypeList1);
440
441 GetFormatArgs(FormatStr2, ArgList2);
442 UpdateTypeList(ArgList2, TypeList2);
443
444 if TypeList1.Count <> TypeList2.Count then
445 raise EFormatSpecError.Create(SMismatchedArgumentCounts + CRLF + CRLF + '> ' + FormatStr1 + CRLF + '> ' + FormatStr2);
446
447 for i := 0 to TypeList1.Count - 1 do begin
448 if TypeList1.Objects[i] <> TypeList2.Objects[i] then begin
449 raise EFormatSpecError.CreateFmt(SMismatchedArgumentTypes,
450 [i, TypeList1[i], TypeList2[i]]);
451 end;
452 end;
453
454 finally
455 ArgList1.Free;
456 ArgList2.Free;
457 TypeList1.Free;
458 TypeList2.Free;
459 end;
460end;
461
462function FormatStringsAreCompatible(FormatStr1, FormatStr2: WideString): Boolean;
463var
464 ArgList1: TTntStringList;
465 ArgList2: TTntStringList;
466 TypeList1: TTntStringList;
467 TypeList2: TTntStringList;
468 i: integer;
469begin
470 ArgList1 := nil;
471 ArgList2 := nil;
472 TypeList1 := nil;
473 TypeList2 := nil;
474 try
475 ArgList1 := TTntStringList.Create;
476 ArgList2 := TTntStringList.Create;
477 TypeList1 := TTntStringList.Create;
478 TypeList2 := TTntStringList.Create;
479
480 GetFormatArgs(FormatStr1, ArgList1);
481 UpdateTypeList(ArgList1, TypeList1);
482
483 GetFormatArgs(FormatStr2, ArgList2);
484 UpdateTypeList(ArgList2, TypeList2);
485
486 Result := (TypeList1.Count = TypeList2.Count);
487 if Result then begin
488 for i := 0 to TypeList1.Count - 1 do begin
489 if TypeList1.Objects[i] <> TypeList2.Objects[i] then begin
490 Result := False;
491 break;
492 end;
493 end;
494 end;
495 finally
496 ArgList1.Free;
497 ArgList2.Free;
498 TypeList1.Free;
499 TypeList2.Free;
500 end;
501end;
502
503end.
Note: See TracBrowser for help on using the repository browser.