cxdateutils.pas

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

  end
  else
    if AnsiPos('e', AFormat.ShortDateFormat) > 0 then
      AEraYearOffset := EraYearOffsets[1];
  APart1 := ScanPart(AFormat.DateSeparator);
  APart2 := ScanPart(AFormat.DateSeparator);
  APart3 := ScanPart(' ');
  Result.Era := -1;
  if ACalendar = nil then
  begin
    ACalendar := cxGetLocalCalendar;
    ANeedFreeAndNilCalendar := True;
  end
  else
    ANeedFreeAndNilCalendar := False;
  try
    case GetDateOrder(AFormat.ShortDateFormat) of
      doMDY:
        begin
          if NeedMoreScanMonthStr then
          begin
            APart1 := APart1 + ' ' + APart2;
            APart2 := APart3;
            Dec(APos);
            APart3 := ScanPart(' ');
          end;
          Result.Year := ACalendar.GetYearNumber(APart3);
          Result.Month := ACalendar.GetMonthNumber(Result.Year, APart1);
          Result.Day := ACalendar.GetDayNumber(APart2);
        end;
      doDMY:
        begin
          if NeedMoreScanMonthStr then
          begin
            APart2 := APart2 + ' ' + APart3;
            Dec(APos);
            APart3 := ScanPart(' ');
          end;
          Result.Year := ACalendar.GetYearNumber(APart3);
          Result.Month := ACalendar.GetMonthNumber(Result.Year, APart2);
          Result.Day := ACalendar.GetDayNumber(APart1);
        end;
      doYMD:
        begin
          if NeedMoreScanMonthStr then
          begin
            APart2 := APart2 + ' ' + APart3;
            Dec(APos);
            APart3 := ScanPart(' ');
          end;
          Result.Year := ACalendar.GetYearNumber(APart1);
          Result.Month := ACalendar.GetMonthNumber(Result.Year, APart2);
          Result.Day := ACalendar.GetDayNumber(APart3);
        end;
    end;
    Result.Era := ACalendar.GetEra(AEraYearOffset + 1);
  finally
    if ANeedFreeAndNilCalendar then
      FreeAndNil(ACalendar);
  end;
  H := 0;
  M := 0;
  S := 0;
  MS := 0;
  if APos < Length(ADateStr) then
  begin
    ATime := StrToTime(Copy(ADateStr, APos, Length(ADateStr) - APos + 1));
    DecodeTime(ATime, H, M, S, MS);
  end;
  with Result do
  begin
    Hours := H;
    Minutes := M;
    Seconds := S;
    Milliseconds := MS;
  end;
end;

function cxStrToDate(const ADateString: string; const AFormat: TFormatSettings;
  ACALTYPE: CALTYPE): TDate;
var
  ACalendar: TcxCustomCalendarTable;
  ADate: TcxDateTime;
begin
  ACalendar := cxGetCalendar(ACALTYPE);
  try
    ADate := cxStrToDate(ADateString, AFormat, ACalendar);
    Result := ACalendar.ToDateTime(ADate);
  finally
    FreeAndNil(ACalendar);
  end;
end;

function cxTimeToStr(ATime: TDateTime): string;
begin
  Result := cxTimeToStr(ATime, cxGetLocalFormatSettings);
end;

function cxTimeToStr(ATime: TDateTime; ATimeFormat: string): string;
var
  AFormatSettings: TFormatSettings;
begin
  AFormatSettings := cxGetLocalFormatSettings;
  with AFormatSettings do
  begin
    LongTimeFormat := ATimeFormat;
    TimeSeparator := SysUtils.TimeSeparator;
  end;
  Result := cxTimeToStr(ATime, AFormatSettings);
end;

function cxTimeToStr(ATime: TDateTime; AFormatSettings: TFormatSettings): string;
begin
  DateTimeToString(Result, AFormatSettings.LongTimeFormat, TimeOf(ATime));
end;

function cxGetCalendarInfo(Locale: LCID; Calendar: CALID;
  CalendType: CALTYPE; lpCalData: lpStr; cchData: Integer;
  lpValue: PDWORD): Integer;
var
  AKernelDLL : Integer;
  AGetCalendarInfo: TcxGetCalendarInfo;
begin
  Result:= 0;
  AKernelDLL:= LoadLibrary('Kernel32');
  if AKernelDLL <> 0 then
  try
    AGetCalendarInfo := GetProcAddress(AKernelDll,'GetCalendarInfoA');
    if Assigned(AGetCalendarInfo) then
      Result:= AGetCalendarInfo(Locale, Calendar, CalendType,
        lpCalData, cchData, lpValue);
  finally
    FreeLibrary(AKernelDLL);
  end;
end;

function cxGetLocaleChar(ALocaleType: Integer; const ADefaultValue: Char): string;
begin
  Result := cxGetLocaleInfo(GetThreadLocale, ALocaleType, ADefaultValue)[1];
end;

function cxGetLocaleStr(ALocaleType: Integer; const ADefaultValue: string = ''): string;
begin
  Result := cxGetLocaleInfo(GetThreadLocale, ALocaleType, ADefaultValue);
end;

procedure CorrectTextForDateTimeConversion(var AText: string;
  AOleConversion: Boolean);

  procedure InternalStringReplace(var S: WideString; ASubStr: WideString);
  begin
    S := StringReplace(S, ASubStr, GetCharString(' ', Length(ASubStr)),
      [rfIgnoreCase, rfReplaceAll]);
  end;

  procedure GetSpecialStrings(AList: TStringList);
  var
    I: Integer;
  begin
    if AOleConversion then
    begin
      AList.Add(cxGetLocaleStr(LOCALE_SDATE)[1]);
      AList.Add(cxGetLocaleStr(LOCALE_STIME)[1]);
      AList.Add(cxGetLocaleStr(LOCALE_S1159, 'am'));
      AList.Add(cxGetLocaleStr(LOCALE_S2359, 'pm'));
    end
    else
    begin
      AList.Add(DateSeparator);
      AList.Add(TimeSeparator);
      AList.Add(TimeAMString);
      AList.Add(TimePMString);
    end;
    for I := 0 to AList.Count - 1 do
      AList[I] := AnsiUpperCase(Trim(AList[I]));
  end;

  procedure RemoveStringsThatInFormatInfo(var S: WideString;
    const ADateTimeFormatInfo: TcxDateTimeFormatInfo);
  var
    ASpecialStrings: TStringList;
    ASubStr: string;
    I: Integer;
  begin
    ASpecialStrings := TStringList.Create;
    try
      GetSpecialStrings(ASpecialStrings);
      for I := 0 to High(ADateTimeFormatInfo.Items) do
        if ADateTimeFormatInfo.Items[I].Kind = dtikString then
        begin
          ASubStr := AnsiUpperCase(Trim(ADateTimeFormatInfo.Items[I].Data));
          if (ASubStr <> '') and (ASpecialStrings.IndexOf(ASubStr) = -1) then
            InternalStringReplace(S, ASubStr);
        end;
    finally
      ASpecialStrings.Free;
    end;
  end;

  procedure RemoveUnnecessarySpaces(var S: WideString);
  var
    I: Integer;
  begin
    S := Trim(S);
    I := 2;
    while I < Length(S) - 1 do
      if (S[I] <= ' ') and (S[I + 1] <= ' ') then
        Delete(S, I, 1)
      else
        Inc(I);
  end;

var
  S: WideString;
begin
  S := AText;
  RemoveStringsThatInFormatInfo(S, cxFormatController.DateFormatInfo);
  RemoveStringsThatInFormatInfo(S, cxFormatController.TimeFormatInfo);
  RemoveUnnecessarySpaces(S);
  if AOleConversion then
    InternalStringReplace(S, cxGetLocaleStr(LOCALE_SDATE)[1]);
  AText := S;
end;

procedure InitSmartInputConsts;
begin
  scxDateEditSmartInput[deiToday] := cxGetResourceString(@cxSDateToday);
  scxDateEditSmartInput[deiYesterday] := cxGetResourceString(@cxSDateYesterday);
  scxDateEditSmartInput[deiTomorrow] := cxGetResourceString(@cxSDateTomorrow);
  scxDateEditSmartInput[deiSunday] := cxGetResourceString(@cxSDateSunday);
  scxDateEditSmartInput[deiMonday] := cxGetResourceString(@cxSDateMonday);
  scxDateEditSmartInput[deiTuesday] := cxGetResourceString(@cxSDateTuesday);
  scxDateEditSmartInput[deiWednesday] := cxGetResourceString(@cxSDateWednesday);
  scxDateEditSmartInput[deiThursday] := cxGetResourceString(@cxSDateThursday);
  scxDateEditSmartInput[deiFriday] := cxGetResourceString(@cxSDateFriday);
  scxDateEditSmartInput[deiSaturday] := cxGetResourceString(@cxSDateSaturday);
  scxDateEditSmartInput[deiFirst] := cxGetResourceString(@cxSDateFirst);
  scxDateEditSmartInput[deiSecond] := cxGetResourceString(@cxSDateSecond);
  scxDateEditSmartInput[deiThird] := cxGetResourceString(@cxSDateThird);
  scxDateEditSmartInput[deiFourth] := cxGetResourceString(@cxSDateFourth);
  scxDateEditSmartInput[deiFifth] := cxGetResourceString(@cxSDateFifth);
  scxDateEditSmartInput[deiSixth] := cxGetResourceString(@cxSDateSixth);
  scxDateEditSmartInput[deiSeventh] := cxGetResourceString(@cxSDateSeventh);
  scxDateEditSmartInput[deiBOM] := cxGetResourceString(@cxSDateBOM);
  scxDateEditSmartInput[deiEOM] := cxGetResourceString(@cxSDateEOM);
  scxDateEditSmartInput[deiNow] := cxGetResourceString(@cxSDateNow);
end;

procedure AddDateRegExprMaskSmartInput(var AMask: string; ACanEnterTime: Boolean);

  procedure AddString(var AMask: string; const S: string);
  var
    I: Integer;
  begin
    I := 1;
    while I <= Length(S) do
      if S[I] = '''' then
      begin
        AMask := AMask + '\''';
        Inc(I);
      end
      else
      begin
        AMask := AMask + '''';
        repeat
          AMask := AMask + S[I];
          Inc(I);
        until (I > Length(S)) or (S[I] = '''');
        AMask := AMask + '''';
      end;
  end;

var
  I: TcxDateEditSmartInput;
begin
  InitSmartInputConsts;
  AMask := '(' + AMask + ')|(';
  I := Low(TcxDateEditSmartInput);
  if not ACanEnterTime and (I = deiNow) then
    Inc(I);
  AddString(AMask, scxDateEditSmartInput[I]);
  while I < High(TcxDateEditSmartInput) do
  begin
    Inc(I);
    if not(not ACanEnterTime and (I = deiNow)) then
    begin
      AMask := AMask + '|';
      AddString(AMask, scxDateEditSmartInput[I]);
    end;
  end;
  AMask := AMask + ')((\+|-)\d(\d(\d\d?)?)?)?';
end;

procedure DecMonth(var AYear, AMonth: Word);
begin
  if AMonth = 1 then
  begin
    Dec(AYear);
    AMonth := 12;
  end
  else Dec(AMonth);
end;

procedure IncMonth(var AYear, AMonth: Word);
begin
  if AMonth = 12 then
  begin
    Inc(AYear);
    AMonth := 1;
  end
  else Inc(AMonth);
end;

procedure ChangeMonth(var AYear, AMonth: Word; Delta: Integer);
var
  Month: Integer;
begin
  Inc(AYear, Delta div 12);
  Month := AMonth;
  Inc(Month, Delta mod 12);
  if Month < 1 then
  begin
    Dec(AYear);
    Month := 12 + Month;
  end;
  if Month > 12 then
  begin
    Inc(AYear);
    Month := Month - 12;
  end;
  AMonth := Month;
end;

function GetMonthNumber(const ADate: TDateTime): Integer;
var
  AYear, AMonth, ADay: Word;
begin
  DecodeDate(ADate, AYear, AMonth, ADay);
  Result := (AYear - 1) * 12 + AMonth;
end;

function GetDateElement(ADate: TDateTime; AElement: TcxDateElement;
  ACalendar: TcxCustomCalendarTable = nil): Integer;
var
  ACalendarDate: TcxDateTime;
  AYear, AMonth, ADay: Word;
begin
  if ACalendar = nil then
    DecodeDate(ADate, AYear, AMonth, ADay)
  else
  begin
    ACalendarDate := ACalendar.FromDateTime(ADate);
    wi