1 { Version 050130. Copyright � Alexey A.Chernobaev, 1996-2004 }
2 
3 { Some functions of this unit are based on RX Library (unit StrUtils)
4   Copyright (c) 1995, 1996 AO ROSNO; Copyright (c) 1997, 1998 Master-Bank;
5   StrUtils is based on AlexGraf String Library by Alexei Lukin (c) 1992 }
6 
7 unit VFormat;
8 
9 interface
10 
11 {$I VCheck.inc}
12 {$IFDEF V_D3}{$WRITEABLECONST ON}{$ENDIF}
13 
14 uses
15   SysUtils, ExtType, ExtSys, VectStr, VectErr;
16 
17 const
18   DefaultRealFormat = '%g';
19 
20   Y2KLimit = 80;
21 
22 type
23   TFormat = (WindowsLong, WindowsShort, RussianLong, RussianShort,
24     EnglishLong, EnglishShort, Simple, RFC822);
25 {
26   ��� ���� ��������� ������� ������������� ���� �������� ��������������:
27   WindowsLong: ������� Windows-������;
28   WindowsShort: �������� Windows-������;
29   RussianLong: '<����> <�������� ������ ��-������> <���>' (Windows 1251);
30   RussianShort: dd.mm.yyyy;
31   EnglishLong: '<�������� ������ ��-���������> <����>, <���>';
32   EnglishShort: mm/dd/yyyy;
33   Simple: yyyymmdd;
34 
35   ��� �������:
36   WindowsLong: Windows-������ � ���������;
37   WindowsShort: Windows-������ ��� ������;
38   RussianLong: hh:mm:ss;
39   RussianShort: hh:mm;
40   EnglishLong: hh:mm:ss AM|PM', ��� hh <= 12;
41   EnglishShort: 'hh:mm AM|PM', ��� hh <= 12;
42   Simple: hhmm.
43 
44   ��� ���� � �������:
45   RFC822: '<������� �������� ��� ������ ��-���������>, <����> ' +
46     <������� �������� ������ ��-���������> <���> hh:mm:ss' (��� �������� �����!)
47 
48   ��� ���������� ��������: Yes/No, Y/N, ��/���, �/�, True/False, T/F, 1/0.
49 
50   For dates constants of this enumarated type stand for:
51   long Windows-format,
52   short Windows-format,
53   '<day> <russian name of month> <year>',
54   dd.mm.yyyy,
55   '<english name of month> <day>, <year>',
56   mm/dd/yyyy,
57   yyyymmdd.
58 
59   For time:
60   Windows-format with seconds,
61   Windows-format without seconds,
62   hh:mm:ss,
63   hh:mm,
64   'hh:mm:ss AM|PM', where hh <= 12,
65   'hh:mm AM|PM', where hh <= 12,
66   hhmm.
67 
68   For date and time:
69   RFC822: '<short english name of day of week>, <day> ' +
70     <short english name of month> <year> hh:mm:ss' (without time zone!)'
71 
72   For boolean values: Yes/No, Y/N, ��/���, �/�, True/False, T/F, 1/0.
73 }
74 
StdStrToIntnull75 function StdStrToInt(const Value: String): Integer;
StdStrToInt64null76 function StdStrToInt64(const Value: String): Int64;
77 { ����������� ������ � ����� �����; Value ����� ��������� ������ ����� �
78   ���������� ��� ����������������� ������� (� ��������� ������ ������ ������
79   ���������� � '$' ��� '0x' ���� ������������ �������� 'h') }
80 { converts string to integer; Value can be in decimal or hexadecimal formats
81   (in latter case the string either begins from '$' or '0x' or ends with 'h') }
82 
StringToRealnull83 function StringToReal(Value: String): Extended;
84 { ����������� ������ � ������������ �����; � �������� ����������� ����� �
85   ������� ����� ����������� '.', ',' � ��������� ����������� DecimalSeparator }
86 { converts string to floating-point number; it's possible to use '.', ',' and
87   system-defined DecimalSeparator for delimiting integral and fractional parts }
88 
RealToStringnull89 function RealToString(Value: Extended;
90   const RealFormat: String{$IFDEF V_D4} = DefaultRealFormat{$ENDIF}): String;
91 { ����������� ������������ ����� � ������, ��������� RealFormat; � ��������
92   ����������� ����� � ������� ����� ������������ '.' }
93 { converts floating-point number to string using RealFormat and '.' as the
94   decimal separator }
95 
RealToStringFnull96 function RealToStringF(Value: Extended; Precision, Digits_: Integer;
97   const RealFormat: String{$IFDEF V_D4} = DefaultRealFormat{$ENDIF}): String;
98 { ����������� ������������ ����� � ������, ��������� ffGeneral � ��������
99   ���������; � �������� ����������� ����� � ������� ����� ������������ '.' }
100 { converts floating-point number to string using ffGeneral and '.' as the
101   decimal separator }
102 
103 {$IFNDEF NO_DATETIME}
StdDateToStrnull104 function StdDateToStr(ADate: TDateTime;
105   DateFormat: TFormat{$IFDEF V_D4} = RussianShort{$ENDIF}): String;
106 { ����������� ���� � ������, ��������� ������ DateFormat; ���� ��� �� �����,
107   �� ����������� ������� ��� }
108 { converts date to string using DateFormat; if year isn't specified then current
109   year is used }
110 
StdStrToDatenull111 function StdStrToDate(const Value: String): TDateTime;
112 { ����������� ������, ����������� � ����� �� �������� TFormat, � ���� }
113 { converts string which can be in every of formats TFormat to date }
114 
StdTimeToStrnull115 function StdTimeToStr(ATime: TDateTime;
116   TimeFormat: TFormat{$IFDEF V_D4} = RussianShort{$ENDIF}): String;
117 { ����������� ����� � ������, ��������� ������ TimeFormat }
118 { converts time to string using TimeFormat format }
119 
StdStrToTimenull120 function StdStrToTime(Value: String): TDateTime;
121 { ����������� ������, ����������� � ����� �� �������� TTimeFormat, �� ����� }
122 { converts string which can be in every of formats TTimeFormat to time }
123 
StdDateTimeToStrnull124 function StdDateTimeToStr(ADate: TDateTime;
125   Format: TFormat{$IFDEF V_D4} = RussianShort{$ENDIF}): String;
126 { ����������� ����-����� � ������, ��������� ������� DateFormat � TimeFormat }
127 { converts date-time to string using formats DateFormat and TimeFormat }
128 
StdStrToDateTimenull129 function StdStrToDateTime(Value: String): TDateTime;
130 { ����������� ������, ����������� � ����� �� �������� TFormat, � ����-����� }
131 { converts string which can be in every of formats TFormat to date-time }
132 {$ENDIF}
133 
CharToStrnull134 function CharToStr(C: Char): String;
135 { ��������� ������ � ������; ���� C < #32, �� Result:='#' + IntToStr(Ord(C)) }
136 { converts character to string; if C < #32 then Result:='#' + IntToStr(Ord(C)) }
137 
StrToCharnull138 function StrToChar(const Value: String): Char;
139 { �������, �������� � CharToStr }
140 { function inverse to CharToStr }
141 
BoolToStrnull142 function BoolToStr(B: Boolean; BoolFormat: TFormat{$IFDEF V_D4} = WindowsShort{$ENDIF}): String;
143 { ��������� ���������� �������� � ������ }
144 { converts boolean to string }
145 
StrToBoolnull146 function StrToBool(Value: String): Boolean;
147 { �������, �������� � BoolToStr }
148 { function inverse to BoolToStr }
149 
StandardFormatnull150 function StandardFormat(const FormatStr: String; const Args: array of const): String;
151 { ���������� ������� Format, �� ������ ���������� '.' ��� ����������� �����
152   � ������� ����� ������������ ����� }
153 { analog of Format function which always uses '.' as the decimal separator }
154 
155 implementation
156 
PrepareIntnull157 function PrepareInt(const Value: String): String;
158 begin
159   Result:=Trim(Value);
160   if Result <> '' then begin
161     if UpCase(Result[Length(Result)]) = 'H' then
162       Result:='$' + Copy(Result, 1, Length(Result) - 1)
163     else if Pos('0X', UpperCase(Result)) = 1 then
164       Result:='$' + Copy(Result, 3, Length(Result));
165   end;
166 end;
167 
StdStrToIntnull168 function StdStrToInt(const Value: String): Integer;
169 begin
170   try
171     Result:=StrToInt(PrepareInt(Value));
172   except
173     raise Exception.CreateFmt(SCanNotConvertToInteger_s, [Value]);
174   end;
175 end;
176 
177 {$IFDEF V_D4}
StdStrToInt64null178 function StdStrToInt64(const Value: String): Int64;
179 begin
180   try
181     Result:=StrToInt64(PrepareInt(Value));
182   except
183     raise Exception.CreateFmt(SCanNotConvertToInteger_s, [Value]);
184   end;
185 end;
186 {$ELSE}
StdStrToInt64null187 function StdStrToInt64(const Value: String): Int64;
188 var
189   I, L: Integer;
190   S: String;
191   Hex: Boolean;
192   F: Float64;
193 begin
194   S:=Trim(Value);
195   L:=Length(S);
196   try
197     if L = 0 then
198       Abort;
199     Hex:=False;
200     if UpCase(S[L]) = 'H' then begin
201       Dec(L);
202       SetLength(S, L);
203       Hex:=True;
204     end
205     else if S[1] = '$' then begin
206       Dec(L);
207       Delete(S, 1, 1);
208       Hex:=True;
209     end;
210     if Hex then begin
211       if L = 0 then
212         Abort;
213       I:=L - 7;
214       if I < 1 then
215         I:=1;
216       QWordRec(Result).Lo:=StrToInt('$' + Copy(S, I, 8));
217       S:=Copy(S, 1, I - 1);
218       if S <> '' then
219         QWordRec(Result).Hi:=StrToInt('$' + S)
220       else
221         QWordRec(Result).Hi:=0;
222     end
223     else begin
224       F:=StringToReal(S);
225       if Frac(F) <> 0 then
226         Abort;
227       Result:={$IFNDEF INT64_EQ_COMP}Round{$ENDIF}(F);
228     end;
229   except
230     raise Exception.CreateFmt(SCanNotConvertToInteger_s, [Value]);
231   end;
232 end;
233 {$ENDIF}
234 
235 {$IFDEF NOWARN}{$WARNINGS OFF}{$ENDIF}
StringToRealnull236 function StringToReal(Value: String): Extended;
237 var
238   I: Integer;
239 begin
240   Value:=Trim(Value);
241   {$IFDEF V_DELPHI}
242   if CharPos(DecimalSeparator, Value, 1) = 0 then begin
243     I:=CharPos('.', Value, 1);
244     if I > 0 then
245       Value[I]:=DecimalSeparator
246     else begin
247       I:=CharPos(',', Value, 1);
248       if I > 0 then
249         Value[I]:=DecimalSeparator
250     end;
251   end;
252   try
253     Result:=StrToFloat(Value);
254   except
255     raise Exception.CreateFmt(SCanNotConvertToFloat_s, [Value]);
256   end;
257   {$ELSE}
258   I:=CharPos(',', Value, 1);
259   if I > 0 then
260     Value[I]:='.';
261   Val(Value, Result, I);
262   if I <> 0 then
263     raise Exception.CreateFmt(SCanNotConvertToFloat_s, [Value]);
264   {$ENDIF}
265 end;
266 {$IFDEF NOWARN}{$WARNINGS ON}{$ENDIF}
267 
RealToStringnull268 function RealToString(Value: Extended; const RealFormat: String): String;
269 begin
270   FmtStr(Result, RealFormat, [Value]);
271   if DecimalSeparator <> '.' then
272     ReplaceCharProc(Result, DecimalSeparator, '.');
273 end;
274 
RealToStringFnull275 function RealToStringF(Value: Extended; Precision, Digits_: Integer;
276   const RealFormat: String): String;
277 begin
278   Result:=FloatToStrF(Value, ffGeneral, Precision, Digits_);
279   if DecimalSeparator <> '.' then
280     ReplaceCharProc(Result, DecimalSeparator, '.');
281 end;
282 
283 {$IFNDEF NO_DATETIME}
284 type
285   TMonth = 1..12;
286 
287 const
288   MonthNamesRus: array [TMonth] of String[11] = ('������', '�������', '�����',
289     '������', '���', '����', '����', '�������', '��������', '�������', '������',
290     '�������');
291   MonthNamesEng: array [TMonth] of String[9] = ('January', 'February', 'March',
292     'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November',
293     'December');
294   DayOfWeekNamesEngShort: array [1..7] of String[3] = ('Mon', 'Tue', 'Wed',
295     'Thu', 'Fri', 'Sat', 'Sun');
296 
StdDateToStrnull297 function StdDateToStr(ADate: TDateTime; DateFormat: TFormat): String;
298 var
299   Day, Month, Year: Word;
300 begin
301   Case DateFormat of
302     WindowsLong: begin
303       DateTimeToString(Result, LongDateFormat, ADate);
304       Exit;
305     end;
306     WindowsShort: begin
307       Result:=DateToStr(ADate);
308       Exit;
309     end;
310   End;
311   DecodeDate(ADate, Year, Month, Day);
312   Case DateFormat of
313     RussianLong:
314       Result:=IntToStr(Day) + ' ' + MonthNamesRus[Month] + ' ' + IntToStr(Year) + ' �.';
315     RussianShort:
316       Result:=IntToStr2(Day) + '.' + IntToStr2(Month) + '.' + IntToStr(Year);
317     EnglishLong:
318       Result:=MonthNamesEng[Month] + ' ' + IntToStr(Day) + ', ' + IntToStr(Year);
319     EnglishShort:
320       Result:=IntToStr2(Month) + '/' + IntToStr2(Day) + '/' + IntToStr(Year);
321     RFC822:
322       Result:=Format('%s, %d %s %d', [DayOfWeekNamesEngShort[DayOfWeek(ADate)],
323         Day, Copy(MonthNamesEng[Month], 1, 3), Year]);
324   Else {Simple}
325     Result:=AddChar('0', IntToStr(Year), 4) + IntToStr2(Month) + IntToStr2(Day);
326   End;
327 end;
328 
FStdStrToDatenull329 function FStdStrToDate(const Value: String; var LastPos: Integer): TDateTime;
330 const
331   { �������, ����������� ��� ������������ ����������� ������ }
332   MonthRus: array [TMonth] of string[3] = ('�', '�', '���',
333     '��', '��', '���', '���', '��', '�', '�', '�', '�');
334   MonthEng: array [TMonth] of string[3] = ('JA', 'F', 'MAR',
335     'AP', 'MAY', 'JUN', 'JUL', 'AU', 'S', 'O', 'N', 'D');
336   Delimiters = [' ', '.', ',', ';', '/', '\', '-', '_'];
337 type
338   TCharSet = set of Char;
339 var
340   LPos: Integer;
341   S: String;
342 
PassCharsnull343   function PassChars(const Chars: TCharSet; Equal: Boolean): Boolean;
344   begin
345     Result:=False;
346     if LPos <= Length(S) then begin
347       while (S[LPos] in Chars) = Equal do begin
348         Inc(LPos);
349         if LPos > Length(S) then
350           Exit;
351       end;
352       Result:=True;
353     end;
354   end;
355 
GetMonthnull356   function GetMonth(const S: String): Integer;
357   var
358     I: Integer;
359   begin
360     for I:=1 to 12 do
361       if (Pos(MonthRus[I], S) = 1) and ((I <> 5) or (Length(S) > 2) and
362         (S[3] in ['�', '�'])) or (Pos(MonthEng[I], S) = 1) then
363       begin
364         Result:=I;
365         Exit;
366       end;
367     Result:=0;
368   end;
369 
GetYearnull370   function GetYear(const S: String): Word;
371   begin
372     Result:=StrToInt(S);
373     if Length(S) <= 2 then
374       if Result <= Y2KLimit then
375         Inc(Result, 2000)
376       else
377         Inc(Result, 1900);
378   end;
379 
380 var
381   I, J, K, L, DelimEnd, DelimStart: Integer;
382   DD, MM, Day, Year, Month: Word;
383   HasSuffix: Boolean;
384   T: String;
385 begin
386   Year:=0;
387   S:=AnsiUpperCase(Trim(Value));
388   Month:=GetMonth(S);
389   LPos:=1;
390   try
391     if Month > 0 then begin
392       if not PassChars(Digits, False) then
393         Abort;
394       I:=LPos;
395       J:=I;
396       if PassChars(Digits, True) then begin
397         I:=LPos;
398         if PassChars(Digits, False) then begin
399           K:=LPos;
400           PassChars(Digits, True);
401           L:=LPos;
402           if L <> K then
403             Year:=GetYear(Copy(S, K, L - K))
404         end;
405       end;
406       Day:=StrToInt(Copy(S, J, I - J));
407     end
408     else begin
409       if not PassChars(Digits, True) then
410         Abort;
411       I:=LPos;
412       if I = 1 then
413         Abort;
414       Day:=StrToInt(Copy(S, 1, I - 1));
415       DelimStart:=I;
416       PassChars(Delimiters, True);
417       I:=LPos;
418       DelimEnd:=I;
419       Month:=GetMonth(Copy(S, I, Length(S)));
420       if Month = 0 then begin
421         J:=I;
422         HasSuffix:=PassChars(Digits, True);
423         I:=LPos;
424         Month:=StrToInt(Copy(S, J, I - J));
425         T:=Trim(Copy(S, DelimStart, DelimEnd - DelimStart));
426         if (T <> '') and ((T[1] = '/') or
427           (T[1] <> '.') and (AnsiUpperCase(ShortDateFormat)[1] in ['M', '�'])) then
428         begin
429           L:=Day;
430           Day:=Month;
431           Month:=L;
432         end;
433       end
434       else
435         HasSuffix:=True;
436       if HasSuffix and PassChars(Digits, False) then begin
437         K:=LPos;
438         PassChars(Digits, True);
439         L:=LPos;
440         Year:=GetYear(Copy(S, K, L - K));
441       end;
442     end;
443     PassChars(Digits, False);
444     if Year = 0 then
445       DecodeDate(Date, Year, MM, DD);
446     Result:=EncodeDate(Year, Month, Day);
447     LastPos:=LPos;
448   except
449     raise Exception.CreateFmt(SIllegalDateTime, [Value]);
450   end;
451 end;
452 
StdStrToDatenull453 function StdStrToDate(const Value: String): TDateTime;
454 var
455   LastPos: Integer;
456 begin
457   Result:=FStdStrToDate(Value, LastPos);
458 end;
459 
460 {$IFDEF UNIX}
461 var
462   WinShortTimeFormat: String;
463 {$ENDIF}
464 
StdTimeToStrnull465 function StdTimeToStr(ATime: TDateTime; TimeFormat: TFormat): String;
466 
EnglishTimenull467   function EnglishTime(English, Short: Boolean): String;
468   var
469     HH, MM, SS, MS: Word;
470     S: String;
471   begin
472     DecodeTime(ATime, HH, MM, SS, MS);
473     if English then
474       if HH > 12 then begin
475         Dec(HH, 12);
476         S:='PM';
477       end
478       else
479         S:='AM'
480     else
481       S:='';
482     Result:=IntToStr2(HH) + ':' + IntToStr2(MM);
483     if not Short then
484       Result:=Result + ':' + IntToStr2(SS);
485     if S <> '' then
486       Result:=Result + ' ' + S;
487   end;
488 
489 var
490   HH, MM, SS, MS: Word;
491 begin
492   Case TimeFormat of
493     WindowsLong:
494       Result:=TimeToStr(ATime);
495     WindowsShort:
496       DateTimeToString(Result,
497         {$IFDEF UNIX}WinShortTimeFormat{$ELSE}ShortTimeFormat{$ENDIF}, ATime);
498     RussianLong, RFC822:
499       Result:=EnglishTime(False, False);
500     RussianShort:
501       Result:=EnglishTime(False, True);
502     EnglishLong:
503       Result:=EnglishTime(True, False);
504     EnglishShort:
505       Result:=EnglishTime(True, True);
506   Else {Simple}
507     DecodeTime(ATime, HH, MM, SS, MS);
508     Result:=IntToStr2(HH) + IntToStr2(MM);
509   End;
510 end;
511 
StdStrToTimenull512 function StdStrToTime(Value: String): TDateTime;
513 begin
514   Value:=Trim(Value);
515   if TimeSeparator <> ':' then
516     Value:=ReplaceStr(Value, ':', TimeSeparator);
517   if CharPos(TimeSeparator, Value, 1) <= 0 then
518     raise Exception.CreateFmt(SIllegalDateTime, [Value]);
519   Result:=StrToTime(Value);
520 end;
521 
StdDateTimeToStrnull522 function StdDateTimeToStr(ADate: TDateTime; Format: TFormat): String;
523 begin
524   Result:=StdDateToStr(ADate, Format) + ' ' + StdTimeToStr(ADate, Format);
525 end;
526 
StdStrToDateTimenull527 function StdStrToDateTime(Value: String): TDateTime;
528 var
529   I, L, LastChar: Integer;
530   Negative: Boolean;
531 begin
532   Value:=Trim(Value);
533   Result:=FStdStrToDate(Value, LastChar);
534   I:=LastChar - 1;
535   L:=Length(Value);
536   if (I > L) or (Value[I] in [':', TimeSeparator]) then
537     raise Exception.CreateFmt(SIllegalDateTime, [Value]);
538   Value:=Trim(Copy(Value, LastChar, L));
539   if Value <> '' then begin
540     Negative:=Result < 0;
541     Result:=Abs(Result) + StdStrToTime(Value);
542     if Negative then
543       Result:=-Result;
544   end;
545 end;
546 {$ENDIF}
547 
CharToStrnull548 function CharToStr(C: Char): String;
549 begin
550   if C >= #32 then
551     Result:=C
552   else
553     Result:='#' + IntToStr(Ord(C));
554 end;
555 
StrToCharnull556 function StrToChar(const Value: String): Char;
557 var
558   I, L, Code: Integer;
559 begin
560   L:=Length(Value);
561   if L = 1 then
562     Result:=Value[1]
563   else if (L > 1) and (Value[1] = '#') then begin
564     Val(Copy(Value, 2, L), I, Code);
565     if (Code <> 0) or not (I in [0..255]) then
566       raise Exception.CreateFmt(SIllegalChar, [Value]);
567     Result:=Chr(I);
568   end
569   else
570     raise Exception.CreateFmt(SIllegalChar, [Value]);
571 end;
572 
BoolToStrnull573 function BoolToStr(B: Boolean; BoolFormat: TFormat): String;
574 begin
575   Case BoolFormat of
576     WindowsLong: if B then Result:='Yes' else Result:='No';
577     WindowsShort: if B then Result:='Y' else Result:='N';
578     RussianLong: if B then Result:='��' else Result:='���';
579     RussianShort: if B then Result:='�' else Result:='�';
580     EnglishLong: if B then Result:='True' else Result:='False';
581     EnglishShort: if B then Result:='T' else Result:='F';
582   Else {Simple}
583     Result:=Chr(Ord('0') + Ord(B));
584   End;
585 end;
586 
StrToBoolnull587 function StrToBool(Value: String): Boolean;
588 begin
589   Value:=AnsiUpperCase(Trim(Value));
590   if (Value = '1') or (Value = 'YES') or (Value = 'Y') or (Value = '��') or
591     (Value = '�') or (Value = 'TRUE') or (Value = 'T')
592   then
593     Result:=True
594   else if (Value = '0') or (Value = 'NO') or (Value = 'N') or (Value = '���') or
595     (Value = '�') or (Value = 'FALSE') or (Value = 'F')
596   then
597     Result:=False
598   else
599     raise Exception.CreateFmt(SIllegalBool, [Value]);
600 end;
601 
StandardFormatnull602 function StandardFormat(const FormatStr: String; const Args: array of const): String;
603 begin
604   FmtStr(Result, FormatStr, Args);
605   if DecimalSeparator <> '.' then
606     ReplaceCharProc(Result, DecimalSeparator, '.');
607 end;
608 
609 {$IFDEF UNIX}
610 initialization
611   WinShortTimeFormat:=ReplaceStr(ShortTimeFormat, ':ss', '');
612 {$ENDIF}
613 end.
614