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
Cita:
/******************************************************************************/
/* 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
public
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
uses Unit1;
procedure TForm2.Button1Click(Sender: TObject);
begin
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
public
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);
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;
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);
var ano,mes,dia : word;
xDataAtual : TDateTime;
x: array of Cardinal;
i: integer;
varFinicio,varfFin,varFactual:TDate;
begin
uxtheme.SetWindowTheme(MonthCalendar1.Handle, '', ''); 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; 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.