cxcalendar.pas

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

    property ShowTime: Boolean read FShowTime write SetShowTime default True;
    property WeekNumbers: Boolean read FWeekNumbers write SetWeekNumbers
      default False;
    property YearsInMonthList: Boolean read FYearsInMonthList
      write SetYearsInMonthList default True;
  end;

  { TcxDateEditProperties }

  TcxDateEditProperties = class(TcxCustomDateEditProperties)
  published
    property Alignment;
    property ArrowsForYear;
    property AssignedValues;
    property AutoSelect;
    property ButtonGlyph;
    property ClearKey;
    property DateButtons;
    property DateOnError;
    property ImeMode;
    property ImeName;
    property ImmediatePost;
    property InputKind;
    property Kind;
    property MaxDate;
    property MinDate;
    property PostPopupValueOnTab;
    property ReadOnly;
    property SaveTime;
    property ShowTime;
    property UseLeftAlignmentOnEditing;
    property ValidateOnEnter;
    property WeekNumbers;
    property YearsInMonthList;
    property OnChange;
    property OnCloseUp;
    property OnEditValueChanged;
    property OnInitPopup;
    property OnPopup;
    property OnValidate;
  end;

  { TcxDateEditPopupWindow }

  TcxDateEditPopupWindow = class(TcxPopupEditPopupWindow)
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    function IsPopupCalendarKey(Key: Word; Shift: TShiftState): Boolean; virtual;
  public
    constructor Create(AOwnerControl: TWinControl); override;
  end;

  { TcxDateEditMaskStandardMode }

  TcxDateEditMaskStandardMode = class(TcxMaskEditStandardMode)
  protected
    function GetBlank(APos: Integer): Char; override;
  end;

  { TcxCustomDateEdit }

  TcxCustomDateEdit = class(TcxCustomPopupEdit)
  private
    FDateDropDown: TDateTime;
    FSavedTime: TDateTime;
    procedure DateChange(Sender: TObject);
    function GetActiveProperties: TcxCustomDateEditProperties;
    function GetCurrentDate: TDateTime;
    function GetProperties: TcxCustomDateEditProperties;
    function GetRecognizableDisplayValue(ADate: TDateTime): TcxEditValue;
    procedure SetProperties(Value: TcxCustomDateEditProperties);
  protected
    FCalendar: TcxPopupCalendar;
    function CanSynchronizeModeText: Boolean; override;
    procedure CheckEditorValueBounds; override;
    procedure CreatePopupWindow; override;
//    procedure DoEditKeyDown(var Key: Word; Shift: TShiftState); override;
    procedure DropDown; override;
    procedure Initialize; override;
    procedure InitializePopupWindow; override;
    function InternalGetEditingValue: TcxEditValue; override;
    function InternalGetText: string; override;
    procedure InternalSetEditValue(const Value: TcxEditValue;
      AValidateEditValue: Boolean); override;
    function InternalSetText(const Value: string): Boolean; override;
    procedure InternalValidateDisplayValue(const ADisplayValue: TcxEditValue); override;
    function IsCharValidForPos(var AChar: Char; APos: Integer): Boolean; override;
    procedure PopupWindowClosed(Sender: TObject); override;
    procedure PopupWindowShowed(Sender: TObject); override;
    procedure UpdateTextFormatting; override;
    procedure CreateCalendar; virtual;
    function GetCalendarClass: TcxPopupCalendarClass; virtual;
    function GetDate: TDateTime; virtual;
    function GetDateFromStr(const S: string): TDateTime;
    procedure SetDate(Value: TDateTime); virtual;
    procedure SetupPopupWindow; override;
    property Calendar: TcxPopupCalendar read FCalendar;
  public
    destructor Destroy; override;
    procedure Clear; override;
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    procedure PrepareEditValue(const ADisplayValue: TcxEditValue;
      out EditValue: TcxEditValue; AEditFocused: Boolean); override;
    property ActiveProperties: TcxCustomDateEditProperties read GetActiveProperties;
    property CurrentDate: TDateTime read GetCurrentDate;
    property Date: TDateTime read GetDate write SetDate stored False;
    property Properties: TcxCustomDateEditProperties read GetProperties
      write SetProperties;
  end;

  { TcxDateEdit }

  TcxDateEdit = class(TcxCustomDateEdit)
  private
    function GetActiveProperties: TcxDateEditProperties;
    function GetProperties: TcxDateEditProperties;
    procedure SetProperties(Value: TcxDateEditProperties);
  public
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    property ActiveProperties: TcxDateEditProperties read GetActiveProperties;
  published
    property Anchors;
    property AutoSize;
    property BeepOnEnter;
    property BiDiMode;
    property Constraints;
    property DragCursor;
    property DragKind;
    property Date;
    property DragMode;
    property EditValue;
    property Enabled;
    property ImeMode;
    property ImeName;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property Properties: TcxDateEditProperties read GetProperties
      write SetProperties;
    property ShowHint;
    property Style;
    property StyleDisabled;
    property StyleFocused;
    property StyleHot;
    property TabOrder;
    property TabStop default True;
    property Visible;
    property OnClick;
  {$IFDEF DELPHI5}
    property OnContextPopup;
  {$ENDIF}
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEditing;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property OnStartDock;
  end;

  { TcxFilterDateEditHelper }

  TcxFilterDateEditHelper = class(TcxFilterDropDownEditHelper)
  public
    class function GetFilterEditClass: TcxCustomEditClass; override;
    class function GetSupportedFilterOperators(
      AProperties: TcxCustomEditProperties;
      AValueTypeClass: TcxValueTypeClass;
      AExtendedSet: Boolean = False): TcxFilterControlOperators; override;
    class procedure InitializeProperties(AProperties,
      AEditProperties: TcxCustomEditProperties; AHasButtons: Boolean); override;
  end;

function cxEditIsDateValid(ADate: Double): Boolean;
function VarIsNullDate(const AValue: Variant): Boolean;

implementation

uses
  Math,
  dxOffice11, dxThemeConsts, dxThemeManager, dxUxTheme,
  cxEditPaintUtils, cxEditUtils, cxLookAndFeelPainters,
  cxLookAndFeels, cxSpinEdit, cxVariants;

type
  TDelimiterOffset = record
    Left, Right: Integer;
  end;

const
  cxEditTimeFormatA: array [TcxTimeEditTimeFormat, Boolean] of string = (
    ('hh:nn:ss ampm', 'hh:nn:ss'),
    ('hh:nn ampm', 'hh:nn'),
    ('hh ampm', 'hh')
  );
  DateNavigatorTime = 200;
  Office11HeaderOffset = 2;

  WeekNumbersDelimiterOffset: TDelimiterOffset = (Left: 3; Right: 1);
  WeekNumbersDelimiterWidth = 1;

function cxEditIsDateValid(ADate: Double): Boolean;
begin
  Result := (ADate = NullDate) or
    ((ADate >= cxMinDateTime) and (ADate <= cxMaxDateTime));
end;

function VarIsNullDate(const AValue: Variant): Boolean;
begin
  Result := (VarIsDate(AValue) or VarIsNumericEx(AValue)) and (AValue = NullDate);
end;

function cxEncodeDate(AYear, AMonth, ADay: Word): Double;
begin
  if (AYear < MinYear) or (AYear > MaxYear) or
    (AMonth < 1) or (AMonth > 12) or
    (ADay < 1) or (ADay > DaysInAMonth(AYear, AMonth)) then
    Result := InvalidDate
  else
    Result := EncodeDate(AYear, AMonth, ADay);
end;

procedure GetTimeFormat(const ADateTimeFormatInfo: TcxDateTimeFormatInfo;
  out ATimeFormat: TcxTimeEditTimeFormat; out AUse24HourFormat: Boolean);

  function GetFormatInfoItemIndex(
    AItemKind: TcxDateTimeFormatItemKind): Integer;
  var
    I: Integer;
  begin
    Result := -1;
    for I := 0 to Length(ADateTimeFormatInfo.Items) - 1 do
      if ADateTimeFormatInfo.Items[I].Kind = AItemKind then
      begin
        Result := I;
        Break;
      end;
  end;

var
  AFormatInfoItemIndex: Integer;
begin
  if GetFormatInfoItemIndex(dtikSec) <> -1 then
    ATimeFormat := tfHourMinSec
  else if GetFormatInfoItemIndex(dtikMin) <> -1 then
    ATimeFormat := tfHourMin
  else if GetFormatInfoItemIndex(dtikHour) <> -1 then
    ATimeFormat := tfHour
  else
    ATimeFormat := tfHourMinSec;

  AFormatInfoItemIndex := GetFormatInfoItemIndex(dtikHour);
  if AFormatInfoItemIndex <> -1 then
    AUse24HourFormat := Copy(ADateTimeFormatInfo.Items[AFormatInfoItemIndex].Data, 1, 2) = '24'
  else
    AUse24HourFormat := False;
end;

procedure TrueTextRect(ACanvas: TCanvas; R: TRect; X, Y: Integer;
  const Text: WideString);
begin
  ACanvas.TextRect(R, X, Y, Text);
end;

{ TcxClock }

constructor TcxClock.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMinuteDotColor := clWindow;
end;

procedure TcxClock.Paint;
begin
  LookAndFeel.Painter.DrawClock(Canvas, ClientRect, TDateTime(FTime), Color);
end;

procedure TcxClock.SetMinuteDotColor(Value: TColor);
begin
  if Value <> FMinuteDotColor then
  begin
    FMinuteDotColor := Value;
    Invalidate;
  end;
end;

procedure TcxClock.SetTime(Value: TTime);
begin
  Value := Frac(Value);
  if Value <> FTime then
  begin
    FTime := Value;
    Invalidate;
  end;
end;

{ TcxMonthListBox }

constructor TcxMonthListBox.Create(AOwnerControl: TWinControl);
begin
  inherited Create(AOwnerControl);
  ControlStyle := [csCaptureMouse, csOpaque];
  if not ShowYears then
    ControlStyle := ControlStyle + [csClickEvents];
  FTimer := TcxTimer.Create(nil);
  FTimer.Enabled := False;
  FTimer.Interval := 200;
  FTimer.OnTimer := DoTimer;
  Adjustable := False;
  BorderStyle := pbsFlat;
end;

destructor TcxMonthListBox.Destroy;
begin
  FreeAndNil(FTimer);
  inherited Destroy;
end;

procedure TcxMonthListBox.CloseUp;
var
  ADate: TDateTime;
begin
  if GetCaptureControl = Self then
    SetCaptureControl(nil);
  if not Visible then
    Exit;
  inherited CloseUp;
  FTimer.Enabled := False;
  if ShowYears then
  begin
    ADate := GetDate;
    if ADate <> NullDate then
      Calendar.SetFirstDate(ADate);
  end;
end;

procedure TcxMonthListBox.Popup(AFocusedControl: TWinControl);
var
  R: TRect;
begin
  FCurrentDate := CalendarTable.FromDateTime(Calendar.FirstDate);
  if ShowYears then
    FItemCount := 7
  else
    FItemCount := CalendarTable.GetMonthsInYear(FCurrentDate.Year);
  Font := Calendar.Font;
  FontChanged;
  if ShowYears then
    TopMonthDelta := -3
  else
    TopMonthDelta := 1 - FCurrentDate.Month;
  R := Calendar.FViewInfo.MonthRegion;
  R.TopLeft := Calendar.ClientToScreen(R.TopLeft);
  R.BottomRight := Calendar.ClientToScreen(R.BottomRight);
  FOrigin.X := R.Left + (R.Right - R.Left - Self.Width) div 2;
  FOrigin.Y := (R.Top + R.Bottom) div 2 - Self.Height div 2;
  FItemIndex := -1;
  inherited Popup(AFocusedControl);
end;

procedure TcxMonthListBox.DoTimer(Sender: TObject);
begin
  TopMonthDelta := TopMonthDelta + FSign;
end;

function TcxMonthListBox.GetCalendar: TcxCustomCalendar;
begin
  Result := TcxCustomCalendar(OwnerControl);
end;

function TcxMonthListBox.GetCalendarTable: TcxCustomCalendarTable;
begin
  Result := TcxCustomCalendar(OwnerControl).CalendarTable;
end;

function TcxMonthListBox.GetDate: TDateTime;
var
  ADate: TcxDateTime;
begin
  if ItemIndex = -1 then Result := NullDate
  else
    with CalendarTable do
    begin
      ADate := FromDateTime(AddMonths(FCurrentDate, TopMonthDelta + ItemIndex));
      ADate.Day := 1;