17 respuestas en este tema

[TiammatMX]

...obviamente, bajo condicionamiento.

Jóvenes delphineros, buen día/tarde/noche. Continuando con el tema de los TStringGrid's, ahora debo cambiar bajo una condición específica algunas celdas de un TStringGrid (véase la imagen anexa); éstas celdas son parte de las columnas fijas que integran el TStringGrid.

Como siempre, acepto ideas, palmaditas (¡¡PALMADITAS, ELISEO!! ) en la espalda, código, condolencias...

Archivos adjuntos

•  4085_ad220d3d1751662b4c1ff25a5765fd74ffc81110.jpg   212,94KB   16 descargas

[enecumene]

¿Vale una orejita pues?

delphi

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
   With Sender as TStringGrid do
   begin
      if Cells[4,Arow] = 'Diabetes' then //aqui filtras la columna Cells[N,ARow]
      begin
         Canvas.Brush.Color := clRed;
         Canvas.FillRect(Rect);
         Canvas.Font.Color := clGreen;
         Canvas.TextRect( Rect, Rect.Left+2, Rect.Top+2, Cells[acol, arow]);
      end;
   end;
end;

Saludos.

[TiammatMX]

¿Vale una orejita pues? ...

Buenas Enecumene.

Probando con:

delphi

   with Sender as TStringGrid do
   begin
      if Cells[01,ARow] = 'Desnutrición III' then //aqui filtras la columna Cells[N,ARow]
      begin
         Canvas.Brush.Color := clRed;
         Canvas.FillRect(Rect);
         Canvas.Font.Color := clGreen;
         Canvas.TextRect( Rect, Rect.Left+2, Rect.Top+2, Cells[01,ARow]);
      end;
   end;

Obtengo el resultado en la imagen. Sí, se colorea de rojo, pero no solamente la celda que me interesa, sino TODA LA FILA...

Archivos adjuntos

•  4089_1aa6e63358f8041968dc57bc5155ca9b4e22af18.jpg   71,55KB   8 descargas

[Wilson]

Con la ayuda de una vieja función de Zarko, que posibilita hacer un CASE con strings, te he desarrollado un pequeño ejemplo para lograr lo que buscas.
Puedes ajustar el array a tus necesidades y obviamente completar el CASE.

delphi

function StringToCaseSelect(Selector: string;
  CaseList: array of string): Integer;
var
  cnt: Integer;
begin
  Result := -1;
  for cnt := 0 to Length(CaseList) - 1 do
  begin
    if CompareText(Selector, CaseList[cnt]) = 0 then
    begin
      Result := cnt;
      Break;
    end;
  end;
end;
 
 
procedure TForm1.StringGrid2DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  with Sender as TStringGrid do
  begin
    case StringToCaseSelect(Cells[ACol, ARow],
      ['DESNUTRICION I', 'DESNUTRICION II', 'BAJO PESO', 'DIABETICO']) of
      0:
        Canvas.Brush.Color := ClRed;
      1:
        Canvas.Brush.Color := ClBlue;
      2:
        Canvas.Brush.Color := ClGreen;
      3:
        Canvas.Brush.Color := clFuchsia;
    end;
    Canvas.FillRect(Rect);
    Canvas.TextOut(Rect.Left + 2, Rect.Top + 2, Cells[ACol, ARow]);
  end;
end;

[TiammatMX]

Con la ayuda de una vieja función de Zarko, ...

¡Ah, San Zarko Gäjic!, entonces es casi garantía que funcione...  Déjame terminar y que las celdas queden como lo necesito y con todo gusto lo implementamos, cómo de que no... 


¡Buen día!

Actualización. Usando éste código:

 

delphi

with Sender as TStringGrid do
   begin
   if Cells[01,ARow] = 'Desnutrición III' then
      begin
         with TheRect do
         begin
            Left   := ColWidths[00]+GridLineWidth;
            Top    := (RowHeights[ARow]*ARow)+(GridLineWidth*ARow);
            Right  := ColWidths[00]+ColWidths[01]+ColWidths[02]+GridLineWidth;
            Bottom := (RowHeights[ARow]*(ARow+1))+(GridLineWidth*ARow);
         end;
         Canvas.Brush.Color := clMoneyGreen;
         Canvas.FillRect(TheRect);
         Canvas.Font.Color := clRed;
         Canvas.TextRect( TheRect, TheRect.Left+2, TheRect.Top+2, Cells[01,ARow]);
      end;
.
.
.
.
.
.
.
 
   end;

El resultado se muestra en la imagen..., voy progresando, casi termino... 

Archivos adjuntos

•  4091_8554106ef2acccef631e483bc54652579a2cec15.jpg   220,63KB   16 descargas

[Wilson]

Con la ayuda de una vieja función de Zarko, ...

¡Ah, San Zarko Gäjic!, entonces es casi garantía que funcione... 

De Zarko es la función StringToCaseSelect, el resto de código es mio  , y por supuesto que funciona de maravillas. 

Un cordial saludo, esperando que sean las tres de la tarde para ver a mi amada selección Colombia de futbol ganarle a Bolivia.

[cadetill]

Desde hace mucho que tenemos una FAQ aquí mismo que nos enseña como hacer un case de string y sin necesidad de un bucle.

Nos leemos

[TiammatMX]

...y dos semanas después..., ¡¡¡TERMINÉ SATISFACTORIAMENTE!!!

El resultado, lo pueden observar en la imagen anexa.

El código, inmediatamente:

delphi

procedure TfrmPrescripcionDieteticaInicial.stgProcesarDrawCell(Sender: TObject; ACol, ARow: Integer; TheRect: TRect; State: TGridDrawState);
 
   function ExisteEnTitulo(sTexto: string): Boolean;
   var
      iIndicador: Integer;
   begin
      Result := False;
      for iIndicador := 0 to Length(aTextoColor)-1 do
      begin
         if Trim(aTextoColor[iIndicador,TEXTOCELDA]) = Trim(sTexto) then
         begin
            Result := True;
            Break;
         end;
      end;
   end;
 
var
   aColores: Variant;
begin
   with Sender as TStringGrid do
   begin
      if (ACol = 3) and (ARow = 2) and (Trim(Cells[03,02]) > '') then
      begin
         Canvas.Brush.Color := clRed;
         Canvas.FillRect(TheRect);
         Canvas.Font.Color := clYellow;
         Canvas.TextOut(TheRect.Left + 2, TheRect.Top + 2, Cells[ACol, ARow]);
      end;
 
      if Trim(Cells[ACol, ARow]) = '¤' then
      begin
         Canvas.Brush.Color := clGreen;
         Canvas.FillRect(TheRect);
         Canvas.Font.Color := clWhite;
         Canvas.TextOut(TheRect.Left + 2, TheRect.Top + 2, Cells[ACol, ARow]);
      end;
 
      if (ACol = 1) and (ARow = 2) then
      begin
         with TheRect do
         begin
            Left   := ColWidths[00]+GridLineWidth;
            Top    := (RowHeights[ARow]*ARow)+(GridLineWidth*ARow);
            Right  := ColWidths[00]+ColWidths[01]+ColWidths[02]+GridLineWidth;
            Bottom := (RowHeights[ARow]*(ARow+1))+(GridLineWidth*ARow);
         end;
         Canvas.Brush.Color := clWhite;
         Canvas.FillRect(TheRect);
         Canvas.Font.Color := clWindowText;
         Canvas.TextRect(TheRect, TheRect.Left+2, TheRect.Top+2, '');
      end;
 
      if Trim(Cells[ACol,ARow]) > '' then
      begin
         if Cells[ACol,ARow] = '·' then
         begin
            aColores := GetColores('Sobrepeso');
            with TheRect do
            begin
               Left   := ColWidths[00]+ColWidths[01]+GridLineWidth;
               Top    := (RowHeights[ARow]*ARow)+(GridLineWidth*ARow);
               Right  := ColWidths[00]+ColWidths[01]+ColWidths[02]+GridLineWidth;
               Bottom := (RowHeights[ARow]*(ARow+1))+(GridLineWidth*ARow);
            end;
            Canvas.Brush.Color := StringToColor(aColores[COLORLIENZO]);
            Canvas.FillRect(TheRect);
            Canvas.Font.Color := StringToColor(aColores[COLORFUENTE]);
            Canvas.TextRect(TheRect, TheRect.Left+2, TheRect.Top+2, '');
         end;
 
         if Cells[ACol,ARow] = '_' then
         begin
            aColores := GetColores(Cells[ACol-1,ARow]);
            with TheRect do
            begin
               Left   := ColWidths[00]+ColWidths[01]+GridLineWidth;
               Top    := (RowHeights[ARow]*ARow)+(GridLineWidth*ARow);
               Right  := ColWidths[00]+ColWidths[01]+ColWidths[02]+GridLineWidth;
               Bottom := (RowHeights[ARow]*(ARow+1))+(GridLineWidth*ARow);
            end;
            Canvas.Brush.Color := StringToColor(aColores[COLORLIENZO]);
            Canvas.FillRect(TheRect);
            Canvas.Font.Color := StringToColor(aColores[COLORFUENTE]);
            Canvas.TextRect(TheRect, TheRect.Left+2, TheRect.Top+2, '');
         end;
 
         if ExisteEnTitulo(Trim(Cells[ACol,ARow])) then
         begin
            if Trim(Cells[ACol,ARow]) > '' then
            begin
               aColores := GetColores(Trim(Cells[ACol,ARow]));
               Canvas.Brush.Color := StringToColor(aColores[COLORLIENZO]);
               Canvas.FillRect(TheRect);
               Canvas.Font.Color := StringToColor(aColores[COLORFUENTE]);
               Canvas.TextOut(TheRect.Left + 2, TheRect.Top + 2, Cells[ACol, ARow]);
            end;
         end else begin
            if Cells[00,ARow] = 'I. M. C.' then
            begin
               with TheRect do
               begin
                  Left   := 1;
                  Top    := 0;
                  Right  := ColWidths[00]-GridLineWidth;
                  Bottom := (RowHeights[ARow]*3)-GridLineWidth;
               end;
               Canvas.Brush.Color := clWhite;
               Canvas.FillRect(TheRect);
               Canvas.Font.Color := clWindowText;
               Canvas.TextRect(TheRect, TheRect.Left+2, TheRect.Top+2, Cells[00,ARow]);
            end;
 
            if Cells[01,ARow] = 'Clasificacion de' then
            begin
               with TheRect do
               begin
                  Left   := ColWidths[00]+GridLineWidth;
                  Top    := (RowHeights[ARow]*ARow)+(GridLineWidth*ARow);
                  Right  := ColWidths[00]+ColWidths[01]+ColWidths[02]+GridLineWidth;
                  Bottom := (RowHeights[ARow]*(ARow+1))+(GridLineWidth*ARow);
               end;
               Canvas.Brush.Color := clWhite;
               Canvas.FillRect(TheRect);
               Canvas.Font.Color := clWindowText;
               Canvas.TextRect(TheRect, TheRect.Left+2, TheRect.Top+2, Cells[01,ARow]);
            end;
 
            if Cells[01,ARow] = 'Riesgos Nutricionales' then
            begin
               with TheRect do
               begin
                  Left   := ColWidths[00]+GridLineWidth;
                  Top    := (RowHeights[ARow]*ARow)+(GridLineWidth*ARow);
                  Right  := ColWidths[00]+ColWidths[01]+ColWidths[02]+GridLineWidth;
                  Bottom := (RowHeights[ARow]*(ARow+1))+(GridLineWidth*ARow);
               end;
               Canvas.Brush.Color := clWhite;
               Canvas.FillRect(TheRect);
               Canvas.Font.Color := clWindowText;
               Canvas.TextRect(TheRect, TheRect.Left+2, TheRect.Top+2, Cells[01,ARow]);
            end;
         end;
      end;
   end;
end;

Sí, está un poco complejo. Sí, utiliza muchas funciones y dos arreglos para controlar los textos, las posiciones y los colores, pero funciona DE MARAVILLA. Gracias por su apoyo y colaboración. 

Archivos adjuntos

•  4097_a32e85937fbfed0a9c24c01bdfc80a3acb2db483.jpg   76,09KB   16 descargas

[Rolphy Reyes]

Saludos.

Felicidades al menos saliste de eso por ahora.......

Solo tengo una pequeña mejora a tu código, dado que somos hispanos parlantes nuestro idioma es bastante rico como también la ortografía y por un acento tu código puede que "deje" de funcionar (luego estarás halandote el pelo) .
Código original:

delphi

function ExisteEnTitulo(sTexto: string): Boolean;
   var
      iIndicador: Integer;
   begin
      Result := False;
      for iIndicador := 0 to Length(aTextoColor)-1 do
      begin
         if Trim(aTextoColor[iIndicador,TEXTOCELDA]) = Trim(sTexto) then
         begin
            Result := True;
            Break;
         end;
      end;
   end;

Código mejorado:

delphi

function ExisteEnTitulo(sTexto: string): Boolean;
   var
      iIndicador: Integer;
   begin
      Result := False;
      for iIndicador := 0 to Length(aTextoColor)-1 do
      begin
         if AnsiCompareText(aTextoColor[iIndicador,TEXTOCELDA], sTexto) = 0 then
         begin
            Result := True;
            Break;
         end;
      end;
   end;

Descripción del Wiki.

[off-topic]@Delphius: Por cierto mira una manera de "romper" el código.[/off-topic]

[Delphius]

[off-topic]@Delphius: Por cierto mira una manera de "romper" el código.[/off-topic]

Voy a hacer de cuenta que no vi eso  Jaja. Mi cabeza de una empezó a traducirlo en un repeat 

Por cierto, hay una buena cantidad de procedimientos para comparar cadenas... entre ellas la que has puesto. Aún así tengo que admitir que no me acostumbro usarlas.

Saludos,

[TiammatMX]

...Voy a hacer de cuenta que no vi eso  Jaja. Mi cabeza de una empezó a traducirlo en un repeat  ...

¿Qué, qué hice? 

Lo intenté con un Repeat, pero no me arrojaba los datos requeridos...

[egostar]

...Voy a hacer de cuenta que no vi eso  Jaja. Mi cabeza de una empezó a traducirlo en un repeat  ...

¿Qué, qué hice? 

Lo intenté con un Repeat, pero no me arrojaba los datos requeridos...

Tú nada, el que hizo fué Rolphy acerca de un debate en el uso o abuso de la interrupción de ciclos

Saludos

[Delphius]

...Voy a hacer de cuenta que no vi eso  Jaja. Mi cabeza de una empezó a traducirlo en un repeat  ...

¿Qué, qué hice? 

Lo intenté con un Repeat, pero no me arrojaba los datos requeridos...

Tu no has hecho nada Felipe. Mis más sinceras disculpas si te he molestado en algo al comentar el off-topic. Era en respuesta al off-topic de Rolphy.

Tú nada, el que hizo fué Rolphy acerca de un debate en el uso o abuso de la interrupción de ciclos

Saludos

Bueno... tecnicamente el que inició el debate fui yo. Y convengamos que hasta el momento el que parece estar en posición de galleguito testarudo sobre el tema soy yo... lo cual no sería novedad... que se raya el disco cada vez que mi cabeza se pone filosófica. 

Saludos,

[egostar]

Tú nada, el que hizo fué Rolphy acerca de un debate en el uso o abuso de la interrupción de ciclos

Saludos

Bueno... tecnicamente el que inició el debate fui yo. Y convengamos que hasta el momento el que parece estar en posición de galleguito testarudo sobre el tema soy yo... lo cual no sería novedad... que se raya el disco cada vez que mi cabeza se pone filosófica. 

Saludos,

No dije que Rolphy habia comenzado el debate, digo que el que hizo algo fué rolphy con el off-topic.

En lo que si coincido es en donde dices:

"Bueno... tecnicamente el que inició el debate fui yo. Y convengamos que hasta el momento el que parece estar en posición de galleguito testarudo sobre el tema soy yo... lo cual no sería novedad... que se raya el disco cada vez que mi cabeza se pone filosófica"

Delphius dixit

Saludos

[Delphius]

Delphius dixit

Que Delphius ni 8/4... ¡ese fue el cabrón de NewDelphius que hace de las suyas!   

Saludos,

[Rolphy Reyes]

Saludos.

Sin echarle la culpa a quien mejora el código. 

Pues he visto en las implementaciones del método IndexOf el uso de Break  justo como lo expuse.

@TiammatMX, no te preocupes es que @Delphius se puso a filosofar sobre un tema y quise armar un "bochinche" por el código que expuse. 

[Delphius]

Saludos.

Sin echarle la culpa a quien mejora el código. 

Pues he visto en las implementaciones del método IndexOf el uso de Break  justo como lo expuse.

@TiammatMX, no te preocupes es que @Delphius se puso a filosofar sobre un tema y quise armar un "bochinche" por el código que expuse. 

Yo he visto el Break en varios lados de la VCL, casi en todas era en fors... ¡y de los más simples!. Y la verdad es que justamente por eso me intriga más que se decante por una salida "no tan elegante". O es que ese Break lleva a una mejora en rendimiento al momento de la compilación o es que de plano por ahorrarse unas poquitas LDC no se usa un ciclo más apropiado para salir de forma "legal".

¿Yo bochinche? Naa... si soy todo un santo

Saludos,

[cadetill]

Para las comparaciones de cadenas, yo suelo usar SameText que, a parte de devolver un valor booleano (y por ende hacer más sencilla una comparación lógica) no es case sensitive (al igual que AnsiCompareText) :-)

Nos leemos