
09.04.2010, 17:29
|
 |
Прохожий
|
|
Регистрация: 18.11.2009
Сообщения: 29
Версия Delphi: 7
Репутация: 12
|
|
Календарь на Canvas помогите!
Всем доброго. Собственно проблема вот в чем, нашел исходник календаря на год, но не пойму как сделать чтобы выходные дни отображались другим цветом, к примеру красным.
Код:
unit Unit1;
interface
uses
Windows, SysUtils, Classes, Graphics, Forms;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
months:array[1..12] of byte;
const
year=2009;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Caption:='Календарь на '+IntToStr(year)+' год';
Form1.Color:=clBlack;
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=25;
var
month, i, day:integer;
s:string[2];
begin
with Form1.Canvas do for month:=1 to 12 do begin
// Вывод названия месяца:
Font.Color:=clRed;
Font.Name:='Times';
Font.Size:=13;
Font.Style:=[fsBold];
TextOut((month - 1) mod 3 * MonthDX, (month - 1) div 3 * MonthDY, LongMonthNames[month]);
Font.Color:=clLime;
Font.Name:='Courier';
Font.Size:=9;
Font.Style:=[];
// Вывод названий дней недели:
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);
Font.Color:=clWhite;
Font.Style:=[];
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;
end.
Admin: Пользуемся тегами!
Помогите кто знает.
|