Неверов Евгений Викторович
Меню сайта
Категории раздела
Программирование на языке Паскаль [27]
В данной категории представлены новые функции, созданные на языке Паскаль, которые могут пригодиться при написании своих программ
Программирование на Delphi [18]
В данной категории представлены полезные подпрограммы, которые могут пригодиться при написании своих программ, а также рассматриваются примеры готовых проектов, создаваемых в среде программирования Delphi
Программирование на HTML [0]
В данной категории рассматриваются примеры готовых проектов, создаваемых на языке HTML
Прочее [0]
Свободная тематика
Мини-чат
200
Наш опрос
Оцените мой сайт
Всего ответов: 41
Статистика

Рейтинг@Mail.ru
Онлайн всего: 1
Гостей: 1
Пользователей: 0
Форма входа
Главная » Статьи » Программирование на Delphi [ Добавить статью ]

Календарь
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 выглядит следующим образом:

Категория: Программирование на Delphi | Добавил: newerow1989 (14.08.2016 14:42 )
Просмотров: 116 | Рейтинг: 0.0/0
Всего комментариев: 0
Имя *:
Email *:
Все смайлы
Код *:
Поиск
Друзья сайта
  • Создать сайт
  • Официальный блог
  • Сообщество uCoz
  • FAQ по системе
  • Инструкции для uCoz
  • Все проекты компании
  • Copyright MyCorp © 2018
    Автор этого сайта: Неверов Евгений Викторович

    Мои координаты
    Бесплатный конструктор сайтов - uCozЯндекс.Метрика