source: cprs/branches/tmg-cprs/TMG_Extra/tntUniCode/Source/TntFormatStrUtils.pas

Last change on this file was 672, checked in by Kevin Toppenberg, 9 years ago

Adding source to tntControls for compilation

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.