Crear un calendario y que los eventos esten almacenados en access.

[[José Luis Garcí]]

Hola Feliz-58, como te dije por el privado, público el resultado para que sea útil para otros compañeros, tal como te dije lo he hecho en firebird con sólo una tabla, muy sencilla cuyo código es

/******************************************************************************/
/* Tables */
/******************************************************************************/



CREATE TABLE CALENDARIO (
ID INTEGER NOT NULL,
FECHA DATE,
NOTA VARCHAR(100)
);




/******************************************************************************/
/* Primary Keys */
/******************************************************************************/

ALTER TABLE CALENDARIO ADD CONSTRAINT PK_CALENDARIO PRIMARY KEY (ID);

Le añadí los siguientes campos



Aquí tenéis la pantalla inicial Form2 tanto en fase de diseño, como de uso



El código de este form

Código Delphi [-]
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, IBCustomDataSet, IBDatabase;

type
  TForm2 = class(TForm)
    Button1: TButton;
    DB: TIBDatabase;
    IBT: TIBTransaction;
    Tabla: TIBDataSet;
    TablaID: TIntegerField;
    TablaFECHA: TDateField;
    TablaNOTA: TIBStringField;
    DS1: TDataSource;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

uses Unit1;

procedure TForm2.Button1Click(Sender: TObject);
begin
//   ZeroMemory(@Dia,SizeOf(Dia));    //PAra vaciar el array
   Form1.Show;
end;

end.

y la unidad que realmente lo hace todo



y como no su código

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, DBCtrls, ComCtrls, Mask, DB, IBQuery,
  IBCustomDataSet, IBDatabase, UxTheme, Grids, DBGrids, DateUtils;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    butSalir: TButton;
    IBQ1: TIBQuery;
    Label2: TLabel;
    DBEdit2: TDBEdit;
    Label3: TLabel;
    DBEdit3: TDBEdit;
    LV: TListView;
    DBNavigator1: TDBNavigator;
    Panel2: TPanel;
    IBQ2: TIBQuery;
    dsIBq1: TDataSource;
    dsIBQ2: TDataSource;
    DSPrincipal: TDataSource;
    MonthCalendar1: TMonthCalendar;
    DBGrid1: TDBGrid;
    procedure butSalirClick(Sender: TObject);
    procedure MonthCalendar1Click(Sender: TObject);
    procedure MonthCalendar1GetMonthInfo(Sender: TObject; Month: Cardinal; var MonthBoldInfo: Cardinal);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Unit2;

procedure TForm1.butSalirClick(Sender: TObject);
begin
   Application.Terminate;
end;

function Cambiafecha(ffecha:tDateTime):string;
var
    fec2:string;
    Present: TDateTime;
    Year, Month, Day, Hour, Min, Sec, MSec: Word;
begin
        Present:= ffecha;
        DecodeDate(Present, Year, Month, Day);
        fec2:=inttostr(month)+'/'+inttostr(day)+'/'+inttostr(year);
        result:=fec2;
end;

procedure TForm1.MonthCalendar1Click(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************[ MonthCalendar Click (ANOTACIONES) ]****
//------------------------------------------------------------------------------
var Item: TListItem;
    Contador:Integer;
begin
   try
      IBQ2.Active:=false;
      IBQ2.SQL.Clear;
      IBQ2.SQL.Text:='SELECT * FROM CALENDARIO WHERE (CALENDARIO.FECHA='+QuotedStr(Cambiafecha(MonthCalendar1.Date))+')';
      IBQ2.Active:=true;
   except
      on E: Exception do
      begin
        ShowMessage('Se ha producido el error [ '+E.Message+' ]');
      end;
   end;
   with dsIBq2.DataSet do
   begin
     Close;
     Filtered := False;
     Filter := 'FECHA = ' + QuotedStr(DateTimeToStr(MonthCalendar1.Date));
     Filtered := True;
     Open;
     if not IsEmpty then
     begin
       Panel2.Caption := 'Notas para el día ' + FieldByName('FECHA').AsString;
       DSPrincipal.DataSet.Locate('FECHA', FieldByName('FECHA').value,[loPartialKey,loCaseInsensitive]);
     end else Panel2.Caption := 'No hay notas para este día';
   end;
   //Aqui cargamos en el listview=LV
   LV.Clear;
   LV.GridLines := True;
   Contador:=0;
   if IBQ2.IsEmpty=false then
   begin
      IBQ2.First;
      while not IBQ2.Eof do
      begin
        item:=LV.Items.Add;
        item.SubItems.add(IBQ2.FieldByName('NOTA').AsString);
        item.SubItems.add(IBQ2.FieldByName('NOTA').AsString);
        IBQ2.Next;
      end;
   end;
end;

procedure TForm1.MonthCalendar1GetMonthInfo(Sender: TObject; Month: Cardinal;
  var MonthBoldInfo: Cardinal);
//------------------------------------------------------------------------------
//*******************************[ MonthCalendar (anotaciones)  preparamos ]****
// MArcamos lo días para los que hay notas y coloreamos
//------------------------------------------------------------------------------
var    ano,mes,dia : word;
xDataAtual : TDateTime;
x: array of Cardinal;
i: integer;
varFinicio,varfFin,varFactual:TDate;
begin
   uxtheme.SetWindowTheme(MonthCalendar1.Handle, '', '');  //Desactiva los temas usar uses UxTheme
   x := Nil;
   DecodeDate(MonthCalendar1.Date, ano, mes, dia);
   case Month of
      1: if mes = 12 then  ano := ano + 1;
      12: if mes = 1 then  ano := ano - 1;
   end;
   varFinicio:=strtodate('01/'+inttostr(mes)+'/'+IntToStr(ano));
   if mes<12 then varffin:=strtodate('01/'+inttostr(mes+1)+'/'+inttostr(ano))
           else varffin:=strtodate('01/01/'+inttostr(ano+1));
   xDataAtual := EncodeDate(ano, Month, 1);
   i := -1;
   try
      IBQ1.Active:=false;
      IBQ1.SQL.Clear;
      IBQ1.SQL.Text:='SELECT * FROM CALENDARIO WHERE (CALENDARIO.FECHA BETWEEN '+QuotedStr(Cambiafecha(varFinicio))+' AND '+QuotedStr(Cambiafecha(EndOfTheMonth(varFinicio)))+') ORDER BY CALENDARIO.FECHA';
      IBQ1.Active:=true;
      IBQ2.Active:=false;
      IBQ2.SQL.Clear;
      IBQ2.SQL.Text:='SELECT count(FECHA) FROM CALENDARIO WHERE (CALENDARIO.FECHA BETWEEN '+QuotedStr(Cambiafecha(varFinicio))+' AND '+QuotedStr(Cambiafecha(EndOfTheMonth(varFinicio)))+')';
      IBQ2.Active:=true;
   except
      on E: Exception do
      begin
        ShowMessage('Se ha producido el error [ '+E.Message+' ]');
      end;
   end;
   with dsIBq1.DataSet do
   begin
      mes := mes +1;
      Close;
      Filtered := False;
      Filter := 'FECHA >= ' + QuotedStr(DateTimeToStr(StartOfTheMonth(xDataAtual)))+ ' AND FECHA <= ' + QuotedStr(DateTimeToStr(EndOfTheMonth(xDataAtual)));
      Filtered := True;        // StartOfTheMonth y EndOfTheMonth // Unit DateUtils
      Open;
      if IsEmpty then Exit;
      SetLength(x, IBQ2.FieldByName('COUNT').AsInteger);
      while not(Eof) do
      begin
         Inc(i);
         DecodeDate(FieldByName('FECHA').AsDateTime, ano, mes, dia);
         x[i] := dia;
         Next;
      end;
      Close;
   end;
   MonthCalendar1.BoldDays(x, MonthBoldInfo);
end;

end.

Ahora te toca implementarlo en tu sistema y a tu tipo de base de datos.

Un saludo y que te sea útil.