type
TOrient = (horz, vert);
const
mesyatsR: array[1..12] of string = ('Январь', 'Февраль', 'Март', 'Апрель', 'Май',
'Июнь', 'Июль', 'Август', 'Сентябрь', 'Октябрь', 'Ноябрь', 'Декабрь');
dnR: array[1..7] of string = ('Пн', 'Вт', 'Ср', 'Чт', 'Пт', 'Сб', 'Вс');
procedure CanvasKalendar(Canvas: TCanvas; x, y, dx, dy, leftmes, mes, god,
FontSize: integer; BrushColor, FontColor: array of TColor; d31,
zgod: boolean; orient: TOrient; date: TDateTime; prazdniki: array of byte);
const wihodnye: array[0..1] of byte = (6, 7);
var x1, x2, y1, y2, PosX, PosY: integer;
dat: TDateTime;
s: string;
i, nomer_dn, x_, y_: byte;
function LabelHeightFontSize(FontSize: integer): integer;
begin
If FontSize<1 then
FontSize:=1;
Case FontSize of
10..11: Result:=16;
12..13: Result:=20;
14..16: Result:=24;
17: Result:=26;
18..19: Result:=29;
20..22: Result:=32;
23..26: Result:=37;
27..32: Result:=48;
33..35: Result:=52;
36..38: Result:=58;
39..40: Result:=64;
41..46: Result:=65;
47..48: Result:=74;
else
Result:=13;
end;
end;
function ColorRead(Color: array of TColor; n: byte): TColor;
begin
Result:=0;
If n<=High(Color) then
Result:=Color[n];
end;
function PrinadlezhitB(n: byte; p: array of byte): boolean;
var i: integer;
begin
Result:=false;
For i:=Low(p) to High(p) do
If n=p[i] then
Result:=true;
end;
begin
With Canvas do
begin
If dx<LabelHeightFontSize(FontSize)+4 then
dx:=LabelHeightFontSize(FontSize)+4;
x_:=(dx-LabelHeightFontSize(FontSize)) div 2; //положение надписи слева (Top) (для чисел)
If dy<LabelHeightFontSize(FontSize)+4 then
dy:=LabelHeightFontSize(FontSize)+4;
y_:=(dy-LabelHeightFontSize(FontSize)) div 2; //положение надписи сверху (Top)
Font.Size:=FontSize;
Pen.Color:=1;
{ рисование чисел }
PosX:=1; //для horz
PosY:=2; //для vert
Pen.Width:=1;
For i:=1 to 31 do
If TryEncodeDate(god, mes, i, dat) then
begin
nomer_dn:=DayOfWeek(dat);
nomer_dn:=nomer_dn-1;
If nomer_dn=0 then
nomer_dn:=7;
If (nomer_dn=1) and (i>1) then
begin
PosX:=PosX+1;
PosY:=PosY+1;
end;
If (PosX=6) and d31 {перенести "31" в первый (левый) ряд} then
PosX:=1;
If (PosY=7) and d31 {перенести "31" в первый (верхний) ряд} then
PosY:=2;
Pen.Color:=ColorRead(BrushColor, 2);
Font.Color:=ColorRead(FontColor, 2);
If PrinadlezhitB(nomer_dn, wihodnye) then
begin
Pen.Color:=ColorRead(BrushColor, 4);
Font.Color:=ColorRead(FontColor, 4);
end;
If dat=Trunc(date) then
begin
Pen.Color:=ColorRead(BrushColor, 3);
Font.Color:=ColorRead(FontColor, 3);
end;
If PrinadlezhitB(i, prazdniki) then
begin
Pen.Color:=ColorRead(BrushColor, 5);
Font.Color:=ColorRead(FontColor, 5);
end;
Brush.Color:=Pen.Color;
x1:=x+(nomer_dn-1)*dx+1;
y1:=y+PosY*dy+1;
x2:=x+nomer_dn*dx;
y2:=y+(PosY+1)*dy;
If orient=vert then
begin
x1:=x+PosX*dx+1;
y1:=y+nomer_dn*dy+1;
x2:=x+(PosX+1)*dx;
y2:=y+(nomer_dn+1)*dy;
end;
Rectangle(x1, y1, x2, y2);
If i<10 then
x1:=x1+3;
TextOut(x1+x_, y1+y_-1, IntToStr(i));
end;
{ границы календаря }
PosX:=PosX+1;
If d31 then
PosX:=6;
If orient=horz then
PosX:=7;
PosY:=PosY+1;
If d31 then
PosY:=7;
If orient=vert then
PosY:=8;
Pen.Width:=2;
Pen.Color:=1;
x1:=x;
y1:=y+2*dy;
x2:=x+PosX*dx;
y2:=y+PosY*dy;
If orient=vert then
y1:=y+dy;
MoveTo(x1+Pen.Width-1, y1+Pen.Width-1);
LineTo(x1+Pen.Width-1, y2+Pen.Width-1);
LineTo(x2+Pen.Width-1, y2+Pen.Width-1);
LineTo(x2+Pen.Width-1, y1+Pen.Width-1);
{ название месяца (и года) }
Font.Color:=ColorRead(FontColor, 0);
Brush.Color:=ColorRead(BrushColor, 0);
x2:=x+PosX*dx+1;
Rectangle(x+Pen.Width-1, y+Pen.Width-1, x2+Pen.Width-1, y+dy+Pen.Width);
s:='';
If (mes>=1) and (mes<=12) then
s:=mesyatsR[mes];
If zgod then
s:=Format('%s - %d год', [s, god]);
TextOut(x+leftmes, y+y_, s);
{ названия дней недели }
Font.Color:=ColorRead(FontColor, 1);
Brush.Color:=ColorRead(BrushColor, 1);
x1:=x;
y1:=y+dy;
x2:=x+PosX*dx+1;
y2:=y+2*dy+1;
If orient=vert then
begin
x2:=x+dx+1;
y2:=y+PosY*dy+1;
end;
Rectangle(x1+Pen.Width-1, y1+Pen.Width-1, x2+Pen.Width-1, y2+Pen.Width-1);
For i:=0 to 6 do
begin
x1:=x+i*dx;
y1:=y+dy;
If orient=vert then
begin
x1:=x;
y1:=y+(i+1)*dy;
end;
TextOut(x1+x_, y1+y_, dnR[((i+1) mod 7)+1]);
end;
{ сетка }
Pen.Width:=1;
x1:=1;
x2:=6;
y1:=3;
y2:=PosY-1;
If orient=vert then
begin
x1:=2;
x2:=PosX-1;
y1:=2;
y2:=7;
end;
For i:=x1 to x2 do
begin
MoveTo(x+i*dx, y+dy+1);
LineTo(x+i*dx, y+PosY*dy+1);
end;
For i:=y1 to y2 do
begin
MoveTo(x, y+i*dy);
LineTo(x+PosX*dx+1, y+i*dy);
end;
end;
end;
где
Canvas - объект для рисования (например, Label1.Canvas);
x, y - положение календаря относительно компонента;
dx, dy - размер клетки;
leftmes - положение названия месяца (Left);
mes, god - номера месяца и года соответственно;
FontSize - размер текста;
BrushColor - цвета заливок, размер массива от 0 до 5, обозначения которых даны ниже:
0 - месяц,
1 - дни недели,
2 - обычные дни,
3 - текущий (сегодняшний) день,
4 - выходные дни,
5 - праздничные дни;
FontColor - цвета надписей, размер массива от 0 до 5, обозначения которых совпадают со значениями массива BrushColor;
d31 - перенос чисел (29-31) в первый (верхний/левый) ряд;
zgod - вывод года после месяца в названии;
orient - ориентация ряда чисел, значения которых даны ниже:
horz - горизонтальная,
vert - вертикальная;
date - текущая (сегодняшняя) дата (выделяется цветом BrushColor[3]);
prazdniki - список праздников (выделяется цветом BrushColor[5]).
Например, CanvasKalendar(Image1.Canvas, 0, 0, 12, 12, 40, 5, 2016, 8, [clWhite, clYellow, clWhite, clLime, clFuchsia, clRed], [clBlack, clRed], false, false, vert, 42515, [1, 9]) состоит из следующих параметров:
Image1.Canvas - рисование календаря на компоненте Image1,
0, 0 - положение календаря на Image1,
12, 12 - размер клетки,
40 - положение названия месяца слева,
5, 2016 - май 2016 года,
8 - размер текста,
[clWhite - закрашивание фона в названии месяца,
clYellow - фон в днях недели,
clWhite - фон во всех числах (основной фон),
clLime - выделить сегодняшний день (25.05.2016),
clFuchsia - выделить выходные дни (суббота и воскресенье),
clRed] - выделить праздничные дни (1.05.2016, 9.05.2016),
[clBlack - цвет надписи в названии месяца,
clRed] - цвет надписи в днях недели,
остальные цвета надписей (числа) будут по умолчанию черными, т.к. здесь задан размер массива из 2 значений,
false - не переносить числа (30-31) в первый (левый) ряд (таблица будет состоять из 7 столбцов: дн, 1, 2-8, 9-15, 16-22, 23-29, 30-31),
false - не выводить год после месяца в названии (название таблицы: 'Май'),
vert - расположить числа вертикально,
42515 - сегодня 25.05.2016,
[1, 9] - праздничные дни: 1.05.2016, 9.05.2016.
CanvasKalendar(Image1.Canvas, 130, 0, 20, 20, 12, 3, 2099, 8, [clLime, clWhite, clYellow, clAqua, clRed, clFuchsia], [clRed, clPurple, clBlue, clBlack, clWhite], true, true, horz, 72761, [8]) состоит из следующих параметров (сокращенно):
Image1.Canvas,
130, 0,
20, 20,
12,
3, 2099 - март 2099 года,
8,
[clLime, clWhite, clYellow, clAqua, clRed, clFuchsia],
[clRed, clPurple, clBlue, clBlack, clWhite],
true - переносить числа (30-31) в первый (верхний) ряд (таблица будет состоять из 7 строк: 'Март - 2099 год', 30-31 и 1, 2-8, 9-15, 16-22, 23-29),
true - выводить год после месяца в названии (название таблицы: 'Март - 2099 год'),
horz - расположить числа горизонтально,
72761 - сегодня 17.03.2099,
[8] - праздничные дни: 8.03.2099.
Результат рисования календаря на Image1 выглядит следующим образом:
|
