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