cxdateutils.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,765 行 · 第 1/5 页

      Result := TcxJapaneseCalendarTable.Create;
    CAL_TAIWAN:
      Result := TcxTaiwanCalendarTable.Create;
    CAL_KOREA:
      Result := TcxKoreanCalendarTable.Create;
    CAL_HIJRI:
      Result := TcxHijriCalendarTable.Create;
    CAL_THAI:
      Result := TcxThaiCalendarTable.Create;
    CAL_HEBREW:
      Result := TcxHebrewCalendarTable.Create;
    else
    begin
      Result := TcxGregorianCalendarTable.Create;
    end;
  end;
end;

function cxGetLocalCalendarID: TcxCALID;
begin
  GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_ICALENDARTYPE or CAL_RETURN_NUMBER,
    @Result, SizeOf(Result));
end;

function cxGetLocalCalendar: TcxCustomCalendarTable;
begin
  Result := cxGetCalendar(cxGetLocalCalendarID);
end;

function cxGetDateSeparator: Char;
var
  ABuf: array [0..255] of Char;
begin
  GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SDATE,
    @ABuf, SizeOf(ABuf));
  Result := ABuf[0];
end;

function cxGetLocalFormatSettings: TFormatSettings;
begin
  Result.DateSeparator := cxGetDateSeparator;
  Result.ShortDateFormat := cxGetLocalShortDateFormat;
  Result.LongDateFormat := cxGetLocalLongDateFormat;

  Result.TimeSeparator := cxGetLocalTimeSeparator;
  Result.LongTimeFormat := cxGetLocalLongTimeFormat;
  Result.TimeAMString := cxGetLocalTimeAMString;
  Result.TimePMString := cxGetLocalTimePMString;

  Result.ListSeparator := ListSeparator;

end;

function cxGetLocalLongDateFormat: string;
var
  ABuf: array [0..255] of Char;
begin
  GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SLONGDATE,
    @ABuf, SizeOf(ABuf));
  Result := ABuf;
end;

function cxGetLocalLongTimeFormat: string;
var
  ABuf: array [0..255] of Char;
begin
  GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_STIMEFORMAT,
    @ABuf, SizeOf(ABuf));
  Result := ABuf;
end;

function cxGetLocalMonthName(ADate: TDateTime; ACalendar: TcxCustomCalendarTable): string;
var
  AFormat: string;
  AConvertDate: TcxDateTime;
begin
  AConvertDate := ACalendar.FromDateTime(ADate);
  AConvertDate.Day := 1;
  AFormat := 'MMMM';
  if (cxIsGregorianCalendar(ACalendar) and cxFormatController.UseDelphiDateTimeFormats) or
      not cxGetDateFormat(ACalendar.ToDateTime(AConvertDate), Result,
      0, AFormat) then
    Result := LongMonthNames[AConvertDate.Month];
end;

function cxGetLocalMonthName(AYear, AMonth: Integer; ACalendar: TcxCustomCalendarTable): string;
var
  ADate: TcxDate;
begin
  if cxIsGregorianCalendar(ACalendar) and cxFormatController.UseDelphiDateTimeFormats then
  begin
    Result := LongMonthNames[AMonth];
  end
  else
  begin
    ADate.Year := AYear;
    ADate.Month := AMonth;
    ADate.Day := 1;
    if ACalendar.IsValidMonth(ADate.Year, ADate.Month) then
      Result := cxGetLocalMonthName(ACalendar.ToDateTime(ADate), ACalendar)
    else
      Result := '';
  end;
end;

function cxGetLocalMonthYear(ADate: TDateTime; ACalendar: TcxCustomCalendarTable = nil): string;
var
  AFormat: string;
  AConvertDate: TcxDateTime;
  ABuf: array [0..255] of Char;
  ANeedFreeAndNilCalendar: Boolean;
begin
  if cxIsGregorianCalendar(ACalendar) and cxFormatController.UseDelphiDateTimeFormats then
  begin
    Result := cxDateToStrByFormat(ADate, 'mmmm yyyy', ' ');
    Exit;
  end;
  if ACalendar = nil then
  begin
    ACalendar := cxGetLocalCalendar;
    ANeedFreeAndNilCalendar := True;
  end
  else
    ANeedFreeAndNilCalendar := False;
  try
    AConvertDate := ACalendar.FromDateTime(ADate);
    AConvertDate.Day := 1;
    cxGetCalendarInfo(LOCALE_USER_DEFAULT, ACalendar.GetCalendarID, CAL_SYEARMONTH,
      ABuf, SizeOf(ABuf), nil);
    AFormat := ABuf;
    if not cxGetDateFormat(ACalendar.ToDateTime(AConvertDate), Result,
        0, AFormat) then
      Result := cxGetLocalMonthName(AConvertDate.Year, AConvertDate.Month, ACalendar) + ' ' +
        cxGetLocalYear(ADate, ACalendar);
  finally
    if ANeedFreeAndNilCalendar then
      FreeAndNil(ACalendar);
  end;
end;

function cxGetLocalShortDateFormat: string;
var
  ABuf: array [0..255] of Char;
begin
  GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SSHORTDATE,
    @ABuf, SizeOf(ABuf));
  Result := ABuf;
end;

function cxGetLocalTimeAMString: string;
var
  ABuf: array [0..255] of Char;
begin
  GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_S1159,
    @ABuf, SizeOf(ABuf));
  Result := ABuf;
end;

function cxGetLocalTimePMString: string;
var
  ABuf: array [0..255] of Char;
begin
  GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_S2359,
    @ABuf, SizeOf(ABuf));
  Result := ABuf;
end;

function cxGetLocalTimeSeparator: Char;
var
  ABuf: array [0..255] of Char;
begin
  GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_STIME,
    @ABuf, SizeOf(ABuf));
  Result := ABuf[0];
end;

function cxGetLocalYear(ADate: TDateTime; ACalendar: TcxCustomCalendarTable = nil): string;
var
  AFormat: string;
  AConvertDate: TcxDateTime;
  ANeedFreeAndNilCalendar: Boolean;
begin
  if ACalendar = nil then
  begin
    ACalendar := cxGetLocalCalendar;
    ANeedFreeAndNilCalendar := True;
  end
  else
    ANeedFreeAndNilCalendar := False;
  try
    AConvertDate := ACalendar.FromDateTime(ADate);
    AConvertDate.Day := 1;
    AFormat := 'yyyy';
    if not cxGetDateFormat(ACalendar.ToDateTime(AConvertDate), Result,
        0, AFormat) then
      Result := IntToStr(AConvertDate.Year);
  finally
    if ANeedFreeAndNilCalendar then
      FreeAndNil(ACalendar);
  end;
end;

function cxGetDayOfWeekName(I: Integer; AFontCharset: TFontCharset): string;
const
  cxDayNameLCType: array [Boolean, 1..7] of Cardinal =
    ((LOCALE_SABBREVDAYNAME1, LOCALE_SABBREVDAYNAME2, LOCALE_SABBREVDAYNAME3,
    LOCALE_SABBREVDAYNAME4, LOCALE_SABBREVDAYNAME5, LOCALE_SABBREVDAYNAME6,
    LOCALE_SABBREVDAYNAME7),
    (CAL_SSHORTESTDAYNAME1, CAL_SSHORTESTDAYNAME2, CAL_SSHORTESTDAYNAME3,
    CAL_SSHORTESTDAYNAME4, CAL_SSHORTESTDAYNAME5, CAL_SSHORTESTDAYNAME6,
    CAL_SSHORTESTDAYNAME7));
var
  ABuf: array [0..255] of Char;
begin
  if (I < 1) or (I > 7) then
  begin
    Result := '';
    Exit;
  end;
  if cxIsGregorianCalendar and cxFormatController.UseDelphiDateTimeFormats then
  begin
    Inc(I);
    if I > 7 then
      Dec(I, 7);
    Result := ShortDayNames[I];
  end
  else
  begin
    GetLocaleInfo(GetThreadLocale, cxDayNameLCType[IsWinVista, I], ABuf, SizeOf(ABuf));
    Result := ABuf;
  end;
  if cxUseSingleCharWeekNames then
    if cxGetWritingDirection(AFontCharset, Result) = coRightToLeft then
      Result := AnsiLastChar(Result)
    else
    begin
      Result := WideString(Result)[1];
    end;
end;

function cxIsGregorianCalendar(ACalendar: TcxCustomCalendarTable = nil): Boolean;
var
  ANeedFreeAndNilCalendar: Boolean;
begin
  if ACalendar = nil then
  begin
    ACalendar := cxGetLocalCalendar;
    ANeedFreeAndNilCalendar := True;
  end
  else
    ANeedFreeAndNilCalendar := False;
  try
    Result := ACalendar.GetCalendarID in [CAL_GREGORIAN, CAL_GREGORIAN_US, CAL_GREGORIAN_ME_FRENCH,
      CAL_GREGORIAN_ARABIC, CAL_GREGORIAN_XLIT_ENGLISH, CAL_GREGORIAN_XLIT_FRENCH];
  finally
    if ANeedFreeAndNilCalendar then
      FreeAndNil(ACalendar);
  end;
end;

function cxLocalFormatStrToDate(const ADateStr: string): TDateTime;
var
  D: TcxDateTime;
  ACalendar: TcxCustomCalendarTable;
begin
  case cxGetLocalCalendarID of
    CAL_JAPAN, CAL_TAIWAN, CAL_KOREA, CAL_HIJRI, CAL_THAI, CAL_HEBREW:
      begin
        ACalendar := cxGetLocalCalendar;
        try
          D := cxStrToDate(ADateStr, ACalendar);
          Result := ACalendar.ToDateTime(D);
        finally
          FreeAndNil(ACalendar);
        end;
      end;
    else
      TextToDateEx(ADateStr, Result);
  end;
end;

function cxStrToDate(const ADateStr: string;
  ACalendar: TcxCustomCalendarTable = nil): TcxDateTime;
begin
  Result := cxStrToDate(ADateStr, cxGetLocalFormatSettings, ACalendar);
end;

function cxStrToDate(const ADateStr: string;
  AFormat: TFormatSettings;
  ACalendar: TcxCustomCalendarTable = nil): TcxDateTime; overload;
var
  APart1, APart2, APart3: string;
  H, M, S, MS: Word;
  ATime: TTime;
  APos: Integer;
  ANeedFreeAndNilCalendar: Boolean;
  AEraName : string;
  AEraYearOffset: Integer;

  function GetEraYearOffset(const Name: string): Integer;
  var
    I: Integer;
  begin
    Result := 0;
    for I := Low(EraNames) to High(EraNames) do
    begin
      if EraNames[I] = '' then Break;
      if AnsiStrPos(PChar(EraNames[I]), PChar(Name)) <> nil then
      begin
        Result := EraYearOffsets[I];
        Exit;
      end;
    end;
  end;

  procedure ScanToNumber(const S: string; var Pos: Integer);
  begin
    while (Pos <= Length(S)) and not (S[Pos] in ['0'..'9']) do
    begin
      if S[Pos] in LeadBytes then
        Pos := NextCharIndex(S, Pos)
      else
        Inc(Pos);
    end;
  end;

  function ScanPart(AEndScan: Char): string;
  begin
    Result := '';
    Inc(APos);
    while (APos <= Length(ADateStr)) and (ADateStr[APos] <> AEndScan) do
    begin
      Result := Result + ADateStr[APos];
      Inc(APos);
    end;
  end;

  function NeedMoreScanMonthStr: Boolean;
  begin
    ScanBlanks(ADateStr, APos);
    Result := (AFormat.DateSeparator = ' ') and
      ((APos < Length(ADateStr)) and not (ADateStr[APos] in ['0'..'9']));
  end;

begin
  APos := 0;
  AEraYearOffset := 0;
  if (AFormat.ShortDateFormat <> '') and (AFormat.ShortDateFormat[1] = 'g') then  // skip over prefix text
  begin
    ScanToNumber(ADateStr, APos);
    AEraName := Trim(Copy(ADateStr, 1, APos-1));
    AEraYearOffset := GetEraYearOffset(AEraName);
    Dec(APos);