agenda de eventos com calendario

unit uAgenda;

interface

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

type
  TEvento = record
    Descricao: String;
    Data: TDateTime;
  end;

  TEventos = Array of TEvento;

  TNewMonthCalendar = Class(TMonthCalendar)
  private
    FEvento: TEventos;
  published
    property Evento: TEventos read FEvento write FEvento;
  public
    constructor Create(AOwner: TComponent); override;
    function Salvar(Descricao: String; Data: TDateTime): Boolean;
    procedure NewMonthCalendarClick(Sender: TObject);
    procedure NewMonthCalendarGetMonthInfo(Sender: TObject; Month: Cardinal;
      var MonthBoldInfo: Cardinal);
  end;

  TfAgenda = class(TForm)
    Label1: TLabel;
    edtDia: TEdit;
    Label2: TLabel;
    edtMes: TEdit;
    Label3: TLabel;
    edtAno: TEdit;
    Label4: TLabel;
    edtEvento: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FData: TDateTime;
    function GetData: TDateTime;
    function GetDescricao: String;
    procedure LimpaCampos;
    { Private declarations }
  public
    { Public declarations }
    property Data: TDateTime read GetData;
    property Descricao: String read GetDescricao;
    procedure CriaMonthCalendar;
  end;

var
  fAgenda: TfAgenda;
  NewMonthCalendar: TNewMonthCalendar;

implementation

{$R *.dfm}

procedure TfAgenda.Button1Click(Sender: TObject);
begin
  if NewMonthCalendar.Salvar(Descricao, Data) then
    begin
      Application.MessageBox('Evento registrado com sucesso!', PAnsiChar(Application.Title), MB_OK + MB_ICONWARNING);
      NewMonthCalendar.Date := NewMonthCalendar.Date + 32;
      NewMonthCalendar.Date := NewMonthCalendar.Date - 32;
      LimpaCampos;
    end
  else
    Application.MessageBox('Ocorreu um erro, o evento não foi registrado!', PAnsiChar(Application.Title), MB_OK + MB_ICONWARNING);
end;

{ TNewMonthCalendar }

procedure TfAgenda.CriaMonthCalendar;
begin
  NewMonthCalendar := TNewMonthCalendar.Create(nil);

  NewMonthCalendar.Left := 16;
  NewMonthCalendar.Top := 16;
  NewMonthCalendar.Date := Now;
  NewMonthCalendar.Parent := fAgenda;
  NewMonthCalendar.Visible := True;
end;

function TfAgenda.GetData: TDateTime;
begin
  if (edtDia.Text = '') or (edtMes.Text = '') or (edtAno.Text = '') then
    begin
      Application.MessageBox('Informe Dia/Mês/Ano nos espaços reservados!', PAnsiChar(Application.Title), MB_OK + MB_ICONWARNING);
      Abort;
    end;

  Result := StrToDateTime(edtDia.Text + '/' + edtMes.Text + '/' + edtAno.Text);
end;

procedure TfAgenda.FormShow(Sender: TObject);
begin
  CriaMonthCalendar;
end;

procedure TfAgenda.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeAndNil(NewMonthCalendar);
end;

{ TNewMonthCalendar }

constructor TNewMonthCalendar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  OnClick := NewMonthCalendarClick;
  OnGetMonthInfo := NewMonthCalendarGetMonthInfo;
  SetLength(FEvento, 366);
end;

procedure TNewMonthCalendar.NewMonthCalendarClick(Sender: TObject);
var
  I: Integer;
begin
  if FEvento = nil then
    Exit;

  Self.Hint := '';
  Self.ShowHint := False;

  for I := Low(FEvento) to High(FEvento) do
    begin
      if FEvento[I].Data = TNewMonthCalendar(Sender).Date then
        Self.Hint := FEvento[I].Descricao;

      Self.ShowHint := True;
    end;
end;

procedure TNewMonthCalendar.NewMonthCalendarGetMonthInfo(Sender: TObject;
  Month: Cardinal; var MonthBoldInfo: Cardinal);
var
  I, X, Count: Integer;
  Dias: Array of Cardinal;
  Mes: TDateTime;
begin
  if FEvento = nil then
    Exit;

  Count := 0;

  for I := Low(FEvento) to High(FEvento) do
    begin
      if FEvento[I].Data <> 0 then
        begin
          Mes := StrToInt(FormatDateTime('mm', FEvento[I].Data));

          if Mes = Month then
            Inc(Count);
        end;
    end;

  if Count <> 0 then
    SetLength(Dias, Count);

  if Dias <> nil then
    for I := Low(FEvento) to High(FEvento) do
      begin
        if FEvento[I].Data <> 0 then
          begin
            Mes := StrToInt(FormatDateTime('mm', FEvento[I].Data));

            if Mes = Month then
              for X := 0 to Count do
                if Dias[X] = 0 then
                  begin
                    Dias[X] := StrToInt(FormatDateTime('dd', FEvento[I].Data));
                    Break;
                  end;
          end;
      end;

  if Dias <> nil then
    Self.BoldDays(Dias, MonthBoldInfo);
end;

function TNewMonthCalendar.Salvar(Descricao: String; Data: TDateTime): Boolean;
var
  I: Integer;
begin
  if Trim(Descricao) = '' then
    Exit;

  Result := False;

  for I := Low(FEvento) to High(FEvento) do
    begin
      if (FEvento[I].Descricao = '') and (FEvento[I].Data = 0) then
        begin
          FEvento[I].Descricao := Descricao;
          FEvento[I].Data := Data;
          Result := True;
          Break;
        end;
    end;
    
  Self.Refresh;
end;

function TfAgenda.GetDescricao: String;
begin
  if Length(edtEvento.Text) < 5 then
    begin
      Application.MessageBox('Descrição do evento deve conter mais de 5 caracteres!', PAnsiChar(Application.Title), MB_OK + MB_ICONWARNING);
      Abort;
    end;

  Result := edtEvento.Text;
end;

procedure TfAgenda.LimpaCampos;
begin
  edtDia.Clear;
  edtMes.Clear;
  edtAno.Clear;
  edtEvento.Clear;
end;

end.