tntsysutils2.pas

来自「TntExUpdate 是 流行的 TntUnicodeControls控件的扩」· PAS 代码 · 共 1,036 行 · 第 1/2 页

{*****************************************************************************}
{                                                                             }
{    Tnt Delphi Unicode Controls                                              }
{      http://www.tntware.com/delphicontrols/unicode/                         }
{        Version: 2.1.19                                                      }
{                                                                             }
{    Copyleft (c) 2006, adapted from Troy Wolbrink Tnt delphi controls        }
{    by Jordi March ([e-mail])                                          }
{                                                                             }
{*****************************************************************************}

{ A several updates for date handling: formats methods and WideString support,
  also you can call GetMonthDayNamesW from resources without to change
  the OS language
  WARNING: Not in Linux has been checked! }

unit TntSysUtils2;

{$H+}
{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  SysConst;

function WideStrNextChar(const Str: PWideChar): PWideChar;

{ CharLength returns the number of bytes required by the character starting
  at bytes S[Index].  }

function WideFormatDateTime(const Format: WideString; DateTime: TDateTime): WideString;

{ DateTimeToString converts the date and time value given by DateTime using
  the format WideString given by Format into the WideString variable given by Result.
  For further details, see the description of the FormatDateTime function. }

procedure WideDateTimeToString(var Result: WideString; const Format: WideString;
  DateTime: TDateTime);

{ FloatToDateTime will range validate a value to make sure it falls
  within the acceptable date range }

{ Initialization file support }
function WideGetLocaleChar(Locale, LocaleType: Integer; Default: WideChar): WideChar; platform;

var
  ThousandSeparatorW: WideChar;
  DecimalSeparatorW: WideChar;
  DateSeparatorW: WideChar;
  ShortDateFormatW: WideString;
  LongDateFormatW: WideString;
  TimeAMStringW: WideString;
  TimePMStringW: WideString;
  ShortMonthNamesW: array[1..12] of WideString;
  LongMonthNamesW: array[1..12] of WideString;
  ShortDayNamesW: array[1..7] of WideString;
  LongDayNamesW: array[1..7] of WideString;

procedure GetMonthDayNamesW (UseResource: Boolean);

const
  {DigitLang}
  DL_Latin = 0;
  DL_ArabicIndic = 1;
  DL_ExtendedArabicIndic = 2;
  DL_Denavagari = 3;
  DL_Bengali = 4;
  DL_Gurmukhi = 5;
  DL_Gujarati = 6;
  DL_Oriya = 7;
  DL_Tamil = 8;
  DL_Telugu = 9;
  DL_Kannada = 10;
  DL_Malayalam = 11;
  DL_Thai = 12;
  DL_Lao = 13;
  DL_Tibetan = 14;
  DL_Myanmar = 15;
  DL_Khmer = 16;
  DL_Mongolian = 17;
  DL_Lumbu = 18;
  DL_NewTaiLue = 19;
  DL_Fullwidth = 20;
  DL_MathematicalBold = 21;
  DL_MathematicalDoubleStruck = 22;
  DL_MathematicalSansSerif = 23;
  DL_MathematicalSansSerifBold = 24;
  DL_MathematicalMonospace = 25;

const
  AllDigitsArr: array [DL_Latin..DL_MathematicalMonospace] of Integer = (
    $0030,  {Latin}
    $0660,  {Arabic-Indic}
    $06f0,  {Extended Arabic-Indic}
    $0966,  {Denavagari}
    $09E6,  {Bengali}
    $0A66,  {Gurmukhi}
    $0AE6,  {Gujarati}
    $0B66,  {Oriya}
    $0BE6,  {Tamil}
    $0C66,  {Telugu}
    $0CE6,  {Kannada}
    $0D66,  {Malayalam}
    $0E50,  {Thai}
    $0ED0,  {Lao}
    $0F20,  {Tibetan}
    $1040,  {Myanmar}
    $17E0,  {Khmer}
    $1810,  {Mongolian}
    $1946,  {Lumbu}
    $19D0,  {New Tai Lue}
    $FF10,  {Fullwidth}
    $104A0,  {Mathematical Bold}
    $1D7D8,  {Mathematical Double-Struck}
    $1D7E2,  {Mathematical Sans-Serif}
    $1D7EC,  {Mathematical Sans-Serif Bold}
    $1D7F5);  {Mathematical Monospace}

var
  Def_DigitLang: Byte = DL_Latin;
function WCharIsDigit (Ch: WideChar; var Digit: Byte): Boolean;
function WStrToInt (const S: WideString; var Valid: Boolean): Integer;
function IntToWStrDL (I: Integer; DigitLang: Byte): WideString;
function IntToWStr (I: Integer): WideString;
function WStrToFloat (const S: WideString; var Valid: Boolean): Extended;
function FormatFloatWDL (const Format: string; Value: Extended;
  DigitLang: Byte): WideString;
function FormatFloatW (const Format: string; Value: Extended): WideString;

implementation

uses
  Windows, SysUtils, Math,
  TntSysUtils, TntSystem, TntWideStrUtils;

function WideStrNextChar(const Str: PWideChar): PWideChar;
begin
{$IFDEF LINUX}
  Result := Str + StrCharLength(Str);
{$ENDIF}
{$IFDEF MSWINDOWS}
  Result := CharNextW(Str);
{$ENDIF}
end;

function WideFormatDateTime(const Format: WideString; DateTime: TDateTime): WideString;
begin
  WideDateTimeToString(Result, Format, DateTime);
end;

procedure WideDateTimeToString(var Result: WideString; const Format: WideString;
  DateTime: TDateTime);
var
  BufPos, AppendLevel: Integer;
  Buffer: array[0..255] of WideChar;

  procedure AppendChars(P: PWideChar; Count: Integer);
  var
    N: Integer;
  begin
    N := SizeOf(Buffer) - BufPos;
    if N > Count then N := Count;
    if N <> 0 then Move(P[0], Buffer[BufPos], N*2);
    Inc(BufPos, N);
  end;

  procedure AppendString(const S: WideString);
  begin
    AppendChars(Pointer(S), Length(S));
  end;

  procedure AppendNumber(Number, Digits: Integer);
  const
    Format: array[0..3] of Char = '%.*d';
  var
    S: WideString;
  begin
    S := WideFormat (Format, [Digits, Number]);
    AppendChars(Pointer(S), Length(S));
  end;

  procedure AppendFormat(Format: PWideChar);
  var
    Starter, Token, LastToken: WideChar;
    DateDecoded, TimeDecoded, Use12HourClock,
    BetweenQuotes: Boolean;
    P: PWideChar;
    Count: Integer;
    Year, Month, Day, Hour, Min, Sec, MSec, H: Word;

    procedure GetCount;
    var
      P: PWideChar;
    begin
      P := Format;
      while Format^ = Starter do Inc(Format);
      Count := Format - P + 1;
    end;

    procedure GetDate;
    begin
      if not DateDecoded then
      begin
        DecodeDate(DateTime, Year, Month, Day);
        DateDecoded := True;
      end;
    end;

    procedure GetTime;
    begin
      if not TimeDecoded then
      begin
        DecodeTime(DateTime, Hour, Min, Sec, MSec);
        TimeDecoded := True;
      end;
    end;

{$IFDEF MSWINDOWS}
    function ConvertEraString(const Count: Integer) : WideString;
    var
      FormatStr: WideString;
      SystemTime: TSystemTime;
      Buffer: array[Byte] of WideChar;
      P: PWideChar;
    begin
      Result := '';
      with SystemTime do
      begin
        wYear  := Year;
        wMonth := Month;
        wDay   := Day;
      end;

      FormatStr := 'gg';
      if GetDateFormatW(GetThreadLocale, DATE_USE_ALT_CALENDAR, @SystemTime,
        PWideChar(FormatStr), Buffer, SizeOf(Buffer)) <> 0 then
      begin
        Result := Buffer;
        if Count = 1 then
        begin
          case SysLocale.PriLangID of
            LANG_JAPANESE:
              Result := Copy(Result, 1, CharToBytelen(Result, 1));
            LANG_CHINESE:
              if (SysLocale.SubLangID = SUBLANG_CHINESE_TRADITIONAL)
                and (ByteToCharLen(Result, Length(Result)) = 4) then
              begin
                P := Buffer + CharToByteIndex(Result, 3) - 1;
                SetString(Result, P, CharToByteLen(P, 2));
              end;
          end;
        end;
      end;
    end;

    function ConvertYearString(const Count: Integer): WideString;
    var
      FormatStr: WideString;
      SystemTime: TSystemTime;
      Buffer: array[Byte] of WideChar;
    begin
      Result := '';
      with SystemTime do
      begin
        wYear  := Year;
        wMonth := Month;
        wDay   := Day;
      end;

      if Count <= 2 then
        FormatStr := 'yy' // avoid Win95 bug.
      else
        FormatStr := 'yyyy';

      if GetDateFormatW(GetThreadLocale, DATE_USE_ALT_CALENDAR, @SystemTime,
        PWideChar(FormatStr), Buffer, SizeOf(Buffer)) <> 0 then
      begin
        Result := Buffer;
        if (Count = 1) and (Result[1] = '0') then
          Result := Copy(Result, 2, Length(Result)-1);
      end;
    end;
{$ENDIF}

{$IFDEF LINUX} {???????????????????????????????????????}
    function FindEra(Date: Integer): Byte;
    var
      I : Byte;
    begin
      Result := 0;
      for I := 1 to EraCount do
      begin
        if (EraRanges[I].StartDate <= Date) and
          (EraRanges[I].EndDate >= Date) then
        begin
          Result := I;
          Exit;
        end;
      end;
    end;

    function ConvertEraString(const Count: Integer) : String;
    var
      I : Byte;
    begin
      Result := '';
      I := FindEra(Trunc(DateTime));
      if I > 0 then
        Result := EraNames[I];
    end;

    function ConvertYearString(const Count: Integer) : String;
    var
      I : Byte;
      S : string;
    begin
      I := FindEra(Trunc(DateTime));
      if I > 0 then
        S := IntToStr(Year - EraYearOffsets[I])
      else
        S := IntToStr(Year);
      while Length(S) < Count do
        S := '0' + S;
      if Length(S) > Count then
        S := Copy(S, Length(S) - (Count - 1), Count);
      Result := S;
    end;
{$ENDIF}

  begin
    FillChar (Buffer, SizeOf(Buffer), #0);
    if (Format <> nil) and (AppendLevel < 2) then
    begin
      Inc(AppendLevel);
      LastToken := ' ';
      DateDecoded := False;
      TimeDecoded := False;
      Use12HourClock := False;
      while Format^ <> #0 do
      begin
        Starter := Format^;
        Format := WideStrNextChar(Format);
        if Char(Starter) in LeadBytes then
        begin
          LastToken := ' ';
          Continue;
        end;
        Token := Starter;
        if Char(Token) in ['a'..'z'] then Dec(Token, 32);
        if Char(Token) in ['A'..'Z'] then
        begin
          if (Char(Token) = 'M') and (Char(LastToken) = 'H') then Token := 'N';
          LastToken := Token;
        end;
        case Token of
          'Y':
            begin
              GetCount;
              GetDate;
              if Count <= 2 then
                AppendNumber(Year mod 100, 2) else
                AppendNumber(Year, 4);
            end;
          'G':
            begin
              GetCount;
              GetDate;
              AppendString(ConvertEraString(Count));
            end;
          'E':
            begin
              GetCount;
              GetDate;
              AppendString(ConvertYearString(Count));
            end;
          'M':
            begin
              GetCount;
              GetDate;
              case Count of
                1, 2: AppendNumber(Month, Count);
                3: AppendString(ShortMonthNamesW[Month]);
              else
                AppendString(LongMonthNamesW[Month]);
              end;
            end;
          'D':
            begin
              GetCount;
              case Count of
                1, 2:
                  begin
                    GetDate;
                    AppendNumber(Day, Count);
                  end;
                3: AppendString(ShortDayNamesW[DayOfWeek(DateTime)]);
                4: AppendString(LongDayNamesW[DayOfWeek(DateTime)]);
                5: AppendFormat(Pointer(ShortDateFormatW));
              else
                AppendFormat(Pointer(LongDateFormatW));
              end;
            end;
          'H':
            begin
              GetCount;
              GetTime;
              BetweenQuotes := False;
              P := Format;
              while P^ <> #0 do
              begin
                if Char(P^) in LeadBytes then
                begin
                  P := WideStrNextChar(P);
                  Continue;
                end;
                case P^ of
                  'A', 'a':
                    if not BetweenQuotes then
                    begin
                      if ( (WStrLIComp(P, 'AM/PM', 5) = 0)
                        or (WStrLIComp(P, 'A/P',   3) = 0)
                        or (WStrLIComp(P, 'AMPM',  4) = 0) ) then
                        Use12HourClock := True;
                      Break;
                    end;
                  'H', 'h':
                    Break;
                  '''', '"': BetweenQuotes := not BetweenQuotes;
                end;
                Inc(P);
              end;
              H := Hour;
              if Use12HourClock then
                if H = 0 then H := 12 else if H > 12 then Dec(H, 12);
              if Count > 2 then Count := 2;
              AppendNumber(H, Count);
            end;
          'N':
            begin
              GetCount;
              GetTime;
              if Count > 2 then Count := 2;
              AppendNumber(Min, Count);
            end;
          'S':
            begin
              GetCount;
              GetTime;
              if Count > 2 then Count := 2;
              AppendNumber(Sec, Count);
            end;
          'T':
            begin
              GetCount;
              if Count = 1 then
                AppendFormat(Pointer(ShortTimeFormat)) else
                AppendFormat(Pointer(LongTimeFormat));
            end;
          'Z':
            begin
              GetCount;
              GetTime;
              if Count > 3 then Count := 3;
              AppendNumber(MSec, Count);
            end;
          'A':
            begin
              GetTime;
              P := Format - 1;
              if WStrLIComp(P, 'AM/PM', 5) = 0 then
              begin
                if Hour >= 12 then Inc(P, 3);
                AppendChars(P, 2);
                Inc(Format, 4);
                Use12HourClock := TRUE;
              end else
              if WStrLIComp(P, 'A/P', 3) = 0 then
              begin
                if Hour >= 12 then Inc(P, 2);
                AppendChars(P, 1);
                Inc(Format, 2);
                Use12HourClock := TRUE;
              end else
              if WStrLIComp(P, 'AMPM', 4) = 0 then
              begin
                if Hour < 12 then
                  AppendString(TimeAMStringW) else
                  AppendString(TimePMStringW);
                Inc(Format, 3);
                Use12HourClock := TRUE;
              end else
              if WStrLIComp(P, 'AAAA', 4) = 0 then
              begin
                GetDate;
                AppendString(LongDayNamesW[DayOfWeek(DateTime)]);
                Inc(Format, 3);
              end else
              if WStrLIComp(P, 'AAA', 3) = 0 then
              begin
                GetDate;
                AppendString(ShortDayNamesW[DayOfWeek(DateTime)]);
                Inc(Format, 2);
              end else
              AppendChars(@Starter, 1);
            end;
          'C':
            begin
              GetCount;
              AppendFormat(Pointer(ShortDateFormatW));
              GetTime;
              if (Hour <> 0) or (Min <> 0) or (Sec <> 0) then
              begin
                AppendChars(' ', 1);
                AppendFormat(Pointer(LongTimeFormat));
              end;
            end;
          '/':