[Chaja]

estimados...
hace bastante que no ando por aqui y vengo con una situacion q no se como solucionarla. Para los que nos son de mi pais (Argentina) algunos clientes deben hacer retenciones de Ingresos Brutos (Impuesto provincial ) cuando cobran u/o hacen vtas. Para ello la agencia de recaudacion genera un archivo que se debe bajar desde la pagina, y el cual es de formato txt y contiene aproximadamente 3.500.000 de reg. Para eso hice una pantalla de carga y recorre todo el txt y va ingresando los reg. o actualizando.
A continuacion pongo el codigo que usos en dicha pantalla:

Código Delphi [-]
unit UTasas_Ret_perc;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  UABMBase, Wwintl, wwDialog, wwidlg, Db, DBTables,
  ActnList, ComCtrls, Buttons, StdCtrls, ToolWin,
  ExtCtrls, DBCtrls, Provider, DBClient, Grids, DBGrids,Mask,
  JvComponentBase, ImgList, JvExControls,Math,
  JvGradient, JvFormPlacement, JvLabel, JvDBControls, FMTBcd, SqlExpr,
  JvAnimatedImage, JvThread;

type
  TFormTasasRet_Perc = class(TFormABMBase)
    edPath: TEdit;
    SpeedButton1: TSpeedButton;
    Label2: TLabel;
    OpenDialog: TOpenDialog;
    LeerTxt: TAction;
    CDSTasas: TClientDataSet;
    DSPTasas: TDataSetProvider;
    dbgDetalle: TDBGrid;
    CDSTasasCUIT: TStringField;
    CDSTasasTIPO_CONVENIO: TStringField;
    CDSTasasESTADO: TStringField;
    CDSTasasCAMBIO_ALICUOTA: TStringField;
    CDSTasasGRUPO_PERCEPCION: TSmallintField;
    CDSTasasGRUPO_RETENCION: TSmallintField;
    DSTasas: TDataSource;
    BitBtn1: TBitBtn;
    Label1: TLabel;
    Label3: TLabel;
    lbReg: TLabel;
    lbNroReg: TLabel;
    ComboBox1: TComboBox;
    Label4: TLabel;
    lbTiempoLectua: TLabel;
    Label6: TLabel;
    Label5: TLabel;
    Label7: TLabel;
    lbinicio: TLabel;
    lbfin: TLabel;
    Label8: TLabel;
    Bevel1: TBevel;
    Label9: TLabel;
    QTasas: TSQLQuery;
    QTasasCUIT: TStringField;
    QTasasFECHA: TSQLTimeStampField;
    QTasasDESDE: TSQLTimeStampField;
    QTasasHASTA: TSQLTimeStampField;
    QTasasTIPO_CONVENIO: TStringField;
    QTasasESTADO: TStringField;
    QTasasCAMBIO_ALICUOTA: TStringField;
    QTasasTASA_PERCEPCION: TFMTBCDField;
    QTasasTASA_RETENCION: TFMTBCDField;
    QTasasGRUPO_PERCEPCION: TSmallintField;
    QTasasGRUPO_RETENCION: TSmallintField;
    CDSTasasFECHA: TSQLTimeStampField;
    CDSTasasDESDE: TSQLTimeStampField;
    CDSTasasHASTA: TSQLTimeStampField;
    CDSTasasTASA_PERCEPCION: TFMTBCDField;
    CDSTasasTASA_RETENCION: TFMTBCDField;
    QBorrar: TSQLQuery;
    spGravar: TSQLStoredProc;
    DBStatusLabel2: TJvDBStatusLabel;
    MemoText: TRichEdit;
    chbBorrarDatos: TCheckBox;
    QBuscaCuit: TSQLQuery;
    StringField1: TStringField;
    SQLTimeStampField1: TSQLTimeStampField;
    SQLTimeStampField2: TSQLTimeStampField;
    SQLTimeStampField3: TSQLTimeStampField;
    StringField2: TStringField;
    StringField3: TStringField;
    StringField4: TStringField;
    FMTBCDField1: TFMTBCDField;
    FMTBCDField2: TFMTBCDField;
    SmallintField1: TSmallintField;
    SmallintField2: TSmallintField;
    spGravar_2: TSQLStoredProc;
    BitBtn2: TBitBtn;
    jvHiloTx: TJvThread;
    pgProceso: TProgressBar;
    Timer1: TTimer;
    Label10: TLabel;
    lbPorMinuto: TLabel;
    lbRestan: TLabel;
    lbMinutos: TLabel;
    procedure LeerTxtExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure ConfirmaExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
    procedure CancelarExecute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BorrarExecute(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure jvHiloTxExecute(Sender: TObject; Params: Pointer);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    TotalReg,TotalProcesado,TotalxMinuto,Minutos:Integer;
    Tiempo:TDateTime;
    procedure CargarPadron;
  end;

var
  Cancelado:Boolean;
  ArchiTxt:TextFile;
  I:Integer;
  FormTasasRet_Perc: TFormTasasRet_Perc;

implementation

uses DMMainForm_2;

{$R *.DFM}

procedure TFormTasasRet_Perc.CargarPadron;
VAR Tipo,S:String;
aux:Real;
posicion:Integer;
begin
  inherited;

  if MemoText.Lines.Count<=0 Then
    Raise Exception.Create('No hay datos para procesar...');
 // GifProceso.Visible:=True;
 // GifProceso.Animate:=True;
  if chbBorrarDatos.Checked then
    begin
      Borrar.Execute;
    end;
  btBorrar.Enabled:=False;
  CDSTasas.Close;
  CDSTasas.Open;
  btCancelar.Enabled:=True;
  btSalir.Enabled   :=False;
  if ComboBox1.ItemIndex=0 Then
    DecimalSeparator:=','
  else
  if ComboBox1.ItemIndex=1 Then
    DecimalSeparator:='.';

  Cancelado:=False;
  TotalReg:=0;
  TotalProcesado:=0;
  Minutos:=0;
  lbinicio.Caption:=TimeToStr(Now);
  pgProceso.Min:=0;
  pgProceso.Max:=MemoText.Lines.Count-1;
  pgProceso.Position:=0;
  TotalReg:=MemoText.Lines.Count-1;
  Timer1.Enabled:=True;
  for posicion:=0 to MemoText.Lines.Count-1 do
    begin
      TotalxMinuto     := TotalxMinuto+1; // este se resetea..
      TotalProcesado   := posicion;
      lbNroReg.Caption := IntToStr(posicion);
      lbRestan.Caption := FormatDateTime('hh:mm',Tiempo);
      lbMinutos.Caption:= FormatDateTime('ss',Now);
      s:=MemoText.Lines[posicion];
      pgProceso.Position:=posicion;
  //    Application.ProcessMessages;
      if cancelado=False Then
        begin
          spGravar_2.close;
          Tipo:=copy(s,1,1);
          spGravar_2.ParamByName('TIPO_PERCECPION').Value  := copy(s,1,1);
          delete(s,1,2);
          spGravar_2.ParamByName('desde').AsDate  := StrToDateTime(FormatDateTime('dd/mm/yyyy',StrToDate( (Copy(s,10,2) +'/'+ Copy(s,12,2) +'/'+ Copy(s,14,4) ))));
          spGravar_2.ParamByName('hasta').AsDate  := StrToDateTime(FormatDateTime('dd/mm/yyyy',StrToDate( (Copy(s,19,2) +'/'+ Copy(s,21,2) +'/'+ Copy(s,23,4) ))));
          spGravar_2.ParamByName('fecha').AsDate  := StrToDateTime(FormatDateTime('dd/mm/yyyy',StrToDate( (Copy(s,1,2)  +'/'+ Copy(s,3,2)  +'/'+ Copy(s,5,4) ))));
          spGravar_2.ParamByName('cuit').Value    := Copy(s,28,2)+'-'+Copy(s,30,8)+'-'+copy(s,38,1);
          spGravar_2.ParamByName('tipo').Value    := Copy(s,40,1);  // tipo de contribuyente
          spGravar_2.ParamByName('estado').Value  := Copy(S,42,1);  // se se da de alta o baja
          spGravar_2.ParamByName('cambio').Value  := Copy(s,44,1);  // si cambio la alicuota
          if Tipo='P' then
            spGravar_2.ParamByName('tasa_perc').AsFloat := StrToFloat(copy(s,46,4))
          else
            if Tipo='R' then
               spGravar_2.ParamByName('tasa_ret').AsFloat  :=  StrToFloat(copy(s,46,4));

          spGravar_2.ParamByName('g_per').Value := StrToInt(Copy(s,51,2));
          spGravar_2.ParamByName('g_ret').Value := StrToInt(Copy(s,51,2));
     //    spGravar.ParamByName('g_ret').Value := StrToInt(Copy(s,59,2));
          spGravar_2.ExecProc;
          spGravar_2.close;
        end
      else
        if MessageDlg('continua ?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then
          begin
            btCancelar.Enabled:=True;
            btSalir.Enabled   :=False;
           // GifProceso.Visible:=True;
           // GifProceso.Animate:=True;
            btBorrar.Enabled:=False;
            cancelado:=False;
         //    Application.ProcessMessages;
          end
        else
          begin
            DecimalSeparator  :='.';
           // GifProceso.Visible:=False;
           // GifProceso.Animate:=False;
             pgProceso.Position:=0;
            lbfin.Caption     :=TimeToStr(now);
            btCancelar.Enabled:=False;
            btBorrar.Enabled  :=True;
            btSalir.Enabled   :=True;
            Timer1.Enabled:=False;
        //    Application.ProcessMessages;
            exit;
          end;
       jvHiloTx.Synchronize();
    end;
  DecimalSeparator  :='.';
 // GifProceso.Visible:=False;
 // GifProceso.Animate:=False;
  lbfin.Caption     :=TimeToStr(now);

  btCancelar.Enabled:=False;
  btBorrar.Enabled  :=True;
  btSalir.Enabled   :=True;
  Timer1.Enabled:=False;
end;


procedure TFormTasasRet_Perc.LeerTxtExecute(Sender: TObject);
VAR S:String;
aux:Real;
posicion:Integer;
begin
  inherited;

  if MemoText.Lines.Count<=0 Then
    Raise Exception.Create('No hay datos para procesar...');
  //GifProceso.Visible:=True;
 // GifProceso.Animate:=True;
  if chbBorrarDatos.Checked then
    begin
      Borrar.Execute;
    end;
  btBorrar.Enabled:=False;
  CDSTasas.Close;
  CDSTasas.Open;
  btCancelar.Enabled:=True;
  btSalir.Enabled   :=False;
  if ComboBox1.ItemIndex=0 Then
    DecimalSeparator:=','
  else
  if ComboBox1.ItemIndex=1 Then
    DecimalSeparator:='.';

  Cancelado:=False;

  lbinicio.Caption:=TimeToStr(Now);

  for posicion:=0 to MemoText.Lines.Count-1 do
    begin
     // Application.ProcessMessages;
      lbNroReg.Caption:=IntToStr(posicion);
      s:=MemoText.Lines[posicion];
      if cancelado=False Then
        begin
          spGravar.close;
          spGravar.ParamByName('cuit').Value    := Copy(s,28,2)+'-'+Copy(s,30,8)+'-'+copy(s,38,1);

          spGravar.ParamByName('fecha').AsDate  := StrToDateTime(FormatDateTime('dd/mm/yyyy',StrToDate( (Copy(s,1,2)  +'/'+ Copy(s,3,2)  +'/'+ Copy(s,5,4) ))));
          spGravar.ParamByName('desde').AsDate  := StrToDateTime(FormatDateTime('dd/mm/yyyy',StrToDate( (Copy(s,10,2) +'/'+ Copy(s,12,2) +'/'+ Copy(s,14,4) ))));
          spGravar.ParamByName('hasta').AsDate  := StrToDateTime(FormatDateTime('dd/mm/yyyy',StrToDate( (Copy(s,19,2) +'/'+ Copy(s,21,2) +'/'+ Copy(s,23,4) ))));
          spGravar.ParamByName('tipo').Value    := Copy(s,40,1);
          spGravar.ParamByName('estado').Value  := Copy(S,42,1);
          spGravar.ParamByName('cambio').Value  := Copy(s,44,1);
          spGravar.ParamByName('tasa_perc').AsFloat := StrToFloat(copy(s,46,4));
          spGravar.ParamByName('tasa_ret').AsFloat  := StrToFloat(Copy(s,51,3));

          spGravar.ParamByName('g_per').Value := StrToInt(Copy(s,56,2));
          spGravar.ParamByName('g_ret').Value := StrToInt(Copy(s,59,2));
          spGravar.ExecProc;
          spGravar.close;
        end
      else
        if MessageDlg('continua ?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then
          begin
            btCancelar.Enabled:=True;
            btSalir.Enabled   :=False;
           // GifProceso.Visible:=True;
           // GifProceso.Animate:=True;
            btBorrar.Enabled:=False;
            cancelado:=False;
          end
        else
          begin
            DecimalSeparator  :='.';
           // GifProceso.Visible:=False;
           // GifProceso.Animate:=False;
            lbfin.Caption     :=TimeToStr(now);
            btCancelar.Enabled:=False;
            btBorrar.Enabled  :=True;
            btSalir.Enabled   :=True;
           
            exit;
          end;
    end;
  DecimalSeparator  :='.';
 // GifProceso.Visible:=False;
 // GifProceso.Animate:=False;
  lbfin.Caption     :=TimeToStr(now);

  btCancelar.Enabled:=False;
  btBorrar.Enabled  :=True;
  btSalir.Enabled   :=True;
end;

procedure TFormTasasRet_Perc.FormCreate(Sender: TObject);
begin
  inherited;
  AutoSize:=True;
  //GifProceso.Visible :=False;
 // GifProceso.Animate :=False;
  ComboBox1.ItemIndex:=0;
  MemoText.Clear;
 // AddClientDataSet(CDSTasas,DSPTasas);
  CDSTasas.Open;
end;

procedure TFormTasasRet_Perc.SpeedButton1Click(Sender: TObject);
var Inicio:TDateTime;
begin
  inherited;
  if OpenDialog.Execute Then
    if OpenDialog.FileName<>'' Then
      begin
        Screen.Cursor:=crHourGlass;
        sbEstado.SimpleText:='Cargando Archivo....';
        Application.ProcessMessages;
        Inicio:=Now;
        edPath.Text:=OpenDialog.FileName;
        AssignFile(ArchiTxt, OpenDialog.FileName);
        Reset(ArchiTxt);
        MemoText.Lines.LoadFromFile(OpenDialog.FileName);
        lbReg.Caption:=IntToStr(MemoText.Lines.Count-1);
        lbTiempoLectua.Caption:=TimetoStr(inicio-now);
        Screen.Cursor:=crDefault;
      end
    else
      ShowMessage('No hay archivo Seleccionado');
  sbEstado.SimpleText:='..';
  Application.ProcessMessages;
  Screen.Cursor:=crDefault;

end;

procedure TFormTasasRet_Perc.Timer1Timer(Sender: TObject);
var aux:extended;
begin
  inherited;
  lbPorMinuto.Caption:=IntToStr(TotalxMinuto);
  if (TotalxMinuto>0) then
    Aux:=((((TotalReg-TotalProcesado)*60000)/TotalxMinuto)/60000)/60
  else
    Aux:=0;  
  TotalxMinuto:=0;
  Aux   := RoundTo(Aux,-2);
  Tiempo:= Aux;

 // Application.ProcessMessages;
end;

procedure TFormTasasRet_Perc.ConfirmaExecute(Sender: TObject);
begin
//  inherited;
//  CDSTasas.ApplyUpdates(-1);
end;

procedure TFormTasasRet_Perc.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  MemoText.Clear;
  CDSTasas.Close;
  DecimalSeparator:='.';
  Action:=caFree;
end;

procedure TFormTasasRet_Perc.FormKeyPress(Sender: TObject; var Key: Char);
begin
  inherited;
  if Key=#27 Then
    Cancelado:=True
  else
    Cancelado:=False;
end;

procedure TFormTasasRet_Perc.FormShow(Sender: TObject);
begin
  inherited;
//  btCancelar.Enabled:=False;
//  btSalir.Enabled   :=True;
end;

procedure TFormTasasRet_Perc.jvHiloTxExecute(Sender: TObject; Params: Pointer);
begin
  inherited;
  CargarPadron;
  jvHiloTx.Terminate;
end;

procedure TFormTasasRet_Perc.CancelarExecute(Sender: TObject);
begin
 // inherited;
   Cancelado:=True;
   btCancelar.Enabled:=False;
   btConfirma.Enabled:=False;
   btSalir.Enabled   :=True;
  // GifProceso.Visible:=False;
  // GifProceso.Animate:=False;

//   MemoText.Clear;
//   CDSTasas.Close;
//   CDSTasas.Params.Clear;
//   CDSTasas.Open;
end;

procedure TFormTasasRet_Perc.FormDestroy(Sender: TObject);
begin
  inherited;
  FormTasasRet_Perc:=nil;
end;

procedure TFormTasasRet_Perc.BitBtn2Click(Sender: TObject);
begin
  inherited;
  jvHiloTx.FreeOnTerminate:=True;
  jvHiloTx.Execute(self);
end;

procedure TFormTasasRet_Perc.BorrarExecute(Sender: TObject);
begin
 // inherited;
  QBorrar.Close;
  QBorrar.ExecSQL;
  QBorrar.Close;
  CDSTasas.Close;
  CDSTasas.Open;
end;

end.

esto parece que anda bien pero al llegar al reg 26.000 o 28.000
ma salta el error

canvas does not allow drawing

y se cuelga. Segun dice por ahi es debido a la falta de recursos, he observado que cuando se ejcuta el hilo, en el administrador de tarea el sistema empieza a utilizar memo, pero nunca se libera, es asi?
Si alguien me puede decir como corregir esto se los agradeceria...

Luis Roldan
Mar del Plata
Argentina