Отправляет email-рассылки с помощью сервиса Sendsay

Советы по Delphi

  Все выпуски  

Советы по Delphi Calendar


Служба Рассылок Subscribe.Ru

Здравствуйте, уважаемые подписчики! С наступающим Новым годом! Извините, раньше сделать выпуск не удалось по независящим от меня причинам. Поэтому программа из этого выпуска даже дополнительно не тестировалась.

Всвязи с наступающим Новым годом я решил посвятить выпуск календарю. Ниже приведенная программа рисует на форме календарь на 2002 год. Для каждого месяца сначала выводится его название (используется глобальная переменная LongMonthNames модуля SysUtils), далее выводятся сокращенные названия дней недели (глобальная переменная ShortDayNames модуля SysUtils) и, наконец, выводятся сами числа. Количество дней в месяце записано в массиве months. Чтобы определить, високосный это год или нет, используется функция IsLeapYear. Скачать необходимые для компиляции файлы проекта можно на program.dax.ru.

const year = 2002; // Год календаря

var months: array [1..12] of byte;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.Caption := 'Календарь на ' + IntToStr(year) + ' год';
  Form1.Color := clWhite;
  // Длины месяцев:
  months[1] := 31;
  months[2] := 28 + ord(IsLeapYear(year));
  months[3] := 31;
  months[4] := 30;
  months[5] := 31;
  months[6] := 30;
  months[7] := 31;
  months[8] := 31;
  months[9] := 30;
  months[10] := 31;
  months[11] := 30;
  months[12] := 31;
end;

procedure TForm1.FormPaint(Sender: TObject);
const // Настройки размеров календаря:
  MonthDX = 150;
  MonthDY = 135;
  DayDX = 20;
  DayDY = 15;
  MonthH = 20;
var
  month, i: integer;
  day: integer;
  s: string[2];
begin
  with Form1.Canvas do for month := 1 to 12 do begin
    // Вывод названия месяца:
    Font.Name := 'Times';
    Font.Size := 13;
    TextOut((month - 1) mod 3 * MonthDX, (month - 1) div 3 * MonthDY,
      LongMonthNames[month]);

    Font.Name := 'Courier';
    Font.Size := 8;
    // Вывод названий дней недели:
    for day := 1 to 7 do
      TextOut((month - 1) mod 3 * MonthDX,
        day mod 7 * DayDY + (month - 1) div 3 * MonthDY + MonthH,
        ShortDayNames[(day + 1) mod 7 + 1]);

    // Определение дня недели первого числа месяца:
    day := DayOfWeek(EncodeDate(year, month, 1)) - 2;
    if day < 0 then inc(day, 7);
    // Вывод чисел:
    for i := 1 to months[month] do begin
      str(i: 2, s);
      TextOut(day div 7 * DayDX + (month - 1) mod 3 * MonthDX + DayDX,
        day mod 7 * DayDY + (month - 1) div 3 * MonthDY + MonthH, s);
      inc(day);
    end;
  end;
end;



Полезные мелочи
Чтобы определить, лежит ли точка внутри или снаружи прямоугольника, удобно использовать функцию PtInRect. Если точка внутри прямоугольника, PtInRect возвращает true, иначе false. Пример:
procedure TForm1.FormPaint(Sender: TObject);
begin
  Form1.Canvas.Rectangle(100, 100, 200, 200);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if PtInRect(Rect(100, 100, 200, 200), Point(X, Y))
    then Form1.Caption := 'In'
    else Form1.Caption := 'Out';
end;



Все советы и замечания, пожалуйста, присылайте на subscribe@program.dax.ru

Всего доброго,
Даниил Карапетян.






http://subscribe.ru/
E-mail: ask@subscribe.ru
Отписаться
Убрать рекламу

В избранное