• 0
Sign in to follow this  
Jhonas

Pintar Celula ( dia ) do TCalendar

Question

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

 

Calendario.JPG

Share this post


Link to post
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this