tsdatetime.pas

企业进销存管理系统

    if VarIsEmpty(Value) then
        Result := Date
    else if (Value < MinDate) or (Value > MaxDate) then
    begin
        if (Date >= MinDate) and (Date <= MaxDate)
            then Result := Date
            else Result := Value;
    end
    else
        Result := Value;

    Direction := 1;
    if (Result < MinDate) then
    begin
        Result := MinDate;
        Direction := 1;
    end
    else if Result > MaxDate then
    begin
        Result := MaxDate;
        Direction := -1;
    end;

    if Direction = 1 then
    begin
        NewDate := Result;
        if (DayOfWeek(NewDate) = 7) and not SelectSaturday then NewDate := NewDate + 1;
        if (DayOfWeek(NewDate) = 1) and not SelectSunday then NewDate := NewDate + 1;
        if NewDate <= MaxDate then
            Result := NewDate
        else
        begin
            if (DayOfWeek(Result) = 1) and not SelectSunday then Result := Result - 1;
            if (DayOfWeek(Result) = 7) and not SelectSaturday then Result := Result - 1;
        end;
    end;

    if Direction = -1 then
    begin
        NewDate := Result;
        if (DayOfWeek(NewDate) = 1) and not SelectSunday then NewDate := NewDate - 1;
        if (DayOfWeek(NewDate) = 7) and not SelectSaturday then NewDate := NewDate - 1;
        if NewDate >= MinDate then
            Result := NewDate
        else
        begin
            if (DayOfWeek(Result) = 7) and not SelectSaturday then Result := Result + 1;
            if (DayOfWeek(Result) = 1) and not SelectSunday then Result := Result + 1;
        end;
    end;
end;

function TtsDateTime.SetSelectedDate(Value: Variant): TDateTime;
var
    CurDate: TDate;
begin
    CurDate := GetValidDate(Value);
    FSelectedDate := Trunc(CurDate);
    FSelectedRMY := Date2RMYvalue(CurDate);
    FValidDateSelected := True;
    Result := CurDate;
end;

procedure TtsDateTime.SetDisplayDate(Value: TDateTime);
var
    D, M, Y: Word;
begin
    DecodeDate(Value, Y, M, D);
    FDisplayYear := Y;
    FDisplayMonth := M;
    FDisplayRowInMonth := 1;
end;

procedure TtsDateTime.SetSelectedDateInView(Invert: Boolean);
var
    StartDate: TdateTime;
begin
    if GetMinDateInView(StartDate) then
    begin
        if VarIsEmpty(FSelectedDate) then
        begin
            SetSelectedDate(StartDate);
            if Invert then InvertSelectedDate;
        end
        else if (DatePart('y', FSelectedDate) <> DatePart('y', StartDate)) or
                (DatePart('m', FSelectedDate) <> DatePart('m', StartDate)) then
        begin
            SetSelectedDate(StartDate);
            if Invert then InvertSelectedDate;
        end;
    end;
end;

procedure TtsDateTime.SetCurDateTime(Init: Boolean);
var
    CurDate: TDate;
    T: TTime;
begin
    //ShowMessage('TtsDateTime Create Step 6a');
    FMaxYear := DatePart('y', MaxDate);
    FMinYear := DatePart('y', MinDate);
    //ShowMessage('TtsDateTime Create Step 6b');
    FMaxRowMonthYear := DetermineMaxRowMonthYear();
    FTodayRMY := Date2RMYvalue(Date);

    //ShowMessage('TtsDateTime Create Step 6c');
    if Init then
    begin
        CurDate := SetSelectedDate(DateTime);
        SetDisplayDate(CurDate);
    end;
    //ShowMessage('TtsDateTime Create Step 6d');
    RefreshData(False);
    //ShowMessage('TtsDateTime Create Step 6e');
    FOldScrollBarPosition := FDateScrollBar.Position;

    SetComboValue;
    ////ShowMessage('TtsDateTime Create Step 6f');
    if VarIsEmpty(DateTime)
        then T := Time
        else T := Frac(DateTime);

    FTxtAMPM.Text := TimePart('ampm', T);
    FTxtHour.Text := TimePart('h', T);
    FTxtMinute.Text := TimePart('n', T);
    if ShowSeconds
        then FTxtSeconds.Text := TimePart('s', T)
        else FTxtSeconds.Text := '00';

    FPrevHour := StrToInt(FTxtHour.Text);
    FPrevMinute := StrToInt(FTxtMinute.Text);
    FPrevSeconds := StrToInt(FTxtSeconds.Text);
    ////ShowMessage('TtsDateTime Create Step 6g');
end;

procedure TtsDateTime.CheckCurDateTime(Init: Boolean);
begin
    if IsUpdating then Exit;
    SetCurDateTime(Init);
end;

procedure TtsDateTime.SetControlColors;
var
    Color: TColor;
begin
    Color := clWindow;
    if not PopupForm then Color := DisabledColor;

    if FComboMonth.Color <> Color then FComboMonth.Color := Color;
    if FTxtYear.Color <> Color then FTxtYear.Color := Color;
    if FPnlEditYear.Color <> Color then FPnlEditYear.Color := Color;

    if FPnlEditTime.Color <> Color then FPnlEditTime.Color := Color;
    if FLblSep1.Color <> Color then FLblSep1.Color := Color;
    if FLblSep2.Color <> Color then FLblSep2.Color := Color;

    if FTxtHour.Color <> Color then FTxtHour.Color := Color;
    if FTxtMinute.Color <> Color then FTxtMinute.Color := Color;
    if FTxtSeconds.Color <> Color then FTxtSeconds.Color := Color;
    if FTxtAMPM.Color <> Color then FTxtAMPM.Color := Color;
end;

procedure TtsDateTime.SetOkButtonPos;
var
    Metric: TTextMetric;
    AvailableWidth, ButCancelWidth, ButOkWidth, MinButWidth: Integer;
    ButHeight: Integer;
begin
    GetTextMetrics(Canvas.Handle, Metric);
    FButOK.Caption := OkCaption;
    FButCancel.Caption := CancelCaption;

    ButOkWidth := Canvas.TextWidth(FButOK.Caption) + Metric.tmOverhang;
    ButCancelWidth := Canvas.TextWidth(FButCancel.Caption) + Metric.tmOverhang;
    MinButWidth := Max(DefaultButWidth, Max(ButOkWidth, ButCancelWidth) + 10);

    if not PopupForm and (DateTimeDisplay = dtDateTime) then
    begin
        FButOK.Height := Max(DefaultButHeight, FPnlEditTime.Height + 2);
        FButOk.Top := FPnlTime.Top + FPnlTime.Height - FButOk.Height - 1;

        if FPnlTime.Width + ButOKWidth + 11 < FPnlDate.Width then
        begin
            FButOK.Width := Min(MinButWidth, FPnlDate.Width - FPnlTime.Width - 8);
            FButOK.Left := FPnlDate.Left + FPnlDate.Width - FButOK.Width ;
        end
        else
        begin
            FButOK.Width := ButOKWidth;
            FButOK.Left := FPnlDate.Left + FPnlDate.Width - FButOK.Width ;
        end;

        FButCancel.Width := FButOK.Width;
        FButOK.Visible := True;
        FButCancel.Visible := False;
        FBevel.Visible := False;
    end
    else if not PopupForm and (DateTimeDisplay = dtTime) then
    begin
        FButOK.Height := DefaultButHeight;
        FButOk.Top := FPnlTime.Top;
        FButOk.Left := FPnlTime.Left + FPnlTime.Width + 8;
        FButOk.Width := MinButWidth;
        FButOK.Visible := True;
        FButCancel.Visible := False;
        FBevel.Visible := False;
    end
    else if PopupForm then
    begin
        ButHeight := DefaultButHeight;

        if FPnlTime.Visible
            then FButOk.Top := FPnlTime.Top + FPnlTime.Height + 8
            else FButOk.Top := FPnlDate.Top + FPnlDate.Height + 10;

        FButOk.Height := ButHeight;
        FButCancel.Top := FButOk.Top;
        FButCancel.Height := FButOk.Height;

        if DateTimeDisplay = dtTime
            then AvailableWidth := (MinButWidth * 2) + 16
            else AvailableWidth := ClientWidth - 16;

        if MinButWidth * 2 <= AvailableWidth
            then FButOk.Width := MinButWidth
            else FButOk.Width := (AvailableWidth div 2);
        FButCancel.Width := FButOk.Width;

        if DateTimeDisplay = dtTime then
        begin
            FButOk.Left := 8;
            FButCancel.Left := FButOk.Left + FButOk.Width + 8;
        end
        else
        begin
            FButOk.Left := (ClientWidth - (FButOk.Width + FButCancel.Width + 8)) div 2;
            FButCancel.Left := FButOk.Left + FButOk.Width + 8;
        end;

        if DateTimeDisplay <> dtTime then
        begin
            FBevel.Left := -1;
            FBevel.Top := FButOk.Top - 6;
            FBevel.Width := Self.Width + 1;
            FBevel.Visible := True;
        end
        else
            FBevel.Visible := False;

        FButOk.Visible := True;
        FButCancel.Visible := True;
    end
    else
    begin
        FBevel.Visible := False;
        FButOk.Visible := False;
        FButCancel.Visible := False;
    end;
end;

procedure TtsDateTime.SetCalendarHeight;
var
    NewHeight: Integer;
begin
    if DateTimeDisplay in [dtTime, dtDateTime]
        then NewHeight := FPnlTime.Top + FPnlTime.Height + 3
        else NewHeight := FPnlDate.Top * 2 + FPnlDate.Height;
    if FButCancel.Visible then
        NewHeight := Max(NewHeight, FButCancel.Top + FButCancel.Height + 4);
    ClientHeight := NewHeight;
end;

procedure TtsDateTime.SetDayNames;
var
    I, J: Integer;
begin
    for I := 1 to 7 do
    begin
        if (FirstDayOfWeek = dowSunday) then
            J := I
        else if (I = 7) then
            J := 1 
        else
            J := I + 1;

        case ShowDayNames of
            sdnFirstLetter: FDayNames[I] := UpperCase(Copy(ShortDayNames[J], 1, 1));
            sdnShortDayNames: FDayNames[I] := ShortDayNames[J];
            else FDayNames[I] := '';
        end;
    end;
end;

procedure TtsDateTime.PositionDateGrid;
var
    I: Integer;
    Width: Integer;
    Metric: TTextMetric;
begin
    FDateGrid.ResetSelection;
    FDateGrid.Canvas.Font.Assign(Canvas.Font);
    FDateGrid.DefaultRowHeight := FDateGrid.Canvas.TextHeight('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVXWYZ1234567890') + 2;

    //determine max width needed in columns
    Width := FDateGrid.Canvas.TextWidth('00');
    Width := Max(Width, FDateGrid.DefaultRowHeight);

    if ShowDayNames <> sdnNone then
    begin
        SetDayNames;
        for I := 1 to 7 do
        begin
            if FDateGrid.Canvas.TextWidth(FDayNames[I]) > Width then
                Width := FDateGrid.Canvas.TextWidth(FDayNames[I]);
        end;
    end;

    //setup columns
    GetTextMetrics(FDateGrid.Canvas.handle, Metric);
    Width := Width + Metric.tmOverhang;

    If (fsItalic in FDateGrid.Font.Style) and (Metric.tmOverhang = 0) then
        Width := Round(Width * 1.2);

    for I := 2 to 8 do
        FDateGrid.Col[I].Width := Max(15, Width) + 3;

    //setup column with weeknumbers
    FDateGrid.Col[1].Width := Max(7, FDateGrid.Canvas.TextWidth('53') + Metric.tmOverhang) + 1;
    FDateGrid.Col[1].Width := Round(FDateGrid.Col[1].Width * 1.5);
    If (fsItalic in FDateGrid.Font.Style) and (Metric.tmOverhang = 0) then
        FDateGrid.Col[1].Width := Round(FDateGrid.Col[1].Width * 1.2);

    FDateGrid.Col[1].Visible := ShowWeekNumbers;

    //setup rows
    FDateGrid.Rows := CalcGridRows;
    for I := 1 to FDateGrid.Rows do
    begin
        FDateGrid.ResetRowFont(I);
        FDateGrid.AssignRowFont(I);
        FDateGrid.RowHeight[I] := FDateGrid.DefaultRowHeight;
    end;
end;

procedure TtsDateTime.PositionMonthCombo(TextHeight: Integer);
var
    I: Integer;
    Width: Integer;
    BitmapCombo: TBitmap;
    ComboHeight: Integer;
begin
    Width := 0;
    for I := 1 to 12 do