TCalendar

← →
Khabibulin (2006-10-26 13:46) [0]

Народ, подскажите пожалуйста, как изменить в стандартном компоненте TCalendar цвет выбранной ячейки?

За ранее спасибки!))))

← →
silversmith (2006-10-26 14:57) [1]

Создайте потомка от TCalendar. В нем перегрузите процедуру DrawCell
и в ней напишите следующий код:

var
cl:TColor;
begin
cl:=Canvas.Brush.Color;
if (gdSelected in AState) and (not (gdFixed in AState))
then Canvas.Brush.Color := clRed;//новый цвет
inherited DrawCell(ACol, ARow, ARect, AState);
Canvas.Brush.Color:=cl;
end;

← →
Khabibulin (2006-11-05 22:51) [2]

ну это что касается выделения ячейки как я понял... а вот если я хочу просто сделать ячейку какой то даты другого цвета, а выделение оставить прежним?

← →
Германн © (2006-11-06 02:13) [3]

>
> Khabibulin (26.10.06 13:46)
>
> Народ, подскажите пожалуйста, как изменить в стандартном
> компоненте TCalendar цвет выбранной ячейки?

> Khabibulin (05.11.06 22:51) [2]
>
> ну это что касается выделения ячейки как я понял... а вот
> если я хочу просто сделать ячейку какой то даты другого
> цвета, а выделение оставить прежним?

Как прикажешь понимать тебя, Саид?
P.S. Выделено мной.

← →
RASkov (2006-11-06 04:41) [4]

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, Mask, ToolEdit, Grids, Calendar;

type
TMyCal = class(TCalendar)
procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
public
constructor Create(AOwner: TComponent); override;
end;
TCalendar = class(TMyCal);

TForm1 = class(TForm)
Calendar1: TCalendar;
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TMyCal }

constructor TMyCal.Create(AOwner: TComponent);
begin
inherited;
Options := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
goRangeSelect, goDrawFocusSelected, {goRowSizing, goColSizing, goRowMoving,
goColMoving, goEditing,} goTabs, {goRowSelect,}
goAlwaysShowEditor, goThumbTracking];
end;

procedure TMyCal.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
function GetDay: Integer;
begin
Result := -2 + ACol + (ARow - 1) * 7; //Вот здесь "косяк"
if (Result < 1) or (Result > DaysThisMonth) then Result :=0;
end;
const SelDays = [1..3, 7, 15, 27];
var n: Integer;
begin
n :=GetDay;
if n in SelDay then Canvas.Brush.Color:=clBlue else
if (gdSelected in AState) and ( n > 0 ) then Canvas.Brush.Color:=clRed;
inherited;
end;

end.

Есть один косяк (выделен жирным), смещение первого дня месяца, по умному не предумал как вытащить его из TCalendar. Проще заного переписать этот календарь, там кода-то 5 с половиной строчек. Если не сообразишь дай знать, что нибудь придумаем. Ну и константу SelDays нужно вытащить из DrawCell.
Хотя из [3] может и не то совсем:)

← →
RASkov (2006-11-06 04:47) [5]

Блин, ошибок глупых наделал:) ..придумал.. заново...:)

← →
unknown © (2006-11-06 04:55) [6]

> RASkov (06.11.06 04:47) [5]
>
> Блин, ошибок глупых наделал:) ..придумал.. заново...:)

Вообще, не стоило [4] выкладывать. Пока сделаешь - столько
нервов и времени потратишь - лучше чем полезным заняться :)
Да и не стоит шкурка выделки. Чем в стандартном менять - проще
свой сделать.

← →
RASkov (2006-11-06 05:12) [7]

> [6] unknown © (06.11.06 04:55)

> > RASkov (06.11.06 04:47) [5]
> >
> > Блин, ошибок глупых наделал:) ..придумал.. заново...:)
>
>
> Вообще, не стоило [4] выкладывать. Пока сделаешь - столько
> нервов и времени потратишь - лучше чем полезным заняться
> :)

Да и чего, интересно, хитрого я придумал?:) измучился думать:)
Ошибок в русском тексте наделал сравни то что выделенно и эти слова в [5]:))

> проще
> свой сделать.

Во во и я про тоже.

← →
RASkov (2006-11-06 05:16) [8]

Т.е.
Ошибок в русском тексте наделал сравни то что выделенно и эти слова в [6]

> смещение первого дня месяца, по умному не предумал как вытащить
> его из TCalendar. Проще заного переписать этот календарь,

:))

← →
Ketmar © (2006-11-06 05:24) [9]

а вот пользуй CDM, там spellchecker есть %-)

← →
unknown © (2006-11-06 05:33) [10]

> Ketmar © (06.11.06 05:24) [9]
>
> а вот пользуй CDM, там spellchecker есть %-)

Хех, в FireFox2 тоже есть. Правда смешной бывает - такие словечки предлагает,
что закачаешся :)))
p.s.
Не матерные, не надейтесь :)

← →
Ketmar © (2006-11-06 05:37) [11]

Semagic тоже смешной. как-то предложил переименовать Кондолизу Райс в, извините, Гондолизу. я, конечно, с ним согласен, но мог бы и как-то помягче...

← →
RASkov (2006-11-06 05:53) [12]

> [9] Ketmar © (06.11.06 05:24)

не достаточно плюсов в пользу CDM:)

← →
RASkov (2006-11-06 05:55) [13]

[12] имел ввиду только у себя эти плюсы и минусы CDM:)
CDM, "штучка", вообщем-то не плохая, но консоль.....
Ketmar, надеюсь поймешь меня правильно.

← →
Ketmar © (2006-11-06 06:00) [14]

>[12] RASkov 6-Nov-2006, 05:53
>не достаточно плюсов в пользу CDM:)
Кэтмар вспоминает, куда спрятал свою большую дубину

>[13] RASkov 6-Nov-2006, 05:55
>но консоль.....
>Ketmar, надеюсь поймешь меня правильно.
Кэтмар прекратил думать о дубине и задумался о двуручной пиле

← →
RASkov (2006-11-06 06:02) [15]

← →
RASkov (2006-11-06 06:03) [16]

> двуручной пиле

?

>[15] RASkov 6-Nov-2006, 06:02
>Надеюсь, что Ketmar никогда не вспомнит, где у него пила и
>дубина:))
он уже вспомнил. пропил нафиг. теперь рыдает и рвёт бороду...

>[16] RASkov 6-Nov-2006, 06:03
>> двуручной пиле
есть такая. зубья большие, пилят двое. видел, наверняка.

← →
RASkov (2006-11-06 06:05) [19]

>[19] RASkov 6-Nov-2006, 06:05
>кто второй?
какая разница, если пилу я всё равно пропил...

TCalendar Найти похожие ветки