cxcalendar.pas

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

begin
  if Value <> FHotTrackRegion then
  begin
    if FHotTrackRegion <> chrNone then
      InvalidateRect(GetHotTrackRegion(FHotTrackRegion), False);
    FHotTrackRegion := Value;
    if FHotTrackRegion <> chrNone then
      InvalidateRect(GetHotTrackRegion(FHotTrackRegion), False);

    if Value = chrNone then
      Screen.Cursor := FPrevCursor
    else
    begin
      FPrevCursor := Screen.Cursor;
//      Screen.Cursor := crcxEditMouseWheel;
    end;
  end;
end;

procedure TcxCustomCalendar.SetKind(Value: TcxCalendarKind);
begin
  if Value <> FKind then
  begin
    FKind := Value;
    Calculate;
    if Value = ckDate then
      ControlStyle := ControlStyle - [csDoubleClicks, csClickEvents]
    else
      ControlStyle := ControlStyle + [csDoubleClicks, csClickEvents];
  end;
end;

procedure TcxCustomCalendar.SetTimeFormat(Value: TcxTimeEditTimeFormat);
begin
  if Value <> TimeFormat then
  begin
    FTimeEdit.ActiveProperties.TimeFormat := Value;
    Calculate;
  end;
end;

procedure TcxCustomCalendar.SetUse24HourFormat(Value: Boolean);
begin
  if Value <> Use24HourFormat then
  begin
    FTimeEdit.ActiveProperties.Use24HourFormat := Value;
    Calculate;
  end;
end;

procedure TcxCustomCalendar.SetWeekNumbers(Value: Boolean);
begin
  if Value <> FWeekNumbers then
  begin
    FWeekNumbers := Value;
    Calculate;
  end;
end;

procedure TcxCustomCalendar.TimeChanged(Sender: TObject);
var
  R: TRect;
begin
  FClock.Time := FTimeEdit.Time;
  R := Rect(0, 0, Width, FHeaderHeight - 1);
  if not FFlat then
    InflateRect(R, -1, -1);
  InvalidateRect(R, False);
end;

procedure TcxCustomCalendar.FontChanged;
begin
  inherited FontChanged;
  Calculate;
end;

procedure TcxCustomCalendar.DblClick;
var
  ADate: TDateTime;
begin
  inherited DblClick;
  if Kind = ckDateTime then
  begin
    ADate := PosToDateTime(ScreenToClient(InternalGetCursorPos));
    if ADate <> NullDate then
    begin
      SelectDate := ADate;
      HidePopup(Self, crEnter);
      DoDateTimeChanged;
    end;
  end;
end;

function TcxCustomCalendar.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
const
  AArrowMap: array[Boolean, Boolean] of TcxCalendarArrow =
    ((caPrevMonth, caNextMonth), (caPrevYear, caNextYear));
begin
  Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  MousePos := ScreenToClient(MousePos);
  if not Result and not FMonthListBox.IsVisible and (PtInRect(FViewInfo.MonthRegion, MousePos) or
    PtInRect(FViewInfo.YearRegion, MousePos)) then
  begin
    Result := True;
    DoStep(AArrowMap[PtInRect(FViewInfo.YearRegion, MousePos), WheelDelta < 0]);
  end;
end;

function TcxCustomCalendar.HasBackground: Boolean;
begin
  // for correctly work with manifest
  Result := FTodayButton.LookAndFeel.NativeStyle and AreVisualStylesAvailable;
end;

procedure TcxCustomCalendar.InitControl;
begin
  inherited InitControl;
  FClearButton.Parent := Self;
  FOKButton.Parent := Self;
  FNowButton.Parent := Self;
  FTodayButton.Parent := Self;
  FClock.Parent := Self;
  FTimeEdit.Parent := Self;
  FontChanged;
end;

procedure TcxCustomCalendar.KeyDown(var Key: Word; Shift: TShiftState);
var
  ADate: TcxDateTime;

  procedure MoveByMonth(AForward: Boolean);
  begin
    ADate := CalendarTable.FromDateTime(SelectDate);
    if AForward then
      SelectDate := CalendarTable.AddMonths(SelectDate, 1)
    else
      SelectDate := CalendarTable.AddMonths(SelectDate, -1);
  end;

begin
  ADate := CalendarTable.FromDateTime(SelectDate);
  case Key of
    VK_LEFT:
        SelectDate := SelectDate - 1;
    VK_RIGHT: SelectDate := SelectDate + 1;
    VK_UP:
      if not (Shift = [ssAlt]) then SelectDate := SelectDate - 7;
    VK_DOWN:
      if not (Shift = [ssAlt]) then SelectDate := SelectDate + 7;
    VK_HOME:
      if Shift = [ssCtrl] then
      begin
        ADate.Day := 1;
        SelectDate := CalendarTable.ToDateTime(ADate);
      end
      else
        SelectDate := SelectDate - DayOfWeekOffset(SelectDate);
    VK_END:
      if Shift = [ssCtrl] then
      begin
        ADate.Day := CalendarTable.GetDaysInMonth(ADate.Era, ADate.Year, ADate.Month);
        SelectDate := CalendarTable.ToDateTime(ADate);
      end
      else SelectDate := SelectDate + (6 - DayOfWeekOffset(SelectDate));
    VK_PRIOR: MoveByMonth(False);
    VK_NEXT: MoveByMonth(True)
  end;
  inherited KeyDown(Key, Shift);
end;

procedure TcxCustomCalendar.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);

  function GetMonthPopupRect: TRect;
  begin
    Result := FViewInfo.MonthRegion;
    CorrectHeaderTextRect(Result);
  end;

var
  ADate: Double;
  AArrow: TcxCalendarArrow;
  P: TPoint;
begin
  inherited MouseDown(Button, Shift, X, Y);
  CheckHotTrack;
  if Button <> mbLeft then
    Exit;
  P := Point(X, Y);
  ADate := PosToDateTime(P);
  if ADate <> NullDate then
    InternalSetSelectDate(ADate, False)
  else
  begin
    for AArrow := caPrevMonth to FViewInfo.LastVisibleArrow do
      if PtInRect(FViewInfo.ArrowRects[AArrow], P) then
      begin
        DoStep(AArrow);
        FTimer.Enabled := True;
        Exit;
      end;
    if PtInRect(GetMonthPopupRect, P) then
      FMonthListBox.Popup(Self);
  end;
end;

procedure TcxCustomCalendar.MouseEnter(AControl: TControl);
begin
  inherited MouseEnter(AControl);
  CheckHotTrack;
  BeginMouseTracking(Self, GetControlRect(Self), Self);
end;

procedure TcxCustomCalendar.MouseLeave(AControl: TControl);
begin
  inherited MouseLeave(AControl);
  CheckHotTrack;
  EndMouseTracking(Self);
end;

procedure TcxCustomCalendar.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  ADate: Double;
begin
  CheckHotTrack;
  BeginMouseTracking(Self, GetControlRect(Self), Self);
  if FTimer.Enabled then
    Exit;
  ADate := NullDate;
  if ssLeft in Shift then
    ADate := PosToDateTime(Point(X, Y));
  inherited MouseMove(Shift, X, Y);
  if (ssLeft in Shift) and (ADate <> NullDate) then
    InternalSetSelectDate(ADate, False);
end;

procedure TcxCustomCalendar.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);

  function GetMonthRegion: TRect;
  begin
    Result := FViewInfo.MonthRegion;
    CorrectHeaderTextRect(Result);
  end;

  function GetYearRegion: TRect;
  begin
    Result := FViewInfo.YearRegion;
    CorrectHeaderTextRect(Result);
  end;

var
  P: TPoint;
begin
  inherited MouseUp(Button, Shift, X, Y);
  CheckHotTrack;
  if FTimer.Enabled then
  begin
    FTimer.Enabled := False;
    Exit;
  end;
  P := Point(X, Y);
  if (Kind = ckDate) and PtInRect(ClientRect, P) and
    not PtInRect(GetMonthRegion, P) and not PtInRect(GetYearRegion, P) then
  begin
    HidePopup(Self, crEnter);
    if PosToDateTime(P) <> NullDate then
      DoDateTimeChanged;
  end;
  if (Kind = ckDateTime) and (SelectDate <> NullDate) then
    FirstDate := DateOf(SelectDate);
end;

procedure TcxCustomCalendar.Paint;  

  procedure DrawCurrentDateRegion;
  var
    ATextSize: TSize;
    R: TRect;
    S: string;
  begin
    R := FViewInfo.CurrentDateRegion;
    if FOKButton.LookAndFeel.SkinPainter <> nil then
    begin
      InflateRect(R, 1, 0);
      FOKButton.LookAndFeel.SkinPainter.DrawHeader(Canvas, R, cxEmptyRect, [],
        [], cxbsNormal, taCenter, vaCenter, False, False, '', Font, 0, 0)
    end    
    else
      if FOKButton.LookAndFeel.Painter = TcxWinXPLookAndFeelPainter then
        DrawThemeBackground(OpenTheme(totHeader), Canvas.Handle,
          HP_HEADERITEMLEFT, HIS_NORMAL, R)
      else
        if FOKButton.LookAndFeel.Painter <> TcxOffice11LookAndFeelPainter then
        begin
          if FFlat then
          begin
            with R do
              InternalPolyLine(Canvas, [Point(Left, Bottom - 1),
                Point(Right - 1, Bottom - 1)], clBtnText, True);
            Dec(R.Bottom);
          end else
          begin
            Canvas.DrawEdge(R, False, False, cxBordersAll);
            InflateRect(R, -1, -1);
          end;
        end;
    S := cxDateToLocalFormatStr(SelectDate + cxSign(SelectDate) * FTimeEdit.Time);
    Canvas.Font := Font;
    Canvas.Font.Color := clBtnText;
    Canvas.Brush.Color := GetHeaderColor;
    ATextSize := Canvas.TextExtent(S);
    if (FOKButton.LookAndFeel.SkinPainter <> nil) or
      (FOKButton.LookAndFeel.Painter = TcxWinXPLookAndFeelPainter)
    then
      Canvas.Brush.Style := bsClear;
    TrueTextRect(Canvas.Canvas, R, R.Left + (R.Right - R.Left - ATextSize.cx) div 2,
      R.Top + (R.Bottom - R.Top - ATextSize.cy) div 2, S);
    Canvas.Brush.Style := bsSolid;
    Canvas.ExcludeClipRect(FViewInfo.CurrentDateRegion);
  end;

  procedure DrawWeekNumbers;
  var
    I: Integer;
    R: TRect;
  begin
    if not WeekNumbers then
      Exit;
    Canvas.Brush.Color := Color;
    Canvas.Font := Font;
    Canvas.Font.Size := MulDiv(Canvas.Font.Size, 2, 3);
    for I := 0 to 5 do
    begin
      if not cxEditIsDateValid(GetDateFromCell(0, I)) then
        Continue;
      R.Left := FViewInfo.CalendarRect.Left + FSideWidth;
      R.Top := FViewInfo.CalendarRect.Top + FDaysOfWeekHeight + FRowHeight * I;
      R.Right := R.Left + FWeekNumberWidth;
      R.Bottom := R.Top + FRowHeight;

      Canvas.DrawTexT(IntToStr(CalendarTable.GetWeekNumber(GetDateFromCell(0, I),
        TDay(cxFormatController.StartOfWeek), cxFormatController.FirstWeekOfYear)),
        R, cxAlignRight or cxAlignVCenter);
    end;
    Canvas.Font := Font;
  end;

  procedure DrawMonth;
  var
    ACurDate, ADate, ALastDate: Double;
    ASelected: Boolean;
    ASideRect, ATextRect, R: TRect;
    ASize: TSize;
    AWeekNumbersDelimiterPos, I, J: Integer;
    S: string;
  begin
    ACurDate := Date;
    ALastDate := GetLastDate;
    with Canvas do
    begin
      // write first letters of day's names
      Brush.Color := Self.Color;
      R := FViewInfo.CalendarRect;
      with ATextRect do
      begin
        Left := R.Left + FSideWidth + GetWeekNumbersRegionWidth;
        Right := R.Right - FSideWidth;
        Top := R.Top;
        Bottom := Top + FDaysOfWeekHeight - 2;
        FillRect(Rect(Left - 8, Top, Left, Bottom + 2));
        FillRect(Rect(Right, Top, Right + 8, Bottom + 2));

        InternalPolyLine(Self.Canvas, [Point(Left, Bottom),
          Point(Right - 1, Bottom)], clBtnShadow, True);
        InternalPolyLine(Self.Canvas, [Point(Left, Bottom + 1),
          Point(Right - 1, Bottom + 1)], clWindow, True);
        if (Kind = ckDate) and ShowButtonsRegion then
          InternalPolyLine(Self.Canvas, [Point(Left, ClientHeight - FButtonsRegionHeight - 1),
            Point(Right - 1, ClientHeight - FButtonsRegionHeight - 1)], clBtnShadow, True);
        if WeekNumbers then
        begin
          AWeekNumbersDelimiterPos := R.Left + FSideWidth + FWeekNumberWidth + WeekNumbersDelimiterOffset.Left;
          Brush.Color := Self.Color;
          FillRect(Rect(R.Left, Top, AWeekNumbersDelimiterPos, R.Bottom));
          InternalPolyLine(Self.Canvas, [Point(AWeekNumbersDelimiterPos, R.Top),
            Point(AWeekNumbersDelimiterPos, Bottom - 1)], Self.Color, True);
          if (Kind = ckDate) and ShowButtonsRegion then
          begin
            InternalPolyLine(Self.Canvas, [Point(AWeekNumbersDelimiterPos, Bottom),
              Point(AWeekNumbersDelimiterPos, ClientHeight - FButtonsRegionHeight - 1)], clBtnShadow, True);
            InternalPolyLine(Self.Canvas, [Point(AWeekNumbersDelimiterPos + 1, ClientHeight - FButtonsRegionHeight - 1),
              Point(AWeekNumbersDelimit