cxcalendar.pas

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

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressEditors                                               }
{                                                                    }
{       Copyright (c) 1998-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 EXPRESSEDITORS 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 cxCalendar;

{$I cxVer.inc}

interface

uses
  Windows, Messages, ComCtrls,
{$IFDEF DELPHI6}
  Types, Variants, DateUtils,
{$ENDIF}
  SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, Clipbrd,
  cxClasses, cxGraphics, cxControls, cxContainer, cxDataStorage, cxDataUtils,
  cxEdit, cxDropDownEdit, cxTextEdit, cxMaskEdit, cxButtons, cxDateUtils,
  cxEditConsts, cxFormats, cxTimeEdit, cxFilterControlUtils;

type
  TCalendarButton = (btnClear, btnNow, btnToday, btnOk);
  TDateButton = btnClear..btnToday;
  TDateButtons = set of TDateButton;

  TcxCalendarArrow = (caPrevMonth, caNextMonth, caPrevYear, caNextYear);
  TcxCalendarHotTrackRegion = (chrNone, chrMonth, chrYear);
  TcxCalendarKind = (ckDate, ckDateTime);
  TcxCustomCalendar = class;

  { TcxClock }

  TcxClock = class(TcxControl)
  private
    FMinuteDotColor: TColor;
    FTime: TTime;
    procedure SetMinuteDotColor(Value: TColor);
    procedure SetTime(Value: TTime);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Color;
    property MinuteDotColor: TColor read FMinuteDotColor write SetMinuteDotColor
      default clWindow;
    property Time: TTime read FTime write SetTime;
  end;

{ TcxMonthListBox - Bug in Delphi5: Must be in the interface part }

  TcxMonthListBox = class(TcxCustomPopupWindow)
  private
    FCurrentDate: TcxDateTime;
    FOrigin: TPoint;
    FTopMonthDelta: Integer;
    FItemHeight: Integer;
    FItemIndex: Integer;
    FItemCount: Integer;
    FTimer: TcxTimer;
    FSign: Integer;
    procedure DoTimer(Sender: TObject);
    function GetCalendar: TcxCustomCalendar;
    function GetCalendarTable: TcxCustomCalendarTable;
    function GetDate: TDateTime;
    function GetShowYears: Boolean;
    procedure SetItemIndex(Value: Integer);
    procedure SetTopMonthDelta(Value: Integer);
  protected
    function CalculatePosition: TPoint; override;
    procedure Click; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DoShowed; override;
    procedure FontChanged;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Paint; override;
    property Calendar: TcxCustomCalendar read GetCalendar;
    property CalendarTable: TcxCustomCalendarTable read GetCalendarTable;
    property ItemHeight: Integer read FItemHeight;
    property ItemIndex: Integer read FItemIndex write SetItemIndex;
    property ShowYears: Boolean read GetShowYears;
    property TopMonthDelta: Integer read FTopMonthDelta write SetTopMonthDelta;
  public
    constructor Create(AOwnerControl: TWinControl); override;
    destructor Destroy; override;
    procedure CloseUp; override;
    procedure Popup(AFocusedControl: TWinControl); override;
    property Date: TDateTime read GetDate;
  end;

  { TcxCustomCalendar }

  TcxCalendarViewInfo = record
    ArrowRects: array[TcxCalendarArrow] of TRect;
    CalendarRect: TRect;
    CurrentDateRegion: TRect;
    HeaderRegion: TRect;
    LastVisibleArrow: TcxCalendarArrow;
    MonthRegion: TRect;
    YearRegion: TRect;
  end;

  TcxCustomCalendar = class(TcxControl, IcxMouseTrackingCaller)
  private
    FArrowsForYear: Boolean;
    FButtonsHeight: Integer;
    FButtonsOffset: Integer;
    FButtonsRegionHeight: Integer;
    FButtonWidth: Integer;
    FCalendarButtons: TDateButtons;
    FCalendarTable: TcxCustomCalendarTable;
    FClearButton: TcxButton;
    FClock: TcxClock;
    FClockSize: Integer;
    FColWidth: Integer;
    FDateRegionWidth: Integer;
    FDaysOfWeekHeight: Integer;
    FFirstDate: Double;
    FFlat: Boolean;
    FHeaderHeight: Integer;
    FHotTrackRegion: TcxCalendarHotTrackRegion;
    FKind: TcxCalendarKind;
    FMonthListBox: TcxMonthListBox;
    FNowButton: TcxButton;
    FOKButton: TcxButton;
    FPrevCursor: TCursor;
    FRowHeight: Integer;
    FSelectDate: Double;
    FSideWidth: Integer;
    FTimeEdit: TcxTimeEdit;
    FTimer: TcxTimer;
    FTodayButton: TcxButton;
    FViewInfo: TcxCalendarViewInfo;
    FWeekNumbers: Boolean;
    FWeekNumberWidth: Integer;
    FYearsInMonthList: Boolean;
    FOnDateTimeChanged: TNotifyEvent;
    procedure AdjustCalendarControlsPosition;
    procedure ButtonClick(Sender: TObject);
    procedure CalculateViewInfo;
    procedure CreateButtons;
    procedure CorrectHeaderTextRect(var R: TRect);
    procedure DoDateTimeChanged;
    procedure DoScrollArrow(Sender: TObject);
    procedure DrawHeader;
    function GetDateHeaderFrameColor: TColor;
    function GetDateFromCell(X, Y: Integer): Double;
    function GetDateTimeHeaderFrameColor: TColor;
    function GetHeaderColor: TColor;
    function GetHeaderOffset: TRect;
    function GetShowButtonsRegion: Boolean;
    function GetTimeEditWidth: Integer;
    function GetTimeFormat: TcxTimeEditTimeFormat;
    function GetUse24HourFormat: Boolean;
    function GetWeekNumbersRegionWidth: Integer;
    procedure GetVisibleButtonList(AList: TList);
    procedure SetArrowsForYear(Value: Boolean);
    procedure SetCalendarButtons(Value: TDateButtons);
    procedure SetFlat(Value: Boolean);
    procedure SetHotTrackRegion(Value: TcxCalendarHotTrackRegion);
    procedure SetKind(Value: TcxCalendarKind);
    procedure SetTimeFormat(Value: TcxTimeEditTimeFormat);
    procedure SetUse24HourFormat(Value: Boolean);
    procedure SetWeekNumbers(Value: Boolean);
    procedure TimeChanged(Sender: TObject);
  protected
    procedure DblClick; override;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
    procedure FontChanged; override;
    function HasBackground: Boolean; override;
    procedure InitControl; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseEnter(AControl: TControl); override;
    procedure MouseLeave(AControl: TControl); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Paint; override;
    procedure Calculate; virtual;
    function CanResize(var NewWidth, NewHeight: Integer): Boolean;
      override;
    procedure CheckHotTrack; virtual;
    procedure DoStep(AArrow: TcxCalendarArrow);
    function GetButtonsRegionOffset: Integer; virtual;
    function GetLastDate: Double; virtual;
    function GetMonthCalendarOffset: TPoint; virtual;
    function GetRealFirstDate: Double; virtual;
    function GetRealLastDate: Double; virtual;
    function GetSize: TSize; virtual;
    procedure HidePopup(Sender: TcxControl; AReason: TcxEditCloseUpReason); virtual;
    procedure InternalSetSelectDate(Value: Double; ARepositionVisibleDates: Boolean);
    function PosToDateTime(P: TPoint): Double; virtual;
    procedure SetFirstDate(Value: Double); virtual;
    procedure SetSelectDate(Value: Double); virtual;
    procedure SetSize;
    procedure StepToFuture;
    procedure StepToPast;

    // IcxMouseTrackingCaller
    procedure MouseTrackingMouseLeave;
    procedure IcxMouseTrackingCaller.MouseLeave = MouseTrackingMouseLeave;

    property CalendarTable: TcxCustomCalendarTable read FCalendarTable;
    property HotTrackRegion: TcxCalendarHotTrackRegion read FHotTrackRegion
      write SetHotTrackRegion;
    property ShowButtonsRegion: Boolean read GetShowButtonsRegion;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property ArrowsForYear: Boolean read FArrowsForYear write SetArrowsForYear
      default True;
    property CalendarButtons: TDateButtons
      read FCalendarButtons write SetCalendarButtons;
    property FirstDate: Double read FFirstDate write SetFirstDate;
    property Flat: Boolean read FFlat write SetFlat default True;
    property Font;
    property Kind: TcxCalendarKind read FKind write SetKind default ckDate;
    property SelectDate: Double read FSelectDate write SetSelectDate;
    property TimeFormat: TcxTimeEditTimeFormat read GetTimeFormat
      write SetTimeFormat default tfHourMinSec;
    property Use24HourFormat: Boolean read GetUse24HourFormat
      write SetUse24HourFormat default True;
    property WeekNumbers: Boolean read FWeekNumbers write SetWeekNumbers
      default False;
    property YearsInMonthList: Boolean read FYearsInMonthList
      write FYearsInMonthList default True;
    property OnDateTimeChanged: TNotifyEvent read FOnDateTimeChanged
      write FOnDateTimeChanged;
  end;

  { TcxPopupCalendar }

  TcxCustomDateEdit = class;

  TcxPopupCalendar = class(TcxCustomCalendar)
  private
    FEdit: TcxCustomDateEdit;
    FOnHidePopup: TcxEditClosePopupEvent;
  protected
    procedure CheckHotTrack; override;
    procedure HidePopup(Sender: TcxControl; AReason: TcxEditCloseUpReason); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  public
    property Edit: TcxCustomDateEdit read FEdit write FEdit;
    property OnHidePopup: TcxEditClosePopupEvent read FOnHidePopup write FOnHidePopup;
  end;

  TcxPopupCalendarClass = class of TcxPopupCalendar;

  { TcxDateEditPropertiesValues }

  TcxDateEditPropertiesValues = class(TcxTextEditPropertiesValues)
  private
    FDateButtons: Boolean;
    FInputKind: Boolean;
    function GetMaxDate: Boolean;
    function GetMinDate: Boolean;
    function IsMaxDateStored: Boolean;
    function IsMinDateStored: Boolean;
    procedure SetDateButtons(Value: Boolean);
    procedure SetInputKind(Value: Boolean);
    procedure SetMaxDate(Value: Boolean);
    procedure SetMinDate(Value: Boolean);
  public
    procedure Assign(Source: TPersistent); override;
    procedure RestoreDefaults; override;
  published
    property DateButtons: Boolean read FDateButtons write SetDateButtons
      stored False;
    property InputKind: Boolean read FInputKind write SetInputKind stored False;
    property MaxDate: Boolean read GetMaxDate write SetMaxDate stored IsMaxDateStored;
    property MinDate: Boolean read GetMinDate write SetMinDate stored IsMinDateStored;
  end;

  { TcxCustomDateEditProperties }

  TDateOnError = (deNoChange, deToday, deNull);
  TcxInputKind = (ikStandard, ikMask, ikRegExpr);

  TcxCustomDateEditProperties = class(TcxCustomPopupEditProperties)
  private
    FArrowsForYear: Boolean;
    FDateButtons: TDateButtons;
    FDateOnError: TDateOnError;
    FInputKind: TcxInputKind;
    FKind: TcxCalendarKind;
    FSaveTime: Boolean;
    FShowTime: Boolean;
    FWeekNumbers: Boolean;
    FYearsInMonthList: Boolean;
    procedure BuildEditMask;
    function GetAssignedValues: TcxDateEditPropertiesValues;
    function GetDateButtons: TDateButtons;
    function GetDefaultDateButtons: TDateButtons;
    function GetDefaultInputKind: TcxInputKind;
    function GetInputKind: TcxInputKind;
    function GetMaxDate: TDateTime;
    function GetMinDate: TDateTime;
    function IsDateButtonsStored: Boolean;
    function IsInputKindStored: Boolean;
    function NeedShowTime(ADate: TDateTime; AIsFocused: Boolean): Boolean;
    procedure SetArrowsForYear(Value: Boolean);
    procedure SetAssignedValues(Value: TcxDateEditPropertiesValues);
    procedure SetDateButtons(Value: TDateButtons);
    procedure SetDateOnError(Value: TDateOnError);
    procedure SetInputKind(Value: TcxInputKind);
    procedure SetKind(Value: TcxCalendarKind);
    procedure SetMaxDate(Value: TDateTime);
    procedure SetMinDate(Value: TDateTime);
    procedure SetSaveTime(Value: Boolean);
    procedure SetShowTime(Value: Boolean);
    procedure SetWeekNumbers(Value: Boolean);
    procedure SetYearsInMonthList(Value: Boolean);
  protected
    function GetAlwaysPostEditValue: Boolean; override;
    class function GetAssignedValuesClass: TcxCustomEditPropertiesValuesClass; override;
    function GetDisplayFormatOptions: TcxEditDisplayFormatOptions; override;
    function GetModeClass(AMaskKind: TcxEditMaskKind): TcxMaskEditCustomModeClass; override;
    class function GetPopupWindowClass: TcxCustomEditPopupWindowClass; override;
    function IsEditValueNumeric: Boolean; override;
    function IsValueBoundDefined(ABound: TcxEditValueBound): Boolean; override;
    function IsValueBoundsDefined: Boolean; override;
    function PopupWindowAcceptsAnySize: Boolean; override;
    function GetEmptyDisplayValue(AEditFocused: Boolean): string;
    function GetStandardMaskBlank(APos: Integer): Char; virtual;
    function GetTimeZoneInfo(APos: Integer;
      out AInfo: TcxTimeEditZoneInfo): Boolean; virtual;
    procedure InternalPrepareEditValue(ADisplayValue: string;
      out EditValue: TcxEditValue);
    property AssignedValues: TcxDateEditPropertiesValues read GetAssignedValues
      write SetAssignedValues;
  public
    constructor Create(AOwner: TPersistent); override;
    procedure Assign(Source: TPersistent); override;
    procedure Changed; override;
    class function GetContainerClass: TcxContainerClass; override;
    function GetEditValueSource(AEditFocused: Boolean): TcxDataEditValueSource; override;
    function IsDisplayValueValid(var DisplayValue: TcxEditValue;
      AEditFocused: Boolean): Boolean; override;
    function IsEditValueValid(var EditValue: TcxEditValue;
      AEditFocused: Boolean): Boolean; override;
    procedure PrepareDisplayValue(const AEditValue: TcxEditValue;
      var DisplayValue: TcxEditValue; AEditFocused: Boolean); override;
    procedure ValidateDisplayValue(var ADisplayValue: TcxEditValue;
      var AErrorText: TCaption; var AError: Boolean;
      AEdit: TcxCustomEdit); override;
    // !!!
    property ArrowsForYear: Boolean read FArrowsForYear
      write SetArrowsForYear default True;
    property DateButtons: TDateButtons read GetDateButtons write SetDateButtons
      stored IsDateButtonsStored;
    property DateOnError: TDateOnError read FDateOnError write SetDateOnError
      default deNoChange;
    property ImmediateDropDown default False;
    property InputKind: TcxInputKind read GetInputKind write SetInputKind
      stored IsInputKindStored;
    property Kind: TcxCalendarKind read FKind write SetKind default ckDate;
    property MaxDate: TDateTime read GetMaxDate write SetMaxDate;
    property MinDate: TDateTime read GetMinDate write SetMinDate;
    property SaveTime: Boolean read FSaveTime write SetSaveTime default True;