cxcalendar.pas

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

  var
    ABorderWidth: Integer;
    AHeaderOffset: TRect;
  begin
    ABorderWidth := GetHeaderBorderWidth;
    AHeaderOffset := GetHeaderOffset;
    with FViewInfo do
    begin
      ArrowRects[caPrevMonth] := Rect(AHeaderOffset.Left + ABorderWidth,
        AHeaderOffset.Top + ABorderWidth,
        AHeaderOffset.Left + ABorderWidth + FColWidth - 2, AHeaderOffset.Top + FHeaderHeight - 1);
      ArrowRects[caNextMonth] := Rect(FDateRegionWidth - FColWidth + 2 - ABorderWidth - AHeaderOffset.Right,
        AHeaderOffset.Top + ABorderWidth, FDateRegionWidth - ABorderWidth - AHeaderOffset.Right,
        AHeaderOffset.Top + FHeaderHeight - 1);
      MonthRegion := Rect(ArrowRects[caPrevMonth].Right, AHeaderOffset.Top,
        ArrowRects[caNextMonth].Left, AHeaderOffset.Top + FHeaderHeight);
    end;
  end;

  procedure CalculateFourArrowsViewInfo;
  var
    ABorderWidth: Integer;
    AHeaderOffset: TRect;
    AMaxMonthNameWidth, AMonthNameWidth, ASpaceWidth: Integer;
    AYearTextWidth, AMaxYearTextWidth, I: Integer;
    AMonthRegionWidth: Integer;
    AConvertDate: TcxDateTime;
  begin
    ABorderWidth := GetHeaderBorderWidth;
    AHeaderOffset := GetHeaderOffset;
    AMaxMonthNameWidth := 0;
    Canvas.Font := Font;
    AMaxYearTextWidth := 0;
    AConvertDate := CalendarTable.FromDateTime(FirstDate);
    for I := 1 to CalendarTable.GetMonthsInYear(AConvertDate.Era, AConvertDate.Year) do
    begin
      AMonthNameWidth := Canvas.TextWidth(
        cxGetLocalMonthName(CalendarTable.AddMonths(FirstDate, I), CalendarTable));
      if AMonthNameWidth > AMaxMonthNameWidth then
        AMaxMonthNameWidth := AMonthNameWidth;
      AYearTextWidth := Canvas.TextWidth(
        cxGetLocalYear(CalendarTable.AddYears(FirstDate, I), CalendarTable));
      AMaxYearTextWidth := Max(AMaxYearTextWidth, AYearTextWidth);
    end;

    ASpaceWidth := FDateRegionWidth - ABorderWidth * 2 - AHeaderOffset.Left -
      AHeaderOffset.Right - AMaxMonthNameWidth - AMaxYearTextWidth - 4 * (FColWidth - 2);
    with FViewInfo do
    begin
      ArrowRects[caPrevMonth] := Rect(AHeaderOffset.Left + ABorderWidth,
        AHeaderOffset.Top + ABorderWidth,
        AHeaderOffset.Left + ABorderWidth + FColWidth - 2, AHeaderOffset.Top + FHeaderHeight - 1);
      ArrowRects[caNextYear] := Rect(FDateRegionWidth - FColWidth + 2 - ABorderWidth - AHeaderOffset.Right,
        AHeaderOffset.Top + ABorderWidth, FDateRegionWidth - ABorderWidth - AHeaderOffset.Right,
        AHeaderOffset.Top + FHeaderHeight - 1);
    end;
    AMonthRegionWidth := AMaxMonthNameWidth + ASpaceWidth * AMaxMonthNameWidth div
      (AMaxMonthNameWidth + AMaxYearTextWidth);
    with FViewInfo.ArrowRects[caNextMonth] do
    begin
      Left := FViewInfo.ArrowRects[caPrevMonth].Right + AMonthRegionWidth;
      Top := FViewInfo.ArrowRects[caPrevMonth].Top;
      Right := Left + FColWidth - 2;
      Bottom := FViewInfo.ArrowRects[caPrevMonth].Bottom;
    end;
    with FViewInfo do
    begin
      ArrowRects[caPrevYear] := ArrowRects[caNextMonth];
      OffsetRect(ArrowRects[caPrevYear], FColWidth - 2, 0);

      MonthRegion := Rect(ArrowRects[caPrevMonth].Right, AHeaderOffset.Top,
        ArrowRects[caNextMonth].Left, AHeaderOffset.Top + FHeaderHeight);
      YearRegion := Rect(ArrowRects[caPrevYear].Right, AHeaderOffset.Top,
        ArrowRects[caNextYear].Left, AHeaderOffset.Top + FHeaderHeight);
    end;
  end;

  function GetCalendarRect: TRect;
  begin
    with Result do
    begin
      Left := 0;
      Top := FViewInfo.MonthRegion.Bottom + 1;
      Right := FDateRegionWidth;
      Bottom := Top + FDaysOfWeekHeight + 6 * FRowHeight + 1;
    end;
  end;

begin
  if Kind = ckDateTime then
    FViewInfo.CurrentDateRegion := GetCurrentDateRegion;
  if ArrowsForYear then
  begin
    FViewInfo.LastVisibleArrow := caNextYear;
    CalculateFourArrowsViewInfo;
  end
  else
  begin
    FViewInfo.LastVisibleArrow := caNextMonth;
    CalculateTwoArrowsViewInfo;
  end;
  with FViewInfo do
    HeaderRegion := Rect(0, MonthRegion.Top, FDateRegionWidth,
      MonthRegion.Bottom);
  FViewInfo.CalendarRect := GetCalendarRect;
  OffsetMonthCalendar;
end;

procedure TcxCustomCalendar.CreateButtons;

  function CreateButton(ACaption: TcxResourceStringID; ATabOrder: Integer;
    ATag: TCalendarButton; ADefault: Boolean = False): TcxButton;
  begin
    Result := TcxButton.Create(Self);
    Result.TabOrder := ATabOrder;
    Result.UseSystemPaint := False;
    Result.Caption := cxGetResourceString(ACaption);
    Result.OnClick := ButtonClick;
    Result.Tag := Integer(ATag);
    Result.Default := ADefault;
  end;

begin
  FTodayButton := CreateButton(@cxSDatePopupToday, 1, btnToday);
  FNowButton := CreateButton(@cxSDatePopupNow, 2, btnNow);
  FClearButton := CreateButton(@cxSDatePopupClear, 3, btnClear);
  FOKButton := CreateButton(@cxSDatePopupOK, 4, btnOk, True);

  FTimeEdit := TcxTimeEdit.Create(Self);
  with FTimeEdit do
  begin
    ActiveProperties.Circular := True;
    ActiveProperties.OnChange := TimeChanged;
    TabOrder := 0;
  end;

  FClock := TcxClock.Create(Self);
  FClock.TabStop := False;
  FClock.LookAndFeel.MasterLookAndFeel := FOKButton.LookAndFeel;
end;

procedure TcxCustomCalendar.CorrectHeaderTextRect(var R: TRect);
begin
    if Kind = ckDateTime then
      Inc(R.Top)
    else
      Inc(R.Top, Integer(not Flat));
    Dec(R.Bottom);
end;

procedure TcxCustomCalendar.DoDateTimeChanged;
begin
  if Assigned(FOnDateTimeChanged) then FOnDateTimeChanged(Self);
end;

procedure TcxCustomCalendar.DoScrollArrow(Sender: TObject);
var
  AArrow: TcxCalendarArrow;
  P: TPoint;
begin
  P := ScreenToClient(InternalGetCursorPos);
  for AArrow := caPrevMonth to FViewInfo.LastVisibleArrow do
    if PtInRect(FViewInfo.ArrowRects[AArrow], P) then
      DoStep(AArrow);
end;

procedure TcxCustomCalendar.DrawHeader;
const
  HeaderBorders: array[Boolean] of TcxBorders = ([bBottom], cxBordersAll);
var
  ADate: TcxDateTime;
  AHeaderRect: TRect;
  AIsTransparent: Boolean;
  ASkinPainter: TcxCustomLookAndFeelPainterClass;

  procedure DrawArrows;
  const
    AArrowDirectionMap: array[TcxCalendarArrow] of TcxArrowDirection =
      (adLeft, adRight, adLeft, adRight);
  var
    AArrow: TcxCalendarArrow;
    P: TcxArrowPoints;
    R: TRect;
  begin
    for AArrow := caPrevMonth to FViewInfo.LastVisibleArrow do
    begin
      R := FViewInfo.ArrowRects[AArrow];
      if not AIsTransparent then
      begin
        if FFlat and (Kind = ckDate) then
          InternalPolyLine(Canvas, [Point(R.Left, R.Top), Point(R.Right - 1, R.Top)],
            GetHeaderColor, True);
        InternalPolyLine(Canvas, [Point(R.Left, R.Bottom - 1),
          Point(R.Right - 1, R.Bottom - 1)], GetHeaderColor, True);
        if FFlat and (Kind = ckDate) and (FOKButton.LookAndFeel.Painter <> TcxOffice11LookAndFeelPainter) then
          Inc(R.Top);
        Dec(R.Bottom);
      end;

      if not AIsTransparent then
        cxEditFillRect(Canvas.Handle, R, GetSolidBrush(GetHeaderColor));
      TcxUltraFlatLookAndFeelPainter.CalculateArrowPoints(R, P, AArrowDirectionMap[AArrow], False);
      Canvas.Brush.Color := clBtnText;
      Canvas.Pen.Color := clBtnText;
      Canvas.Polygon(P);

      Canvas.ExcludeClipRect(FViewInfo.ArrowRects[AArrow]);
    end;
  end;

  procedure DrawHeaderText(const S: string; R: TRect; AIsHighlighted: Boolean);
  var
    ATextSize: TSize;
  begin
    if AIsHighlighted then
      Canvas.Font.Color := GetHotTrackColor
    else
      Canvas.Font.Color := clBtnText;
    CorrectHeaderTextRect(R);
    ATextSize := Canvas.TextExtent(S);
    with R do
      TrueTextRect(Canvas.Canvas, R, Left + (Right - Left - ATextSize.cx) div 2,
        Top + (Bottom - Top - ATextSize.cy) div 2, S);
  end;

begin
  ASkinPainter := FOkButton.LookAndFeel.SkinPainter;
  AIsTransparent := (ASkinPainter <> nil) or (FOKButton.LookAndFeel.Painter = TcxWinXPLookAndFeelPainter);
  if ASkinPainter <> nil then
  begin
    ASkinPainter.DrawHeader(Canvas, FViewInfo.HeaderRegion, cxEmptyRect, [],
      HeaderBorders[Kind = ckDateTime], 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, FViewInfo.HeaderRegion);
  DrawArrows;

  ADate := CalendarTable.FromDateTime(FirstDate);
  Canvas.Font.Color  := clBtnText;
  Canvas.Brush.Color := GetHeaderColor;

  if AIsTransparent then
    Canvas.Brush.Style := bsClear;
  if ArrowsForYear then
  begin
    DrawHeaderText(cxGetLocalMonthName(FirstDate, CalendarTable), FViewInfo.MonthRegion, HotTrackRegion = chrMonth);
    DrawHeaderText(cxGetLocalYear(FirstDate, CalendarTable), FViewInfo.YearRegion, HotTrackRegion = chrYear);
  end else
    DrawHeaderText(cxGetLocalMonthYear(FirstDate, CalendarTable),
      FViewInfo.MonthRegion, HotTrackRegion = chrMonth);
  Canvas.Brush.Style := bsSolid;

  AHeaderRect := FViewInfo.HeaderRegion;
  if not AIsTransparent then
    if not FFlat then
      Canvas.DrawEdge(AHeaderRect, False, False, cxBordersAll)
    else
      if Kind = ckDateTime then
        Canvas.FrameRect(AHeaderRect, GetDateTimeHeaderFrameColor)
      else
        if FOKButton.LookAndFeel.Painter = TcxOffice11LookAndFeelPainter then
          Canvas.FrameRect(Rect(AHeaderRect.Left, AHeaderRect.Top - Office11HeaderOffset, AHeaderRect.Right, AHeaderRect.Bottom + Office11HeaderOffset - 1), Color, Office11HeaderOffset)
        else
          InternalPolyLine(Canvas, [Point(AHeaderRect.Left, AHeaderRect.Bottom - 1), Point(AHeaderRect.Right - 1, AHeaderRect.Bottom - 1)], GetDateHeaderFrameColor, True);
          
  Canvas.ExcludeClipRect(AHeaderRect);
end;

function TcxCustomCalendar.GetDateHeaderFrameColor: TColor;
begin
  if FOKButton.LookAndFeel.Painter = TcxOffice11LookAndFeelPainter then
    Result := Color
  else
    Result := clBtnText;
end;

function TcxCustomCalendar.GetDateFromCell(X, Y: Integer): Double;
begin
  Result := FirstDate - DayOfWeekOffset(FirstDate) + Y * 7 + X;
  if (DayOfWeekOffset(FirstDate) = 0) and (FirstDate > cxMinDateTime) then
    Result := Result - 7;
end;

function TcxCustomCalendar.GetDateTimeHeaderFrameColor: TColor;
begin
  if FOKButton.LookAndFeel.Painter = TcxOffice11LookAndFeelPainter then
    Result := Color
  else
    Result := clBtnShadow;
end;

function TcxCustomCalendar.GetHeaderColor: TColor;
begin
  if FOKButton.LookAndFeel.Painter = TcxOffice11LookAndFeelPainter then
    Result := TcxOffice11LookAndFeelPainter.DefaultDateNavigatorHeaderColor
  else
    Result := clBtnFace;
end;

function TcxCustomCalendar.GetHeaderOffset: TRect;
begin
  if (Kind = ckDate) and (FOKButton.LookAndFeel.Painter = TcxOffice11LookAndFeelPainter) then
    Result := Rect(Office11HeaderOffset, Office11HeaderOffset, Office11HeaderOffset, 0)
  else
    Result := cxEmptyRect;
end;

function TcxCustomCalendar.GetShowButtonsRegion: Boolean;
begin
  Result := (Kind = ckDateTime) or FTodayButton.Visible
    or FClearButton.Visible;
end;

function TcxCustomCalendar.GetTimeEditWidth: Integer;
var
  AEditSizeProperties: TcxEditSizeProperties;
begin
  AEditSizeProperties := DefaultcxEditSizeProperties;
  AEditSizeProperties.MaxLineCount := 1;
  Result := FTimeEdit.ActiveProperties.GetEditSize(Canvas, FTimeEdit.Style,
    True, 0, AEditSizeProperties).cx + Canvas.TextWidth('0');
end;

function TcxCustomCalendar.GetTimeFormat: TcxTimeEditTimeFormat;
begin
  Result := FTimeEdit.ActiveProperties.TimeFormat;
end;

function TcxCustomCalendar.GetUse24HourFormat: Boolean;
begin
  Result := FTimeEdit.ActiveProperties.Use24HourFormat;
end;

function TcxCustomCalendar.GetWeekNumbersRegionWidth: Integer;
begin
  if WeekNumbers then
    Result := FWeekNumberWidth + WeekNumbersDelimiterOffset.Left +
      WeekNumbersDelimiterWidth + WeekNumbersDelimiterOffset.Right
  else
    Result := 0;
end;

procedure TcxCustomCalendar.GetVisibleButtonList(AList: TList);
begin
  if btnToday in CalendarButtons then
    AList.Add(FTodayButton);
  if (Kind = ckDateTime) and (btnNow in CalendarButtons) then
    AList.Add(FNowButton);
  if btnClear in CalendarButtons then
    AList.Add(FClearButton);
  if Kind = ckDateTime then
    AList.Add(FOKButton);
end;

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

procedure TcxCustomCalendar.SetCalendarButtons(Value: TDateButtons);
begin
  if Value <> FCalendarButtons then
  begin
    FCalendarButtons := Value;
    FClearButton.Visible := btnClear in Value;
    FNowButton.Visible := btnNow in Value;
    FTodayButton.Visible := btnToday in Value;
    Calculate;
  end;
end;

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

procedure TcxCustomCalendar.SetHotTrackRegion(Value: TcxCalendarHotTrackRegion);

  function GetHotTrackRegion(AHotTrackRegion: TcxCalendarHotTrackRegion): TRect;
  begin
    if AHotTrackRegion = chrMonth then
      Result := FViewInfo.MonthRegion
    else
      Result := FViewInfo.YearRegion;
  end;