cxformats.pas

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

{********************************************************************}
{                                                                    }
{           Developer Express Visual Component Library               }
{           Express Cross Platform Library classes                   }
{                                                                    }
{           Copyright (c) 2000-2008 Developer Express Inc.           }
{           ALL RIGHTS RESERVED                                      }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSCROSSPLATFORMLIBRARY AND ALL   }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM       }
{   ONLY.                                                            }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit cxFormats;

{$I cxVer.inc}

interface

uses
  Windows, Messages,
  Classes, cxDateUtils;

type
  IcxFormatControllerListener = interface
    ['{A7F2F6D3-1A7D-4295-A6E6-9297BD83D0DE}']
    procedure FormatChanged;
  end;

  IcxFormatControllerListener2 = interface
  ['{5E33A2A7-0C77-415F-A359-112103E54937}']
    procedure TimeChanged;
  end;

  TcxDateTimeEditMaskKind = (dtmkDate, dtmkTime, dtmkDateTime);

  TcxDateTimeFormatItemKind = (
    dtikString,
    dtikYear,          // YY YYYY
    dtikMonth,         // M MM MMM MMMM
    dtikDay,           // D DD DDD DDDD
    dtikHour,          // 12H 12HH 24H 24HH
    dtikMin,           // N NN
    dtikSec,           // S SS
    dtikMSec,          // Z ZZ ZZZ
    dtikTimeSuffix,    // A/P AM/PM AMPM (lower, upper, or mixed case)
    dtikDateSeparator,
    dtikTimeSeparator
  );

  TcxTimeSuffixKind = (tskAP, tskAMPM, tskAMPMString);

  TcxDateTimeFormatItem = record
    Kind: TcxDateTimeFormatItemKind;
    Data: string;
  end;

  TcxDateTimeFormatInfo = record
    DefinedItems: array[TcxDateTimeFormatItemKind] of Boolean;
    Items: array of TcxDateTimeFormatItem;
  end;

  TcxDateTimeFormatItemInfo = record
    Kind: TcxDateTimeFormatItemKind;
    ItemZoneStart, ItemZoneLength: Integer;
    TimeSuffixKind: TcxTimeSuffixKind;
  end;

  { TcxFormatController }

  TcxFormatController = class
  private
    FAssignedCurrencyFormat: Boolean;
    FAssignedRegExprDateEditMask: Boolean;
    FAssignedRegExprDateTimeEditMask: Boolean;
    FAssignedStandardDateEditMask: Boolean;
    FAssignedStandardDateTimeEditMask: Boolean;
    FAssignedStartOfWeek: Boolean;
    FCurrencyFormat: string;
    FDateEditFormat: string;
    FDateEditMask: string;
    FDateFormatInfo: TcxDateTimeFormatInfo;
    FDateTimeFormatInfo: TcxDateTimeFormatInfo;
    FFirstWeekOfYear: TcxFirstWeekOfYear;
    FList: TList;
    FLockCount: Integer;
    FMaskedDateEditFormat: string;
    FMaskedDateTimeEditFormat: string;
    FRegExprDateEditMask: string;
    FRegExprDateTimeEditMask: string;
    FStandardDateEditMask: string;
    FStandardDateTimeEditMask: string;
    FStartOfWeek: TDayOfWeek;
    FTimeFormatInfo: TcxDateTimeFormatInfo;
    FUseDelphiDateTimeFormats: Boolean;
    procedure CalculateDateEditMasks(AUseSmartInputWhenRegExpr: Boolean);
    function GetCurrencyFormat: string;
    function GetDateEditFormat(AIsMasked: Boolean): string;
    function GetDateTimeDisplayFormat(AMaskKind: TcxDateTimeEditMaskKind): string;
    class function GetDateTimeFormatItemStandardMaskZoneLength(
      const AItem: TcxDateTimeFormatItem): Integer;
    function GetStartOfWeek: TDayOfWeek;
    function InternalGetDateTimeEditRegExprMask(
      AFormatInfo: TcxDateTimeFormatInfo;
      AMaskKind: TcxDateTimeEditMaskKind): string;
    function InternalGetDateTimeEditStandardMask(
      AFormatInfo: TcxDateTimeFormatInfo;
      AMaskKind: TcxDateTimeEditMaskKind): string;
    function InternalGetMaskedDateEditFormat(
      AFormatInfo: TcxDateTimeFormatInfo): string;
    procedure SetAssignedCurrencyFormat(Value: Boolean);
    procedure SetAssignedRegExprDateEditMask(Value: Boolean);
    procedure SetAssignedRegExprDateTimeEditMask(Value: Boolean);
    procedure SetAssignedStandardDateEditMask(Value: Boolean);
    procedure SetAssignedStandardDateTimeEditMask(Value: Boolean);
    procedure SetAssignedStartOfWeek(Value: Boolean);
    procedure SetCurrencyFormat(const Value: string);
    procedure SetFirstWeekOfYear(Value: TcxFirstWeekOfYear);
    procedure SetRegExprDateEditMask(const Value: string);
    procedure SetRegExprDateTimeEditMask(const Value: string);
    procedure SetStandardDateEditMask(const Value: string);
    procedure SetStandardDateTimeEditMask(const Value: string);
    procedure SetStartOfWeek(Value: TDayOfWeek);
    procedure SetUseDelphiDateTimeFormats(Value: Boolean);
  protected
    FWindow: HWND;
    procedure MainWndProc(var Message: TMessage);
    procedure WndProc(var Message: TMessage); virtual;
    procedure FormatChanged;
    procedure TimeChanged;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddListener(AListener: IcxFormatControllerListener); virtual;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure GetFormats;
    class function GetDateTimeFormatItemStandardMaskInfo(
      const AFormatInfo: TcxDateTimeFormatInfo; APos: Integer;
      out AItemInfo: TcxDateTimeFormatItemInfo): Boolean;
    function GetDateTimeStandardMaskStringLength(
      const AFormatInfo: TcxDateTimeFormatInfo): Integer;
    procedure NotifyListeners;
    procedure RemoveListener(AListener: IcxFormatControllerListener); virtual;
    property AssignedCurrencyFormat: Boolean read FAssignedCurrencyFormat write SetAssignedCurrencyFormat;
    property AssignedRegExprDateEditMask: Boolean read FAssignedRegExprDateEditMask write SetAssignedRegExprDateEditMask;
    property AssignedRegExprDateTimeEditMask: Boolean read FAssignedRegExprDateTimeEditMask write SetAssignedRegExprDateTimeEditMask;
    property AssignedStandardDateEditMask: Boolean read FAssignedStandardDateEditMask write SetAssignedStandardDateEditMask;
    property AssignedStandardDateTimeEditMask: Boolean read FAssignedStandardDateTimeEditMask write SetAssignedStandardDateTimeEditMask;
    property AssignedStartOfWeek: Boolean read FAssignedStartOfWeek write SetAssignedStartOfWeek;
    property CurrencyFormat: string read FCurrencyFormat write SetCurrencyFormat;
    property DateEditFormat: string read FDateEditFormat;
    property DateEditMask: string read FDateEditMask;
    property DateFormatInfo: TcxDateTimeFormatInfo read FDateFormatInfo;
    property DateTimeFormatInfo: TcxDateTimeFormatInfo read FDateTimeFormatInfo;
    property FirstWeekOfYear: TcxFirstWeekOfYear read FFirstWeekOfYear write SetFirstWeekOfYear; 
    property MaskedDateEditFormat: string read FMaskedDateEditFormat;
    property MaskedDateTimeEditFormat: string read FMaskedDateTimeEditFormat;
    property RegExprDateEditMask: string read FRegExprDateEditMask write SetRegExprDateEditMask;
    property RegExprDateTimeEditMask: string read FRegExprDateTimeEditMask write SetRegExprDateTimeEditMask;
    property StandardDateEditMask: string read FStandardDateEditMask write SetStandardDateEditMask;
    property StandardDateTimeEditMask: string read FStandardDateTimeEditMask write SetStandardDateTimeEditMask;
    property StartOfWeek: TDayOfWeek read FStartOfWeek write SetStartOfWeek;
    property TimeFormatInfo: TcxDateTimeFormatInfo read FTimeFormatInfo;
    property UseDelphiDateTimeFormats: Boolean read FUseDelphiDateTimeFormats write SetUseDelphiDateTimeFormats;
  end;

function cxFormatController: TcxFormatController;
function GetCharString(C: Char; ACount: Integer): string;

implementation

uses
  SysUtils, Forms, cxClasses;

var
  FcxFormatController: TcxFormatController;

function GetCharString(C: Char; ACount: Integer): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to ACount do
    Result := Result + C;
end;

function CharLength(const S: string; Index: Integer): Integer;
begin
  Result := 1;
  assert((Index > 0) and (Index <= Length(S)));
  if SysLocale.FarEast and (S[Index] in LeadBytes) then
    Result := cxStrCharLength(S, Index);
end;

procedure GetDateTimeFormatInfo(const AFormat: string;
  var AFormatInfo: TcxDateTimeFormatInfo);
var
  A12HourFormat: Boolean;

  procedure AddFormatItem(AItemKind: TcxDateTimeFormatItemKind;
    const AItemData: string);
  begin
    if not(AItemKind in [dtikString, dtikDateSeparator, dtikTimeSeparator]) and
      AFormatInfo.DefinedItems[AItemKind] then
        Exit;
    AFormatInfo.DefinedItems[AItemKind] := True;
    SetLength(AFormatInfo.Items, Length(AFormatInfo.Items) + 1);
    with AFormatInfo.Items[Length(AFormatInfo.Items) - 1] do
    begin
      Kind := AItemKind;
      Data := AItemData;
    end;
  end;

  procedure AppendChars(const S: string; AStartIndex, ACount: Integer);
  begin
    if (Length(AFormatInfo.Items) = 0) or
      (AFormatInfo.Items[Length(AFormatInfo.Items) - 1].Kind <> dtikString) then
        AddFormatItem(dtikString, '');
    with AFormatInfo.Items[Length(AFormatInfo.Items) - 1] do
      Data := Data + Copy(S, AStartIndex, ACount);
  end;

  function GetCount(const AFormat: string; var AStartIndex: Integer;
    AStartSymbol: Char): Integer;
  begin
    Result := 1;
    while (AStartIndex <= Length(AFormat)) and (AFormat[AStartIndex] = AStartSymbol) do
    begin
      Inc(AStartIndex);
      Inc(Result);
    end;
  end;

  function ParseFormat(const AFormat: string; ARecursionDepth: Integer): Boolean;
  var
    ACount, APrevI, I: Integer;
    AFormatItemData: string;
    ALastToken, AStartSymbol, AToken: Char;
    AThereIsHourItem, AThereIsTimeSuffixItem: Boolean;
  begin
    Result := True;
    if (AFormat = '') or (ARecursionDepth = 2) then
      Exit;
    Inc(ARecursionDepth);
    ALastToken := ' ';
    AThereIsHourItem := False;
    AThereIsTimeSuffixItem := False;
    I := 1;
    while I <= Length(AFormat) do
    begin
      AStartSymbol := AFormat[I];
      if AStartSymbol in LeadBytes then
      begin
        AppendChars(AFormat, I, CharLength(AFormat, I));
        Inc(I, CharLength(AFormat, I));
        ALastToken := ' ';
        Continue;
      end;
      Inc(I, CharLength(AFormat, I));
      AToken := AStartSymbol;
      if AToken in ['a'..'z'] then
        Dec(AToken, 32);
      if AToken in ['A'..'Z'] then
      begin
        if (AToken = 'M') and (ALastToken = 'H') then
          AToken := 'N';
        ALastToken := AToken;
      end;
      case AToken of
        'E', 'Y':
          begin
            ACount := GetCount(AFormat, I, AStartSymbol);
            if ACount <= 2 then
              AFormatItemData := 'YY'
            else
              AFormatItemData := 'YYYY';
            AddFormatItem(dtikYear, AFormatItemData);
          end;
        'G':
          begin
            Result := False;
            Break;
          end;
        'M':
          begin
            ACount := GetCount(AFormat, I, AStartSymbol);
            if ACount > 4 then
              ACount := 4;
            AddFormatItem(dtikMonth, GetCharString('M', ACount));
          end;
        'D':
          begin
            ACount := GetCount(AFormat, I, AStartSymbol);
            case ACount of
              1..4:
                AddFormatItem(dtikDay, GetCharString('D', ACount));
              5:
                Result := ParseFormat(ShortDateFormat, ARecursionDepth);
              else
                Result := ParseFormat(LongDateFormat, ARecursionDepth);
            end;
            if not Result then
              Break;
          end;
        'H':
          begin
            ACount := GetCount(AFormat, I, AStartSymbol);
            if ACount > 2 then
              ACount := 2;
            AddFormatItem(dtikHour, GetCharString('H', ACount));
            AThereIsHourItem := True;
          end;
        'N':
          begin
            ACount := GetCount(AFormat, I, AStartSymbol);
            if ACount > 2 then
              ACount := 2;
            AddFormatItem(dtikMin, GetCharString('N', ACount));
          end;
        'S':
          begin
            ACount := GetCount(AFormat, I, AStartSymbol);
            if ACount > 2 then
              ACount := 2;
            AddFormatItem(dtikSec, GetCharString('S', ACount));
          end;
        'T':
          begin
            ACount := GetCount(AFormat, I, AStartSymbol);
            if ACount = 1 then
              Result := ParseFormat(ShortTimeFormat, ARecursionDepth)
            else
              Result := ParseFormat(LongTimeFormat, ARecursionDepth);
            if not Result then
              Break;
          end;
        'Z':
          begin
            ACount := GetCount(AFormat, I, AStartSymbol);
            if ACount > 3 then
              ACount := 3;
            AddFormatItem(dtikMSec, GetCharString('Z', ACount));
          end;
        'A':
          begin
            if SameText(Copy(AFormat, I - 1, 5), 'AM/PM') then
            begin
              AddFormatItem(dtikTimeSuffix, Copy(AFormat, I - 1, 5));
              Inc(I, 4);
              AThereIsTimeSuffixItem := True;
            end
            else if SameText(Copy(AFormat, I - 1, 3), 'A/P') then
            begin
              AddFormatItem(dtikTimeSuffix, Copy(AFormat, I - 1, 3));
              Inc(I, 2);
              AThereIsTimeSuffixItem := True;
            end
            else if SameText(Copy(AFormat, I - 1, 4), 'AMPM') then
            begin
              AddFormatItem(dtikTimeSuffix, 'AMPM');
              Inc(I, 3);
              AThereIsTimeSuffixItem := True;
            end
            else if SameText(Copy(AFormat, I - 1, 3), 'AAA') then
            begin
              if SameText(Copy(AFormat, I - 1, 4), 'AAAA') then
                ACount := 4
              else
                ACount := 3;
              AddFormatItem(dtikDay, GetCharString('D', ACount));
              Inc(I, ACount - 1);
            end
            else
              AppendChars(AStartSymbol, 1, 1);
          end;
        'C':
          begin
            GetCount(AFormat, I, AStartSymbol);
            Result := ParseFormat(ShortDateFormat, ARecursionDepth);
            if not Result then
              Break;
            AppendChars(' ', 1, 1);
            Result := ParseFormat(LongTimeFormat, ARecursionDepth);
            if not Result then
              Break;
          end;
        '/':
          AddFormatItem(dtikDateSeparator, '');
        ':':
          AddFormatItem(dtikTimeSeparator, '');
        '''', '"':
          begin
            APrevI := I;
            while (I <= Length(AFormat)) and (AFormat[I] <> AStartSymbol) do