cxformats.pas

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

PAS
1,256
字号
  begin
    S := S + '\' + C;
  end;

var
  I, J: Integer;
begin
  Result := '';
  if Length(AFormatInfo.Items) = 0 then
    Exit;
  if AMaskKind <> dtmkTime then
    Result := '!';
  for I := 0 to Length(AFormatInfo.Items) - 1 do
    with AFormatInfo.Items[I] do
      case Kind of
        dtikString:
          for J := 1 to Length(Data) do
            AddChar(Result, Data[J]);
        dtikYear:
          if Length(Data) = 2 then
            Result := Result + '99'
          else
            Result := Result + '9999';
        dtikMonth:
          if Length(Data) < 3 then
            Result := Result + '99'
          else
            Result := Result + 'lll';
        dtikDay:
          if Length(Data) < 3 then
            Result := Result + '99'
          else
            Result := Result + 'lll';
        dtikHour, dtikMin, dtikSec:
          if AMaskKind = dtmkTime then
            Result := Result + '00'
          else
            Result := Result + '99';
//        dtikMSec:
        dtikTimeSuffix:
          begin
            if UpperCase(Data) = 'A/P' then
              Result := Result + 'c'
            else if UpperCase(Data) = 'AM/PM' then
              Result := Result + 'cc'
            else
            begin
              J := Length(TimeAMString);
              if Length(TimePMString) > J then
                J := Length(TimePMString);
              Result := Result + GetCharString('c', J);
            end;
          end;
        dtikDateSeparator:
          Result := Result + '/';
        dtikTimeSeparator:
          Result := Result + ':';
      end;
  if AMaskKind = dtmkTime then
    Result := Result + ';1;0'
  else
    Result := Result + ';1; ';
end;

function TcxFormatController.InternalGetMaskedDateEditFormat(
  AFormatInfo: TcxDateTimeFormatInfo): string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Length(AFormatInfo.Items) - 1 do
    with AFormatInfo.Items[I] do
      case Kind of
        dtikString:
          Result := Result + '''' + Data + '''';
        dtikYear:
          Result := Result + LowerCase(Data);
        dtikMonth:
          if Length(Data) < 3 then
            Result := Result + 'mm'
          else
            Result := Result + 'mmm';
        dtikDay:
          if Length(Data) < 3 then
            Result := Result + 'dd'
          else
            Result := Result + 'ddd';
        dtikHour:
          Result := Result + 'hh';
        dtikMin:
          Result := Result + 'nn';
        dtikSec:
          Result := Result + 'ss';
//        dtikMSec:
        dtikTimeSuffix:
          Result := Result + LowerCase(Data);
        dtikDateSeparator:
          Result := Result + '/';
        dtikTimeSeparator:
          Result := Result + ':';
      end;
end;

procedure TcxFormatController.AddListener(
  AListener: IcxFormatControllerListener);
begin
  with FList do
    if IndexOf(Pointer(AListener)) = -1 then
    begin
      if Count = 0 then
      {$IFDEF DELPHI6}
        FWindow := Classes.AllocateHWnd(MainWndProc);
      {$ELSE}
        FWindow := Forms.AllocateHWnd(MainWndProc);
      {$ENDIF}
      Add(Pointer(AListener));
    end;
end;

procedure TcxFormatController.RemoveListener(
  AListener: IcxFormatControllerListener);
begin
  FList.Remove(Pointer(AListener));
  if FList.Count = 0 then
  begin
  {$IFDEF DELPHI6}
    Classes.DeallocateHWnd(FWindow);
  {$ELSE}
    Forms.DeallocateHWnd(FWindow);
  {$ENDIF}
    FWindow := 0;
  end;
end;

procedure TcxFormatController.GetFormats;
begin
  if FcxFormatController = nil then // to avoid stack overflow
    FcxFormatController := Self;
  if not FAssignedCurrencyFormat then
    FCurrencyFormat := GetCurrencyFormat;
  if not FAssignedStartOfWeek then
    FStartOfWeek := GetStartOfWeek;

  CalculateDateEditMasks(True);
  FDateEditFormat := GetDateEditFormat(False);
end;

class function TcxFormatController.GetDateTimeFormatItemStandardMaskInfo(
  const AFormatInfo: TcxDateTimeFormatInfo; APos: Integer;
  out AItemInfo: TcxDateTimeFormatItemInfo): Boolean;

  function GetTimeSuffixKind(const AFormatItemData: string): TcxTimeSuffixKind;
  begin
    if UpperCase(AFormatItemData) = 'A/P' then
      Result := tskAP
    else if UpperCase(AFormatItemData) = 'AM/PM' then
      Result := tskAMPM
    else
      Result := tskAMPMString;
  end;

var
  AItemZoneStart, I: Integer;
  AItemZoneStarts: array of Integer;
begin
  Result := False;
  if (APos < 1) or (Length(AFormatInfo.Items) = 0) then
    Exit;
  SetLength(AItemZoneStarts, Length(AFormatInfo.Items));
  AItemZoneStart := 1;
  for I := 0 to Length(AFormatInfo.Items) - 1 do
  begin
    AItemZoneStarts[I] := AItemZoneStart;
    Inc(AItemZoneStart, GetDateTimeFormatItemStandardMaskZoneLength(AFormatInfo.Items[I]));
    if APos < AItemZoneStart then
    begin
      AItemInfo.Kind := AFormatInfo.Items[I].Kind;
      AItemInfo.ItemZoneStart := AItemZoneStarts[I];
      AItemInfo.ItemZoneLength := AItemZoneStart - AItemZoneStarts[I];
      if AItemInfo.Kind = dtikTimeSuffix then
        AItemInfo.TimeSuffixKind := GetTimeSuffixKind(AFormatInfo.Items[I].Data);
      Result := True;
      Break;
    end;
  end;
end;

function TcxFormatController.GetDateTimeStandardMaskStringLength(
  const AFormatInfo: TcxDateTimeFormatInfo): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to Length(AFormatInfo.Items) - 1 do
    Inc(Result, GetDateTimeFormatItemStandardMaskZoneLength(AFormatInfo.Items[I]));
end;

procedure TcxFormatController.NotifyListeners;
var
  I: Integer;
begin
  for I := 0 to FList.Count - 1 do
    IcxFormatControllerListener(FList[I]).FormatChanged;
end;

procedure TcxFormatController.MainWndProc(var Message: TMessage);
begin
  try
    WndProc(Message);
  except
    Application.HandleException(Self);
  end;
end;

procedure TcxFormatController.WndProc(var Message: TMessage);
begin
  if (Message.Msg = WM_SETTINGCHANGE) and ((Message.WParam = 0) and
    (PChar(Message.LParam) = 'intl')) and
    Application.UpdateFormatSettings then
  begin
    SysUtils.GetFormatSettings;
    GetFormats;
    NotifyListeners;
    Message.Result := 0;
    Exit;
  end;
  if Message.Msg = WM_TIMECHANGE then
  begin
    TimeChanged;
    Message.Result := 0;
    Exit;
  end;
  with Message do Result := DefWindowProc(FWindow, Msg, wParam, lParam);
end;

procedure TcxFormatController.BeginUpdate;
begin
  Inc(FLockCount);
end;

procedure TcxFormatController.EndUpdate;
begin
  Dec(FLockCount);
  if FLockCount = 0 then
    NotifyListeners;
end;

procedure TcxFormatController.FormatChanged;
begin
  if FLockCount = 0 then
  begin
    GetFormats;
    NotifyListeners;
  end;
end;

procedure TcxFormatController.TimeChanged;
var
  I: Integer;
  AIntf: IcxFormatControllerListener2;
begin
  for I := 0 to FList.Count - 1 do
    if Supports(IcxFormatControllerListener(FList[I]),
      IcxFormatControllerListener2, AIntf) then
        AIntf.TimeChanged;
end;

function cxFormatController: TcxFormatController;
begin
  if FcxFormatController = nil then
    FcxFormatController := TcxFormatController.Create;
  Result := FcxFormatController;
end;

procedure TcxFormatController.SetAssignedCurrencyFormat(Value: Boolean);
begin
  if FAssignedCurrencyFormat <> Value then
  begin
    FAssignedCurrencyFormat := Value;
    FormatChanged;
  end;
end;

procedure TcxFormatController.SetAssignedRegExprDateEditMask(Value: Boolean);
begin
  if FAssignedRegExprDateEditMask <> Value then
  begin
    FAssignedRegExprDateEditMask := Value;
    FormatChanged;
  end;
end;

procedure TcxFormatController.SetAssignedRegExprDateTimeEditMask(Value: Boolean);
begin
  if FAssignedRegExprDateTimeEditMask <> Value then
  begin
    FAssignedRegExprDateTimeEditMask := Value;
    FormatChanged;
  end;
end;

procedure TcxFormatController.SetAssignedStandardDateEditMask(Value: Boolean);
begin
  if FAssignedStandardDateEditMask <> Value then
  begin
    FAssignedStandardDateEditMask := Value;
    FormatChanged;
  end;
end;

procedure TcxFormatController.SetAssignedStandardDateTimeEditMask(Value: Boolean);
begin
  if FAssignedStandardDateTimeEditMask <> Value then
  begin
    FAssignedStandardDateTimeEditMask := Value;
    FormatChanged;
  end;
end;

procedure TcxFormatController.SetAssignedStartOfWeek(Value: Boolean);
begin
  if FAssignedStartOfWeek <> Value then
  begin
    FAssignedStartOfWeek := Value;
    FormatChanged;
  end;
end;

procedure TcxFormatController.SetCurrencyFormat(const Value: string);
begin
  FAssignedCurrencyFormat := True;
  if FCurrencyFormat <> Value then
  begin
    FCurrencyFormat := Value;
    FormatChanged;
  end;
end;

procedure TcxFormatController.SetFirstWeekOfYear(Value: TcxFirstWeekOfYear);
begin
  if Value <> FFirstWeekOfYear then
  begin
    FFirstWeekOfYear := Value;
    FormatChanged;
  end;
end;

procedure TcxFormatController.SetRegExprDateEditMask(const Value: string);
begin
  FAssignedRegExprDateEditMask := True;
  if FRegExprDateEditMask <> Value then
  begin
    FRegExprDateEditMask := Value;
    FormatChanged;
  end;
end;

procedure TcxFormatController.SetRegExprDateTimeEditMask(const Value: string);
begin
  FAssignedRegExprDateTimeEditMask := True;
  if FRegExprDateTimeEditMask <> Value then
  begin
    FRegExprDateTimeEditMask := Value;
    FormatChanged;
  end;
end;

procedure TcxFormatController.SetStandardDateEditMask(const Value: string);
begin
  FAssignedStandardDateEditMask := True;
  if FStandardDateEditMask <> Value then
  begin
    FStandardDateEditMask := Value;
    FormatChanged;
  end;
end;

procedure TcxFormatController.SetStandardDateTimeEditMask(const Value: string);
begin
  FAssignedStandardDateTimeEditMask := True;
  if FStandardDateTimeEditMask <> Value then
  begin
    FStandardDateTimeEditMask := Value;
    FormatChanged;
  end;
end;

procedure TcxFormatController.SetStartOfWeek(Value: TDayOfWeek);
begin
  FAssignedStartOfWeek := True;
  if FStartOfWeek <> Value then
  begin
    FStartOfWeek := Value;
    FormatChanged;
  end;
end;

procedure TcxFormatController.SetUseDelphiDateTimeFormats(Value: Boolean);
begin
  if FUseDelphiDateTimeFormats <> Value then
  begin
    FUseDelphiDateTimeFormats := Value;
    FormatChanged;
    if Value then
      MinYear := 1
    else
      MinYear := 100;
  end;
end;

initialization

finalization
  FcxFormatController.Free;
  FcxFormatController := nil;
  
end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?