cxformats.pas

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

              if AFormat[I] in LeadBytes then
                Inc(I, CharLength(AFormat, I))
              else
                Inc(I);
            AppendChars(AFormat, APrevI, I - APrevI);
            if I <= Length(AFormat) then
              Inc(I);
          end;
      else
        AppendChars(AStartSymbol, 1, 1);
      end;
    end;
    if AThereIsHourItem then
      A12HourFormat := AThereIsTimeSuffixItem;
  end;

  procedure ClearFormatInfo;
  var
    AFormatItemKind: TcxDateTimeFormatItemKind;
  begin
    SetLength(AFormatInfo.Items, 0);
    for AFormatItemKind := Low(TcxDateTimeFormatItemKind) to High(TcxDateTimeFormatItemKind) do
      AFormatInfo.DefinedItems[AFormatItemKind] := False;
  end;

  procedure ProcessHourItem;
  var
    I: Integer;
  begin
    if AFormatInfo.DefinedItems[dtikHour] then
    begin
      for I := 0 to Length(AFormatInfo.Items) - 1 do
        if AFormatInfo.Items[I].Kind = dtikHour then
          with AFormatInfo.Items[I] do
          begin
            if A12HourFormat then
              Data := '12' + Data
            else
              Data := '24' + Data;
            Break;
          end;
    end
    else
      if AFormatInfo.DefinedItems[dtikTimeSuffix] then
        for I := 0 to Length(AFormatInfo.Items) - 1 do
          if AFormatInfo.Items[I].Kind = dtikTimeSuffix then
          begin
            AFormatInfo.DefinedItems[dtikTimeSuffix] := False;
            if I < Length(AFormatInfo.Items) - 1 then
              Move(AFormatInfo.Items[I + 1], AFormatInfo.Items[I],
                SizeOf(TcxDateTimeFormatItem) * Length(AFormatInfo.Items) - 1 - I);
            Break;
          end;
  end;

var
  ARes: Boolean;
begin
  ClearFormatInfo;
  if AFormat <> '' then
    ARes := ParseFormat(AFormat, 0)
  else
    ARes := ParseFormat('C', 0);
  if not ARes then
    ClearFormatInfo
  else
    ProcessHourItem;
end;

{ TcxFormatController }

constructor TcxFormatController.Create;
begin
  inherited Create;
  FList := TList.Create;
  FFirstWeekOfYear := fwySystem;
  FUseDelphiDateTimeFormats := False;
  GetFormats;
end;

destructor TcxFormatController.Destroy;
begin
  FList.Free;
  if FWindow <> 0 then
  {$IFDEF DELPHI6}
    Classes.DeallocateHWnd(FWindow);
  {$ELSE}
    Forms.DeallocateHWnd(FWindow);
  {$ENDIF}
  inherited Destroy;
end;

procedure TcxFormatController.CalculateDateEditMasks(
  AUseSmartInputWhenRegExpr: Boolean);
begin
  GetDateTimeFormatInfo(GetDateTimeDisplayFormat(dtmkDate), FDateFormatInfo);
  GetDateTimeFormatInfo(GetDateTimeDisplayFormat(dtmkTime), FTimeFormatInfo);
  GetDateTimeFormatInfo(GetDateTimeDisplayFormat(dtmkDateTime),
    FDateTimeFormatInfo);

  FDateEditMask := InternalGetDateTimeEditStandardMask(FDateFormatInfo,
    dtmkDate);
  if not FAssignedStandardDateEditMask then
    FStandardDateEditMask := FDateEditMask;

  if not FAssignedRegExprDateEditMask then
  begin
    FRegExprDateEditMask := InternalGetDateTimeEditRegExprMask(FDateFormatInfo, dtmkDate);
    if AUseSmartInputWhenRegExpr then
      AddDateRegExprMaskSmartInput(FRegExprDateEditMask, False);
  end;

  if not FAssignedRegExprDateTimeEditMask then
  begin
    FRegExprDateTimeEditMask := InternalGetDateTimeEditRegExprMask(
      FDateFormatInfo, dtmkDate);
    FRegExprDateTimeEditMask := FRegExprDateTimeEditMask + ' '' ''(' +
      InternalGetDateTimeEditRegExprMask(FTimeFormatInfo, dtmkTime) + ')?';
    if AUseSmartInputWhenRegExpr then
      AddDateRegExprMaskSmartInput(FRegExprDateTimeEditMask, True);
  end;

  if not FAssignedStandardDateTimeEditMask then
    FStandardDateTimeEditMask := InternalGetDateTimeEditStandardMask(
      FDateTimeFormatInfo, dtmkDateTime);

  FMaskedDateEditFormat := InternalGetMaskedDateEditFormat(FDateFormatInfo);
  FMaskedDateTimeEditFormat := InternalGetMaskedDateEditFormat(FDateTimeFormatInfo);
end;

function TcxFormatController.GetCurrencyFormat: string;

  function GetPositiveCurrencyFormat(const AFormat, ACurrStr: string): string;
  begin
    if Length(ACurrStr) > 0 then
      case Sysutils.CurrencyFormat of
        0: Result := ACurrStr + AFormat; { '$1' }
        1: Result := AFormat + ACurrStr; { '1$' }
        2: Result := ACurrStr + ' ' + AFormat; { '$ 1' }
        3: Result := AFormat + ' ' + ACurrStr; { '1 $' }
      end;
  end;

  function GetNegativeCurrencyFormat(const AFormat, ACurrStr: string): string;
  begin
    case Sysutils.NegCurrFormat of
      0: Result := '(' + ACurrStr + AFormat + ')';
      1: Result := '-' + ACurrStr + AFormat;
      2: Result := ACurrStr + '-' + AFormat;
      3: Result := ACurrStr + AFormat + '-';
      4: Result := '(' + AFormat + ACurrStr + ')';
      5: Result := '-' + AFormat + ACurrStr;
      6: Result := AFormat + '-' + ACurrStr;
      7: Result := AFormat + ACurrStr + '-';
      8: Result := '-' + AFormat + ' ' + ACurrStr;
      9: Result := '-' + ACurrStr + ' ' + AFormat;
      10: Result := AFormat + ' ' + ACurrStr + '-';
      11: Result := ACurrStr + ' ' + AFormat + '-';
      12: Result := ACurrStr + ' ' + '-' + AFormat;
      13: Result := AFormat + '-' + ' ' + ACurrStr;
      14: Result := '(' + ACurrStr + ' ' + AFormat + ')';
      15: Result := '(' + AFormat + ' ' + ACurrStr + ')';
    end;
  end;

var
  ACurrStr: string;
  I: Integer;
  C: Char;
begin
  if CurrencyDecimals > 0 then
    Result := GetCharString('0', CurrencyDecimals)
  else
    Result := '';
  Result := ',0.' + Result;
  ACurrStr := '';
  for I := 1 to Length(CurrencyString) do
  begin
    C := CurrencyString[I];
    if (C = ',') or (C = '.') then
      ACurrStr := ACurrStr + '''' + C + ''''
    else
      ACurrStr := ACurrStr + C;
  end;
  Result := GetPositiveCurrencyFormat(Result, ACurrStr) + ';' +
    GetNegativeCurrencyFormat(Result, ACurrStr);
end;

function TcxFormatController.GetDateEditFormat(AIsMasked: Boolean): string;

  procedure CorrectForMaskEdit(var S: string);
  var
    APos, AStartPos: Integer;
  begin
    APos := Pos('M', S);
    if APos <> 0 then
    begin
      AStartPos := APos;
      while APos <= Length(S) do
        if S[APos] = 'M' then
          Inc(APos)
        else
          Break;
      if APos - AStartPos > 3 then
        Delete(S, AStartPos + 3, APos - AStartPos - 3);
    end;
  end;

var
  Format: string;
  I: Integer;
  ExistFirst: Boolean;
begin
  Format := ShortDateFormat;
  Result := '';
  for I := 1 to Length(Format) do
  begin
    if (Format[I] = 'd') then
    begin
      ExistFirst := True;
      if (1 < I) and (Format[I - 1] = 'd') then ExistFirst := False;
      if (I < Length(Format)) and (Format[I + 1] = 'd') then ExistFirst := False;
      if ExistFirst then Result := Result + 'd';
    end;
    if (Format[I] = 'M') then
    begin
      ExistFirst := True;
      if (1 < I) and (Format[I - 1] = 'M') then ExistFirst := False;
      if (I < Length(Format)) and (Format[I + 1] = 'M') then ExistFirst := False;
      if ExistFirst then Result := Result + 'M';
    end;
    Result := Result + Format[I];
  end;
  if AIsMasked then CorrectForMaskEdit(Result);
end;

function TcxFormatController.GetDateTimeDisplayFormat(
  AMaskKind: TcxDateTimeEditMaskKind): string;
begin
  case AMaskKind of
    dtmkDate:
      Result := ShortDateFormat;
    dtmkTime:
      Result := LongTimeFormat;
    dtmkDateTime:
      Result := ShortDateFormat + ' ' + LongTimeFormat;
  end;
end;

class function TcxFormatController.GetDateTimeFormatItemStandardMaskZoneLength(
  const AItem: TcxDateTimeFormatItem): Integer;
begin
  case AItem.Kind of
    dtikString:
      Result := Length(AItem.Data);
    dtikYear:
      if Length(AItem.Data) = 2 then
        Result := 2
      else
        Result := 4;
    dtikMonth, dtikDay:
      if Length(AItem.Data) < 3 then
        Result := 2
      else
        Result := 3;
    dtikHour, dtikMin, dtikSec:
      Result := 2;
//        dtikMSec:
    dtikTimeSuffix:
      begin
        if UpperCase(AItem.Data) = 'A/P' then
          Result := 1
        else if UpperCase(AItem.Data) = 'AM/PM' then
          Result := 2
        else
        begin
          Result := Length(TimeAMString);
          if Length(TimePMString) > Result then
            Result := Length(TimePMString);
        end;
      end;
    dtikDateSeparator, dtikTimeSeparator:
      Result := 1;
    else
      Result := 0;
  end;
end;

function TcxFormatController.GetStartOfWeek: TDayOfWeek;
begin
  Result := cxDateUtils.GetStartOfWeek;
end;

function TcxFormatController.InternalGetDateTimeEditRegExprMask(
  AFormatInfo: TcxDateTimeFormatInfo;
  AMaskKind: TcxDateTimeEditMaskKind): string;

  procedure AddChar(var S: string; C: Char);
  begin
    if C = ' ' then
      S := S + ''' '''
    else
      S := S + '\' + C;
  end;

  procedure AddString(var ADst: string; const ASrc: string);
  begin
    ADst := ADst + '''' + ASrc + '''';
  end;

  procedure ProcessDateItem(var S: string;
    const AFormatItem: TcxDateTimeFormatItem);
  const
    reTwoDigitYearMask = '\d\d';
    reFourDigitYearMask = '\d\d\d\d';
    reMonthMask = '(0?[1-9]|1[012])';
    reDayMask = '([012]?[1-9]|[123]0|31)';
  var
    AUseLongMonthNames: Boolean;
    I: Integer;
  begin
    with AFormatItem do
      case Kind of
        dtikString:
          AddString(S, Data);
        dtikYear:
          if Length(Data) = 2 then
            Result := S + reTwoDigitYearMask
          else
            Result := S + reFourDigitYearMask;
        dtikMonth:
          begin
            S := S + '(' + reMonthMask + '|(';
            AUseLongMonthNames := Length(Data) = 4;
            if AUseLongMonthNames then
              AddString(S, LongMonthNames[1])
            else
              AddString(S, ShortMonthNames[1]);
            for I := 2 to 12 do
            begin
              S := S + '|';
              if AUseLongMonthNames then
                AddString(S, LongMonthNames[I])
              else
                AddString(S, ShortMonthNames[I]);
            end;
            S := S + '))';
          end;
        dtikDay:
          S := S + reDayMask;
        dtikDateSeparator:
          if DateSeparator <> #0 then
            AddChar(S, DateSeparator);
      end;
  end;

  procedure ProcessTimeItem(var S: string;
    const AFormatItem: TcxDateTimeFormatItem);
  begin
    with AFormatItem do
      case Kind of
        dtikString:
          AddString(S, Data);
        dtikHour:
          begin
            if Copy(Data, 1, 2) = '12' then
              S := S + '(0?[1-9]|1[012])'
            else
              S := S + '([01]?\d|2[0-3])';
          end;
        dtikMin:
          S := S + '[0-5]?\d';
        dtikSec:
          S := S + '[0-5]?\d';
//        dtikMSec:
        dtikTimeSuffix:
          begin
            if UpperCase(Data) = 'A/P' then
              S := S + '(A|P)?'
            else if UpperCase(Data) = 'AM/PM' then
              S := S + '(AM|PM)?'
            else
              if (TimeAMString <> '') or (TimePMString <> '') then
              begin
                S := S + '(''';
                if (TimeAMString <> '') and (TimePMString <> '') then
                  S := S + TimeAMString + '''|''' + TimePMString
                else
                  if TimeAMString <> '' then
                    S := S + TimeAMString
                  else
                    S := S + TimePMString;
                S := S + ''')?';
              end;
          end;
        dtikTimeSeparator:
          if TimeSeparator <> #0 then
            AddChar(S, TimeSeparator);
      end;
  end;

var
  I: Integer;
begin
  Result := '';
  if (AMaskKind = dtmkDateTime) or (Length(AFormatInfo.Items) = 0) then
    Exit;
  for I := 0 to Length(AFormatInfo.Items) - 1 do
    if AMaskKind = dtmkDate then
      ProcessDateItem(Result, AFormatInfo.Items[I])
    else
      ProcessTimeItem(Result, AFormatInfo.Items[I]);
end;

function TcxFormatController.InternalGetDateTimeEditStandardMask(
  AFormatInfo: TcxDateTimeFormatInfo;
  AMaskKind: TcxDateTimeEditMaskKind): string;

  procedure AddChar(var S: string; C: Char);