tntsysutils2.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

            if DateSeparatorW <> #0 then
              AppendChars(@DateSeparatorW, 1);
          ':':
            if TimeSeparator <> #0 then
              AppendChars(@TimeSeparator, 1);
          '''', '"':
            begin
              P := Format;
              while (Format^ <> #0) and (Format^ <> Starter) do
              begin
                if Char(Format^) in LeadBytes then
                  Format := WideStrNextChar(Format)
                else
                  Inc(Format);
              end;
              AppendChars(P, Format - P);
              if Format^ <> #0 then Inc(Format);
            end;
        else
          AppendChars(@Starter, 1);
        end;
      end;
      Dec(AppendLevel);
    end;
  end;

begin
  BufPos := 0;
  AppendLevel := 0;
  if Format <> '' then AppendFormat(Pointer(Format)) else AppendFormat('C');
  SetString(Result, Buffer, BufPos);
end {WideDateTimeToString};

{$IFDEF MSWINDOWS}
function WideTranslateDateFormat(const FormatStr: WideString): WideString;
var
  I: Integer;
  L: Integer;
  CalendarType: CALTYPE;
  RemoveEra: Boolean;
begin
  I := 1;
  Result := '';
  CalendarType := StrToIntDef(WideGetLocaleStr(GetThreadLocale,
    LOCALE_ICALENDARTYPE, '1'), 1);
  if not (CalendarType in [CAL_JAPAN, CAL_TAIWAN, CAL_KOREA]) then
  begin
    RemoveEra := SysLocale.PriLangID in [LANG_JAPANESE, LANG_CHINESE, LANG_KOREAN];
    if RemoveEra then
    begin
      While I <= Length(FormatStr) do
      begin
        if not (Char(FormatStr[I]) in ['g', 'G']) then
          Result := Result + FormatStr[I];
        Inc(I);
      end;
    end
    else
      Result := FormatStr;
    Exit;
  end;

  while I <= Length(FormatStr) do
  begin
    if Char(FormatStr[I]) in LeadBytes then
    begin
      L := CharLength(FormatStr, I);
      Result := Result + Copy(FormatStr, I, L);
      Inc(I, L);
    end else
    begin
      if WStrLIComp(@FormatStr[I], 'gg', 2) = 0 then
      begin
        Result := Result + 'ggg';
        Inc(I, 1);
      end
      else if WStrLIComp(@FormatStr[I], 'yyyy', 4) = 0 then
      begin
        Result := Result + 'eeee';
        Inc(I, 4-1);
      end
      else if WStrLIComp(@FormatStr[I], 'yy', 2) = 0 then
      begin
        Result := Result + 'ee';
        Inc(I, 2-1);
      end
      else if Char(FormatStr[I]) in ['y', 'Y'] then
        Result := Result + 'e'
      else
        Result := Result + FormatStr[I];
      Inc(I);
    end;
  end;
end;
{$ENDIF}

{$IFDEF LINUX}  {?????}
procedure InitEras;
var
  Count : Byte;
  I, J, Pos : Integer;
  Number : Word;
  S : string;
  Year, Month, Day: Word;
begin
  EraCount := 0;
  S := nl_langinfo(ERA);
  if S = '' then
    S := LoadResString(@SEraEntries);

  Pos := 1;
  for I := 1 to MaxEraCount do
  begin
    if Pos > Length(S) then Break;
    if not(ScanChar(S, Pos, '+') or ScanChar(S, Pos, '-')) then Break;
    // Eras in which year increases with negative time (eg Christian BC era)
    // are not currently supported.
//    EraRanges[I].Direction := S[Pos - 1];

    // Era offset, in years from Gregorian calendar year
    if not ScanChar(S, Pos, ':') then Break;
    if ScanChar(S, Pos, '-') then
      J := -1
    else
      J := 1;
    if not ScanNumber(S, Pos, Number, Count) then Break;
    EraYearOffsets[I] := J * Number;   // apply sign to Number

    // Era start date, in Gregorian year/month/day format
    if not ScanChar(S, Pos, ':') then Break;
    if not ScanNumber(S, Pos, Year, Count) then Break;
    if not ScanChar(S, Pos, '/') then Break;
    if not ScanNumber(S, Pos, Month, Count) then Break;
    if not ScanChar(S, Pos, '/') then Break;
    if not ScanNumber(S, Pos, Day, Count) then Break;
    EraRanges[I].StartDate := Trunc(EncodeDate(Year, Month, Day));
    EraYearOffsets[I] := Year - EraYearOffsets[I];

    // Era end date, in Gregorian year/month/day format
    if not ScanChar(S, Pos, ':') then Break;
    if ScanString(S, Pos, '+*') then       // positive infinity
      EraRanges[I].EndDate := High(EraRanges[I].EndDate)
    else if ScanString(S, Pos, '-*') then  // negative infinity
      EraRanges[I].EndDate := Low(EraRanges[I].EndDate)
    else if not ScanNumber(S, Pos, Year, Count) then
      Break
    else
    begin
      if not ScanChar(S, Pos, '/') then Break;
      if not ScanNumber(S, Pos, Month, Count) then Break;
      if not ScanChar(S, Pos, '/') then Break;
      if not ScanNumber(S, Pos, Day, Count) then Break;
      EraRanges[I].EndDate := Trunc(EncodeDate(Year, Month, Day));
    end;

    // Era name, in locale charset
    if not ScanChar(S, Pos, ':') then Break;
    J := AnsiPos(':', Copy(S, Pos, Length(S) + 1 - Pos));
    if J = 0 then Break;
    EraNames[I] := Copy(S, Pos, J - 1);
    Inc(Pos, J - 1);

    // Optional Era format string for era year, in locale charset
    if not ScanChar(S, Pos, ':') then Break;
    J := AnsiPos(';', Copy(S, Pos, Length(S) + 1 - Pos));
    if J = 0 then
      J := 1 + Length(S) + 1 - Pos;
    {if J = 0 then Break;}
    EraYearFormats[I] := Copy(S, Pos, J - 1);
    Inc(Pos, J - 1);
    Inc(EraCount);
    if not((Pos > Length(S)) or ScanChar(S, Pos, ';')) then Break;
  end;

  // Clear the rest of the era slots, including partial entry from failed parse
  for I := EraCount+1 to MaxEraCount do
  begin
    EraNames[I] := '';
    EraYearOffsets[I] := -1;
    EraRanges[I].StartDate := High(EraRanges[I].StartDate);
    EraRanges[I].EndDate := High(EraRanges[I].EndDate);
    EraYearFormats[I] := '';
  end;
end;
{$ENDIF}


function WideGetLocaleChar(Locale, LocaleType: Integer; Default: WideChar): WideChar;
{$IFDEF MSWINDOWS}
var
  Buffer: array[0..1] of WideChar;
begin
  if GetLocaleInfoW(Locale, LocaleType, Buffer, 2) > 0 then
    Result := Buffer[0] else
    Result := Default;
end;
{$ENDIF}
{$IFDEF LINUX}
begin
  Result := Default;
end;
{$ENDIF}

(**
var
  DefShortMonthNames: array[1..12] of Pointer = (@SShortMonthNameJan,
    @SShortMonthNameFeb, @SShortMonthNameMar, @SShortMonthNameApr,
    @SShortMonthNameMay, @SShortMonthNameJun, @SShortMonthNameJul,
    @SShortMonthNameAug, @SShortMonthNameSep, @SShortMonthNameOct,
    @SShortMonthNameNov, @SShortMonthNameDec);

  DefLongMonthNames: array[1..12] of Pointer = (@SLongMonthNameJan,
    @SLongMonthNameFeb, @SLongMonthNameMar, @SLongMonthNameApr,
    @SLongMonthNameMay, @SLongMonthNameJun, @SLongMonthNameJul,
    @SLongMonthNameAug, @SLongMonthNameSep, @SLongMonthNameOct,
    @SLongMonthNameNov, @SLongMonthNameDec);

  DefShortDayNames: array[1..7] of Pointer = (@SShortDayNameSun,
    @SShortDayNameMon, @SShortDayNameTue, @SShortDayNameWed,
    @SShortDayNameThu, @SShortDayNameFri, @SShortDayNameSat);

  DefLongDayNames: array[1..7] of Pointer = (@SLongDayNameSun,
    @SLongDayNameMon, @SLongDayNameTue, @SLongDayNameWed,
    @SLongDayNameThu, @SLongDayNameFri, @SLongDayNameSat);
**)

procedure GetMonthDayNamesW (UseResource: Boolean);
{$IFDEF MSWINDOWS}
var
  I, Day: Integer;
  DefaultLCID: LCID;
  S: WideString;

  (**
  function LocalGetLocaleStr(LocaleType, Index: Integer;
    const DefValues: array of Pointer): WideString;
  procedure LoadRes;
  begin
    Result := WideLoadResString(DefValues[Index]);
  end;
  begin
    if UseResource
    then LoadRes
    else  begin
      Result := WideGetLocaleStr(DefaultLCID, LocaleType, '');
      if Result = ''
      then LoadRes;
    end;
  end;
  **)

  function LocalGetLocaleStr(LocaleType, Index: Integer): WideString;
  begin
    if UseResource
    then Result := S
    else  begin
      Result := WideGetLocaleStr(DefaultLCID, LocaleType, '');
      if Result = ''
      then Result := S;
    end;
  end;

begin
  DefaultLCID := GetThreadLocale;
  for I := 1 to 12 do
  begin
    case I of
    1: S := SShortMonthNameJan;
    2: S := SShortMonthNameFeb;
    3: S := SShortMonthNameMar;
    4: S := SShortMonthNameApr;
    5: S := SShortMonthNameMay;
    6: S := SShortMonthNameJun;
    7: S := SShortMonthNameJul;
    8: S := SShortMonthNameAug;
    9: S := SShortMonthNameSep;
    10: S := SShortMonthNameOct;
    11: S := SShortMonthNameNov;
    12: S := SShortMonthNameDec;
    end;
    ShortMonthNamesW[I] := LocalGetLocaleStr(LOCALE_SABBREVMONTHNAME1 + I - 1,
      I - 1);
    case I of
    1: S := SLongMonthNameJan;
    2: S := SLongMonthNameFeb;
    3: S := SLongMonthNameMar;
    4: S := SLongMonthNameApr;
    5: S := SLongMonthNameMay;
    6: S := SLongMonthNameJun;
    7: S := SLongMonthNameJul;
    8: S := SLongMonthNameAug;
    9: S := SLongMonthNameSep;
    10: S := SLongMonthNameOct;
    11: S := SLongMonthNameNov;
    12: S := SLongMonthNameDec;
    end;
    LongMonthNamesW[I] := LocalGetLocaleStr(LOCALE_SMONTHNAME1 + I - 1,
      I - 1);
    (**
    ShortMonthNamesW[I] := LocalGetLocaleStr(LOCALE_SABBREVMONTHNAME1 + I - 1,
      I - Low(DefShortMonthNames), DefShortMonthNames);
    LongMonthNamesW[I] := LocalGetLocaleStr(LOCALE_SMONTHNAME1 + I - 1,
      I - Low(DefLongMonthNames), DefLongMonthNames);
    **)
  end;
  for I := 1 to 7 do
  begin
    Day := (I + 5) mod 7;
    case I of
    1: S := SShortDayNameSun;
    2: S := SShortDayNameMon;
    3: S := SShortDayNameTue;
    4: S := SShortDayNameWed;
    5: S := SShortDayNameThu;
    6: S := SShortDayNameFri;
    7: S := SShortDayNameSat;
    end;
    ShortDayNamesW[I] := LocalGetLocaleStr(LOCALE_SABBREVDAYNAME1 + Day,
      I - 1);
    case I of
    1: S := SLongDayNameSun;
    2: S := SLongDayNameMon;
    3: S := SLongDayNameTue;
    4: S := SLongDayNameWed;
    5: S := SLongDayNameThu;
    6: S := SLongDayNameFri;
    7: S := SLongDayNameSat;
    end;
    LongDayNamesW[I] := LocalGetLocaleStr(LOCALE_SDAYNAME1 + Day,
      I - 1);
    (**
    ShortDayNamesW[I] := LocalGetLocaleStr(LOCALE_SABBREVDAYNAME1 + Day,
      I - Low(DefShortDayNames), DefShortDayNames);
    LongDayNamesW[I] := LocalGetLocaleStr(LOCALE_SDAYNAME1 + Day,
      I - Low(DefLongDayNames), DefLongDayNames);
    **)
  end;
end;
{$ELSE}
{$IFDEF LINUX}
  function WideGetLocaleStr(LocaleIndex, Index: Integer;
    const DefValues: array of Pointer): string;
  var
    temp: PChar;
  begin
    temp := nl_langinfo(LocaleIndex);
    if (temp = nil) or (temp^ = #0) then
      Result := WideLoadResString(DefValues[Index])
    else
      Result := temp;
  end;

var
  I: Integer;
begin
  for I := 1 to 12 do
  begin
    ShortMonthNamesW[I] := WideGetLocaleStr(ABMON_1 + I - 1,
      I - Low(DefShortMonthNames), DefShortMonthNames);
    LongMonthNamesW[I] := WideGetLocaleStr(MON_1 + I - 1,
      I - Low(DefLongMonthNames), DefLongMonthNames);
  end;
  for I := 1 to 7 do
  begin
    ShortDayNamesW[I] := WideGetLocaleStr(ABDAY_1 + I - 1,
      I - Low(DefShortDayNames), DefShortDayNames);
    LongDayNamesW[I] := WideGetLocaleStr(DAY_1 + I - 1,
      I - Low(DefLongDayNames), DefLongDayNames);
  end;
end {GetMonthDayNamesW};
{$ELSE}
var
  I: Integer;
begin
  for I := 1 to 12 do
  begin
    ShortMonthNamesW[I] := WideLoadResString(DefShortMonthNames[I]);
    LongMonthNamesW[I] := WideLoadResString(DefLongMonthNames[I]);
  end;
  for I := 1 to 7 do
  begin
    ShortDayNamesW[I] := WideLoadResString(DefShortDayNames[I]);
    LongDayNamesW[I] := WideLoadResString(DefLongDayNames[I]);
  end;
end {GetMonthDayNamesW};
{$ENDIF}
{$ENDIF}

procedure GetFormatSettingsW;
var
  DefaultLCID: LCID;
begin
  DefaultLCID := GetThreadLocale;
  ThousandSeparatorW := WideGetLocaleChar(DefaultLCID, LOCALE_STHOUSAND, ',');
  DecimalSeparatorW := WideGetLocaleChar(DefaultLCID, LOCALE_SDECIMAL, '.');
  GetMonthDayNamesW (False);
  DateSeparatorW := WideGetLocaleChar(DefaultLCID, LOCALE_SDATE, '/');
  ShortDateFormatW := WideTranslateDateFormat(WideGetLocaleStr(DefaultLCID, LOCALE_SSHORTDATE, 'm/d/yy'));
  LongDateFormatW := WideTranslateDateFormat(WideGetLocaleStr(DefaultLCID, LOCALE_SLONGDATE, 'mmmm d, yyyy'));
  TimeAMStringW := WideGetLocaleStr(DefaultLCID, LOCALE_S1159, 'am');
  TimePMStringW := WideGetLocaleStr(DefaultLCID, LOCALE_S2359, 'pm');
end;

function WCharIsDigit (Ch: WideChar; var Digit: Byte): Boolean;
function FoundIntArray (I: Integer): Boolean;
var
  J: Integer;
  K: Byte;
begin
  Result := False;
  for  J := DL_Latin to DL_MathematicalMonospace  do
    for  K := 0 to 9  do
      if  I = AllDigitsArr[J]+K  then  begin
        Result := True;
        Digit := K;
        Exit;
      end;
end {FoundInIntArray};
begin
  Result := FoundIntArray (Integer (Ch));
end {WCharIsDigit};

function WStrToInt (const S: WideString; var Valid: Boolean): Integer;
var
  Digit: Byte;
  I: Integer;
  SAcc: string;
begin
  Valid := False;
  Result := 0;
  if  S = ''
  then  Exit;
  SAcc := '';
  for  I := 1 to Length(S)  do
    if  WCharIsDigit (S[I], Digit)
    then  SAcc := Concat (SAcc, IntToStr(Digit))
    else  Exit;
  try
    Result := StrToInt (SAcc);
    Valid := True;
  except
  end;
end {WStrToInt};

function IntToWStrDL (I: Integer; DigitLang: Byte): WideString;
var
  J: Integer;
  SAcc: string;
begin
  if Sign (I) = -1
  then  Result := '-';
  I := Abs (I);
  SAcc := IntToStr (I);
  for  J := 1 to Length(SAcc)  do
    Result := Concat (Result, WideChar(AllDigitsArr[DigitLang]+StrToInt(Sacc[J])));
end {IntToWStrDL};

function IntToWStr (I: Integer): WideString;
begin
  Result := IntToWStrDL (I, Def_DigitLang);
end;

function WStrToFloat (const S: WideString; var Valid: Boolean): Extended;
var
  Digit: Byte;
  I: Integer;
  SAcc: string;
begin
  Valid := False;
  Result := 0;
  if  S = ''
  then  Exit;
  SAcc := '';
  for  I := 1 to Length(S)  do
    if  WCharIsDigit (S[I], Digit)
    then  SAcc := Concat (SAcc, IntToStr(Digit))
    else if  S[I] = DecimalSeparatorW
    then  SAcc := Concat (SAcc, '.')
    else  Exit;
  try
    Result := StrToFloat (SAcc);
    Valid := True;
  except
  end;
end {IntToWStrDL};

function FormatFloatWDL (const Format: string; Value: Extended;
  DigitLang: Byte): WideString;
var
  I: Integer;
  Digit: Byte;
begin
  Result := '';
  try
    Result := FormatFloat (Format, Value);
    if  DigitLang = DL_Latin
    then  Exit;
    for  I := 1 to Length(Result)  do
      if  WCharIsDigit (Result[I], Digit)
      then  Result[I] := WideChar(AllDigitsArr[DigitLang]+I)
      else if  Char(Result[I]) = ThousandSeparator
      then  Result[I] := ThousandSeparatorW
      else if  Char(Result[I]) = DecimalSeparator
      then  Result[I] := DecimalSeparatorW;
  finally
  end;
end {FormatFloatWDL};

function FormatFloatW (const Format: string; Value: Extended): WideString;
begin
  FormatFloatWDL (Format, Value, Def_DigitLang);
end;

initialization
  GetFormatSettingsW;

end.