unit CalendarioPagos;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, RdxPaneles, ExtCtrls, cxSpinEdit, cxControls, Contnrs,
  cxContainer, cxEdit, cxTextEdit, cxMaskEdit, cxDropDownEdit, RdxBotones,
  cxGraphics;

type
  TOnDrawDayEvent = procedure(Sender : TObject; ADate : TDate; var ABackColor : TColor; var AFont : TFont; var Caption : TCaption; var Hint : String) of object;
  TOnClickDayEvent = procedure(Sender : TObject; ADate : TDate) of object;
  TfrCalendarioPagos = class(TFrame)
    pnlCalendario: TPanel;
    pnlDia1: TRdxPanel;
    eDia1: TLabel;
    eTextoDia1: TLabel;
    pnlDia2: TRdxPanel;
    eDia2: TLabel;
    eTextoDia2: TLabel;
    pnlDia3: TRdxPanel;
    eDia3: TLabel;
    eTextoDia3: TLabel;
    pnlDia4: TRdxPanel;
    eDia4: TLabel;
    eTextoDia4: TLabel;
    pnlDia5: TRdxPanel;
    eDia5: TLabel;
    eTextoDia5: TLabel;
    pnlDia6: TRdxPanel;
    eDia6: TLabel;
    eTextoDia6: TLabel;
    pnlDia7: TRdxPanel;
    eDia7: TLabel;
    eTextoDia7: TLabel;
    pnlDia8: TRdxPanel;
    eDia8: TLabel;
    eTextoDia8: TLabel;
    pnlDia9: TRdxPanel;
    eDia9: TLabel;
    eTextoDia9: TLabel;
    pnlDia10: TRdxPanel;
    eDia10: TLabel;
    eTextoDia10: TLabel;
    pnlDia11: TRdxPanel;
    eDia11: TLabel;
    eTextoDia11: TLabel;
    pnlDia12: TRdxPanel;
    eDia12: TLabel;
    eTextoDia12: TLabel;
    pnlDia13: TRdxPanel;
    eDia13: TLabel;
    eTextoDia13: TLabel;
    pnlDia14: TRdxPanel;
    eDia14: TLabel;
    eTextoDia14: TLabel;
    pnlDia15: TRdxPanel;
    eDia15: TLabel;
    eTextoDia15: TLabel;
    pnlDia16: TRdxPanel;
    eDia16: TLabel;
    eTextoDia16: TLabel;
    pnlDia17: TRdxPanel;
    eDia17: TLabel;
    eTextoDia17: TLabel;
    pnlDia18: TRdxPanel;
    eDia18: TLabel;
    eTextoDia18: TLabel;
    pnlDia19: TRdxPanel;
    eDia19: TLabel;
    eTextoDia19: TLabel;
    pnlDia20: TRdxPanel;
    eDia20: TLabel;
    eTextoDia20: TLabel;
    pnlDia21: TRdxPanel;
    eDia21: TLabel;
    eTextoDia21: TLabel;
    pnlDia22: TRdxPanel;
    eDia22: TLabel;
    eTextoDia22: TLabel;
    pnlDia23: TRdxPanel;
    eDia23: TLabel;
    eTextoDia23: TLabel;
    pnlDia24: TRdxPanel;
    eDia24: TLabel;
    eTextoDia24: TLabel;
    pnlDia25: TRdxPanel;
    eDia25: TLabel;
    eTextoDia25: TLabel;
    pnlDia26: TRdxPanel;
    eDia26: TLabel;
    eTextoDia26: TLabel;
    pnlDia27: TRdxPanel;
    eDia27: TLabel;
    eTextoDia27: TLabel;
    pnlDia28: TRdxPanel;
    eDia28: TLabel;
    eTextoDia28: TLabel;
    pnlDia29: TRdxPanel;
    eDia29: TLabel;
    eTextoDia29: TLabel;
    pnlDia30: TRdxPanel;
    eDia30: TLabel;
    eTextoDia30: TLabel;
    pnlDia31: TRdxPanel;
    eDia31: TLabel;
    eTextoDia31: TLabel;
    pnlDia32: TRdxPanel;
    eDia32: TLabel;
    eTextoDia32: TLabel;
    pnlDia33: TRdxPanel;
    eDia33: TLabel;
    eTextoDia33: TLabel;
    pnlDia34: TRdxPanel;
    eDia34: TLabel;
    eTextoDia34: TLabel;
    pnlDia35: TRdxPanel;
    eDia35: TLabel;
    eTextoDia35: TLabel;
    pnlContenido: TPanel;
    pnlDia42: TRdxPanel;
    eDia42: TLabel;
    eTextoDia42: TLabel;
    pnlDia41: TRdxPanel;
    eDia41: TLabel;
    eTextoDia41: TLabel;
    pnlDia40: TRdxPanel;
    eDia40: TLabel;
    eTextoDia40: TLabel;
    pnlDia39: TRdxPanel;
    eDia39: TLabel;
    eTextoDia39: TLabel;
    pnlDia38: TRdxPanel;
    eDia38: TLabel;
    eTextoDia38: TLabel;
    pnlDia37: TRdxPanel;
    eDia37: TLabel;
    eTextoDia37: TLabel;
    pnlDia36: TRdxPanel;
    eDia36: TLabel;
    eTextoDia36: TLabel;
    pnlSuperior: TPanel;
    pnlOpciones: TPanel;
    eMes: TLabel;
    eAno: TLabel;
    bHoy: TRdxBoton;
    cbxMes: TcxComboBox;
    seAno: TcxSpinEdit;
    eLunes: TLabel;
    eMartes: TLabel;
    eMiercoles: TLabel;
    eJueves: TLabel;
    eViernes: TLabel;
    eSabado: TLabel;
    eDomingo: TLabel;
    Panel1: TPanel;
    eTextoFecha: TLabel;
    bAnterior: TRdxBoton;
    bSiguiente: TRdxBoton;
    procedure bHoyClick(Sender: TObject);
    procedure cbxMesPropertiesEditValueChanged(Sender: TObject);
    procedure seAnoPropertiesEditValueChanged(Sender: TObject);
    procedure pnlCalendarioResize(Sender: TObject);
    procedure eTextoDia1Click(Sender: TObject);
    procedure eTextoDia1MouseEnter(Sender: TObject);
    procedure eTextoDia1MouseLeave(Sender: TObject);
    procedure bAnteriorClick(Sender: TObject);
    procedure bSiguienteClick(Sender: TObject);
  private
    { Private declarations }
    FListaEtiquetasNombres : TComponentList;
    FListaPanelesDias : TComponentList;
    FListaEtiquetasDias : TComponentList;
    FListaEtiquetasTextos : TComponentList;
    FListaFechas : Array[1..42] of TDate;
    FOnDrawDay: TOnDrawDayEvent;
    FOnClickDay: TOnClickDayEvent;
    procedure InicializarListas;
    procedure RellenarCalendario; overload;
    procedure RellenarCalendario(const Fecha : TDateTime); overload;
    procedure SetOnDrawDay(const Value: TOnDrawDayEvent);
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property OnDrawDay : TOnDrawDayEvent read FOnDrawDay write SetOnDrawDay;
    property OnClickDay : TOnClickDayEvent read FOnClickDay write FOnClickDay;
  end;

implementation

uses DateUtils, StrUtils, BaseDatos;

{$R *.dfm}

{ TFrame1 }

constructor TfrCalendarioPagos.Create(AOwner: TComponent);
begin
  inherited;
  FListaEtiquetasNombres := TComponentList.Create;
  FListaPanelesDias := TComponentList.Create;
  FListaEtiquetasDias := TComponentList.Create;
  FListaEtiquetasTextos := TComponentList.Create;
  InicializarListas;

  cbxMes.ItemIndex := MonthOf(dmBaseDatos.DarFecha) - 1;
  seAno.Value := YearOf(dmBaseDatos.DarFecha);
  RellenarCalendario;
end;

procedure TfrCalendarioPagos.bHoyClick(Sender: TObject);
begin
  cbxMes.ItemIndex := MonthOf(dmBaseDatos.DarFecha) - 1;
  seAno.Value := YearOf(dmBaseDatos.DarFecha);
end;

procedure TfrCalendarioPagos.RellenarCalendario;
var
  FFecha : TDateTime;
begin
  FFecha := StrToDateTime('01/' + IntToStr(cbxMes.ItemIndex + 1) + '/' + IntToStr(seAno.Value));
  RellenarCalendario(FFecha);
end;

destructor TfrCalendarioPagos.Destroy;
begin
  FListaEtiquetasNombres.Free;
  FListaPanelesDias.Free;
  FListaEtiquetasDias.Free;
  FListaEtiquetasTextos.Free;
  inherited;
end;

procedure TfrCalendarioPagos.cbxMesPropertiesEditValueChanged(Sender: TObject);
begin
  RellenarCalendario
end;

procedure TfrCalendarioPagos.seAnoPropertiesEditValueChanged(Sender: TObject);
begin
  RellenarCalendario;
end;

procedure TfrCalendarioPagos.pnlCalendarioResize(Sender: TObject);
var
  FAncho : Integer;
  FNumPanel : Word;
  FTop : Word;
  FLeft : Word;
  FLabel : TLabel;
  FPanel : TWinControl;
begin
  if Self.Height < Self.Width then
    FAncho := (Self.Height) div 7
  else
    FAncho := (Self.Width - 20) div 7;        
  FTop := 0;
  FLeft := 0;
  pnlCalendario.Autosize := False;
  pnlCalendario.Visible := False;

  // Colocar las etiquetas con los nombres de los días de la semana
  for FNumPanel := 0 to FListaEtiquetasNombres.Count - 1 do
  begin
    FLeft := (FNumPanel mod 7) * FAncho;
    FLabel := FListaEtiquetasNombres.Items[FNumPanel] as TLabel;
    FLabel.Width := FAncho;
    FLabel.Height := 18;
    FLabel.Left := FLeft;
  end;

  // Colocar los paneles de los días del mes
  for FNumPanel := 0 to FListaPanelesDias.Count - 1 do
  begin
    FTop := (FNumPanel div 7) * FAncho + 18;
    FLeft := (FNumPanel mod 7) * FAncho;

    FPanel := FListaPanelesDias.Items[FNumPanel] as TWinControl;
    FPanel.Width := FAncho;
    FPanel.Height := FAncho;
    FPanel.Top := FTop;
    FPanel.Left := FLeft;
  end;
  pnlCalendario.Visible := True;
  pnlCalendario.Autosize := True;
  pnlOpciones.Left := (FLeft + FAncho) - pnlOpciones.Width;
end;

procedure TfrCalendarioPagos.SetOnDrawDay(const Value: TOnDrawDayEvent);
begin
  FOnDrawDay := Value;
  RellenarCalendario;
end;

procedure TfrCalendarioPagos.InicializarListas;
begin
  with FListaEtiquetasNombres do
  begin
    Add(eLunes);
    Add(eMartes);
    Add(eMiercoles);
    Add(eJueves);
    Add(eViernes);
    Add(eSabado);
    Add(eDomingo);
  end;

  with FListaPanelesDias do
  begin
    Add(pnlDia1);
    Add(pnlDia2);
    Add(pnlDia3);
    Add(pnlDia4);
    Add(pnlDia5);
    Add(pnlDia6);
    Add(pnlDia7);
    Add(pnlDia8);
    Add(pnlDia9);
    Add(pnlDia10);
    Add(pnlDia11);
    Add(pnlDia12);
    Add(pnlDia13);
    Add(pnlDia14);
    Add(pnlDia15);
    Add(pnlDia16);
    Add(pnlDia17);
    Add(pnlDia18);
    Add(pnlDia19);
    Add(pnlDia20);
    Add(pnlDia21);
    Add(pnlDia22);
    Add(pnlDia23);
    Add(pnlDia24);
    Add(pnlDia25);
    Add(pnlDia26);
    Add(pnlDia27);
    Add(pnlDia28);
    Add(pnlDia29);
    Add(pnlDia30);
    Add(pnlDia31);
    Add(pnlDia32);
    Add(pnlDia33);
    Add(pnlDia34);
    Add(pnlDia35);
    Add(pnlDia36);
    Add(pnlDia37);
    Add(pnlDia38);
    Add(pnlDia39);
    Add(pnlDia40);
    Add(pnlDia41);
    Add(pnlDia42);
  end;

  with FListaEtiquetasDias do
  begin
    Add(eDia1);
    Add(eDia2);
    Add(eDia3);
    Add(eDia4);
    Add(eDia5);
    Add(eDia6);
    Add(eDia7);
    Add(eDia8);
    Add(eDia9);
    Add(eDia10);
    Add(eDia11);
    Add(eDia12);
    Add(eDia13);
    Add(eDia14);
    Add(eDia15);
    Add(eDia16);
    Add(eDia17);
    Add(eDia18);
    Add(eDia19);
    Add(eDia20);
    Add(eDia21);
    Add(eDia22);
    Add(eDia23);
    Add(eDia24);
    Add(eDia25);
    Add(eDia26);
    Add(eDia27);
    Add(eDia28);
    Add(eDia29);
    Add(eDia30);
    Add(eDia31);
    Add(eDia32);
    Add(eDia33);
    Add(eDia34);
    Add(eDia35);
    Add(eDia36);
    Add(eDia37);
    Add(eDia38);
    Add(eDia39);
    Add(eDia40);
    Add(eDia41);
    Add(eDia42);
  end;

  with FListaEtiquetasTextos do
  begin
    Add(eTextoDia1);
    Add(eTextoDia2);
    Add(eTextoDia3);
    Add(eTextoDia4);
    Add(eTextoDia5);
    Add(eTextoDia6);
    Add(eTextoDia7);
    Add(eTextoDia8);
    Add(eTextoDia9);
    Add(eTextoDia10);
    Add(eTextoDia11);
    Add(eTextoDia12);
    Add(eTextoDia13);
    Add(eTextoDia14);
    Add(eTextoDia15);
    Add(eTextoDia16);
    Add(eTextoDia17);
    Add(eTextoDia18);
    Add(eTextoDia19);
    Add(eTextoDia20);
    Add(eTextoDia21);
    Add(eTextoDia22);
    Add(eTextoDia23);
    Add(eTextoDia24);
    Add(eTextoDia25);
    Add(eTextoDia26);
    Add(eTextoDia27);
    Add(eTextoDia28);
    Add(eTextoDia29);
    Add(eTextoDia30);
    Add(eTextoDia31);
    Add(eTextoDia32);
    Add(eTextoDia33);
    Add(eTextoDia34);
    Add(eTextoDia35);
    Add(eTextoDia36);
    Add(eTextoDia37);
    Add(eTextoDia38);
    Add(eTextoDia39);
    Add(eTextoDia40);
    Add(eTextoDia41);
    Add(eTextoDia42);
  end;
end;

procedure TfrCalendarioPagos.eTextoDia1Click(Sender: TObject);
var
  FNombre : String;
begin
  if Assigned(FOnClickDay) then
  begin
    FNombre := (Sender as TLabel).Name;
    FNombre := Copy(FNombre, Length('eTextoDia') + 1, 2);
    FOnClickDay(Self, FListaFechas[StrToInt(FNombre)]);
  end;
end;

procedure TfrCalendarioPagos.eTextoDia1MouseEnter(Sender: TObject);
begin
  with (((Sender as TLabel).Parent) as TRdxPanel) do
  begin
    ColorShadow := clBlack;
    ColorHighLight := clBlack;
  end;
end;

procedure TfrCalendarioPagos.eTextoDia1MouseLeave(Sender: TObject);
begin
  with (((Sender as TLabel).Parent) as TRdxPanel) do
  begin
    ColorShadow := $008396A0;
    ColorHighLight := $008396A0;
  end;
end;

procedure TfrCalendarioPagos.RellenarCalendario(const Fecha: TDateTime);
var
  FFecha : TDateTime;
  FDiasMes : Word;
  FContadorDia : Word;
  FDia : Word;
  FPrimerDia : Word;
  FTexto : TCaption;
  FHint : String;
  FBackColor : TColor;
  AFont : TFont;
  FPos : String;
begin
  FFecha := Fecha;
  cbxMes.ItemIndex := MonthOf(FFecha) - 1;
  seAno.Value := YearOf(FFecha);
  eTextoFecha.Caption := cbxMes.Text + ' de ' + IntToStr(seAno.Value);

  FDiasMes := DaysInAMonth(YearOf(FFecha), MonthOf(FFecha));
  FPrimerDia := DayOfTheWeek(FFecha);
  FDia := FPrimerDia - 1;
  FContadorDia := 0;

  AFont := TFont.Create;
  try
    // Rellenar la parte final del mes anterior
    if (FPrimerDia - 2) >= 0 then
    begin
      FFecha := IncDay(FFecha, (FDia * (-1)));
      FDiasMes := DaysInAMonth(YearOf(FFecha), MonthOf(FFecha));
      FDia := DayOf(FFecha);

      for FContadorDia := 0 to (FPrimerDia - 2) do
      begin
        with (FListaEtiquetasDias.Items[FContadorDia] as TLabel) do
        begin
          Caption := IntToStr(FDia);
          Font.Color := clAppWorkSpace;
          Color := clBtnFace;
          FPos := Name;
          FPos := Copy(FPos, Length('eDia') + 1, 2);
          FListaFechas[StrToInt(FPos)] := FFecha;
        end;

        with (FListaEtiquetasTextos.Items[FContadorDia] as TLabel) do
        begin
          FTexto := '';
          FHint := '';
          FBackColor := $00EFF7F7;
          with AFont do
          begin
            Name := 'Tahoma';
            Color := $00737373;
            Style := [];
          end;

          if DayOfTheWeek(FListaFechas[StrToInt(FPos)]) = DaySunday then
          begin
            AFont.Color := $00564EBA;
            FBackColor := $00D9E5E9;
          end;

          if Assigned(FOnDrawDay) then
            FOnDrawDay(Self, FListaFechas[StrToInt(FPos)], FBackColor, AFont, FTexto, FHint);
          (FListaEtiquetasTextos.Items[FContadorDia] as TLabel).Color := FBackColor;
          Font.Assign(AFont);
          Caption := FTexto;
          Hint := FHint;
        end;
        FFecha := IncDay(FFecha);
        FDia := DayOf(FFecha);
      end;
    end;


    FDiasMes := DaysInAMonth(YearOf(FFecha), MonthOf(FFecha));
    FDia := FContadorDia;
    // Rellenar los paneles del mes
    for FContadorDia := 1 to FDiasMes do
    begin
      with (FListaEtiquetasDias.Items[FDia] as TLabel) do
      begin
        Caption := IntToStr(FContadorDia);
        Font.Color := clWindowText;
        Color := $00C2F0FF;//$00D9E5E9;
      end;
      with (FListaEtiquetasTextos.Items[FDia] as TLabel) do
      begin
        FTexto := '';
        FHint := '';
        FBackColor := clWhite;
        with AFont do
        begin
          Name := 'Tahoma';
          Color := clWindowText;
          Style := [];
        end;
        FPos := Name;
        FPos := Copy(FPos, Length('eTextoDia') + 1, 2);
        FListaFechas[StrToInt(FPos)] := IncDay(FFecha, FContadorDia - 1);

        if DayOfTheWeek(FListaFechas[StrToInt(FPos)]) = DaySunday then
        begin
          with (FListaEtiquetasDias.Items[FDia] as TLabel) do
          begin
            Color := $00BCBBEE;
            Font.Color := $001F1A62;
          end;
        end;

        if Assigned(FOnDrawDay) then
          FOnDrawDay(Self, FListaFechas[StrToInt(FPos)], FBackColor, AFont, FTexto, FHint);
        (FListaEtiquetasTextos.Items[FDia] as TLabel).Color := FBackColor;
        Font.Assign(AFont);
        Caption := FTexto;
        Hint := FHint;
      end;
      FDia := FDia + 1;
    end;

    // Rellenar los paneles que quedan al final
    FFecha := IncMonth(FFecha, 1);
    FFecha := StartOfAMonth(YearOf(FFecha), MonthOf(FFecha));
    for FContadorDia := 1 to ((FListaEtiquetasDias.Count) - FDia) do
    begin
      with (FListaEtiquetasDias.Items[FDia] as TLabel) do
      begin
        Caption := IntToStr(FContadorDia);
        Font.Color := clAppWorkSpace;
        Color := clBtnFace;
        FPos := Name;
        FPos := Copy(FPos, Length('eDia') + 1, 2);
        FListaFechas[StrToInt(FPos)] := FFecha;
        FFecha := IncDay(FFecha);
      end;

      with (FListaEtiquetasTextos.Items[FDia] as TLabel) do
      begin
          FTexto := '';
          FHint := '';
          FBackColor := $00E2E9E9;
          with AFont do
          begin
            Name := 'Tahoma';
            Color := $00737373;
            Style := [];
          end;


          if DayOfTheWeek(FListaFechas[StrToInt(FPos)]) = DaySunday then
          begin
            AFont.Color := $00564EBA;
            FBackColor := $00D9E5E9;
          end;

          if Assigned(FOnDrawDay) then
            FOnDrawDay(Self, FListaFechas[StrToInt(FPos)], FBackColor, AFont, FTexto, FHint);
          (FListaEtiquetasTextos.Items[FDia] as TLabel).Color := FBackColor;
          Font.Assign(AFont);
          Caption := FTexto;
          Hint := FHint;
       end;
       FDia := FDia + 1;
    end;
  finally
    AFont.Free;
  end;
end;

procedure TfrCalendarioPagos.bSiguienteClick(Sender: TObject);
var
  FechaAux : TDate;
begin
  FechaAux := StrToDate('01/' + IntToStr(cbxMes.ItemIndex + 1) + '/' + IntToStr(seAno.Value));
  FechaAux := IncMonth(FechaAux);
  RellenarCalendario(FechaAux);
end;

procedure TfrCalendarioPagos.bAnteriorClick(Sender: TObject);
var
  FechaAux : TDate;
begin
  FechaAux := StrToDate('01/' + IntToStr(cbxMes.ItemIndex + 1) + '/' + IntToStr(seAno.Value));
  FechaAux := IncMonth(FechaAux, -1);
  RellenarCalendario(FechaAux);
end;

end.