Pintar Celula ( dia ) do TCalendar

[Jhonas]

OBS: Os dias estão estáticos no código, mas voce pode substituir por dados de uma tabela com os dias

exemplo: ao montar uma agenda, voce pode marcar as datas que tem algum evento, ou aviso ..  entretanto deve-se criar uma rotina para filtrar as datas para um determinado mes.

esse calendario só é visivel em tempo de execução.

Façam as modificações necessarias para o seu uso.

============================================================

unit Unit1;

interface

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

type
   TCalendario = class(TCalendar)
protected
   procedure Click; override;
   procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
end;

type
  TForm1 = class(TForm)
    Edit1: TEdit;

    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    texto : string; col, lin : integer;
  end;

var
  Form1: TForm1;
  a: Array [0..31] of byte;
  dia, cc : integer;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var  Calendar1 : TCalendar;
begin
   Calendar1 := TCalendario.Create(Self);
   Calendar1.Parent := Form1;
   Calendar1.Top := 10;
   Calendar1.Left := 10;
   Calendar1.Height := 200;
   Calendar1.Width := 200;
end;

procedure TCalendario.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
var  Calendar1 : TCalendar;
var
   Ano, Mes, Dia: Word;
   Texto, s, s1 : string; x : integer;
begin
   inherited;
   DecodeDate(Now, Ano, Mes, Dia);
   Texto := CellText[ACol, ARow];
   x := 0;

   /// dias que ficarão coloridos
   a[0]:= 4;
   a[1]:= 10;
   a[2]:= 19;
   a[3]:= 21;
   a[4]:= 29;

   for x := 0 to 4 do
   begin
   if Texto = inttostr(a[x]) then
   begin
      Canvas.Font.Color := clBlue;
      Canvas.Font.Style := [fsBold];

      case x of
        0: Canvas.Brush.Color := claqua;
        1: Canvas.Brush.Color := clYellow;
        2: Canvas.Brush.Color := clLime;
        3: Canvas.Brush.Color := clMoneyGreen;
        4: Canvas.Brush.Color := $00FFAEFF;
      end;

      with ARect, Canvas do
         TextRect(ARect, Left + (Right - Left - TextWidth(Texto)) div 2,
         Top + (Bottom - Top - TextHeight(Texto)) div 2, texto);
         Canvas.Font.Color := clBlue;
      end
   else
      begin
         with ARect, Canvas do
              TextRect(ARect, Left + (Right - Left - TextWidth(Texto)) div 2,
              Top + (Bottom - Top - TextHeight(Texto)) div 2, Texto);
      end;
   end;

end;

procedure TCalendario.Click;
var s : string;
begin
   inherited;
   s :=datetostr(CalendarDate);
   Form1.Edit1.Text := copy(s,1,2);
   Form1.Edit1.Refresh;
end;

end.

===============================================================

abraço