Primeiro, insira em um formulário os seguintes objetos e os renomeie:

- TForm --> frm_calendario;
- TPanel --> pnl_mes_01;
- TPanel --> pnl_mes_02;
- TPanel --> pnl_mes_03;
- TPanel --> pnl_mes_04;
- TPanel --> pnl_mes_05;
- TPanel --> pnl_mes_06;
- TPanel --> pnl_mes_07;
- TPanel --> pnl_mes_08;
- TPanel --> pnl_mes_09;
- TPanel --> pnl_mes_10;
- TPanel --> pnl_mes_11;
- TPanel --> pnl_mes_12;
- TStringGrid --> stg_mes_01;
- TStringGrid --> stg_mes_02;
- TStringGrid --> stg_mes_03;
- TStringGrid --> stg_mes_04;
- TStringGrid --> stg_mes_05;
- TStringGrid --> stg_mes_06;
- TStringGrid --> stg_mes_07;
- TStringGrid --> stg_mes_08;
- TStringGrid --> stg_mes_09;
- TStringGrid --> stg_mes_10;
- TStringGrid --> stg_mes_11;
- TStringGrid --> stg_mes_12;
- TEdit --> edt_ano;
- TEdit --> edt_data_consulta
- TButton --> btn_gerar_calendario

Organize os objetos de forma a ficar semelhante a um calendário e implemente as rotinas abaixo;

Figura 1 - Interface do projeto em DesignTime

A seguir, as codificações:

function ano_bisexto(Lint_ano: Integer): Boolean;
begin
  //Verifica se o ano é bissexto
  Result := (Lint_ano mod 4 = 0) and ((Lint_ano mod 100 <> 0) or
            (Lint_ano mod 400 = 0));
  //Também pode-se usar a função "IsLeapYear(Year: Word): Boolean",
  //existente em SysUtils
end;

//Função para determinar o último dia do mês
function ultimo_dia_mes(Lint_ano, Lint_mes: Integer): Integer;
const
  //Array que armazena último dia de cada mês
  dia_mes: array[1..12] of Integer = (31,28,31,30,31,30,31,31,30,31,30,31);
  //-----------> mês de referência =  J  F  M  A  M  J  J  A  S  O  N  D
begin
  Result := dia_mes[Lint_mes];
  //Tratamento para ano bisexto. Caso seja fevereiro, incrementa 1 dia
  if (Lint_mes = 2) and ano_bisexto(Lint_ano) then
    Inc(Result);
end;


procedure Tfrm_calendario.carrega_calendario(Lstr_mes, Lstr_ano: string;
  String_Grid: TStringGrid; pnl_panel: TPanel);
var
  Lint_dia_semana, i, Lint_ultimo_dia, Lint_linha: integer;
begin
  //ajusta a largura das colunas
  for i := 0 to String_Grid.ColCount - 1 do
    String_Grid.ColWidths[i] := 25;

  //ajusta a altura das linhas
  for i := 0 to String_Grid.RowCount - 1 do
    String_Grid.RowHeights[i] := 15;

  //Exibe no panel o mês de referência do calendário
  case strtoint(Lstr_mes) of
    1: pnl_panel.Caption := '01';
    2: pnl_panel.Caption := '02';
    3: pnl_panel.Caption := '03';
    4: pnl_panel.Caption := '04';
    5: pnl_panel.Caption := '05';
    6: pnl_panel.Caption := '06';
    7: pnl_panel.Caption := '07';
    8: pnl_panel.Caption := '08';
    9: pnl_panel.Caption := '09';
    10: pnl_panel.Caption := '10';
    11: pnl_panel.Caption := '11';
    12: pnl_panel.Caption := '12';
  end;

  //Formata o ano para fica no formato yy
  if strtoint(Lstr_ano) < 10 then
    Lstr_ano := '0' + Lstr_ano;

  //Concatena no panel o ano com o mês de referência do calendário
  pnl_panel.Caption := pnl_panel.Caption + '/' + Lstr_ano;

  //Insere na primeira linha do stringgrid os dias da semana
  String_Grid.Cells[0,0] := ' D';
  String_Grid.Cells[1,0] := ' S';
  String_Grid.Cells[2,0] := ' T';
  String_Grid.Cells[3,0] := ' Q';
  String_Grid.Cells[4,0] := ' Q';
  String_Grid.Cells[5,0] := ' S';
  String_Grid.Cells[6,0] := ' S';

  //Seta a variável do dia da semana para 1
  Lint_dia_semana := 1;

  //Seta a variável do que controla a linha do string para 1
  Lint_linha :=1;

  //Limpa as células do stringgrid
  for i := 1 to 49 do
  begin
    String_Grid.Cells[Lint_dia_semana - 1 ,Lint_linha] := '';
    inc(Lint_dia_semana);
    if Lint_dia_semana = 8 then
    begin
      Lint_dia_semana := 1;
      inc(Lint_linha);
    end;
  end;

  //Determina o dia da semana do primeiro dia do mês
  Lint_dia_semana := dayofweek(strtodate('01/' + Lstr_mes + '/' + Lstr_ano));

  //Armazena o último dia do mês (28, 29, 30 ou 31)
  Lint_ultimo_dia := ultimo_dia_mes(strtoint(Lstr_ano), StrToInt(Lstr_mes));

  Lint_linha := 1;

  //Loop para inserir no stringgrid (calendário) os dias
  for i := 1 to Lint_ultimo_dia do
  begin
    String_Grid.Cells[Lint_dia_semana - 1 ,Lint_linha] := inttostr(i);
    inc(Lint_dia_semana);
    //Tratamento se o último dia semana = 8, converte para 0 (segunda-feira)
    if Lint_dia_semana = 8 then
    begin
      Lint_dia_semana := 1;
      inc(Lint_linha);
    end;
  end;
end;

//procedure para carregar os calendários
procedure Tfrm_calendario.prepara_carrega_calendario();
var
  Lint_ano: integer;
  Lstr_dia: string;
begin
    carrega_calendario(inttostr(1),
                       edt_ano.text,
                       stg_mes_01,
                       pnl_mes_01);

    carrega_calendario(inttostr(2),
                       edt_ano.text,
                       stg_mes_02,
                       pnl_mes_02);

    carrega_calendario(inttostr(3),
                       edt_ano.text,
                       stg_mes_03,
                       pnl_mes_03);

    carrega_calendario(inttostr(4),
                       edt_ano.text,
                       stg_mes_04,
                       pnl_mes_04);

    carrega_calendario(inttostr(5),
                       edt_ano.text,
                       stg_mes_05,
                       pnl_mes_05);

    carrega_calendario(inttostr(6),
                       edt_ano.text,
                       stg_mes_06,
                       pnl_mes_06);

    carrega_calendario(inttostr(7),
                       edt_ano.text,
                       stg_mes_07,
                       pnl_mes_07);

    carrega_calendario(inttostr(8),
                       edt_ano.text,
                       stg_mes_08,
                       pnl_mes_08);

    carrega_calendario(inttostr(9),
                       edt_ano.text,
                       stg_mes_09,
                       pnl_mes_09);

    carrega_calendario(inttostr(10),
                       edt_ano.text,
                       stg_mes_10,
                       pnl_mes_10);

    carrega_calendario(inttostr(11),
                       edt_ano.text,
                       stg_mes_11,
                       pnl_mes_11);

    carrega_calendario(inttostr(12),
                       edt_ano.text,
                       stg_mes_12,
                       pnl_mes_12);
end;

//Caso seja necessário marcar alguma data, como por exemplo, para uma
//consulta ou reunião, no evento onDrawCell do Primeiro Grid, implemente
//o seguinte código, e depois ligue o Evento de Todos os Outros Grids ao
//deste (Obs.: No edt_data_consulta insira uma data no formato dd/MM/yyyy):
procedure Tfrm_semestre_letivo.stg_mes_01DrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  Lstr_dia : string;
begin
  Lstr_dia := (Sender as TStringGrid).Cells[ACol, ARow];
  try
    if (strtoint(copy(edt_data_consulta.text,1,2)) = strtoint(Lstr_dia)) and
       (strtoint(copy(edt_data_consulta.text,4,2)) =
        StrToInt(Copy((Sender as TStringGrid).Name, 9, 2))) then
    begin
      with (Sender as TStringGrid) do
      begin
        Canvas.Font.Color := clWhite;
        Canvas.Brush.Color := clRed;
        Canvas.TextRect(Rect, Rect.Left+2, Rect.Top + 2,
          (Sender as TStringGrid).Cells[ACol, ARow]);
      end;
    end;
  except
  end;
end;

//código do botão Gerar
procedure Tfrm_calendario.btn_gerar_calendarioClick(Sender: TObject);
begin
  try
    strtoint(edt_ano.text)
  except
    Showmessage('Favor informar um ano válido para gerar o calendário.');
    exit;
  end;
 
  prepara_carrega_calendario;
end;

Segue uma imagem do programa em execução:

Figura 2 - Programa em execução

Espero que este código seja útil para a comunidade.

Clique aqui para baixar os fontes de exemplo.

Por: ruysalles
Contato: ruysalles@ig.com.br