Agrupar Filas en Stringgrid

[escorpionrojo43]

Hola Miembros del club.
Me ha surgido la necesidad de agrupa los valores de un stringgrid Alguien aquí sabe como puedo hacerlo.

tengo algo como esto

----------------------------------
CODIGO | DESCRIPCION |PRECIO   |
----------------------------------
10          producto 10       20
31          producto 31       5
15          producto 15       5
10          producto 10       50
20          producto 20       8
15          producto 15       10



Pero necesito agruparlos por codigo
algo asi

----------------------------------
CODIGO | DESCRIPCION |PRECIO   |
----------------------------------
31          producto 31       5
10          producto 10       70
20          producto 20       8
15          producto 15       15

Espero me puedan ayudar.

[ecfisa]

Hola escorpionrojo43.

Probá de este modo:

Código Delphi [-]
...
type
  TStringGrid = class(Grids.TStringGrid);
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    ...
  end;
...
implementation

(* Agrupar y acumular precios por codigo *)
procedure AgruparGrid(StrGrd: TStringGrid);
var
  i,j: Integer;
  v1,v2: Double;
begin
  i:= StrGrd.FixedRows;
  while i < StrGrd.RowCount  do
  begin
    j:= i+1;
    while j < StrGrd.RowCount  do
    begin
      if (StrGrd.Cells[0,i]=StrGrd.Cells[0,j])  // código en columna 0
        and TryStrToFloat(StrGrd.Cells[2,i],v1) and TryStrToFloat(StrGrd.Cells[2,j],v2) then
      begin
        StrGrd.Cells[2,i]:= FloatToStr(v1+v2);
        StrGrd.DeleteRow(j);
      end
      else
        Inc(j);
    end;
    Inc(i);
  end;
end;

(* llamada *)
procedure TForm1.btnAgruparClick(Sender: TObject);
begin
  AgruparGrid(StringGrid1);
end;

Saludos.

[escorpionrojo43]

Empezado por ecfisa

Hola escorpionrojo43.

Probá de este modo:

Código Delphi [-]
...
type
  TStringGrid = class(Grids.TStringGrid);
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    ...
  end;
...
implementation

(* Agrupar y acumular precios por codigo *)
procedure AgruparGrid(StrGrd: TStringGrid);
var
  i,j: Integer;
  v1,v2: Double;
begin
  i:= StrGrd.FixedRows;
  while i < StrGrd.RowCount  do
  begin
    j:= i+1;
    while j < StrGrd.RowCount  do
    begin
      if (StrGrd.Cells[0,i]=StrGrd.Cells[0,j])  // código en columna 0
        and TryStrToFloat(StrGrd.Cells[2,i],v1) and TryStrToFloat(StrGrd.Cells[2,j],v2) then
      begin
        StrGrd.Cells[2,i]:= FloatToStr(v1+v2);
        StrGrd.DeleteRow(j); // el error esta en esta linea, si la comento entonces como quiera no me hace el trabajo. 
      end
      else
        Inc(j);
    end;
    Inc(i);
  end;
end;

(* llamada *)
procedure TForm1.btnAgruparClick(Sender: TObject);
begin
  AgruparGrid(StringGrid1);
end;

Saludos.

ecfisa companero Estoy tratando de implementar este codigo pero el asunto es que no me anda. me da un error de compilacion porque
Tstringgrid no contiene un miembro llamado deleterow.
[DCC Error] loteriaventa.pas(870): E2362 Cannot access protected symbol TCustomGrid.DeleteRow
no se si estoy haciendo algo mal pero no me funciona.

se queda haciendo un bucle infinito en el while

[ecfisa]

Hola.

me da un error de compilacion porque
Tstringgrid no contiene un miembro llamado deleterow.

Fijate que en el código que te adjunte está desprotegida la clase TStringGrid con:

Código Delphi [-]
type
  TStringGrid = class(Grids.TStringGrid);
  ...

Sin esa línea no te compilará y te dará el error que mencionas.

Saludos.

[escorpionrojo43]

Hermano. Gracias por la aclaracion. Funciona a la perfeccion.
Una cosa mas. Despues de agregar esa clase es posible poder borrar una linea del stringgrid. osea para borrarla uso esto

Código Delphi [-]
procedure TForm2.Button6Click(Sender: TObject);
var  i: Integer;
begin
If MessageDlg('Seguro de borrar la Jugada '+#13+StringGrid2.Cells[1,StringGrid2.Row], mtConfirmation, [mbYes, mbNo], 0) = mrYes Then
  Begin
   For i := StringGrid2.Row To StringGrid2.RowCount - 1 Do
   Begin
     StringGrid2.Rows[i][0] := StringGrid2.Rows[i+1][0];
     StringGrid2.Rows[i][1] := StringGrid2.Rows[i+1][1];
     StringGrid2.Rows[i][2] := StringGrid2.Rows[i+1][2];
     StringGrid2.Rows[i][3] := StringGrid2.Rows[i+1][3];
     StringGrid2.Rows[i][4] := StringGrid2.Rows[i+1][4];
    End;
     StringGrid2.RowCount := StringGrid2.RowCount -1;
     SumarCeldas;
  End;
end;

[ecfisa]

Hola de nuevo.

Para evitar cualquier confución y que puedas estudiar con tranquilidad el código te adjunto el ejemplo funcionando. El mismo tiene un procedimiento asociado a un TButton (btnGenerar) que genera el contenido de las celdas del TStringGrid de forma aleatoria.

Para descargarlo no utilices Internet Explorer ya que dá problemas con las descargas, con Mozilla Firefox funcionan bién.

Saludos.

[ecfisa]

Empezado por escorpionrojo43

Hermano. Gracias por la aclaracion. Funciona a la perfeccion.
Una cosa mas. Despues de agregar esa clase es posible poder borrar una linea del stringgrid.

Una vez desprotegida la clase TStringGrid podés utilizar DeleteRow sin problemas en esa unidad, también tendrás disponible algunas funciones más como MoveRow, DeleteColumn MoveColumn, ...

Mientras adjuntaba el ejemplo ya habías contestado... disculpas

Saludos.

[escorpionrojo43]

Empezado por ecfisa

Una vez desprotegida la clase TStringGrid podés utilizar DeleteRow sin problemas en esa unidad, también tendrás disponible algunas funciones más como MoveRow, DeleteColumn MoveColumn, ...

Mientras adjuntaba el ejemplo ya habías contestado... disculpas

Saludos.

Te agradesco mucho que me ayudaras con esto.
Ahora tengo una preunta mas.
parece ser que mi codigo tiene algun error pues mientras depuraba me di cuenta de que hace lo siguiente.

---------------------
cod desc. valor
---------------------
01 cod01 5
02 cod02 5
03 cod03 5
04 cod04 5
01 cod01 5
---------------------

ejecuto el procedimiento y todo bien hasta ahi

---------------------
cod desc. valor
---------------------
01 cod01 10
02 cod02 5
03 cod03 5
04 cod04 5
---------------------
pero luego agrego un items mas en este caso el 05 pero obtengo estos resultados en mi stringgid

---------------------
cod desc. valor
---------------------
01 cod01 10
02 cod02 5
03 cod03 5
04 cod04 5
05 cod05 5
01 cod01 5 ------------------------- este fuel el anterior que se borro pero al agregar un articulo mas me lo trajo de nuevo
---------------------

mi codigo es este. me podrian decir si encuentran el fallo ya que no lo encuentro.

Código Delphi [-]
//Validacion de la jugada y precios al salir del edit
procedure TForm2.Edit4KeyPress(Sender: TObject; var Key: Char);
begin
 if key=#13 then
  with Stringgrid2 do
  begin
    case Length(Edit1.Text) of
    6 :  cells[ct_j,row] := 'TRIPLETA';
    4 :  cells[ct_j,row] := 'PALE';
    2 :  cells[ct_j,row] := 'QUINIELA';
    0 :  begin  edit1.SetFocus;  exit;  end
    else
      begin
        edit1.SetFocus;
        Raise Exception.Create('Los numeros no tienen el formato adecuado. Revise');
      end
    end;
//Verifica si la Jugada esta Controlada
    with dm.qry_Control_numero, sql do
      begin
      Close;
      Clear;
      Add('SELECT * FROM Num_Controlados');
      Add('WHERE jugada = '+ Quotedstr(edit1.Text)+  ' and loteria = '+ Quotedstr(inttostr(cloteria.ItemIndex)));
      open;
      if not eof then
        begin
          if strtoint(Edit4.Text) > fieldbyname('Disponible').AsInteger then
          begin
          edit1.SetFocus;
          Raise Exception.Create('De la Jugada '+ (Edit1.Text)+ ' Solo quedan '+fieldbyname('Disponible').AsString);
          end;
        end;
      first;
    end;
    cells[cjug,row] := edit1.text;
    cells[cval,row] := edit4.Text;
    x2 := x2+ strtoint(cells[cval,row]);
    //label3.Caption := inttostr(x2); // mustra la suma en un label
    // Agrega un registro nuevo al grid
    rowcount := rowcount + 1;
    row      := row + 1;
    edit1.SetFocus;
    x1 := x1+1;
    edit1.Text:='';
    edit4.Text:='';
  end;
end;

[escorpionrojo43]

Empezado por ecfisa

Hola escorpionrojo43.

Probá de este modo:

Código Delphi [-]
...
type
  TStringGrid = class(Grids.TStringGrid);
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    ...
  end;
...
implementation

(* Agrupar y acumular precios por codigo *)
procedure AgruparGrid(StrGrd: TStringGrid);
var
  i,j: Integer;
  v1,v2: Double;
begin
  i:= StrGrd.FixedRows;
  while i < StrGrd.RowCount  do
  begin
    j:= i+1;
    while j < StrGrd.RowCount  do
    begin
      if (StrGrd.Cells[0,i]=StrGrd.Cells[0,j])  // código en columna 0
        and TryStrToFloat(StrGrd.Cells[2,i],v1) and TryStrToFloat(StrGrd.Cells[2,j],v2) then
      begin
        StrGrd.Cells[2,i]:= FloatToStr(v1+v2);
        StrGrd.DeleteRow(j);
      end
      else
        Inc(j);
    end;
    Inc(i);
  end;
end;

(* llamada *)
procedure TForm1.btnAgruparClick(Sender: TObject);
begin
  AgruparGrid(StringGrid1);
end;

Saludos.

Una pregunta mas Amigo mio.
De esta forma me funciona muy bien pero de que manera podria hacer que la agrupaciones se deslicen a la ultima fila y no los agrupe en la primera

[ecfisa]

Hola escorpionrojo43.

Quizá te sirva ordenar el TStringGrid por código u otro campo. Revisá este enlace: Ordenar STringGrid por más de una columna

Saludos.

[escorpionrojo43]

Empezado por ecfisa

Hola escorpionrojo43.

Quizá te sirva ordenar el TStringGrid por código u otro campo. Revisá este enlace: Ordenar STringGrid por más de una columna

Saludos.

La verdad es que no necesito que lo ordene por codigo u otro campo. que lo ordene por orden de entrada. y que los agrupe.
si introduje de ultimo el codigo 1010 y ya lo tenia en una fila x. quiero que ya no este en la fila x si no que este en la ultima fila rowcount.

[ecfisa]

Hola.

Cuando te sugerí ordenarlos fué por tu comentario anterior:

De esta forma me funciona muy bien pero de que manera podria hacer que la agrupaciones se deslicen a la ultima fila y no los agrupe en la primera

Entonces si son ordenados por 'precio' (la celda por la que se agrupó) lógicamente los registros agrupados quedan al final. Del código de ordenamiento tendrías que cambiar la comparación:

Código Delphi [-]
  if Cells[ACol,j] > Cells[ACol,j+1] then

por:

Código Delphi [-]
  if StrToInt(Cells[ACol,j]) > StrToInt(Cells[ACol,j+1]) then

A decir verdad respetar el orden de manera estricta despues de usar DeleteRow no lo veo sencillo. Quizá trabajando un poco sobre el código que te adjunté le encuentres la solución...

Un saludo.