Marcar Celdas en StringGrid
 

Buenos días.

Estoy intentando crea un calendario con un StringGrid. En principio ya tengo solucionado casi todos los temas de pintar el calendar y marcar el día actual.
El problema surge cuando intento cargar días específicos.

Me explico…..

Si en el elemento OnDrawCell con el código
// wMes = Mes mostrado en calendario

Código Delphi [-]
If ( StringGrid1.Cells[ACol,ARow]=  nDia ) And ( wMes = nMes ) Then
     begin
       Canvas.Brush.Color := clRed;
       Canvas.Font.Style := [fsBold];
       Canvas.Font.Color  := clWhite;
     end;

Me marca la celda seleccionada en rojo sin ningún problema.

El problema surge cuando la carga de los datos intento hacerla de manera dinámica a trabes de una lista de fechas cargadas en un TStringList,

Código Delphi [-]
For i := 0 To ListaFechas.Count -1 Do
  Begin
   DecodeDate(StrToDate(ListaFechas.Strings[i]),nAno,nMes,nDia);
   If ( StringGrid1.Cells[ACol,ARow]= IntToStr(nDia) ) And (wMes = nMes) Then
     begin
       Canvas.Brush.Color := clRed;
       Canvas.Font.Style := [fsBold];
       Canvas.Font.Color  := clWhite;
     end;
   End;

De esta segunda manera solo me marca la ultima fecha y al cargar los datos en un listBox para verificar el funcionamiento
me repite las lista de fechas una y otra vez.

Hola ramonibk.

Este código debería pintarte las celdas que son acordes con el dia y mes de las fechas cargadas en LstFechas:

Código Delphi [-]
...
implementation

uses DateUtils;

var
  LstFechas : TStrings;
  MesActual : Integer;

...

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  i: Integer;
begin
  for i:= 0 to LstFechas.Count-1 do
    with StringGrid1 do
    begin
      if (MonthOf(StrToDate(LstFechas[i])) = MesActual) and
         (StrToInt(Cells[ACol,ARow])= DayOf(StrToDate(LstFechas[i]))) then
      begin
        Canvas.Brush.Color:= clRed;
        Canvas.Font.Color:= clWhite;
        Canvas.FillRect(Rect);
        Canvas.TextOut(Rect.Left,Rect.Top,Cells[ACol,ARow]);
      end;
    end;
end;

Saludos.

Parece que esta no es la solución.

pues al ejecutar me da el error
"list index of bounds 1239256"

Os cuento mas o menos todo el proceso pare que me comentéis.

Tengo un procedimiento llamado calendario que es quie me pinta eso el calendario.

Código Delphi [-]
Procedure TForm1.Calendario;
var
 days : array[0..6] of string;
 i, iNumDays, iDay: Integer;
 iRowCtr, iColCtr: Integer;
 Fecha : String;
begin
 Fecha := '1/' + IntToStr(wMes) + '/' + IntToStr(wAnyo);
 DaysInMonth( StrToDate( Fecha ));
 days[0] := 'L';
 days[1] := 'M';
 days[2] := 'X';
 days[3] := 'J';
 days[4] := 'V';
 days[5] := 'S';
 days[6] := 'D';
 with StringGrid1 do
  begin
   for i := 0 to 6 do
    Cells[i, 0] := days[i]
  end;
 iNumDays := MonthDays[IsLeapYear(WAnyo), WMes]; // Numero de dias en el mes
 ShortDateFormat := 'dd/mm/yyyy';
 iDay := DayOfTheWeek(StrToDate(Fecha)); // En que dia de la semana estamos (1-7)

  If iDay = 7 Then // Si el primer dia de mes es domingo
   Begin
    StringGrid1.RowCount := 7;
   End Else
   Begin
    StringGrid1.RowCount := 6;
   End;
  If  iDay = 6  Then // Si el primer dia de mes es domingo
   Begin
     If iNumDays = 31 Then
       Begin
        StringGrid1.RowCount := 7;
       End;
   End Else
   Begin
    StringGrid1.RowCount := 6;
   End;

 iRowCtr := 1;
 iColCtr := iDay - 1;
  for i := 1 to iNumDays do
   begin
    StringGrid1.Cells[iColCtr, iRowCtr] := IntToStr(i);
    Inc(iColCtr);
    if iColCtr > 6 then
     begin
      iColCtr := 0;
      Inc(iRowCtr);
     end;
   end;
end;

Este procedimiento es cargado ne el create del form.
y releído cuando se varia de mes o año y a contibuacion en el OnDrawCell

Código Delphi [-]
with Sender as TStringGrid do
  begin
   if ACol = 6 Then // Los domingos los pintamos en rojo
    Begin
     Canvas.font.Color := clRed;
     Canvas.Font.Style := [fsBold];
    End;
   if gdFixed in State then // Fila superior Dias de la semana en azul
    begin
     Canvas.Brush.Color := clNavy;
     Canvas.Font.Color := clWhite;
     Canvas.Font.Style := [fsBold];
    end;
  if gdSelected in State then  // Celda seleccionada
     begin
       Canvas.Brush.Color := clRed;
       Canvas.Font.Color := clHighlightText;
       Canvas.Font.Style := [];
     end;
//************* Aqui marco los dias especiales ********//
 if ( StringGrid1.Cells[ACol,ARow]= '10' ) And (wMes=8) Then
     begin
       Canvas.Brush.Color := clYellow;
       Canvas.Font.Style := [fsBold];
     end;

 if ( StringGrid1.Cells[ACol,ARow]= '15' ) And (wMes=8) Then
     begin
       Canvas.Brush.Color := clYellow;
       Canvas.Font.Style := [fsBold];
     end;
//***********************************************//
   Canvas.FillRect(Rect);
   Canvas.TextRect(Rect, Rect.Left + (Rect.Right - Rect.Left - Canvas.TextWidth(Cells[ACol,ARow]) + 1)
                                      div 2, Rect.Top + 2, Cells[ACol,ARow]);
  end;
end;
}

y asta aqui todo es correcto, no hay errores y funciona correctamente.
pero cuando intento sustituir.

Código Delphi [-]
//************* Aqui marco los dias especiales ********//
 if ( StringGrid1.Cells[ACol,ARow]= '10' ) And (wMes=8) Then
     begin
       Canvas.Brush.Color := clYellow;
       Canvas.Font.Style := [fsBold];
     end;

 if ( StringGrid1.Cells[ACol,ARow]= '15' ) And (wMes=8) Then
     begin
       Canvas.Brush.Color := clYellow;
       Canvas.Font.Style := [fsBold];
     end;
//***********************************************//

Por

Código Delphi [-]
DecodeDate(StrToDate(ListaFechas.Strings[i]),nAno,nMes,nDia);
 For i := 0 To ListaFechas.Count -1 Do
  Begin
    Canvas.Brush.Color := clYellow;
    Canvas.Font.Style := [fsBold];
    ListBox1.Items.Add(ListaFechas.Strings[i]); //Para verificacion de datos a cargar
  End

he intentado ponerlo por delante de

Código Delphi [-]
with Sender as TStringGrid do

como indica ecfisa en el interior de pero no hay manera y lo único que veo es que el lixbox se vuelve loco
Por cierto también he echo que cuando lo haga de manera automática no lea la primera linea ya que al ser esta las letras de día de la semana es cuelga.

<<<<<<<<<< RESUELTO >>>>>>>>>>>>

Al final he optado por lo mas sencillo, he tirado todo abajo y he empezado de cero paso a paso.

Os dejo el código del OnDrawCell por si a alguno le viene bien o se le ocurre algún arreglo mas.

Código Delphi [-]
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
Var
 i : Integer;
begin
  for i:= 0 to ListaFechas.Count-1 do
    with StringGrid1 do
       begin
         If ARow <> 0 Then
           Begin
// Decodifico la fecha que tomo de la lista.         
             DecodeDate(StrToDate(ListaFechas[i]),nYear,nMonth,nDay);
// Comparo la fecha decodificada con las que hay en el calendario.
             If ( StringGrid1.Cells[ACol,ARow]= IntToStr(nDay) ) And (wMes=nMonth) Then
                begin
                  Canvas.Brush.Color:= clRed;
                  Canvas.Font.Color:= clWhite;
                End;
           End;
         If ACol = 6 Then // Los domingos los pintamos en rojo
           Begin
             Canvas.font.Color := clRed;
             Canvas.Font.Style := [fsBold];
           End;
         If gdFixed in State then // Fila superior Dias de la semana en azul
           begin
             Canvas.Brush.Color := clNavy;
             Canvas.Font.Color := clWhite;
             Canvas.Font.Style := [fsBold];
           end;
        Canvas.FillRect(Rect);
        Canvas.TextRect(Rect, Rect.Left + (Rect.Right - Rect.Left - Canvas.TextWidth(Cells[ACol,ARow]) + 1)
                                      div 2, Rect.Top + 2, Cells[ACol,ARow]);
       End;
End;

Hola ramonibk.

Primero que nada me alegro que lo hayas solucionado.

Ahora que veo que valor tienen las celdas del StringGrid, la comparación del código que te puse no puede funcionar ya que supuse que las celdas contienian fechas.
Pero adecuando la comparación a celdas con días, funciona igual.

Esta es la prueba rápida que hice sobre tu código:

Código Delphi [-]
...
uses DateUtils;

var
  wMes:Integer= 8;
  wAnyo: Integer= 2011;
  ListaFechas:TStrings;

Procedure TForm1.Calendario;
var
 days : array[0..6] of string;
 i, iNumDays, iDay: Integer;
 iRowCtr, iColCtr: Integer;
 Fecha : String;
begin
  Fecha := '1/' + IntToStr(wMes) + '/' + IntToStr(wAnyo);
  DaysInMonth( StrToDate( Fecha ));
  days[0] := 'L';
  days[1] := 'M';
  days[2] := 'X';
  days[3] := 'J';
  days[4] := 'V';
  days[5] := 'S';
  days[6] := 'D';
  with StringGrid1 do
  begin
   for i := 0 to 6 do
    Cells[i, 0] := days[i]
  end;
  iNumDays := MonthDays[IsLeapYear(WAnyo), WMes]; // Numero de dias en el mes
  ShortDateFormat := 'dd/mm/yyyy';
  iDay := DayOfTheWeek(StrToDate(Fecha)); // En que dia de la semana estamos (1-7)

  If iDay = 7 Then // Si el primer dia de mes es domingo
    StringGrid1.RowCount := 7
  else
    StringGrid1.RowCount := 6;
  If  iDay = 6  Then // Si el primer dia de mes es domingo
    If iNumDays = 31 Then
      StringGrid1.RowCount := 7
  else
    StringGrid1.RowCount := 6;
  iRowCtr := 1;
  iColCtr := iDay - 1;
  for i := 1 to iNumDays do
   begin
    StringGrid1.Cells[iColCtr, iRowCtr] := IntToStr(i);
    Inc(iColCtr);
    if iColCtr > 6 then
     begin
      iColCtr := 0;
      Inc(iRowCtr);
     end;
   end;
  // Cargo los días 10 y 15 en ListaFechas para la prueba 
  ListaFechas:= TStringList.Create;
  ListaFechas.Add('10');
  ListaFechas.Add('15');
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Calendario;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  i: Integer;
begin
  with Sender as TStringGrid do
  begin
    if ACol = 6 Then // Los domingos los pintamos en rojo
    Begin
     Canvas.font.Color := clRed;
     Canvas.Font.Style := [fsBold];
    End;
    if gdFixed in State then // Fila superior Dias de la semana en azul
    begin
     Canvas.Brush.Color := clNavy;
     Canvas.Font.Color := clWhite;
     Canvas.Font.Style := [fsBold];
    end;
    { Desactivado (Pinta celda [0,1])
    if gdSelected in State then  // Celda seleccionada
     begin
       Canvas.Brush.Color := clRed;
       Canvas.Font.Color := clHighlightText;
       Canvas.Font.Style := [];
     end;
    }
   {************* Aqui marco los dias especiales ********}
    for i:= 0 to ListaFechas.Count-1 do
      if (ARow>0) and (wMes = 8) and (Cells[ACol,ARow]>'')and
         (StrToInt(Cells[ACol,ARow]) = StrToInt(ListaFechas[i])) then
      begin
        Canvas.Brush.Color:= clRed;
        Canvas.Font.Color:= clWhite;
        Canvas.FillRect(Rect);
        Canvas.TextOut(Rect.Left,Rect.Top,Cells[ACol,ARow]);
      end;
  end;
end;

Dado que ya solucionaste el problema, te adjunto la prueba sólo como un comentario.


Un saludo.:)

Ok Muchas gracias por la ayuda.
echo un vistazo a tu código haber si con eso aprendo que no me viene mal. jejejejje