MyCalendar в Delphi

[TaYgA]

Здравствуйте дорогие эксперты... Делаю календарь, что то типо на любой год

Возникает ошибка в компаненте MyCalendar, как исправить я не знаю (MyCalendar - это переделанный компанент Calendar) Стандартным компанентом пользоваться не могу т.к. нельзя выделять другим цветом опредённые даты... Ошибка связана с выбором года в SpinEdit... Выкладываю свой проект, чтоб было наглядней. Надеюсь на вашу помощь

[Stilet]

Вся проблема в том что ты в OnShow создаешь календари последовательно.
Вот строчка:

SpinEdit1.Value:=Cal1.Year;

Которая возбуждает событие OnChange
В котором ты обращаешся к этим календарям, в часности ко второму календарю

 Cal2.Year:=SpinEdit1.Value; Cal2.Month:=2;

который еще не создан.

У тя три выхода
1. Проверять на вшивость:

if Cal2<>nil then
  Cal2.Year:=SpinEdit1.Value; Cal2.Month:=2;

2. Отключать обработчик:

SpinEdit1.OnChange:=nil;
SpinEdit1.Value:=Cal1.Year;
SpinEdit1.OnChange:=OnChange;

И так для остальных

3.Все календари собрать в TObjectList или в динмассив и в цикле по нему проходя работать с только созданными экземплярами - это наилучший вариант.

[TaYgA]

Stilet, спасибо... Буду разбираться

Вынужден вернуться к этой теме... Предыдущую ошибку исправил, теперь при загрузки проекта всё работает правельно, но когда изменяешь год в SpinEdit в Январе не правельно указываются числа... Не могу понять из-за чего... Так же не могу понять как определённому числу присвоить другой цвет... Делал так:

Cal2.AlterColor:=clRed;
Cal2.AlterCells:=[29]; \\Отмечает 23 февраля красным цвет

При изменении года цвет остаётся в той же ячейки, а число переходит в другую ячейу..... Как это исправить?!?!

Неужели никто не знает как это делать?!?! Как можно присвоить определённой ячеки цвет и чтоб с изменение года закрашенная ячейка не оставалась на месте?!?! Хотябы поделитесь своими мыслями, а то я всю голову уже себе изломал

[Stilet]

Как можно присвоить определённой ячеки цвет

Для этого нужно изучать кишки этого компонента.
Залезь в генофонд и посмотри как там и что.

[TaYgA]

Пробывал, мне это не сильно помогло Может быть вы подскажите...

constructor TMyCalendar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  { defaults }
  FUseCurrentDate := True;
  FixedCols := 0;
  FixedRows := 1;
  ColCount := 7;
  RowCount := 7;
  ScrollBars := ssNone;
  Options := Options - [goRangeSelect] + [goDrawFocusSelected];
  FDate := Date;
  UpdateCalendar;
end;

procedure TMyCalendar.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TMyCalendar.Click;
var
  TheCellText: string;
begin
  inherited Click;
  TheCellText := CellText[Col, Row];
  if TheCellText <> '' then Day := StrToInt(TheCellText);
end;

function TMyCalendar.IsLeapYear(AYear: Integer): Boolean;
begin
  Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
end;

function TMyCalendar.DaysPerMonth(AYear, AMonth: Integer): Integer;
const
  DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
  Result := DaysInMonth[AMonth];
  if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special }
end;

function TMyCalendar.DaysThisMonth: Integer;
begin
  Result := DaysPerMonth(Year, Month);
end;

procedure TMyCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var
  TheText: string;
  AltCell: byte;
begin
  TheText := CellText[ACol, ARow];
  AltCell:=ARow*ColCount+ACol;
  with ARect, Canvas do
    begin
    if AltCell in FAlterCells then Font.Color:=FAlterColor;
    if AltCell in FBoldCells then Font.Style:=[fsBold];
    TextRect(ARect, Left + (Right - Left - TextWidth(TheText)) div 2,
      Top + (Bottom - Top - TextHeight(TheText)) div 2, TheText);
    end;
end;

function TMyCalendar.GetCellText(ACol, ARow: Integer): string;
var
  DayNum: Integer;
begin
  if ARow = 0 then  { day names at tops of columns }
    Result := ShortDayNames[(StartOfWeek + ACol) mod 7 + 1]
  else
  begin
    DayNum := FMonthOffset + ACol + (ARow - 1) * 7;
    if (DayNum < 1) or (DayNum > DaysThisMonth) then Result := ''
    else Result := IntToStr(DayNum);
  end;
end;

function TMyCalendar.SelectCell(ACol, ARow: Longint): Boolean;
begin
  if ((not FUpdating) and FReadOnly) or (CellText[ACol, ARow] = '') then
    Result := False
  else Result := inherited SelectCell(ACol, ARow);
end;

procedure TMyCalendar.SetCalendarDate(Value: TDateTime);
begin
  FDate := Value;
  UpdateCalendar;
  Change;
end;

function TMyCalendar.StoreCalendarDate: Boolean;
begin
  Result := not FUseCurrentDate;
end;

function TMyCalendar.GetDateElement(Index: Integer): Integer;
var
  AYear, AMonth, ADay: Word;
begin
  DecodeDate(FDate, AYear, AMonth, ADay);
  case Index of
    1: Result := AYear;
    2: Result := AMonth;
    3: Result := ADay;
    else Result := -1;
  end;
end;

procedure TMyCalendar.SetDateElement(Index: Integer; Value: Integer);
var
  AYear, AMonth, ADay: Word;
begin
  if Value > 0 then
  begin
    DecodeDate(FDate, AYear, AMonth, ADay);
    case Index of
      1: if AYear <> Value then AYear := Value else Exit;
      2: if (Value <= 12) and (Value <> AMonth) then AMonth := Value else Exit;
      3: if (Value <= DaysThisMonth) and (Value <> ADay) then ADay := Value else Exit;
      else Exit;
    end;
    FDate := EncodeDate(AYear, AMonth, ADay);
    FUseCurrentDate := False;
    UpdateCalendar;
    Change;
  end;
end;

procedure TMyCalendar.SetStartOfWeek(Value: TDayOfWeek);
begin
  if Value <> FStartOfWeek then
  begin
    FStartOfWeek := Value;
    UpdateCalendar;
  end;
end;

[TaYgA]

procedure TMyCalendar.SetUseCurrentDate(Value: Boolean);
begin
  if Value <> FUseCurrentDate then
  begin
    FUseCurrentDate := Value;
    if Value then
    begin
      FDate := Date; { use the current date, then }
      UpdateCalendar;
    end;
  end;
end;

{ Given a value of 1 or -1, moves to Next or Prev month accordingly }
procedure TMyCalendar.ChangeMonth(Delta: Integer);
var
  AYear, AMonth, ADay: Word;
  NewDate: TDateTime;
  CurDay: Integer;
begin
  DecodeDate(FDate, AYear, AMonth, ADay);
  CurDay := ADay;
  if Delta > 0 then ADay := DaysPerMonth(AYear, AMonth)
  else ADay := 1;
  NewDate := EncodeDate(AYear, AMonth, ADay);
  NewDate := NewDate + Delta;
  DecodeDate(NewDate, AYear, AMonth, ADay);
  if DaysPerMonth(AYear, AMonth) > CurDay then ADay := CurDay
  else ADay := DaysPerMonth(AYear, AMonth);
  CalendarDate := EncodeDate(AYear, AMonth, ADay);
end;

procedure TMyCalendar.PrevMonth;
begin
  ChangeMonth(-1);
end;

procedure TMyCalendar.NextMonth;
begin
  ChangeMonth(1);
end;

procedure TMyCalendar.NextYear;
begin
  if IsLeapYear(Year) and (Month = 2) and (Day = 29) then Day := 28;
  Year := Year + 1;
end;

procedure TMyCalendar.PrevYear;
begin
  if IsLeapYear(Year) and (Month = 2) and (Day = 29) then Day := 28;
  Year := Year - 1;
end;

procedure TMyCalendar.UpdateCalendar;
var
  AYear, AMonth, ADay: Word;
  FirstDate: TDateTime;
begin
  FUpdating := True;
  try
    DecodeDate(FDate, AYear, AMonth, ADay);
    FirstDate := EncodeDate(AYear, AMonth, 1);
    FMonthOffset := 2 - ((DayOfWeek(FirstDate) - StartOfWeek + 7) mod 7); { day of week for 1st of month }
    if FMonthOffset = 2 then FMonthOffset := -5;
    MoveColRow((ADay - FMonthOffset) mod 7, (ADay - FMonthOffset) div 7 + 1,
      False, False);
    Invalidate;
  finally
    FUpdating := False;
  end;
end;

procedure TMyCalendar.WMSize(var Message: TWMSize);
var
  GridLines: Integer;
begin
  GridLines := 6 * GridLineWidth;
  DefaultColWidth := (Message.Width - GridLines) div 7;
  DefaultRowHeight := (Message.Height - GridLines) div 7;
end;

Сам компонент я уже выкладывал вместе с проектом.... Если этого не достаточно то можно посмотреть там....