tsdatetime.pas

企业进销存管理系统

        procedure SetDateTimeDisplay(Value: TtsDateTimeDisplay); override;
        function  GetDayNameFontColor: TColor; override;
        procedure SetDayNameFontColor(Value: TColor); override;
        function  GetDisabledFontColor: TColor; override;
        procedure SetDisabledFontColor(Value: TColor); override;
        function  GetFirstDayOfWeek: TtsFirstDayOfWeek; override;
        procedure SetFirstDayOfWeek(Value: TtsFirstDayOfWeek); override;
        function  GetFont: TFont; override;
        procedure SetFont(Value: TFont); override;
        function  GetParentFont: Boolean; override;
        procedure SetParentFont(Value: Boolean); override;
        function  GetLineColor: TColor; override;
        procedure SetLineColor(Value: TColor); override;
        function  GetMaxDate: TtsDate; override;
        procedure SetMaxDate(Value: TtsDate); override;
        function  GetMinDate: TtsDate; override;
        procedure SetMinDate(Value: TtsDate); override;
        function  GetMonthColor: TColor; override;
        procedure SetMonthColor(Value: TColor); override;
        function  GetMonthFontColor: TColor; override;
        procedure SetMonthFontColor(Value: TColor); override;
        function  GetOkCaption: string; override;
        procedure SetOkCaption(Value: string); override;
        function  GetCancelCaption: string; override;
        procedure SetCancelCaption(Value: string); override;
        function  GetCaption: string; override;
        procedure SetCaption(Value: string); override;
        function  GetSelectSaturday: Boolean; override;
        procedure SetSelectSaturday(Value: Boolean); override;
        function  GetSelectSunday: Boolean; override;
        procedure SetSelectSunday(Value: Boolean); override;
        function  GetShowDayNames: TtsShowDayNames; override;
        procedure SetShowDayNames(Value: TtsShowDayNames); override;
        function  GetShowSeconds: Boolean; override;
        procedure SetShowSeconds(Value: Boolean); override;
        function  GetShowToday: Boolean; override;
        procedure SetShowToday(Value: Boolean); override;
        function  GetShowWeekNumbers: Boolean; override;
        procedure SetShowWeekNumbers(Value: Boolean); override;
        function  GetShowSingleMonth: Boolean; override;
        procedure SetShowSingleMonth(Value: Boolean); override;
        function  GetWeekFontColor: TColor; override;
        procedure SetWeekFontColor(Value: TColor); override;
        function  GetDateTime: Variant; override;
        procedure SetDateTime(Value: Variant); override;
        function  GetPopupForm: Boolean; override;
        procedure SetPopupForm(Value: Boolean); override;

        function  GetDateTimeControl: TtsDateTime;
        function  GetDateTimeDef: TtsDateTimeDef;

    public
        procedure Assign(Source: TPersistent); override;

        property DateTimeControl: TtsDateTime read GetDateTimeControl;
        property DateTimeDef: TtsDateTimeDef read GetDateTimeDef;
    end;

    TtsDateTimeDef = class(TtsDateTimeDefComponent)
    protected
        FDateTimeControl: TtsDateTime;
        FDateTimeControlProps: TtsDateTimeDefProps;

        function  GetControl: TWinControl; override;
        procedure SetSelect(Value: TNotifyEvent); override;
        function  GetSelect: TNotifyEvent; override;
        procedure SetCancel(Value: TNotifyEvent); override;
        function  GetCancel: TNotifyEvent; override;
        procedure SetDateTime(Value: Variant); override;
        function  GetDateTime: Variant; override;
        procedure SetDateTimeDisplay(Value: TtsDateTimeDisplay); override;
        function  GetDateTimeDisplay: TtsDateTimeDisplay; override;
        procedure SetPopupForm(Value: Boolean); override;
        function  GetPopupForm: Boolean; override;
        procedure SetDateTimeProps(Value: TtsDateTimeProps); override;
        function  GetDateTimeProps: TtsDateTimeProps; override;
        procedure SetDateTimeControl(Value: TtsDateTime);

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

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

        property DateTimeControl: TtsDateTime read FDateTimeControl write SetDateTimeControl;

    published
        property DateTimeProps;
    end;

const
    StsInvalidMinDate = 'MinDate is larger than MaxDate';
    StsInvalidMaxDate = 'MaxDate is smaller than MinDate';

implementation

{$R *.RES}
{$R *.dcr}

uses
    TSCommon;

const
    SpinKeyDownDelay = 500;
    DisabledColor = cl3DLight;
    MinEditControlHeight = 18;
    DefaultButWidth = 75;
    DefaultButHeight = 27;
    MaxCalendarYear = 9999;
    MinCalendarYear = 1;

    DateCaption = 'Date';
    TimeCaption = 'Time';
    DateTimeCaption = DateCaption + '/' + TimeCaption;

{$IFNDEF TSVER_V3}
type
    TDayTable = array[1..12] of Word;

const
    MonthDays: array [Boolean] of TDayTable =
        ((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
         (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31));

function IsLeapYear(Year: Word): Boolean;
begin
  Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;
{$ENDIF}


{TtsDateTime}

constructor TtsDateTime.Create(AOwner: TComponent);
begin
    //ShowMessage('TtsDateTime Create Start');
    inherited;

    FOldButHourIncrSize := 0;
    FOldButHourDecrSize := 0;
    FOldButYearIncrSize := 0;
    FOldButYearDecrSize := 0;
    FUpdateCount := 0;
    FInDesignMode := False;
    FInPositionControls := False;

    FDisplayRowInMonth := 1;
    FValidDateSelected := False;
    FDateTimeDisplay := dtDate;
    FCaption := CaptionStr(FDateTimeDisplay);
    FDateTime := Unassigned;
    FMinDate := EncodeDate(1900, 1, 1);
    FMaxDate := EncodeDate(2099, 12, 31);
    FShowWeekNumbers := True;
    FShowDayNames := sdnFirstLetter;
    FShowToday := True;
    FirstDayOfWeek := dowSunday;
    FCalendarRows := 8;
    FShowSingleMonth := True;
    FPopupForm := False;

    FWeekFontColor := clHighLight;
    FDayNameFontColor := clHighLight;
    FLineColor := clGrayText;
    FMonthFontColor := clHighLightText;
    FMonthColor := clHighLight;
    FDisabledFontColor := clInactiveBorder;
    FSelectSaturday := True;
    FSelectSunday := True;
    FOkCaption := '&OK';
    FCancelCaption := '&Cancel';

    CreateControls;
    //ShowMessage('TtsDateTime Create Step 5');
    InitControlProperties;
    //ShowMessage('TtsDateTime Create Step 6');
    SetCurDateTime(True);
    //ShowMessage('TtsDateTime Create Step 7');
end;

destructor TtsDateTime.Destroy;
begin
    inherited;
end;

procedure TtsDateTime.Assign(Source: TPersistent);
const
    NoAssignProps = 'Height;Left;Name;Top;Width;Visible';
begin
    if Source is TtsDateTime then
    begin
        BeginUpdate;
        try
            AssignObject(Self, Source, NoAssignProps);
        finally
            EndUpdate;
        end;
    end
    else
        inherited;
end;

procedure TtsDateTime.InvalidOp(Msg: string);
begin
    if Name <> ''
        then raise Exception.Create(Name + ': ' + Msg)
        else raise Exception.Create(Owner.Name + ': ' + Msg);
end;

procedure TtsDateTime.CMFontChanged(var Message: TMessage);
begin
    inherited;
    ReAlign;
end;

procedure TtsDateTime.CreateWnd;
begin
    inherited;
    InitMonthCombo;
    PositionControls;
end;

procedure TtsDateTime.KeyDown(var Key: Word; Shift: TShiftState);
begin
    inherited;
    if Key <> 0 then DateGridKeyDown(Self, Key, Shift);
    if Key <> 0 then
    begin
        case Key of
            VK_ESCAPE:
                begin
                    Close(False);
                    Key := 0;
                end;
            VK_RETURN:
                begin
                    Close(True);
                    Key := 0;
                end;
        end;
    end;
end;

procedure TtsDateTime.CreateControls;
begin
    FPnlTime := TPanel.Create(Self);
    FPnlEditTime := TPanel.Create(FPnlTime);
    FButOK := TSpeedButton.Create(Self);
    FButCancel := TSpeedButton.Create(Self);
    FBevel := TBevel.Create(Self);

    FButHourIncr := TSpeedButton.Create(FPnlTime);
    FButHourDecr := TSpeedButton.Create(FPnlTime);
    FButMinIncr := TSpeedButton.Create(FPnlTime);
    FButMinDecr := TSpeedButton.Create(FPnlTime);
    FButSecIncr := TSpeedButton.Create(FPnlTime);
    FButSecDecr := TSpeedButton.Create(FPnlTime);
    FButAMPMIncr := TSpeedButton.Create(FPnlTime);
    FButAMPMDecr := TSpeedButton.Create(FPnlTime);
    FTxtHour := TEdit.Create(FPnlEditTime);
    FTxtMinute := TEdit.Create(FPnlEditTime);
    FTxtSeconds := TEdit.Create(FPnlEditTime);
    FTxtAMPM := TEdit.Create(FPnlEditTime);
    FLblSep1 := TLabel.Create(FPnlEditTime);
    FLblSep2 := TLabel.Create(FPnlEditTime);

    FPnlTime.Parent := Self;
    FPnlEditTime.Parent := FPnlTime;
    FButOK.Parent := Self;
    FButCancel.Parent := Self;
    FBevel.Parent := Self;

    FButHourIncr.Parent := FPnlTime;
    FButHourDecr.Parent := FPnlTime;
    FButMinIncr.Parent := FPnlTime;
    FButMinDecr.Parent := FPnlTime;
    FButSecIncr.Parent := FPnlTime;
    FButSecDecr.Parent := FPnlTime;
    FButAMPMIncr.Parent := FPnlTime;
    FButAMPMDecr.Parent := FPnlTime;
    FTxtHour.Parent := FPnlEditTime;
    FTxtMinute.Parent := FPnlEditTime;
    FTxtSeconds.Parent := FPnlEditTime;
    FTxtAMPM.Parent := FPnlEditTime;
    FLblSep1.Parent := FPnlEditTime;
    FLblSep2.Parent := FPnlEditTime;

    FPnlDate := TPanel.Create(Self);
    FPnlCalendar := TPanel.Create(FPnlDate);
    FDateGrid := TtsGrid.Create(FPnlCalendar);
    FButYearIncr := TSpeedButton.Create(FPnlDate);
    FButYearDecr := TSpeedButton.Create(FPnlDate);
    FTxtYear := TEdit.Create(FPnlDate);
    FPnlEditYear := TPanel.Create(FPnlDate);
    FComboMonth := TtsGrid.Create(FPnlDate);
    FComboBevel := TBevel.Create(FPnlDate);
    FDateScrollBar := TScrollBar.Create(FPnlDate);

    FPnlDate.Parent := Self;
    FPnlCalendar.Parent := FPnlDate;
    FDateGrid.Parent := FPnlCalendar;
    FButYearIncr.Parent := FPnlDate;
    FButYearDecr.Parent := FPnlDate;
    FTxtYear.Parent := FPnlEditYear;
    FPnlEditYear.Parent := FPnlDate;
    FComboMonth.Parent := FPnlDate;
    FComboBevel.Parent := FPnlDate;
    FDateScrollBar.Parent := FPnlDate;

    FTimKeyDownDelay := TTimer.Create(Self);
end;

procedure TtsDateTime.InitControlProperties;
var
    I: Integer;
begin
    //ShowMessage('TtsDateTime Create Step 5-1');
    Left := 0;
    Top := 0;
    BevelOuter := bvNone;
    BorderStyle := bsSingle;
    Ctl3D := False;
    ParentCtl3D := False;

    //ShowMessage('TtsDateTime Create Step 5-2');
    FPnlDate.BevelOuter := bvNone;
    FPnlDate.Ctl3D := True;
    FPnlDate.ParentCtl3D := False;
    FPnlDate.TabOrder := 0;

    ////ShowMessage('TtsDateTime Create Step 5-3');
    FButYearIncr.Layout := blGlyphBottom;
    FButYearIncr.OnMouseDown := butYearIncrMouseDown;
    FButYearIncr.OnMouseUp := butYearIncrMouseUp;

    FButYearDecr.Layout := blGlyphBottom;
    FButYearDecr.OnMouseDown := butYearDecrMouseDown;
    FButYearDecr.OnMouseUp := butYearDecrMouseUp;

    //ShowMessage('TtsDateTime Create Step 5-4');
    FComboMonth.Top := 1;
    FComboMonth.Left := 1;
    FComboMonth.TabOrder := 0;
    //ShowMessage('TtsDateTime Create Step 5-4b');
    FComboMonth.Cols := 1;
    //ShowMessage('TtsDateTime Create Step 5-4c');
    FComboMonth.Rows := 1;
    //ShowMessage('TtsDateTime Create Step 5-4d');
    FComboMonth.Ctl3D := False;
    FComboMonth.ParentCtl3D := False;
    FComboMonth.DefaultRowHeight := 18;
    FComboMonth.BorderStyle := bsNone;