Fórum Não apaga todas as linhas desejadas do Memo / processo demora muito #614000

03/02/2021

0

Delphi

Bom dia, preciso identificar todas as linhas de um Memo que contenha um determinado texto e apagar estas linhas. Porém estou enfrentando dois problemas que não consegui resolver. O primeiro é que ele não apaga todas as linhas que contem o texto indicado preciso rodar umas 3x para que ele realmente apague todas as linhas. O outro problema é que ele demora demais para concluir o processo, ele apaga 1 linha a cada 2~3 segundos mais ou menos.

Dentro do Memo é carregado um arquivo txt com mais ou menos 50k de linhas. O problema acontece com ou sem Thread.

Fiz da seguinte forma.

procedure TFrm_SAD.c870;
begin
  TThread.CreateAnonymousThread(
  procedure
  var i: integer;
  begin
    for i := 0 to MemoSped.Lines.Count do begin
      if (MemoSped.Lines.Strings[i].Contains('|C870|') = True) then begin
        MemoSped.Lines.Delete(i);
      end;
    end;
  end
  ).Start;
end;
Paulo

Paulo

Responder

Posts

03/02/2021

Emerson Nascimento

faça a verificação de trás pra frente, assim você resolve numa única passagem;
quando um resultado for booleano e você precisar utilizar numa condição, não precisa comparar com True ou False. basta avaliar o resultado;
procedure TFrm_SAD.c870;
begin
  TThread.CreateAnonymousThread(
  procedure
  var i: integer;
  begin
    for i := MemoSped.Lines.Count downto 0 do
    begin
      if MemoSped.Lines.Strings[i].Contains('|C870|') then
        MemoSped.Lines.Delete(i);
    end;
  end
  ).Start;
end;
o fato de usar thread no caso acima só traz alguma vantagem se você quiser liberar o programa para uso, porque não há nenhum ganho de performance.
para obter ganho de performance o ideal seria dividir o conteúdo do memo e passar para threads distintas. assim haveria ganho real de performance.
Responder

Gostei + 0

03/02/2021

Emerson Nascimento

outra coisa... no lugar de um TMemo, use um TStrings ou TStringList criado em tempo de execução. acredito que ficará bem mais rápido.
Responder

Gostei + 0

03/02/2021

Paulo

outra coisa... no lugar de um TMemo, use um TStrings ou TStringList criado em tempo de execução. acredito que ficará bem mais rápido.


Só o fato de eu alterar o for de

for i := 0 to MemoSped.Lines.Count do begin

para

for i := MemoSped.Lines.Count downto 0 do begin


Resolveu os dois problemas, deu um ganho considerável de performance e limpou todos os registros. Mas eu preferi testar a dica de usar o TStringList e realmente o desempenho foi muito superior. Usei a Thread apenas com a intenção de que o programa não fique "Não respondendo" como os txt que estou abrindo tem muitas linhas.

Segue o codigo.

procedure TFrm_SAD.C870;
begin
  TThread.CreateAnonymousThread(
  procedure
  var i : integer; Sped: TStrings;
  begin
    Sped:= TStringList.Create;
    for i := 0 to MemoSped.Lines.Count do begin
      Sped.Add(MemoSped.Lines.Strings[i]);
    end;
    for i:= Sped.Count-1 downto 0 do begin
      if (Sped.Strings[i].Contains('|C870|') = True) then begin
        Sped.Delete(i);
      end;
    end;
    MemoSped.Clear;
    MemoSped.Lines:=Sped;
    FreeAndNil(Sped);
  end
  ).Start;
end;


Muito Obrigado pela ajuda.
Responder

Gostei + 0

03/02/2021

Emerson Nascimento

faça assim:
procedure TFrm_SAD.C870;
begin
  TThread.CreateAnonymousThread(
  procedure
  var i : integer; Sped: TStrings;
  begin
    Sped := TStringList.Create; // cria o stringlist
//    Sped.LoadFromFile( arquivoSped ); //carrega o arquivo diretamente para o Sped ou 
    Sped.AddStrings(MemoSped.Lines); // carrega todas as linhas do MemoSped para o Sped

    for i := Sped.Count-1 downto 0 do
      if Sped.Strings[i].Contains('|C870|') then
        Sped.Delete(i);

    MemoSped.Clear;
    MemoSped.Lines.AddStrings( Sped );
    FreeAndNil(Sped);
  end
  ).Start;
end;

ou assim:
procedure TFrm_SAD.C870;
begin
  TThread.CreateAnonymousThread(
  procedure
  var i : integer; Sped: TStrings;
  begin
    Sped:= TStringList.Create;
    for i := 0 to MemoSped.Lines.Count-1 do
      if not MemoSped.Lines[i].Contains('|C870|') then // inclui apenas as linhas válidas
        Sped.Add(MemoSped.Lines.Strings[i]);

    MemoSped.Clear;
    MemoSped.Lines.AddStrings(Sped);
    FreeAndNil(Sped);
  end
  ).Start;
end;

Responder

Gostei + 0

03/02/2021

Emerson Nascimento

Você pode adicionar um progress pra indicar pro usuário o quanto do procedimento foi executado.
Responder

Gostei + 0

03/02/2021

Paulo

faça assim:
procedure TFrm_SAD.C870;
begin
  TThread.CreateAnonymousThread(
  procedure
  var i : integer; Sped: TStrings;
  begin
    Sped := TStringList.Create; // cria o stringlist
//    Sped.LoadFromFile( arquivoSped ); //carrega o arquivo diretamente para o Sped ou 
    Sped.AddStrings(MemoSped.Lines); // carrega todas as linhas do MemoSped para o Sped

    for i := Sped.Count-1 downto 0 do
      if Sped.Strings[i].Contains('|C870|') then
        Sped.Delete(i);

    MemoSped.Clear;
    MemoSped.Lines.AddStrings( Sped );
    FreeAndNil(Sped);
  end
  ).Start;
end;

ou assim:
procedure TFrm_SAD.C870;
begin
  TThread.CreateAnonymousThread(
  procedure
  var i : integer; Sped: TStrings;
  begin
    Sped:= TStringList.Create;
    for i := 0 to MemoSped.Lines.Count-1 do
      if not MemoSped.Lines[i].Contains('|C870|') then // inclui apenas as linhas válidas
        Sped.Add(MemoSped.Lines.Strings[i]);

    MemoSped.Clear;
    MemoSped.Lines.AddStrings(Sped);
    FreeAndNil(Sped);
  end
  ).Start;
end;



Eu tinha feito de um jeito parecido do primeiro exemplo que você passou, mas dava erro, a TStringList ficava com uma linha só por isso fui adicionando uma por uma com o for. Mas desse jeito que você passou deu certo usei ele e retirei o for.

Você pode adicionar um progress pra indicar pro usuário o quanto do procedimento foi executado.


achei interessante, como que faz? não tenho ideia desse.
Responder

Gostei + 0

04/02/2021

Emerson Nascimento

há várias formas de fazer. vou postar uma.

segue o forumulário que apresentará a barra de progresso. como não tem como publicar uma imagem neste fórum, vou colar aqui o conteúdo do formulário de progresso:

object FormProgresso: TFormProgresso
  Left = 0
  Top = 0
  BorderIcons = [biMinimize]
  BorderStyle = bsSizeToolWin
  Caption = 'frmSegundoPlano'
  ClientHeight = 92
  ClientWidth = 521
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnClose = FormClose
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 16
    Width = 31
    Height = 13
    Caption = 'Label1'
  end
  object ProgressBar1: TProgressBar
    Left = 8
    Top = 35
    Width = 505
    Height = 17
    TabOrder = 0
  end
  object ButtonCancelar: TButton
    Left = 438
    Top = 58
    Width = 75
    Height = 25
    Caption = 'Cancelar'
    TabOrder = 1
    OnClick = ButtonCancelarClick
  end
end
salve o conteúdo acima como UnitProgressWindow.dfm

unit UnitProgressWindow;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;

type
  TFormProgresso = class(TForm)
    ProgressBar1: TProgressBar;
    ButtonCancelar: TButton;
    Label1: TLabel;
    procedure ButtonCancelarClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    FPointerTaskWindow: Pointer;
    FCaption: string;
    FMaxValue: integer;
    Rotina: TProc;
    FCanceled: boolean;
  public
    { Public declarations }
    procedure IncProgress(ProgMessage: string = ''; Increment: integer = 1);
    property Canceled: boolean read FCanceled;
  end;

function CreateProgress(Caption: string; MaxValue: integer; CancelButton: boolean = False): TFormProgresso;

implementation

{$R *.dfm}

function CreateProgress(Caption: string; MaxValue: integer; CancelButton: boolean): TFormProgresso;
var
  Form: TFormProgresso;
begin
  // cria a tela de progresso e configura os objetos
  // com base nos parâmetros recebidos
  Form := TFormProgresso.Create(nil);
  Form.FCanceled := False;
  Form.FCaption := Caption;
  Form.FMaxValue := MaxValue;
  Form.ButtonCancelar.Visible := CancelButton;

  // desabilita todas as telas do programa, exceto a tela de progresso
  Form.FPointerTaskWindow := DisableTaskWindows(Form.Handle);

  Form.Show;
  Form.Repaint;
  Result := Form;
end;

{ TFormProgresso }

procedure TFormProgresso.ButtonCancelarClick(Sender: TObject);
begin
  // se o botão 'Cancelar' foi pressionado,
  // pergunta se o usuário deseja realmente cancelar
  FCanceled := (MessageDlg('Cancelar '+FCaption+'?', mtConfirmation, [mbYes, mbNo], 0, mbNo) = mrYes);
end;

procedure TFormProgresso.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // habilita todas as telas do programa
  EnableTaskWindows(FPointerTaskWindow);
end;

procedure TFormProgresso.FormShow(Sender: TObject);
begin
  // altera o caption do formulário para o
  // conteúdo recebido pela função CreateProgress
  Self.Caption := FCaption;

  // limpa o caption da label1
  Label1.Caption := '';

  // configura a barra de progresso
  ProgressBar1.Position := 0;
  ProgressBar1.Max := FMaxValue;
end;

procedure TFormProgresso.IncProgress(ProgMessage: string; Increment: integer);
begin
  // incrementa a barra de progresso
  // se for passada uma mensagem no primeiro parâmetro,
  // ela será exibida logo acima da barra de progressso

  // apresenta a mensagem, caso tenha sido recebida
  if ProgMessage <> null then
    Label1.Caption := ProgMessage;

  // se for passado um valor no segundo parâmetro, esse
  // será o incremento da barra; se nada for passado,
  // o incremento será de uma unidade

  // incrementa a barra
  ProgressBar1.Position := ProgressBar1.Position + Increment;

  // redesenha a barra no formulário
  ProgressBar1.Repaint;

  // aguarda 5 milissegundos para
  // montagem visual da barra de progresso
  // esse valor pode ser alterado
  Sleep(5);

  // permite ao windows processar os eventos e mernsagens do formulário
  Application.ProcessMessages;
end;

end.
salve o conteúdo acima como UnitProgressWindow.pas

salve os dois arquivos na mesma pasta.


agora pra usar:

adicione a unit UnitProgressWindow na cláusula uses de onde você quer usar a barra de progresso.
um exemplo de uso naquela função da qual trata este tópico:
var
  i: integer;
  Sped: TStringList;
  FormProgress: UnitProgressWindow.TFormProgresso;
begin
  // cria a tela de progresso (um formulário com label e progressbar)
  FormProgress := UnitProgressWindow.CreateProgress(
                      'Lendo arquivo SPED', // caption da tela de progresso
                      MemoSped.Lines.Count-1, // número total de iterações
                      True // permite cancelar o processo
  );

  Sped := TStringList.Create;

  for i := 0 to MemoSped.Lines.Count-1 do
  begin
    // incrementa o progresso sem apresentar mensagens
//  FormProgress.IncProgress;

    // incrementa o progresso mostrando o número da linha atual
    FormProgress.IncProgress('Tratando da linha ' + IntToStr(i+1));

    // inclui apenas as linhas válidas
    if not MemoSped.Lines[i].Contains('|C870|') then
      Sped.Add(MemoSped.Lines.Strings[i]);

    // verifica se o usuário clicou no botão 'cancelar' na tela de processo
    // só faz sentido avaliar o conteúdo se foi passado True para o
    // terceiro parâmetro de UnitProgressWindow.CreateProgress()
    if FormProgress.Canceled then
      break;

    // permite ao windows processar os eventos e mensagens do formulário
    Application.ProcessMessages;
  end;

  MemoSped.Clear;
  MemoSped.Lines.AddStrings(Sped);
  FreeAndNil(Sped);

  // fecha a tela de progresso e libera a memória
  FormProgress.Close;
  FreeAndNil(FormProgress);

end;

você também pode chamar a partir da thread, como fez antes, porém o botão ficará liberado para executar varias vezes, com processos sobrepostos.
acredito que, para esse caso, a barra de progresso baste.
Responder

Gostei + 0

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar