tsdatetime.pas

企业进销存管理系统

{*******************************************************}
{                                                       }
{       ObjectSight Visual Components                   }
{       TopGrid TtsDateTime component                   }
{                                                       }
{       Copyright (c) 2001, ObjectSight                 }
{                                                       }
{*******************************************************}

unit TSDateTime;

{$INCLUDE TSCmpVer}

interface

uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    StdCtrls, ExtCtrls, Buttons, Grids_ts, TSGrid, TSDateTimeDef
    {$IFDEF TSVER_V6}, Variants {$ENDIF};

const
    tsMaxCalendarRows = 30;

type
    TtsDateTime = class;
    TtsDateTimeDef = class;

    TtsDateTimeSpinType = (dtsIncrYear, dtsDecrYear, dtsIncrTime, dtsDecrTime);
    TtsCalendarRowType = (crtMonthHeader, crtDayNames, crtDays);
    TtsCalendarRowData = record
                             WeekNumber: Integer;
                             RowInMonth: Integer;
                             MonthYear: Integer;
                             Days: array[1..7] of Integer;
                             RowType: TtsCalendarRowType;
                         end;

    {$IFNDEF TSVER_V3}
    TtsDate = TDateTime;
    TtsTime = TDateTime;
    {$ENDIF}

    TtsDateTime = class(TCustomPanel)
    protected
        FDisplayMonth: Integer;
        FDisplayYear: Integer;
        FDisplayRowInMonth: Integer;
        FSelectedDate: TDate;
        FMaxYear: Word;
        FMinYear: Word;
        FMaxRowMonthYear: Integer;
        FRowData: array[1..tsMaxCalendarRows] of TtsCalendarRowData;
        FDayNames: array[1..7] of string;
        FOldScrollBarPosition: Integer;
        FValidDateSelected: Boolean;
        FFormat24Hour: Boolean;
        FSpinButton: TtsDateTimeSpinType;
        FTodayRMY: Integer;
        FSelectedRMY: Integer;
        FPrevHour: Integer;
        FPrevMinute: Integer;
        FPrevSeconds: Integer;
        FUpdateCount: Integer;
        FOldButHourIncrSize: Integer;
        FOldButHourDecrSize: Integer;
        FOldButYearIncrSize: Integer;
        FOldButYearDecrSize: Integer;
        FInDesignMode: Boolean;
        FInPositionControls: Boolean;

        FPnlDate: TPanel;
        FPnlTime: TPanel;
        FPnlEditTime: TPanel;
        FPnlEditYear: TPanel;
        FPnlCalendar: TPanel;
        FButYearIncr: TSpeedButton;
        FButYearDecr: TSpeedButton;

        FButHourIncr: TSpeedButton;
        FButHourDecr: TSpeedButton;
        FButMinIncr: TSpeedButton;
        FButMinDecr: TSpeedButton;
        FButSecIncr: TSpeedButton;
        FButSecDecr: TSpeedButton;
        FButAMPMIncr: TSpeedButton;
        FButAMPMDecr: TSpeedButton;

        FButOK: TSpeedButton;
        FButCancel: TSpeedButton;
        FTxtYear: TEdit;
        FTxtHour: TEdit;
        FTxtMinute: TEdit;
        FTxtSeconds: TEdit;
        FTxtAMPM: TEdit;
        FLblSep1: TLabel;
        FLblSep2: TLabel;
        FBevel: TBevel;
        FTimKeyDownDelay: TTimer;
        FDateGrid: TtsGrid;
        FComboMonth: TtsGrid;
        FComboBevel: TBevel;
        FDateScrollBar: TScrollBar;
        FActiveControl: TWinControl;

        //property fields
        FDateTime: Variant;
        FShowSeconds: Boolean;
        FMinDate: TDate;
        FMaxDate: TDate;
        FShowWeekNumbers: Boolean;
        FShowDayNames: TtsShowDayNames;
        FShowToday: Boolean;
        FDateTimeDisplay: TtsDateTimeDisplay;
        FFirstDayOfWeek: TtsFirstDayOfWeek;
        FCalendarRows: Integer;
        FShowSingleMonth: Boolean;
        FWeekFontColor: TColor;
        FDayNameFontColor: TColor;
        FLineColor: TColor;
        FMonthColor: TColor;
        FMonthFontColor: TColor;
        FDisabledFontColor: TColor;
        FSelectSaturday: Boolean;
        FSelectSunday: Boolean;
        FOkCaption: string;
        FCancelCaption: string;
        FCaption: string;
        FPopupForm: Boolean;

        //event fields
        FOnCancel: TNotifyEvent;
        FOnSelect: TNotifyEvent;

        procedure InvalidOp(Msg: string);
        procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
        procedure CreateWnd; override;
        procedure KeyDown(var Key: Word; Shift: TShiftState); override;

        procedure YearUpdated;
        procedure timKeyDownDelayTimer(Sender: TObject);
        procedure grdMonthComboGetValue(Sender: TObject; Combo: TtsComboGrid; GridDataCol, GridDataRow,
                                        ComboDataRow: Longint; var Value: Variant);
        procedure grdMonthKeyPress(Sender: TObject; var Key: Char);
        procedure ScrollLineUp;
        procedure ScrollLineDown;
        procedure ScrollPageUp;
        procedure ScrollPageDown;
        procedure DateScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
        procedure DateScrollBarKeyPress(Sender: TObject; var Key: Char);
        procedure DateGridCellLoaded(Sender: TObject; DataCol, DataRow: Longint; var Value: Variant);
        procedure DateGridPaint(Sender: TObject);
        procedure DateGridMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure DateGridMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure DateGridKeyPress(Sender: TObject; var Key: Char);
        function  GetMinDateInView(var MinDate: TDateTime): Boolean;
        function  GetMaxDateInView(var MaxDate: TDateTime): Boolean;
        function  DateInView(Value: TDateTime): Boolean;
        procedure PutDateInView(Value: TDateTime);
        procedure KeyScrollUp(PageUp: Boolean);
        procedure KeyScrollDown(PageDown: Boolean);
        procedure KeyScrollLeft;
        procedure KeyScrollRight;
        procedure DateGridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
        procedure butYearIncrMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure butYearIncrMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure butYearDecrMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure butYearDecrMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure butTimeIncrMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure butTimeIncrMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure butTimeDecrMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure butTimeDecrMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure txtYearExit(Sender: TObject);
        procedure txtYearKeyPress(Sender: TObject; var Key: Char);
        procedure txtYearKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
        procedure txtHourExit(Sender: TObject);
        procedure txtHourKeyPress(Sender: TObject; var Key: Char);
        procedure txtHourKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
        procedure txtHourChange(Sender: TObject);
        procedure txtMinuteExit(Sender: TObject);
        procedure txtMinuteKeyPress(Sender: TObject; var Key: Char);
        procedure txtMinuteKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
        procedure txtMinuteChange(Sender: TObject);
        procedure txtSecondsExit(Sender: TObject);
        procedure txtSecondsKeyPress(Sender: TObject; var Key: Char);
        procedure txtSecondsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
        procedure txtSecondsChange(Sender: TObject);
        procedure txtAMPMKeyPress(Sender: TObject; var Key: Char);
        procedure txtAMPMKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
        procedure butOKClick(Sender: TObject);
        procedure butCancelClick(Sender: TObject);

        function  GetFirstDayInRow(Year, Month, RowInMonth: Integer): Integer;
        procedure BuildGridRows(RowInMonth: Integer; Month: Integer; Year: Integer);
        function  GetFullYear(YearStr: string): Integer;
        function  YearOk(YearStr: string): Boolean;
        procedure CheckEnableButton;
        procedure CheckMinMaxDate(var RowInMonth: Integer; var Month: Integer; var Year: Integer);
        procedure Close(Ok: Boolean);
        procedure CreateControls;
        procedure DecHour;
        procedure DecMinutes;
        procedure CheckValidDate(var Month, Year: Integer);
        procedure DecMonth(var Month: Integer; var Year: Integer);
        procedure DecSeconds;
        procedure DecodeRMYvalue(RMYvalue: Integer; var RowInMonth: Integer; var Month: Integer; var Year: Integer);
        procedure DecRow(var Row: Integer; var Month: Integer; var Year: Integer);
        function  GetRMYRow(RMY: Integer): Integer;
        procedure InvertSelectedDate;
        procedure HandleKeyDownHomeEnd(Key: Word);
        procedure InitControlProperties;
        procedure InitMonthCombo;
        procedure IncHour;
        procedure IncMinutes;
        procedure IncMonth(var Month: Integer; var Year: Integer);
        procedure IncRow(var Row: Integer; var Month: Integer; var Year: Integer);
        procedure IncSeconds;
        function  ButYearSizeChanged: Boolean;
        function  ButTimeSizeChanged: Boolean;
        procedure SaveButtonHeights;
        function  CalcGridRows: Integer;
        procedure SetComboValue;
        procedure BuildGridData;
        procedure RefreshControls;
        procedure RefreshDates;
        procedure RefreshData(CheckDates: Boolean);
        procedure CheckRefreshData(CheckDates: Boolean);
        function  GetPrevDay(CurDate: TDateTime): TDateTime;
        function  GetNextDay(CurDate: TDateTime): TDateTime;
        function  GetValidDate(Value: Variant): TDateTime;
        function  SetSelectedDate(Value: Variant): TDateTime;
        procedure SetDisplayDate(Value: TDateTime);
        procedure SetSelectedDateInView(Invert: Boolean);
        procedure SetCurDateTime(Init: Boolean);
        procedure CheckCurDateTime(Init: Boolean);
        procedure SetControlColors;
        procedure SetOkButtonPos;
        procedure SetCalendarHeight;
        procedure SetDayNames;
        procedure PositionDateGrid;
        procedure PositionMonthCombo(TextHeight: Integer);
        procedure PositionYearEdit(TextHeight: Integer);
        procedure PositionScrollBar;
        procedure PositionYearButtons;
        procedure PositionTimeButtons(TxtOffset, AMPMWidth, AMPMOffset, ButHeight, ButWidth,
                                      ButIncrTop, ButDecrTop: Integer);
        function  GetAMPMWidth: Integer;
        procedure PositionTimeControls(TextHeight: Integer);
        procedure SetButtonGlyphs(ButtonHeight: Integer);
        procedure PositionControls;
        procedure SelectDate(Col, Row: Integer);
        procedure ToggleAMPM;
        procedure SetButControlFocus(Button: TSpeedButton);
        procedure DoSelect;
        procedure DoCancel;

        procedure BeginUpdate;
        procedure EndUpdate;
        function  IsUpdating: Boolean;
        procedure CheckUpdate;
        procedure CheckUpdateCalendar;
        procedure CheckReAlign;
        procedure InvalidateControls(Control: TWinControl);

        procedure SetColor(Value: TColor);
        function  GetColor: TColor;
        procedure SetDateTime(Value: Variant);
        function  GetDateTime: Variant;
        procedure SetCalendarRows(Value: Integer);
        procedure SetDateTimeDisplay(Value: TtsDateTimeDisplay);
        procedure SetDayNameFontColor(Value: TColor);
        procedure SetDisabledFontColor(Value: TColor);
        procedure SetFirstDayOfWeek(Value: TtsFirstDayOfWeek);
        procedure SetLineColor(Value: TColor);
        procedure SetMaxDate(Value: TDate);
        procedure SetMinDate(Value: TDate);
        procedure SetMonthColor(Value: TColor);
        procedure SetMonthFontColor(Value: TColor);
        procedure SetOkCaption(Value: string);
        procedure SetCancelCaption(Value: string);
        procedure SetCaption(Value: string);
        procedure SetSelectSaturday(Value: Boolean);
        procedure SetSelectSunday(Value: Boolean);
        procedure SetShowDayNames(Value: TtsShowDayNames);
        procedure SetShowSeconds(Value: Boolean);
        procedure SetShowToday(Value: Boolean);
        procedure SetShowWeekNumbers(Value: Boolean);
        procedure SetShowSingleMonth(Value: Boolean);
        procedure SetWeekFontColor(Value: TColor);
        procedure SetPopupForm(Value: Boolean);
        function  GetInDesignMode: Boolean;

        function  Date2RMYValue(Value: TDate): Integer;
        function  DatePart(Code: String; Value: TDate): Word;
        function  DetermineMaxRowMonthYear: Integer;
        function  FirstDayOfRMY(RMYvalue: Integer): Integer;
        function  Min(i, j: Integer): Integer;
        function  Max(i, j: Integer): Integer;
        function  RowsInMonth(Month: Integer; Year:Integer): Integer;
        procedure GetHourFormat;
        function  TimePart(Code: String; Value: TTime): String;
        function  tsDayOfWeek(Value: TDate): Integer;
        function  ISODayOfWeek(Value: TDate): Integer;
        function  WeekNumber(Value: TDate): Word;
        function  CaptionStr(DateTimeDisplay: TtsDateTimeDisplay): string;
        function  IsDefaultCaption(Caption: string): Boolean;

    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;

        procedure Assign(Source: TPersistent); override;
        procedure InitializeDisplay;
        procedure InitializeFocus;
        procedure ReAlign;
        procedure SetFocus; override;

        property DateTime: Variant read GetDateTime write SetDateTime;
        property PopupForm: Boolean read FPopupForm write SetPopupForm default False;
        property OnSelect: TNotifyEvent read FOnSelect write FOnSelect;
        property OnCancel: TNotifyEvent read FOnCancel write FOnCancel;

    published
        property CalendarRows: Integer read FCalendarRows write SetCalendarRows default 8;
        property Color: TColor read GetColor write SetColor default clWindow;
        property DateTimeDisplay: TtsDateTimeDisplay read FDateTimeDisplay write SetDateTimeDisplay default dtDate;
        property DayNameFontColor: TColor read FDayNameFontColor write SetDayNameFontColor default clHighLight;
        property DisabledFontColor: TColor read FDisabledFontColor write SetDisabledFontColor default clInactiveBorder;
        property FirstDayOfWeek: TtsFirstDayOfWeek read FFirstDayOfWeek write SetFirstDayOfWeek default dowSunday;
        property Font;
        property LineColor: TColor read FLineColor write SetLineColor default clGrayText;
        property MaxDate: TDate read FMaxDate write SetMaxDate;
        property MinDate: TDate read FMinDate write SetMinDate;
        property MonthColor: TColor read FMonthColor write SetMonthColor default clHighLight;
        property MonthFontColor: TColor read FMonthFontColor write SetMonthFontColor default clHighLightText;
        property OkCaption: string read FOkCaption write SetOkCaption;
        property CancelCaption: string read FCancelCaption write SetCancelCaption;
        property Caption: string read FCaption write SetCaption;
        property SelectSaturday: Boolean read FSelectSaturday write SetSelectSaturday default True;
        property SelectSunday: Boolean read FSelectSunday write SetSelectSunday default True;
        property ShowDayNames: TtsShowDayNames read FShowDayNames write SetShowDayNames default sdnFirstLetter;
        property ShowSeconds: Boolean read FShowSeconds write SetShowSeconds default False;
        property ShowSingleMonth: Boolean read FShowSingleMonth write SetShowSingleMonth default True;
        property ShowToday: Boolean read FShowToday write SetShowToday default True;
        property ShowWeekNumbers: Boolean read FShowWeekNumbers write SetShowWeekNumbers default True;
        property WeekFontColor: TColor read FWeekFontColor write SetWeekFontColor default clHighLight;
    end;

    TtsDateTimeDefProps = class(TtsDateTimeProps)
    protected
        function  GetColor: TColor; override;
        procedure SetColor(Value: TColor); override;
        function  GetCalendarRows: Integer; override;
        procedure SetCalendarRows(Value: Integer); override;
        function  GetDateTimeDisplay: TtsDateTimeDisplay; override;