cxcalendar.pas

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

      Result := ToDateTime(ADate);
    end;
end;

function TcxMonthListBox.GetShowYears: Boolean;
begin
  Result := not Calendar.ArrowsForYear or Calendar.YearsInMonthList;
end;

procedure TcxMonthListBox.SetItemIndex(Value: Integer);

  procedure InvalidateItemRect(AIndex: Integer);
  var
    R: TRect;
  begin
    if AIndex <> -1 then
    begin
      R.Left := BorderWidths[bLeft];
      R.Top := AIndex * ItemHeight + BorderWidths[bTop];
      R.Right := Width - BorderWidths[bRight];
      R.Bottom := R.Top + ItemHeight;
      cxInvalidateRect(Handle, R, False);
    end;
  end;

var
  APrevItemIndex: Integer;
begin
  if not HandleAllocated then Exit;
  if FItemIndex <> Value then
  begin
    if FItemIndex <> Value then
    begin
      begin
        APrevItemIndex := FItemIndex;
        FItemIndex := Value;
        InvalidateItemRect(APrevItemIndex);
        InvalidateItemRect(FItemIndex);
      end
    end;
  end;
end;

procedure TcxMonthListBox.SetTopMonthDelta(Value: Integer);
begin
  if FTopMonthDelta <> Value then
  begin
    FTopMonthDelta := Value;
    Repaint;
  end;
end;

function TcxMonthListBox.CalculatePosition: TPoint;
begin
  Result := FOrigin;
end;

procedure TcxMonthListBox.Click;
var
  ADate: TcxDateTime;
begin
  inherited Click;
  CloseUp;
  ADate := CalendarTable.FromDateTime(CalendarTable.AddMonths(FCurrentDate, -FCurrentDate.Month + 1));
  ADate.Day := 1;
  if ItemIndex <> -1 then
    Calendar.SetFirstDate(CalendarTable.AddMonths(CalendarTable.ToDateTime(ADate),
      ItemIndex));
end;

procedure TcxMonthListBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
end;

procedure TcxMonthListBox.DoShowed;
begin
  if ShowYears then
    SetCaptureControl(Self)
  else
    SetCaptureControl(nil);
end;

procedure TcxMonthListBox.FontChanged;
begin
  Canvas.Font := Font;
  with Calendar do
  begin
    FItemHeight := FHeaderHeight - 2;
    Self.Width := 6 * FColWidth + 2;
    Self.Height := FItemCount * FItemHeight + 2;
  end;
end;

procedure TcxMonthListBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if ShowYears then
    CloseUp;
end;

procedure TcxMonthListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
const
  Times: array[0..3] of UINT = (500, 250, 100, 50);
var
  Delta: Integer;
  Interval: Integer;
begin
  if PtInRect(ClientRect, Point(X, Y)) then
  begin
    FTimer.Enabled := False;
    ItemIndex := Y div ItemHeight;
  end
  else
  begin
    ItemIndex := -1;
    if Y < 0 then Delta := Y
    else
      if Y >= ClientHeight then
        Delta := 1 + Y - ClientHeight
      else
      begin
        FTimer.Enabled := False;
        Exit;
      end;
    FSign := Delta div Abs(Delta);
    Interval := Abs(Delta) div ItemHeight;
    if Interval > 3 then Interval := 3;
    if not FTimer.Enabled or (Times[Interval] <> FTimer.Interval) then
    begin
      FTimer.Interval := Times[Interval];
      FTimer.Enabled := True;
    end;
  end;
end;

procedure TcxMonthListBox.Paint;

  function GetItemColor(ASelected: Boolean): TColor;
  begin
    if ASelected then
      Result := clWindowText
    else
      Result := Calendar.Color;
  end;

var
  ASelected: Boolean;
  R: TRect;
  I: Integer;
  S: string;
  ADate: TcxDateTime;
  AConvertDate: TDateTime;
begin
  Canvas.FrameRect(GetControlRect(Self), clBlack);
  R := Rect(1, 1, Width - 1, ItemHeight + 1);
  ADate := CalendarTable.FromDateTime(CalendarTable.AddMonths(FCurrentDate, TopMonthDelta));
  for I := 0 to FItemCount - 1 do
  begin
    ASelected := I = ItemIndex;
    Canvas.Font.Color := GetItemColor(not ASelected);
    Canvas.Brush.Color := GetItemColor(ASelected);
    Canvas.FillRect(R);
    if CalendarTable.IsValidYear(ADate.Era, ADate.Year) then
    begin
      AConvertDate := CalendarTable.ToDateTime(ADate);
      if ShowYears then
        S := cxGetLocalMonthYear(AConvertDate, CalendarTable)
      else
        S := cxGetLocalMonthName(CalendarTable.ToDateTime(ADate), CalendarTable);
      Canvas.DrawText(S, R, cxAlignCenter or cxSingleLine, True);
    end;
    ADate := CalendarTable.FromDateTime(CalendarTable.AddMonths(ADate, 1));
    OffsetRect(R, 0, ItemHeight);
  end;
end;

{ TcxCustomCalendar }

constructor TcxCustomCalendar.Create(AOwner: TComponent);
var
  ADate: TcxDateTime;
begin
  inherited Create(AOwner);
  ControlStyle := [csCaptureMouse, csOpaque];
  FArrowsForYear := True;
  FHotTrackRegion := chrNone;
  FSelectDate := Date;
  FCalendarTable := cxGetLocalCalendar;
  ADate := FCalendarTable.FromDateTime(FSelectDate);
  ADate.Day := 1;
  FFirstDate := FCalendarTable.ToDateTime(ADate);
  Width := 20;
  Height := 20;
  FTimer := TcxTimer.Create(nil);
  with FTimer do
  begin
    Enabled := False;
    Interval := DateNavigatorTime;
    OnTimer := DoScrollArrow;
  end;
  FMonthListBox := TcxMonthListBox.Create(Self);
  FMonthListBox.CaptureFocus := False;
  FMonthListBox.IsTopMost := True;
  FMonthListBox.OwnerParent := Self;
  Keys := [kAll, kArrows, kChars, kTab];
  CreateButtons;
  FKind := ckDate;
  SetCalendarButtons([btnClear, btnToday]);
  FFlat := True;
  FYearsInMonthList := True;
end;

destructor TcxCustomCalendar.Destroy;
begin
  FreeAndNil(FTimer);
  EndMouseTracking(Self);
  FreeAndNil(FMonthListBox);
  FreeAndNil(FCalendarTable);
  inherited Destroy;
end;

procedure TcxCustomCalendar.AdjustCalendarControlsPosition;

  function GetTodayButtonRect: TRect;
  begin
    Result :=
    {$IFDEF DELPHI6}
      Types.Bounds(
    {$ELSE}
      Classes.Bounds(
    {$ENDIF}
        (FDateRegionWidth - FButtonWidth - Byte(FClearButton.Visible) * FButtonWidth) div
         (3 - Byte(not FClearButton.Visible)),
        ClientHeight - FButtonsRegionHeight + FButtonsOffset,
        FButtonWidth + 1, FButtonsHeight);
  end;

  function GetClearButtonRect: TRect;
  begin
    Result :=
    {$IFDEF DELPHI6}
      Types.Bounds(
    {$ELSE}
      Classes.Bounds(
    {$ENDIF}
        FDateRegionWidth - FButtonWidth -
        (FDateRegionWidth - Byte(FTodayButton.Visible) * FButtonWidth - FButtonWidth) div
         (3 - Byte(not FTodayButton.Visible)),
        ClientHeight - FButtonsRegionHeight + FButtonsOffset,
        FButtonWidth + 1, FButtonsHeight);
  end;

  procedure SetButtonsPosition;
  var
    AButtonLeft, AButtonsOffset, AButtonsTop, I: Integer;
    AList: TList;
  begin
    AList := TList.Create;
    try
      GetVisibleButtonList(AList);

      AButtonsTop := Height - FButtonsRegionHeight + 1 +
        (FButtonsRegionHeight - 1 - FButtonsHeight) div 2;
      AButtonsOffset := MulDiv(Font.Size, 5, 4);

      TButton(AList[AList.Count - 1]).SetBounds(Width - AButtonsOffset -
        FButtonWidth - 1, AButtonsTop, FButtonWidth + 1, FButtonsHeight);
      if AList.Count > 1 then
        if AList.Count = 2 then
          TButton(AList[0]).SetBounds(TButton(AList[1]).Left - AButtonsOffset -
            FButtonWidth - 1, AButtonsTop, FButtonWidth + 1, FButtonsHeight)
        else
        begin
          AButtonLeft := AButtonsOffset;
          for I := 0 to AList.Count - 2 do
          begin
            TButton(AList[I]).SetBounds(AButtonLeft, AButtonsTop,
              FButtonWidth + 1, FButtonsHeight);
            Inc(AButtonLeft, AButtonsOffset + FButtonWidth + 1);
          end;
        end;
    finally
      AList.Free;
    end;
  end;

var
  R: TRect;
  AButtonVOffset: Integer;
begin
  if not HandleAllocated then
    Exit;

  FClearButton.Visible := btnClear in CalendarButtons;
  FNowButton.Visible := (Kind = ckDateTime) and (btnNow in CalendarButtons);
  FOKButton.Visible := Kind = ckDateTime;
  FTodayButton.Visible := btnToday in CalendarButtons;

  FClock.Visible := FOKButton.Visible;
  FTimeEdit.Visible := FOKButton.Visible;

  if Kind = ckDate then
  begin
    R := GetTodayButtonRect;
    FTodayButton.SetBounds(R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top);
    R := GetClearButtonRect;
    FClearButton.SetBounds(R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top);
  end
  else
  begin
    SetButtonsPosition;

    AButtonVOffset := (FButtonsRegionHeight - 1 - FButtonsHeight) div 2;
    FTimeEdit.Top := (Height - FButtonsRegionHeight - FTimeEdit.Height) -
      AButtonVOffset;
    FTimeEdit.Width := GetTimeEditWidth;
    FTimeEdit.Left := (Width - GetMonthCalendarOffset.X - FClockSize - AButtonVOffset * 2) + ((FClockSize + AButtonVOffset * 2 - FTimeEdit.Width) div 2);
    FTimeEdit.SelStart := 0; // refit text
    FClock.SetBounds(Width - GetMonthCalendarOffset.X - AButtonVOffset - FClockSize,
      FHeaderHeight + GetMonthCalendarOffset.Y + AButtonVOffset, FClockSize,
      FClockSize);
  end;
end;

procedure TcxCustomCalendar.ButtonClick(Sender: TObject);
var
  ADate: TDateTime;
begin
  case TCalendarButton(Integer(TcxButton(Sender).Tag)) of
    btnNow: ADate := Now;
    btnToday: ADate := Date + cxSign(Date) * FClock.Time;
    btnClear: ADate := NullDate;
  else
    ADate := SelectDate + cxSign(SelectDate) * FClock.Time;
  end;
  FClock.Time := TTime(TimeOf(ADate));
  FTimeEdit.Time := FClock.Time;
  SelectDate := ADate;
  DoDateTimeChanged;
  HidePopup(Self, crEnter);
end;

procedure TcxCustomCalendar.CalculateViewInfo;

  function GetCurrentDateRegion: TRect;
  begin
    Result := Rect(0, 0, Width, FHeaderHeight);
    if FOKButton.LookAndFeel.Painter = TcxOffice11LookAndFeelPainter then
    begin
      Inc(Result.Left, Office11HeaderOffset);
      Inc(Result.Top, Office11HeaderOffset);
      Dec(Result.Right, Office11HeaderOffset);
    end;
  end;

  function GetMonthCalendarPosition: TPoint;
  begin
    if Kind = ckDateTime then
    begin
      Result := GetMonthCalendarOffset;
      Inc(Result.Y, FViewInfo.CurrentDateRegion.Bottom);
    end
    else
      Result := Point(0, 0);
  end;

  procedure OffsetMonthCalendar;
  var
    AArrow: TcxCalendarArrow;
    AOffset: TPoint;
  begin
    AOffset := GetMonthCalendarPosition;
    with FViewInfo do
    begin
      for AArrow := Low(TcxCalendarArrow) to LastVisibleArrow do
        OffsetRect(ArrowRects[AArrow], AOffset.X, AOffset.Y);
      OffsetRect(CalendarRect, AOffset.X, AOffset.Y);
      OffsetRect(HeaderRegion, AOffset.X, AOffset.Y);
      OffsetRect(MonthRegion, AOffset.X, AOffset.Y);
      OffsetRect(YearRegion, AOffset.X, AOffset.Y);
    end;
  end;

  function GetHeaderBorderWidth: Integer;
  begin
    if Kind = ckDateTime then
      Result := 1
    else
      Result := Integer(not FFlat);
  end;

  procedure CalculateTwoArrowsViewInfo;