Hola Muchachos gracias por su interes pra la colaboracion que pido...
Al mira que cuando ejecuto con depurador Delphi me envia a esa tlinea de codigo (la de color rojo). curiosamente este es otro procedimiento relacinado que no habia tenido en cuenta.
Sobre lo que comenta [AgustinOrtu]; pues tambien me suena mucho. voy a ir estudiando esta solucion tambien.
Mil gracias a ambos.
Que se busca;
Este codigo Filtra de una tabla llama procedimientos una serie de productos y servicios que vende un laboratorio de patologia; y nos muestra (Junto con el diseño) unas opciones entre otras cosas de repetir 2 o mas veces la misma venta del procedimiento.
El codigo anterior graba esa venta que puede ser de un procedimiento unico o de uno repetido muchas veces. con el error de "out Of Memory" solo me grba 1 las repeticiones no las hace y salta el error.
Gracias
Código Delphi
[-]
procedure TFormPersonas.Button9Click(Sender: TObject);
Var
QPacientes, QCategorias, QProcedimiento: TQuery;
vFields: array of TStringField;
vCamposBool: array of TBooleanField;
vCodigoProc, vRepeticiones: array of TIntegerField;
vValorProc, vCopago, vAbono, vNeto, vSaldo: array of TFloatField;
I: Integer;
begin
CDSProcedimientos.Free;
CDSProcedimientos := TClientDataSet.Create(Self);
CDSProcedimientos.OnCalcFields := CDSProcedimientosCalcFields;
DataSource2.DataSet := CDSProcedimientos;
QProcedimiento := TQuery.Create(nil);
QCategorias := TQuery.Create(nil);
try
QProcedimiento.DatabaseName := 'Clara';
QProcedimiento.SQL.Clear;
QProcedimiento.SQL.Add('select distinct Nombreentidad, procedimiento, codigo_procedimiento, valor from procedimientos where NombreEntidad = :Entidad');
if DBLookupComboBox2.Text <> '' then
begin
QProcedimiento.SQL.Add('and convenio= :convenio');
QProcedimiento.ParamByName('convenio').AsString :=
TableConveniosConvenio.AsString;
end;
QProcedimiento.Close;
QProcedimiento.ParamByName('Entidad').AsString := DBComboBox9.Text;
QProcedimiento.Open;
vgEntidad := DBComboBox9.Text;
QCategorias.DatabaseName := 'Clara';
QCategorias.SQL.Clear;
QCategorias.SQL.Add('select distinct NombreEntidad from procedimientos where NombreEntidad= :Entidad');
if DBLookupComboBox2.Text <> '' then
begin
QCategorias.SQL.Add('and convenio=:convenio');
QCategorias.ParamByName('convenio').AsString :=
TableConveniosConvenio.AsString;
end;
QCategorias.Close;
QCategorias.ParamByName('Entidad').AsString := DBComboBox9.Text;
QCategorias.Open;
begin
try
CDSProcedimientos.Close;
CDSProcedimientos.CreateDataSet;
except
end;
end;
CDSProcedimientos.Close;
for I := CDSProcedimientos.FieldCount - 1 downto 0 do
begin
CDSProcedimientos.Fields[i].DataSet := nil;
end;
I := 0;
SetLength(vFields, QCategorias.RecordCount);
SetLength(vCamposBool, QCategorias.RecordCount);
SetLength(vCodigoProc, QCategorias.RecordCount);
SetLength(vValorProc, QCategorias.RecordCount);
SetLength(vCopago, QCategorias.RecordCount);
SetLength(vAbono, QCategorias.RecordCount);
SetLength(vNeto, QCategorias.RecordCount);
SetLength(vSaldo, QCategorias.RecordCount);
SetLength(vRepeticiones, QCategorias.RecordCount);
QCategorias.First;
while not QCategorias.EOF do
begin
if Assigned(vFields[i]) then
vFields[i].Free;
if Assigned(vCamposBool[i]) then
vCamposBool[i].Free;
if Assigned(vCodigoProc) then
vCodigoProc[i].Free;
if Assigned(vValorProc) then
vValorProc[i].Free;
vFields[i] := TStringField.Create(CDSProcedimientos);
vCamposBool[i] := TBooleanField.Create(CDSProcedimientos);
vCodigoProc[i] := TIntegerField.Create(CDSProcedimientos);
vValorProc[i] := TFloatField.Create(CDSProcedimientos);
vCopago[i] := TFloatField.Create(CDSProcedimientos);
vAbono[i] := TFloatField.Create(CDSProcedimientos);
vNeto[i] := TFloatField.Create(CDSProcedimientos);
vSaldo[i] := TFloatField.Create(CDSProcedimientos);
vRepeticiones[i] := TIntegerField.Create(CDSProcedimientos);
vCamposBool[i].FieldName := 'CheckBox_' + QCategorias.Fields[0].AsString;
if CDSProcedimientos.Fields.FindField('CheckBox_' + QCategorias.Fields[0]
.AsString) = nil then
vCamposBool[i].DataSet := CDSProcedimientos;
vCamposBool[i].DisplayLabel := 'Elegir';
vCamposBool[i].OnValidate := Validate;
vRepeticiones[i].FieldName := 'Repeticiones_' + QCategorias.Fields
[0].AsString;
if CDSProcedimientos.Fields.FindField('Repeticiones_' + QCategorias.Fields
[0].AsString) = nil then
vRepeticiones[i].DataSet := CDSProcedimientos;
vRepeticiones[i].DisplayLabel := 'Repite';
vRepeticiones[i].DisplayFormat := '###,###,##0';
vRepeticiones[i].Visible := True;
vFields[i].FieldName := QCategorias.Fields[0].AsString;
vFields[i].ReadOnly := False;
if CDSProcedimientos.Fields.FindField(QCategorias.Fields[0].AsString)
= nil then
vFields[i].DataSet := CDSProcedimientos;
vFields[i].DisplayLabel := 'Procedimiento';
vCodigoProc[i].FieldName := 'Codigo_' + QCategorias.Fields[0].AsString;
if CDSProcedimientos.Fields.FindField('Codigo_' + QCategorias.Fields[0]
.AsString) = nil then
vCodigoProc[i].DataSet := CDSProcedimientos;
vCodigoProc[i].DisplayLabel := 'Codigo';
vCodigoProc[i].Visible := True;
vValorProc[i].FieldName := 'Valor_' + QCategorias.Fields[0].AsString;
if CDSProcedimientos.Fields.FindField('Valor_' + QCategorias.Fields[0]
.AsString) = nil then
vValorProc[i].DataSet := CDSProcedimientos;
vValorProc[i].DisplayLabel := 'Valor';
vValorProc[i].DisplayFormat := '###,###,##0.00';
vValorProc[i].OnChange := CDSProcedimientosValor_Change;
vValorProc[i].Visible := True;
vCopago[i].FieldName := 'Copago_' + QCategorias.Fields[0].AsString;
if CDSProcedimientos.Fields.FindField('Copago_' + QCategorias.Fields[0]
.AsString) = nil then
vCopago[i].DataSet := CDSProcedimientos;
vCopago[i].DisplayLabel := 'Cop./Part.';
vCopago[i].DisplayFormat := '###,###,##0.00';
vCopago[i].Visible := True;
vAbono[i].FieldName := 'Abono_' + QCategorias.Fields[0].AsString;
if CDSProcedimientos.Fields.FindField('Abono_' + QCategorias.Fields[0]
.AsString) = nil then
vAbono[i].DataSet := CDSProcedimientos;
vAbono[i].DisplayLabel := 'Abono';
vAbono[i].DisplayFormat := '###,###,##0.00';
vAbono[i].Visible := True;
vNeto[i].FieldName := 'Neto_' + QCategorias.Fields[0].AsString;
vNeto[i].FieldKind := fkCalculated;
if CDSProcedimientos.Fields.FindField('Neto_' + QCategorias.Fields[0]
.AsString) = nil then
vNeto[i].DataSet := CDSProcedimientos;
vNeto[i].DisplayLabel := 'Neto';
vNeto[i].DisplayFormat := '###,###,##0.00';
vNeto[i].Visible := True;
vSaldo[i].FieldName := 'Saldo_' + QCategorias.Fields[0].AsString;
vSaldo[i].FieldKind := fkCalculated;
if CDSProcedimientos.Fields.FindField('Saldo_' + QCategorias.Fields[0]
.AsString) = nil then
vSaldo[i].DataSet := CDSProcedimientos;
vSaldo[i].DisplayLabel := 'Saldo';
vSaldo[i].DisplayFormat := '###,###,##0.00';
vSaldo[i].Visible := True;
Inc(I);
QCategorias.Next;
end;
try
CDSProcedimientos.Close;
CDSProcedimientos.CreateDataSet;
except
end;
CDSProcedimientos.Open;
QProcedimiento.DisableControls;
try
QProcedimiento.First;
while not QProcedimiento.EOF do
begin
if BuscaLinea(QProcedimiento.Fields[0].AsString) <> nil then
CDSProcedimientos.Edit
else
CDSProcedimientos.Append;
CDSProcedimientos.FieldByName(QProcedimiento.Fields[0].AsString)
.AsString := QProcedimiento.Fields[1].AsString;
CDSProcedimientos.FieldByName('CheckBox_' + QProcedimiento.Fields[0]
.AsString).AsBoolean := False;
CDSProcedimientos.FieldByName('Codigo_' + QProcedimiento.Fields[0]
.AsString).AsInteger := QProcedimiento.Fields[2].AsInteger;
CDSProcedimientos.FieldByName('Valor_' + QProcedimiento.Fields[0]
.AsString).AsFloat := QProcedimiento.Fields[3].AsFloat;
CDSProcedimientos.FieldByName('Abono_' + QProcedimiento.Fields[0]
.AsString).AsFloat := 0;
CDSProcedimientos.FieldByName('Neto_' + QProcedimiento.Fields[0]
.AsString).AsFloat := 0;
CDSProcedimientos.FieldByName('Saldo_' + QProcedimiento.Fields[0]
.AsString).AsFloat := 0;
CDSProcedimientos.FieldByName('Repeticiones_' + QProcedimiento.Fields[0]
.AsString).AsFloat := 1;
CDSProcedimientos.Post;
QProcedimiento.Next;
end;
CDSProcedimientos.First;
finally
QProcedimiento.EnableControls;
end;
for I := 0 to DBGCategoria.Columns.Count - 1 do
begin
if (Pos('CheckBox_', DBGCategoria.Columns[i].FieldName) = 0) and
(Pos('Copago_', DBGCategoria.Columns[i].FieldName) = 0) and
(Pos('Abono_', DBGCategoria.Columns[i].FieldName) = 0) and
(Pos('Repeticiones_', DBGCategoria.Columns[i].FieldName) = 0) and
(Pos('Valor_', DBGCategoria.Columns[i].FieldName) = 0) then
DBGCategoria.Columns[i].ReadOnly := True;
end;
finally
QCategorias.Free;
QProcedimiento.Free;
end;
DBGCategoria.Columns[0].Title.Caption := 'Elegir';
DBGCategoria.Columns[1].Alignment := taCenter;
DBGCategoria.Columns[3].Alignment := taCenter;
DBGCategoria.Columns[4].Alignment := taCenter;
DBGCategoria.Columns[5].Alignment := taCenter;
DBGCategoria.Columns[6].Alignment := taCenter;
DBGCategoria.Columns[7].Alignment := taCenter;
DBGCategoria.Columns[8].Alignment := taCenter;
end;