Владимир Коднянко
дата публикации 02-11-2004 12:05

---

Версия для печати

29.10.2004 г. на Королевстве был задан вопрос № 26400 "Прошу просветить! Как в MonthCalendar выделить (цветом) дату или несколько дат". Поразмышляв над ним, получил решение, которое, с одной стороны, оказалось довольно пространным, выходящим за рамки традиционного ответа. С другой стороны, задача показалась достаточно реальной, поэтому вместо ответа решил подготовить настоящее сообщение.

После изучения доступных свойств и методов компонента MonthCalendar (весьма скудных) пришел к выводу, что решить задачу можно программным анализом изображения на календаре с последующим изменением цветов для требуемых дат. Назовем их условно "праздничными", поскольку чаще такая задача может возникнуть именно для отображения праздничных (или выходных) дней. С алгоритмической точки зрения характер выделяемых дней не имеет значения. Сразу замечу, что нижеприведенный код, реализующий решение задачи, пригоден для компонента, с Default-свойствами: AutoSize = true, неизмененный фонт и т. д.

Const HoliFontColor = clRed; // цвет фонта HoliBrushColor = clYellow; // цвет подложки

var McCanvas: TControlCanvas;

Календарь любого месяца всегда имеет 6 строк и 7 столбцов. Экспериментально установил, что координаты верхнего левого угла числа, находящегося в столбце Col и строке Row, подчиняются функциям:

function xByCol(Col: byte): Integer; // x-координата текста begin Result:= 7+(Col-1)*27; end; function yByRow(Row: byte): Integer; // y-координата текста begin Result:= 46+(Row-1)*15; end;

В календарь могут быть выведены числа предыдущего, текущего и следующего месяца. Идея заключается в том, чтобы сначала найти координаты первого числа текущего месяца. Если они определены, то нахождение координат остальных дней месяца не представляет трудностей. Первое число может находиться в 1-й или 2-й строках. Числа текущего месяца имеют черный цвет, одно из чисел, являющееся выбранным, лежит на подложке цвета $00E35400, кроме того первое число может быть уже выделено "праздничными" цветами. Исходя из этого составил функцию поиска координат первого числа текущего месяца:

function FindCoordForFirstDayOfMonth(var Row,Col: byte): boolean; // поиск строки и столбца первого дня текущего месяца var i,j,k,iR,iC: Integer; begin Result:= false; for iR:= 1 to 2 do begin i:= yByRow(iR)+2; // сместимся от вершины числа на 2 пиксела вниз for iC:= 1 to 7 do begin j:= xByCol(iC); for k:= j to j+8 do // ширина числа не более 8 символов if (McCanvas.Pixels[k,i] = $00E35400) or (McCanvas.Pixels[k,i] = clBlack) or (McCanvas.Pixels[k,i] = HoliFontColor) then begin Row:= iR; Col:= iC; Result:= true; exit; end; end; end; end;

function FindCoordForDayOfMonth(Day: byte; var Row,Col: byte): boolean; var d,i,j: byte; begin Result:= false; if FindCoordForFirstDayOfMonth(Row,Col) then // координаты 1 дня месяца begin if Day = 1 then begin Result:= true; exit; end; d:=0; for i:= Row to 6 do for j:=1 to 7 do begin if (i=Row) and (j=Col) and (d=0) then d:=1 else if d>0 then Inc(d); if d = Day then begin // координаты искомого дня месяца Row:= i; Col:= j; Result:= true; exit; end; end; end;

function LPadCh(s: String; d: Word; c: Char): String; // слева от s многократно вставляет c, добирая s до длины d begin if Length(s)<d then Result:= StringOfChar(c,d-Length(s))+s else Result:= s; end; function DayTextOnMonthCalendar(Day: byte): boolean; var Row,Col: byte; begin Result:= FindCoordForDayOfMonth(Day,Row,Col); if Result then begin McCanvas.TextOut(xByCol(Col),yByRow(Row),LPadCh(IntToStr(Day),2,' ')); Result:= true; end else ShowMessage('День не найден'); end;

"Праздничные" даты лучше представить динамическим массивом. Его элементами могут быть даты любых месяцев и лет. Процедура вывода дат месяца, который в текущий момент находится на календаре, имеет вид:

procedure OutHolidaysOnMonthCalendar(MC: TMonthCalendar; Holidays: array of TDate); var Y1,M1,D1,Y2,M2,D2,i: Word; begin if Length(Holidays)>0 then begin MC.Repaint; McCanvas:= TControlCanvas.Create; try McCanvas.Control:= MC; McCanvas.Font.Color:= HoliFontColor; McCanvas.Brush.Color:= HoliBrushColor; DecodeDate(MC.Date,Y1,M1,D1); // текущая дата на календаре for i:=0 to Length(Holidays)-1 do begin DecodeDate(Holidays[i],Y2,M2,D2); if (M2=M1) and (Y2=Y1) then DayTextOnMonthCalendar(MC,D2); end; finally McCanvas.FreeHandle; McCanvas.Free; end; end; end;

procedure HolidaysOnMonthCalendarExample; begin OutHolidaysOnMonthCalendar(Form1.MonthCalendar1, [StrToDate('01.10.2004'), StrToDate('04.10.2004'), StrToDate('12.10.2004'), StrToDate('29.10.2004'), StrToDate('07.11.2004'), StrToDate('08.11.2004'), StrToDate('16.11.2004'), StrToDate('31.12.2004') ]); end;

Чтобы на календаре отображались "праздничные" даты сразу после активации формы, на которой находится календарь, а также после щелчка на дате (в том числе, относящейся к предыдущему или следующему месяцам) на календаре или на кнопках перехода к другому месяцу следует назначить события:

procedure TForm1.FormPaint(Sender: TObject); begin HolidaysOnMonthCalendarExample; end; procedure TForm1.MonthCalendar1Click(Sender: TObject); begin HolidaysOnMonthCalendarExample; end;