12 respuestas en este tema

[FGarcia]

Por aqui solicitando ayuda para optimizar el codigo. Esta es la unidad del modulo de datos de la imagen que adjunto. El proposito es que en la stringgrid se vean los resultados de las consultas efectuadas segun el estado de los checkbox. ¡Funciona asi como esta! pero siento que el codigo es un absoluto cochinero y que se puede mejorar asi que acudo a ustedes por ideas para mejorarlo.

delphi

unit UdmDatos;
 
interface
 
uses
  SysUtils, Classes, DB, IBCustomDataSet, IBQuery, IniFiles;
 
//Declaro el tipo TGrupo
type
  TGrupo = array[1..6] of boolean;
 
type
  TdmDatos = class(TDataModule)
    qyGrupo1: TIBQuery;
    qyGrupo2: TIBQuery;
    qyGrupo3: TIBQuery;
    procedure DataModuleCreate(Sender: TObject);
  private
    { Private declarations }
    idx11,idx12,idx13,idx14,idx15,idx16: integer; //Numeros de bascula grupo1
    idx21,idx22,idx23,idx24,idx25,idx26: integer; //Numeros de bascula grupo2
    idx31,idx32,idx33,idx34,idx35,idx36: integer; //Numeros de bascula grupo3
    procedure LeerGrupos;
    procedure AsignaBasculaGrupo1;
    procedure AsignaBasculaGrupo2;
    procedure AsignaBasculaGrupo3;
  public
    { Public declarations }
    Grupo1, Grupo2, Grupo3: TGrupo;
    Cuantos1,Cuantos2,Cuantos3: integer;
    Total1,Total2,Total3: double;
    procedure SumarGrupo1;
    procedure SumarGrupo2;
    procedure SumarGrupo3;
  end;
 
const
  Archivo = 'Configura.ini';
 
var
  dmDatos: TdmDatos;
 
 
implementation
 
uses
  UdmCnx;
 
 
{$R *.dfm}
 
{ TdmDatos }
 
//Al crear el modulo se ejecutan estos procedimientos
procedure TdmDatos.DataModuleCreate(Sender: TObject);
begin
  LeerGrupos;
  AsignaBasculaGrupo1;
  AsignaBasculaGrupo2;
  AsignaBasculaGrupo3;
  SumarGrupo1;
  SumarGrupo2;
  SumarGrupo3;
end;
 
//Leemos el ultimo estado de los checkbox el cual se guardo en un INI
procedure TdmDatos.LeerGrupos;
var
  F: TiniFile;
begin
    F := TIniFile.Create(ExtractFilePath(Paramstr(0)) + Archivo);
  try
    //***************** grupo 1
   Grupo1[1] := F.readbool('Grupo1', 'Bascula1', False);
   Grupo1[2] := F.readbool('Grupo1', 'Bascula2', False);
   Grupo1[3] := F.readbool('Grupo1', 'Bascula3', False);
   Grupo1[4] := F.readbool('Grupo1', 'Bascula4', False);
   Grupo1[5] := F.readbool('Grupo1', 'Bascula5', False);
   Grupo1[6] := F.readbool('Grupo1', 'Bascula6', False);
    //***************** grupo 2
   Grupo2[1] := F.readbool('Grupo2', 'Bascula1', False);
   Grupo2[2] := F.readbool('Grupo2', 'Bascula2', False);
   Grupo2[3] := F.readbool('Grupo2', 'Bascula3', False);
   Grupo2[4] := F.readbool('Grupo2', 'Bascula4', False);
   Grupo2[5] := F.readbool('Grupo2', 'Bascula5', False);
   Grupo2[6] := F.readbool('Grupo2', 'Bascula6', False);
    //***************** grupo 3
   Grupo3[1] := F.readbool('Grupo3', 'Bascula1', False);
   Grupo3[2] := F.readbool('Grupo3', 'Bascula2', False);
   Grupo3[3] := F.readbool('Grupo3', 'Bascula3', False);
   Grupo3[4] := F.readbool('Grupo3', 'Bascula4', False);
   Grupo3[5] := F.readbool('Grupo3', 'Bascula5', False);
   Grupo3[6] := F.readbool('Grupo3', 'Bascula6', False);
  finally
    F.Free ;
  end;
end;
 
{Segun el estado de cada elemento del array (TRUE / FALSE)
  asignamos un numero a los indices}
procedure TdmDatos.AsignaBasculaGrupo1;
begin
  if Grupo1[1] then
    idx11 := 1
  else
    idx11 := 0;
 
  if Grupo1[2] then
    idx12 := 2
  else
    idx12 := 0;
 
  if Grupo1[3] then
    idx13 := 3
  else
    idx13 := 0;
 
  if Grupo1[4] then
    idx14 := 4
  else
    idx14 := 0;
 
  if Grupo1[5] then
    idx15 := 5
  else
    idx15 := 0;
 
  if Grupo1[6] then
    idx16 := 6
  else
    idx16 := 0;
end;
 
{Segun el estado de cada elemento del array (TRUE / FALSE)
 asignamos un numero a los indices}
procedure TdmDatos.AsignaBasculaGrupo2;
begin
  if Grupo2[1] then
    idx21 := 1
  else
    idx21 := 0;
 
  if Grupo2[2] then
    idx22 := 2
  else
    idx22 := 0;
 
  if Grupo2[3] then
    idx23 := 3
  else
    idx23 := 0;
 
  if Grupo2[4] then
    idx24 := 4
  else
    idx24 := 0;
 
  if Grupo2[5] then
    idx25 := 5
  else
    idx25 := 0;
 
  if Grupo2[6] then
    idx26 := 6
  else
    idx26 := 0;
end;
 
{Segun el estado de cada elemento del array (TRUE / FALSE)
 asignamos un numero a los indices}
procedure TdmDatos.AsignaBasculaGrupo3;
begin
  if Grupo3[1] then
    idx31 := 1
  else
    idx31 := 0;
 
  if Grupo3[2] then
    idx32 := 2
  else
    idx32 := 0;
 
  if Grupo3[3] then
    idx33 := 3
  else
    idx33 := 0;
 
  if Grupo3[4] then
    idx34 := 4
  else
    idx34 := 0;
 
  if Grupo3[5] then
    idx35 := 5
  else
    idx35 := 0;
 
  if Grupo3[6] then
    idx36 := 6
  else
    idx36 := 0;
end;
 
{Ejecutamos la consulta. Proporcionamos como parametro el numero de bascula
que se obtuvo en el procedure AsignarGrupoBascula}
procedure TdmDatos.SumarGrupo1;
begin
 
  with qyGrupo1 do
    begin
      close;
      sql.Clear ;
      sql.Add('SELECT COUNT(*) AS Pesadas, ' +
              'SUM (peso) AS Total ' +
              'FROM DATOS WHERE ((Bascula = :Bas1) OR (Bascula = :Bas2) OR ' +
                                 '(Bascula = :Bas3) OR (Bascula = :Bas4) OR ' +
                                 '(Bascula = :Bas5) OR (Bascula = :Bas6))');
      Params.ParamByName('Bas1').Value := idx11;
      Params.ParamByName('Bas2').Value := idx12;
      Params.ParamByName('Bas3').Value := idx13;
      Params.ParamByName('Bas4').Value := idx14;
      Params.ParamByName('Bas5').Value := idx15;
      Params.ParamByName('Bas6').Value := idx16;
      open;
    end;
 
  if not qygrupo1.IsEmpty then
    begin
      Cuantos1 := qyGrupo1.FieldValues['Pesadas'];
      Total1 := qyGrupo1.FieldValues['Total'];
    end;
end;
 
{Ejecutamos la consulta. Proporcionamos como parametro el numero de bascula
que se obtuvo en el procedure AsignarGrupoBascula}
procedure TdmDatos.SumarGrupo2;
begin
  with qyGrupo2 do
    begin
      close;
      sql.Clear ;
      sql.Add('SELECT COUNT(*) AS Pesadas, ' +
              'SUM (peso) AS Total ' +
              'FROM DATOS WHERE ((Bascula = :Bas1) OR (Bascula = :Bas2) OR ' +
                                 '(Bascula = :Bas3) OR (Bascula = :Bas4) OR ' +
                                 '(Bascula = :Bas5) OR (Bascula = :Bas6))');
      Params.ParamByName('Bas1').Value := idx21;
      Params.ParamByName('Bas2').Value := idx22;
      Params.ParamByName('Bas3').Value := idx23;
      Params.ParamByName('Bas4').Value := idx24;
      Params.ParamByName('Bas5').Value := idx25;
      Params.ParamByName('Bas6').Value := idx26;
      open;
    end;
 
  if not qygrupo2.IsEmpty then
    begin
      Cuantos2 := qyGrupo2.FieldValues['Pesadas'];
      Total2 := qyGrupo2.FieldValues['Total'];
    end;
end;
 
{Ejecutamos la consulta. Proporcionamos como parametro el numero de bascula
que se obtuvo en el procedure AsignarGrupoBascula}
procedure TdmDatos.SumarGrupo3;
begin
  with qyGrupo3 do
    begin
      close;
      sql.Clear ;
      sql.Add('SELECT COUNT(*) AS Pesadas, ' +
              'SUM (peso) AS Total ' +
              'FROM DATOS WHERE ((Bascula = :Bas1) OR (Bascula = :Bas2) OR ' +
                                 '(Bascula = :Bas3) OR (Bascula = :Bas4) OR ' +
                                 '(Bascula = :Bas5) OR (Bascula = :Bas6))');
      Params.ParamByName('Bas1').Value := idx31;
      Params.ParamByName('Bas2').Value := idx32;
      Params.ParamByName('Bas3').Value := idx33;
      Params.ParamByName('Bas4').Value := idx34;
      Params.ParamByName('Bas5').Value := idx35;
      Params.ParamByName('Bas6').Value := idx36;
      open;
    end;
 
  if not qygrupo3.IsEmpty then
    begin
      Cuantos3 := qyGrupo3.FieldValues['Pesadas'];
      Total3 := qyGrupo3.FieldValues['Total'];
    end;
end;
 
 
 
end.

Como siempre les agradesco la atencion y ayuda que me puedan proporcionar.

[Delphius]

Tendría que analizarlo bien para ver hasta que punto lo podría reducir. De forma rápida lo que veo es más recomendable emplear una matriz para tratar los grupos y las básculas.

Si no entiendo mal, cuentas con tres grupos y en cada grupo hay 6 básculas. Eso a mi ya de forma directa me está manifestando que se puede conseguir y tratar ambas cosas (grupos y básculas) como una matriz.

Ya estoy viendo que hay mucho código repetido. Tranquilamente se puede tener métodos como:

delphi

procedure SumarGrupo(NroGrupo: integer);

y

delphi

procedure AsignarBásculasDelGrupo(NroGrupo: integer);

También se podría acelerar la lectura desde el archivo ini.

Dame un tiempo y luego te digo como lo haría yo.

Saludos,

[Delphius]

Pues ya le estoy metiendo mano al asunto, y hay algo que no veo muy claro...
¿Esas consultas SQL funcionan?
Porque veo que es siempre la misma, y no veo que se distinga de un grupo de otra. Es decir: no veo en la cláusula WHERE algo como (Grupo = 1) o (Grupo = 2).

Por lo que estoy comprendiendo, una vez que en tus arrays "grupo" queda cargada la lectura del archivo ini estableces como valor la posición i-ésima de tu array N-ésimo o cero a cada variable idxNi, siendo "N" el numero del grupo e "i" el de la báscula.

Veamos el ejemplo que tu expones:
Grupo[1] tendría lo siguiente: (true,true,false,false,false,false)
Grupo[2] tendría: (false,false,true,true,false,false)
Grupo[3]: (false,false,false,false,true,true)

Entonces, al traspasar los datos a las variables idx, las únicas diferentes a cero, tendremos esto:
idx11 = 1
idx12 = 2

idx23 = 3
idx24 = 4

idx35 = 5
idx36 = 6

Las respectivas consultas SQL quedarían entonces así:
Grupo 1:
(Bascula = 1) or (Bascula = 2) or (Bascula = 0) or (Bascula = 0) or (Bascula = 0) or (Bascula = 0)

Grupo 2:
(Bascula = 0) or (Bascula = 0) or (Bascula = 3) or (Bascula = 4) or (Bascula = 0) or (Bascula = 0)

Grupo 3:
(Bascula = 0) or (Bascula = 0) or (Bascula = 0) or (Bascula = 0) or (Bascula = 5) or (Bascula = 6)

Hay comparaciones redundantes por empezar. Pero ese no es el veradero problema. Supongamos que en realidad del grupo 1 deseamos leer la 3 y 4.
La consula final quedaría con éstas condiciones:
(Bascula = 0) or (Bascula = 0) or (Bascula = 3) or (Bascula = 4) or (Bascula = 0) or (Bascula = 0)

Como vez, igual a la que esperamos para el grupo 2.
Por tanto vuelvo a la pregunta del millón: ¿Cómo en la consulta SQL determinamos al grupo? No que se filtren los datos... ¡Vas a obtener los mismos datos!

O algo no estoy comprendiendo... sería bueno que aclares ese panorama.
Por lo pronto ya estoy reduciendo código.

Me gustaría que aclares bien como está estructuradas tus tablas.

EDITO:
Ha... tal vez el tema de los grupos no es por algo que represente alguna entidad o realidad física propia del dominio.
Creo que por grupo debería entender a que el usuario puede indicar como desea ver los resultados de 6 básculas.

Yo me estaba imaginando que se disponen de 18 básculas, agrupadas de a 6. ¿Son en realidad 6?
¿La finalidad es que el usuario pueda ver los totales y la cantidad de pesadas de dichas básculas segun 3 grupos de formar combinaciones?
Es decir algo como:
"Quiero que en mi primer consulta, me muestra a las básculas 1 y 2; en mi segunda consulta la 3 y 4; y en la tercera a la 5 y 6"
O algo como:
"En mi primer agrupamiento, a 1 y 4. En el segundo grupo a 4 y 2. En el tercero, a 5 y 6."

Si es esto último que estoy pensando me parece que si es válido entonces la forma de la consulta; aunque se la puede refinar un poco: la parte WHERE puede ser así:

sql

WHERE Bascula IN (xx,yy,...,zz)

Saludos,

[egostar]

Hola,

Mientras Dephius ve la parte de los Queries, yo te ayudo a reducir lineas

delphi

//Leemos el ultimo estado de los checkbox el cual se guardo en un INI
procedure TdmDatos.LeerGrupos;
var
  i: integer;
  F: TiniFile;
begin
  F := TIniFile.Create(ExtractFilePath(Paramstr(0)) + Archivo);
  for i := 1 to 6 do begin
      Grupo1[i] := F.readbool('Grupo'+inttostr(i), 'Bascula'+inttostr(i), False);
  end;
  for i := 1 to 6 do begin
      Grupo2[i] := F.readbool('Grupo'+inttostr(i), 'Bascula'+inttostr(i), False);
  end;
  for i := 1 to 6 do begin
      Grupo3[i] := F.readbool('Grupo'+inttostr(i), 'Bascula'+inttostr(i), False);
  end;
end;

Por otro lado, no seria mejor que en el archivo INI tengas directamente los valores 0 y 1 en lugar de False y True?

Con eso te ahorras todo este código.........

delphi

{Segun el estado de cada elemento del array (TRUE / FALSE)
  asignamos un numero a los indices}
procedure TdmDatos.AsignaBasculaGrupo1;
begin
  if Grupo1[1] then
    idx11 := 1
  else
    idx11 := 0;
 
  if Grupo1[2] then
    idx12 := 2
  else
    idx12 := 0;
 
  if Grupo1[3] then
    idx13 := 3
  else
    idx13 := 0;
 
  if Grupo1[4] then
    idx14 := 4
  else
    idx14 := 0;
 
  if Grupo1[5] then
    idx15 := 5
  else
    idx15 := 0;
 
  if Grupo1[6] then
    idx16 := 6
  else
    idx16 := 0;
end;
 
{Segun el estado de cada elemento del array (TRUE / FALSE)
 asignamos un numero a los indices}
procedure TdmDatos.AsignaBasculaGrupo2;
begin
  if Grupo2[1] then
    idx21 := 1
  else
    idx21 := 0;
 
  if Grupo2[2] then
    idx22 := 2
  else
    idx22 := 0;
 
  if Grupo2[3] then
    idx23 := 3
  else
    idx23 := 0;
 
  if Grupo2[4] then
    idx24 := 4
  else
    idx24 := 0;
 
  if Grupo2[5] then
    idx25 := 5
  else
    idx25 := 0;
 
  if Grupo2[6] then
    idx26 := 6
  else
    idx26 := 0;
end;
 
{Segun el estado de cada elemento del array (TRUE / FALSE)
 asignamos un numero a los indices}
procedure TdmDatos.AsignaBasculaGrupo3;
begin
  if Grupo3[1] then
    idx31 := 1
  else
    idx31 := 0;
 
  if Grupo3[2] then
    idx32 := 2
  else
    idx32 := 0;
 
  if Grupo3[3] then
    idx33 := 3
  else
    idx33 := 0;
 
  if Grupo3[4] then
    idx34 := 4
  else
    idx34 := 0;
 
  if Grupo3[5] then
    idx35 := 5
  else
    idx35 := 0;
 
  if Grupo3[6] then
    idx36 := 6
  else
    idx36 := 0;
end;

Y en tus parámetros solo harias esto

delphi

      Params.ParamByName('Bas1').Value := Grupo1[1];
      Params.ParamByName('Bas2').Value := Grupo1[2];
      Params.ParamByName('Bas3').Value := Grupo1[3];
      Params.ParamByName('Bas4').Value := Grupo1[4];
      Params.ParamByName('Bas5').Value := Grupo1[5];
      Params.ParamByName('Bas6').Value := Grupo1[6];

Salud OS

[Delphius]

Bueno, no pude sacar tiempo, y en unas horas me estoy llendo. Brevemente te comento que yo lo haría así:

delphi

const
  CANT_GRUPOS = 3;
  CANT_BASCULAS = 6;
 
type
  TMatrizBasculas[1..CANT_GRUPOS,1..CANT_BASCULAS] of boolean; //matriz de lectura de archivos
 
Y luego al leer el ini, algo como esto:
 
var Matriz: TMatrizBasculas;
     i,j: integer;
 
for i := 1 TO CANT_GRUPOS do
  for j := 1 to CANT_BASCULAS do
     Matriz[i,j] := F.Readbool('Grupo' + IntToStr(i), 'Bascula' + IntToStr(j), False);

Te olvidas de los idx. Ya con esa matriz se hace todo el trabajo.

Tu consulta SQL se puede incluso resumir en una sola:

sql

SELECT COUNT(*) AS Pesadas, SUM(peso) AS Total
FROM Datos
WHERE Bascula IN (xx1,yy1,..,zz1)
UNION
SELECT COUNT(*) AS Pesadas, SUM(peso) AS Total
FROM Datos
WHERE Bascula IN (xx2,yy2,..,zz2)
UNION
SELECT COUNT(*) AS Pesadas, SUM(peso) AS Total
FROM Datos
WHERE Bascula IN (xx3,yy3,..,zz3)

Siendo xx,yy,..zz los valores idx que tu confeccionas. Para distinguir un grupo de otro, le asocie un número.
En lo posible debería evitarse esos UNIONs, tienden a ser un poco lentos. Pero es que como en realidad la consulta es la misma y lo único que cambia es la parte where... me parece cómodo; y en vez de hacer count(*) sería oportuno hacer count(nombre_campo). El * obliga al motor evaluar sobre las tablas de sistemas para saber cuantos campos son, luego hace unas operaciones para extraer los campos y al final termina haciendo esto:
count(campo1, campo2, ..., campoN)

Ahora la rutina que transforma los valores de la matriz en idx lo que hace es simplemente formar la cadena de la parte IN de la consulta:

delphi

var texto_in: string;
begin
  // por ejemplo si quieres para el grupo 1
  texto_in := '(';
  for j := 1 to CANT_BASCULAS do
     begin
        if Matriz[1,j]
          then begin
                   if j = CANT_BASCULAS
                     then texto_in := texto_in + IntToStr(j)
                     else texto_in := texto_in  + IntToStr(j) + ' ,';
                 end;
     end;
   texto_in := texto_in + ')';
end;

Al final de esa rutina tendrás una cadena del tipo (xx,yy,..zz) con los valores de las básculas a evaluar. Sólo resta añadir esa cadena al SQL definitivo.

Creo que con el aporte de Egostar y el mio ya tienes para trabajar.

Espero que se entienda.

[FGarcia]

Delphius, Egostar Gracias por la atencion y ayuda.

Aclarando dudas:

1. Solo son seis (6) básculas.  Puedo agrupar en tres grupos o a lo mejor solo en dos (1,2,3) (4,5,6) o en cualquier combinacion que no repita una bascula en otro grupo.

2. La funcion de leer el ini quedo asi:

delphi

//Leemos el ultimo estado de los checkbox el cual se guardo en un INI
procedure TdmDatos.LeerGrupos;
var
  i,j: integer;
  F: TiniFile;
begin
 
  F := TIniFile.Create(ExtractFilePath(Paramstr(0)) + Archivo);
 
  for i := 1 TO CANT_GRUPOS do
    for j := 1 to CANT_BASCULAS do
      GrupoBascula[i,j] := F.Readbool('Grupo ' + IntToStr(i),'Bascula ' + IntToStr(j),False);
end;

Con lo cual me resulta una matriz con un contenido asi (por ejemplo):

GrupoBascula[1,1] = True
GrupoBascula[1,2] = True
GrupoBascula[1,3] = False
GrupoBascula[1,4] = False
GrupoBascula[1,5] = False
GrupoBascula[1,6] = False
.
.
.
GrupoBascula[3,4] = False
GrupoBascula[3,5] = True
GrupoBascula[3,6] = True

Aun me queda asignar a los indices (idx) el numero de bascula que es TRUE para armar la consulta. En eso estoy.

Egostar en el ini se guardan solo valores 0 y 1 correspondiente a los estados False y True de los checkbox. A los idx les asigno un numero de báscula (1..6) si el estado del checkbox es TRUE; si es FALSE les asigno el valor 0.  A lo mejor no entendi bien lo que me sugeriste.

Vamos a continuar. Nuevamente les repito mi agradecimiento por su ayuda.

[egostar]

Hola,

Me imagino que en algun lugar estas guardando esos valores de True y False, bueno en lugar de hacer eso cuando debas guardar true, guarda el numero de bascula y cuan sea False guarda 0, de tal forma que cuando recuperas los valores desde el INI te quedarias así:

Usando tu mismo ejemplo:

delphi

GrupoBascula[1,1] = 1
GrupoBascula[1,2] = 2
GrupoBascula[1,3] = 0
GrupoBascula[1,4] = 0
GrupoBascula[1,5] = 0
GrupoBascula[1,6] = 0
.
.
.
GrupoBascula[3,4] = 0
GrupoBascula[3,5] = 5
GrupoBascula[3,6] = 6

Es obvio que TGroup ya no seria Bool sino de tipo Integer, ademas de que debes de cambiar la funcion F.Readbool por F.ReadInteger....

Salud OS

[FGarcia]

Obtengo puntos por Km de codigo?   

Bueno asi esta la unit modificada (Gracias a Al González por su ayuda y tiempo):

delphi

unit UdmDatos;
 
interface
 
uses
  SysUtils, Classes, DB, IBCustomDataSet, IBQuery, IniFiles, StrUtils, GHFMath;
 
const
  CANT_GRUPOS = 3;
  CANT_BASCULAS = 6;
 
type
  TMatrizBasculas = array[1..CANT_GRUPOS,1..CANT_BASCULAS] of integer; //matriz de lectura de numero de bascula
 
type
  TMatrizEstado = array[1..CANT_GRUPOS,1..CANT_BASCULAS] of boolean; //matriz de lectura de estado de checkbox por cada bascula
 
type
  TdmDatos = class(TDataModule)
    qySumaGrupos: TIBQuery;
    procedure DataModuleCreate(Sender: TObject);
  private
    { Private declarations }
    procedure LeerGrupos;
    procedure OrganizaGrupos;
  public
    { Public declarations }
    GrupoBascula: TMatrizBasculas;
    EstadoBasculas: TMatrizEstado;
    Cuantos1,Cuantos2,Cuantos3: integer;
    Total1,Total2,Total3: double;
    txtGrupo1,txtGrupo2,txtGrupo3: string;
    procedure SumarGrupos;
  end;
 
const
  Archivo = 'Configura.ini';
 
var
  dmDatos: TdmDatos;
 
implementation
 
uses
  UdmCnx;
 
{$R *.dfm}
 
{ TdmDatos }
 
//Al crear el modulo se ejecutan estos procedimientos
procedure TdmDatos.DataModuleCreate(Sender: TObject);
begin
  LeerGrupos;
  OrganizaGrupos;
  SumarGrupos;
end;
 
//Leemos el ultimo estado de los checkbox el cual se guardo en un INI
procedure TdmDatos.LeerGrupos;
var
  i,j: integer;
  F: TiniFile;
begin
 
  F := TIniFile.Create(ExtractFilePath(Paramstr(0)) + Archivo);
 
  for i := 1 TO CANT_GRUPOS do
    for j := 1 to CANT_BASCULAS do
      GrupoBascula[i,j] := F.ReadInteger('Grupo ' + IntToStr(i),'Bascula ' + IntToStr(j),0);
 
  for i := 1 TO CANT_GRUPOS do
    for j := 1 to CANT_BASCULAS do
      EstadoBasculas[i,j] := F.ReadBool('Grupo ' + IntToStr(i),'Bascula ' + IntToStr(j),False);
end;
 
 
{Creamos las cadenas que definen el numero-estado de las basculas}
procedure TdmDatos.OrganizaGrupos;
  //***********Funcion auxiliar del procedimiento
  //**Basada en un codigo de Seoane
  //**http://www.clubdelphi.com/foros/showthread.php?t=45612
  function QuitaComa(Str: String): String;
  var
    tmpStr: string;
  begin
    tmpStr := Str; //(x,y,z,)
    tmpStr := RightStr(tmpStr,2); //,)
    if (pos(',',tmpStr) > 0) then
      delete(Str,(length(Str)-1),1); //Delete(Str,Start,Count)
    Result:= Str //(x,y,z)
  end;
  //***********************************************
 
var
  j: integer;
begin
  // Armamos la cadena del grupo 1
  txtGrupo1 := '(';
  for j := 1 to CANT_BASCULAS do
    begin
      if EstadoBasculas[1,j] then //Cuales Checkbox estan marcados (TRUE)
        begin
          if j = CANT_BASCULAS then
            txtGrupo1 := txtGrupo1 + IntToStr(GrupoBascula[1,j]) //Numero de bascula correspondiente
          else
            txtgrupo1 := txtgrupo1  + IntToStr(GrupoBascula[1,j]) + ' ,';
        end
      else
        txtgrupo1 := txtgrupo1  + IntToStr(0) + ' ,';
    end;
  txtGrupo1 := txtGrupo1 + ')'; //Si no esta en TRUE la bascula 6 en True se genera (x,y[b],[/b])
  txtGrupo1 := QuitaComa(txtGrupo1); //Eliminamos la coma final
 
  //Armamos la cadena del grupo 2
  txtGrupo2 := '(';
  for j := 1 to CANT_BASCULAS do
    begin
      if EstadoBasculas[2,j] then   //Si el estado es TRUE
        begin
          if j = CANT_BASCULAS then
            txtGrupo2 := txtGrupo2 + IntToStr(GrupoBascula[2,j])
          else
            txtgrupo2 := txtgrupo2  + IntToStr(GrupoBascula[2,j]) + ' ,';
        end
      else
        txtgrupo2 := txtgrupo2  + IntToStr(0) + ' ,';
    end;
  txtGrupo2 := txtGrupo2 + ')';
  txtGrupo2 := QuitaComa(txtGrupo2);
 
  //Armamos la cadena del Grupo3
  txtGrupo3 := '(';
  for j := 1 to CANT_BASCULAS do
    begin
      if EstadoBasculas[3,j] then  //Si el estado es TRUE
        begin
          if j = CANT_BASCULAS then
            txtGrupo3 := txtGrupo3 + IntToStr(GrupoBascula[3,j])
          else
            txtgrupo3 := txtgrupo3  + IntToStr(GrupoBascula[3,j]) + ' ,';
        end
      else
        txtgrupo3 := txtgrupo3  + IntToStr(0) + ' ,';
    end;
  txtGrupo3 := txtGrupo3 + ')';
  txtGrupo3 := QuitaComa(txtGrupo3);
end;
 
{Ejecutamos la consulta en tres pasos. Al intentar hacerlo en un paso (UNION) se genera un error extraño en el StringGrid,
  la fila 1 se pone siempre en 0 si algun grupo no tiene ninguna seleccion (todo en 0)}
procedure TdmDatos.SumarGrupos;
begin
  //********************GRUPO 1*****************************************
  with qySumaGrupos do
    begin
      close;
      sql.Clear ;
      sql.Add('SELECT count(*) AS Pesadas, ' +
              'sum(peso) AS Total ' +
              'FROM Datos WHERE Bascula IN ' + txtGrupo1);    //(1,2,0,0,0,0)
      open;
    end;
  if not qySumaGrupos.IsEmpty then
    begin
      //ghInt y ghFloat forman parte de ghMath de la biblioteca GHFreebrary de AL González devuelven un 0 si existiese un NULL
      Cuantos1 := ghInt(qySumaGrupos['Pesadas']); //FieldValues es la propiedad Default del dataset
      Total1 := ghFloat(qySumaGrupos['Total']);   //Se accede a ella de forma implicita con la sintaxis Dataset[Campo]
    end;
 
 
  //************************GRUPO 2**********************************
  with qySumaGrupos do
    begin
      close;
      sql.Clear ;
      sql.Add('SELECT count(*) AS Pesadas, ' +
              'sum(peso) AS Total ' +
              'FROM Datos WHERE Bascula IN ' + txtGrupo2);    //(0,0,3,4,0,0)
      open;
    end;
  if not qySumaGrupos.IsEmpty then
    begin
      Cuantos2 := ghInt(qySumaGrupos['Pesadas']); //FieldValues es la propiedad Default del dataset
      Total2 := ghFloat(qySumaGrupos['Total']);   //Se accede a ella de forma implicita con la sintaxis Dataset[Campo]
    end;
 
 
  //*******************GRUPO 3 ***************************************
  with qySumaGrupos do
    begin
      close;
      sql.Clear ;
      sql.Add('SELECT count(*) AS Pesadas, ' +
              'sum(peso) AS Total ' +
              'FROM Datos WHERE Bascula IN ' + txtGrupo3);    //(0,0,0,0,5,6)
      open;
    end;
  if not qySumaGrupos.IsEmpty then
    begin
      Cuantos3 := ghInt(qySumaGrupos['Pesadas']); //FieldValues es la propiedad Default del dataset
      Total3 := ghFloat(qySumaGrupos['Total']);   //Se accede a ella de forma implicita con la sintaxis Dataset[Campo]
    end;
 
end;
 
 
 
end.

Definitivamente el codigo se redujo bastante. Seria fabuloso reducir aun mas la consulta. 

El codigo de la consulta en un paso y que genera errores extraños (tal vez alguien vea el error que no veo -¿sera efecto de navidad? - ) :

delphi

procedure TdmDatos.SumarGrupos;
begin
  with qySumaGrupos do
    begin
      close;
      sql.Clear ;
      sql.Add('SELECT count(*) AS Pesadas, ' +
              'sum(peso) AS Total ' +
              'FROM Datos WHERE Bascula IN ' + txtGrupo1 +   //(1,2)
              ' UNION ' +
                'SELECT count(*),' +
                'sum(peso) ' +
                'FROM Datos WHERE Bascula IN ' + txtGrupo2 +  //(3,4)
              ' UNION ' +
                'SELECT count(*),' +
                'sum(peso) ' +
                'FROM Datos WHERE Bascula IN ' + txtGrupo3);  //(5,6)
      open;
    end;
 
  if not qySumaGrupos.IsEmpty then
    begin
      Cuantos1 := ghInt(qySumaGrupos['Pesadas']); //FieldValues es la propiedad Default del dataset
      Total1 := ghFloat(qySumaGrupos['Total']);   //Se accede a ella de forma implicita con la sintaxis Dataset[Campo]
 
      qySumaGrupos.Next; //Delphi ve el resultado como una tabla con
                         //tres registros. Hay que navegar (Next)
 
      Cuantos2 := ghInt(qySumaGrupos['Pesadas']);
      Total2 := ghFloat(qySumaGrupos['Total']);
 
      qySumaGrupos.Next;
 
      Cuantos3 := ghInt(qySumaGrupos['Pesadas']);
      Total3 := ghFloat(qySumaGrupos['Total']);
    end;
end;

Gracias nuevamente por su ayuda y el tiempo .

[FGarcia]

Solamente por si alguien quiere revisarlo anexo el codigo y la BD que estoy usando. Solo descomprimir ambos en una misma carpeta. firebird 2.0 y delphi 7. El unico componente externo es la GHFreebrary. Grupos es el codigo y DatosCap es la BD.

Archivos adjuntos

•  134_.zip   56,36KB   0 descargas
•  133_.zip   19,41KB   0 descargas

[Delphius]

Hola FGarcía,
Veo que se avanzó en el tema.
Lo que yo he notado cuando ejecuté dicha consulta (IBExpert) en mi Firebird 1.5 es que los registros me los devuelve en el orden inverso. Es decir algo así:
datos grupo 3
datos grupo 2
datos grupo 1

Pero funciona. Devuelve los datos correctos, pero no ordenados. Tal vez se debió a que usé un indice descendiente... no se... tendría que ver. La prueba la hice apresurado y con una de las tablas de la DB de ejemplo. Admito que no me fijé en los índices. Disculpa.

Con respecto al tema de formar la cadena de la parte IN yo veo que se puede resumir en una sola:

delphi

function GetTextoIn(NroGrupo: integer): string;
var j: integer;
begin
  result := '(';
  for j := 1 to CANT_BASCULAS do
     if EstadoBasculas[NroGrupo,j] // es true el valor leído desde archivo
        then result := result + IntToStr(j) + ' ,';
  result := QuitarComa(result) + ')';
end;

Tu repites la rutina 3 veces, una por grupo.

Me resulta extraño que tengas otra matriz con valores enteros ¿Para qué? No termino de comprender.

Yo llego a la conclusión de que si tenemos el estado en TRUE y el índice (el j) en la matriz podemos indentificar únivocamente a la báscula y por tanto confirmar que la báscula j-ésima ha sido seleccionada.
Si existe una fiel correspondencia entre el "ID" de la báscula y el índice en la matriz, entonces nos podemos evitar una segunda matriz.

Ahora, una pregunta ¿y si no selecciona ninguna? ¿Que hacemos?
1. no filtrar y considerar a todas las básculas. (Sin WHERE)
2. dar una advertencia y pedir que filtre al menos una.

Esa función GetTextoIn debería funcionar siempre y cuando exista al menos una selección. Noté que en tu código le introduces el cero. ¿Porqué? ¿Tiene algún significado en especial? En mi código debería haber una salida del tipo "()".
Eso es ya una cuestión de "detalle".

Después le hecho una miradita a tu código.
Saludos,

[FGarcia]

Con respecto a lo de que devuelve los resultados en orden inverso, si, si lo hace, de hecho no se a que se debe y hasta este momento que me dices que asi te resulto confirmo la respuesta.

Si la salida es () y se genera un error de SQL que desconoce la expresion (. Por eso cambie para que llene las cadenas (1,2,0,0,0,0) si no seleccionas ninguna pues devuelve solo (0,0,0,0,0,0) y no genera error.

Gracias por tu tiempo.

[Delphius]

Hola FGarcia,
¿Entonces no era algo que me sucedía a mi lo de los regitros inversos? Bueno... no se... tal vez si pruebo poniendo la SQL alrreves... digo algo como:

sql

SELECT ...
WHERE IN (xx3,yy3,...,zz3)
UNION
SELECT ...
WHERE IN (xx2,yy2,...,zz2)
UNION
SELECT ...
WHERE IN (xx1,yy1,...,zz1)

No tengo Firebird abierto en este momento.

Gracias por aclararme lo de los ceros.
Ummm, yo mas bien lo programaría para que antes de lanzar la SQL chequear si el texto es () y en caso afirmativo lanzar una SQL sin where.

No se si es mucho lío lanzar tres consultas simples, como tu haces... o directamente una sola con los unions. Lo que si es bueno es emplear un solo TQuery. No veo, al menos asi opino yo, tener tres TQuerys para lanzar tres consultas que son "las mismas"... bastaría con lanzar, guardar en el stringGrid, cerrar y volver a lanzarla con los nuevos datos en en IN.

Saludos,

[FGarcia]

OK, ya esta eliminada la segunda matriz. No me preguntes porque la ponia pues no le encontre ya logica.  :$

Con respecto a lo de las queries eso ya lo habia dejado en una sola, solo la lanzo tres veces. No he vuelto a probar con lo de la UNION.

delphi

procedure TdmDatos.SumarGrupos;
 
  //***********Funcion auxiliar del procedimiento ***************************
  //**Basada en un codigo de Seoane
  //**http://www.clubdelphi.com/foros/showthread.php?t=45612
  function QuitarComa(Str: String): String;
  var
    tmpStr: string;
  begin
    tmpStr := Str; //(x,y,z,)
    tmpStr := RightStr(tmpStr,1); //,
    if (pos(',',tmpStr) > 0) then
      delete(Str,(length(Str)),1); //Delete(Str,Start,Count)
    Result:= Str //(x,y,z)
  end;
  //*************************************************************************
 
  function GetTextoIn(NroGrupo: integer): string;
  var
    j: integer;
  begin
    result := '(';
 
    for j := 1 to CANT_BASCULAS do
      if EstadoBasculas[NroGrupo,j] then // es true el valor leído desde archivo
        result := result + IntToStr(j) + ' ,'
      else
        result := result + IntToStr(0) + ' ,';
 
    result := QuitarComa(result) + ')';
  end;
  //*************************************************************************
 
begin
 
  //********************GRUPO 1**********************************************
  with [b]qySumaGrupos[/b] do
    begin
      close;
      sql.Clear ;
      sql.Add('SELECT count(*) AS Pesadas, ' +
              'sum(peso) AS Total ' +
              'FROM Datos WHERE Bascula IN ' + GetTextoIn(1));    //(1,2)
      open;
    end;
  if not qySumaGrupos.IsEmpty then
    begin
      Cuantos1 := ghInt(qySumaGrupos['Pesadas']); //FieldValues es la propiedad Default del dataset
      Total1 := ghFloat(qySumaGrupos['Total']);   //Se accede a ella de forma implicita con la sintaxis Dataset[Campo]
    end;
 
 /+++++Se repite para las otras dos solo cambio el parametro de GetTextoIn(X)