Copiar string dentro de outra string

Delphi

30/10/2013

Pessoal, preciso de uma função que copia uma string dentro de outra, mas com uma particularidade, pode acontecer mais de uma ocorrência
Seria assim

tenho uma string com alguns códigos, separados por ponto e virgula e espaço, sem limite de caracteres.

SCOROO, INTE, CABOCLO, ESOM, INTE, EDUCACAO, BOTICA, COSTAS, 0038, LUCR, INTE, CHEVE, ESPELHO, TODO, BETH, FEVA,

Reparem que o código " INTE'" aparece 3 vezes

Quero percorrer essa string e se encontrar o código INTE, continuar até o fim para saber se tem mais ocorrência.

Obrigado



Pedro Vieira

Pedro Vieira

Curtidas 0

Respostas

Thiago Irrazabal

Thiago Irrazabal

30/10/2013

Boa tarde segue um código para contar quantas "ocorrências" existem em uma determinada frase.

Declare em public ou private da tua unit isso:

function ContaOcorrencias(S, Ocorrencia: string): Integer;


CTRL + SHIFT + C pra ele criar, e substitui do begin até o end por isso:

var
  Cont: Integer;
begin
  Cont := 0;

  while Pos(Ocorrencia, S) > 0 do
    begin
      S := Copy(S, Pos(Ocorrencia, S) + Length(Ocorrencia), Length(S));
      Inc(Cont);
    end;

  Result := Cont;
end;


Depois a chamada do código fica assim:

Variavel := ContaOcorrencias('SCOROO, INTE, CABOCLO, ESOM, INTE, EDUCACAO, BOTICA, COSTAS, 0038, LUCR, INTE, CHEVE, ESPELHO', 'INTE');


Lembrando que é só passar no primeiro parâmetro a "Frase" e no segundo o que tu quer que ele ache, ele vai contar quantos tem dentro da frase e te retornar um numero, espero ter ajudado.



Att,
Thiago Irrazabal de Oliveira.
GOSTEI 0
Pedro Vieira

Pedro Vieira

30/10/2013

Obrigado Thiago, mas preciso percorrer a string usando a virgula como separador, tipo quebrar a string quando encontrar uma virgula e copiar os caracteres até encontrar outra virgula... entendeu?

Mais uma vez obrigado pela atenção...
GOSTEI 0
Thiago Irrazabal

Thiago Irrazabal

30/10/2013

Obrigado Thiago, mas preciso percorrer a string usando a virgula como separador, tipo quebrar a string quando encontrar uma virgula e copiar os caracteres até encontrar outra virgula... entendeu?

Mais uma vez obrigado pela atenção...


Beleza, faz assim então, deixa essa função que eu te passei e vamos criar uma outra que vai precisar daquela.

Declara essas 2 coisas no private da tua unit:
  Aux: array of string;
  Cont: Integer;



Depois a procedure:
procedure SeparaPalavras(Palavra: String);



Substitui do begin ao end por isso aqui:
var
  I: Integer;
begin
  for I := 0 to Cont - 1 do
    begin
      if Pos(',', Palavra) > 0 then
        begin
          Aux[I] := Copy(Palavra, 1, Pos(',', Palavra) - 1);
          Palavra := Copy(Palavra, Pos(',', Palavra) + 1, Length(Palavra));
          ShowMessage(Aux[I]);
        end
      else
        begin
          Aux[I] := Palavra;
          Palavra := '';
          ShowMessage(Aux[I]);
        end;
    end;
end;

Lembrando que o array Aux é quem vai guardar cada palavra... e aqui o "ShowMessage" é só para mostrar as palavras separadas.


Depois as chamadas dos códigos ficam assim:
  Cont := ContaOcorrencias('SCOROO, INTE, CABOCLO, ESOM, INTE, EDUCACAO, BOTICA, COSTAS, 0038, LUCR, INTE, CHEVE, ESPELHO', ',') + 1;

  SetLength(Aux, Cont);

  SeparaPalavras('SCOROO, INTE, CABOCLO, ESOM, INTE, EDUCACAO, BOTICA, COSTAS, 0038, LUCR, INTE, CHEVE, ESPELHO');





Att,
Thiago Irrazabal de Oliveira.
GOSTEI 0
Pedro Vieira

Pedro Vieira

30/10/2013

Valeu colega, era tudo que eu precisava....

Abs
GOSTEI 0
Pedro Vieira

Pedro Vieira

30/10/2013

Amigo mudei se código de procedure para function assim:



Function SeparaPalavras(Palavra: String): String;
var I: Integer;
begin
  for I := 0 to Cont - 1 do
    begin
      if Pos(',', Palavra) > 0 then
        begin
          Aux[I] := Copy(Palavra, 1, Pos(',', Palavra) - 1);
          Palavra := Copy(Palavra, Pos(',', Palavra) + 1, Length(Palavra));
          result:= Aux[I];
        end
      else
        begin
          Aux[I] := Palavra;
          Palavra := '';
          result:= Aux[I];
        end;
    end;
end;


coloquei em um botao assim

 s:= minha string
 showmessage(SeparaHorarios(S,','));



Mas não recebo nada no result.
Voce sabe o porque isso acontece?
GOSTEI 0
Thiago Irrazabal

Thiago Irrazabal

30/10/2013

Boa tarde, no onclick do botão ele ta chamando outra função? não entendi muito bem, preciso que tu cole todas functions envolvidas para analisá-las.



Att,
Thiago Irrazabal de Oliveira.
GOSTEI 0
Pedro Vieira

Pedro Vieira

30/10/2013

Estou usando da mesma maneira que vc me passou, apenas mudei de procedure para function


S recebe minha string;

Cont := ContaOcorrencias(S, ',') + 1;
 
SetLength(Aux, Cont);

 showmessage(SeparaPalavras(S,','));


Abs
GOSTEI 0
Thiago Irrazabal

Thiago Irrazabal

30/10/2013

Muda a chamada da função para isso:
function SeparaPalavras(Palavra: String; S: String = ','): String;


Depois mude a função para isso e veja se funciona.
Function SeparaPalavras(Palavra, S: String): String;
var I: Integer;
begin
  for I := 0 to Cont - 1 do
    begin
      if Pos(S, Palavra) > 0 then
        begin
          Aux[I] := Copy(Palavra, 1, Pos(S, Palavra) - 1);
          Palavra := Copy(Palavra, Pos(S, Palavra) + 1, Length(Palavra));
          result:= Aux[I];
        end
      else
        begin
          Aux[I] := Palavra;
          Palavra := '';
          result:= Aux[I];
        end;
    end;
end;




Att,
Thiago Irrazabal de Oliveira.
GOSTEI 0
Deivison Melo

Deivison Melo

30/10/2013

Verifique com o comando POS.

Exemplo:

[url]http://delphi.about.com/od/beginners/l/blrtlPos.htm[/url]

Abração e bons códigos!!
GOSTEI 0
Pedro Vieira

Pedro Vieira

30/10/2013

Mudei e não funcionou, retorna uma mensagem vazia..

Abs
GOSTEI 0
Thiago Irrazabal

Thiago Irrazabal

30/10/2013

Sim, testei aqui cometi uma "gafe" não irá funcionar assim... já te passo o código corrigido.



Att,
Thiago Irrazabal de Oliveira.
GOSTEI 0
Pedro Vieira

Pedro Vieira

30/10/2013

na verdade abro um arquivo texto e vou buscando linha a linha os codigos que sao separados por virgula e espaço


 AssignFile(F,meuarquivo);
    // inicializa para leitura
      Reset(F);
     while not EOF(F) do
     begin

    // lê a linha
        ReadLn(F,linha);
        S:= AnsiUpperCase(linha);

       Cont := ContaOcorrencias(S, ',') + 1;
       SetLength(Aux, Cont);
       showmessage(SeparaPalavras(S ',','));
    
     end;
  CloseFile(F);


Att
GOSTEI 0
Thiago Irrazabal

Thiago Irrazabal

30/10/2013

Modifiquei todo ele pra "adaptar" como função porem não achei útil, eu deixaria como procedure e daria o ShowMessage lá dentro, mas como o programa é teu ai vai o código.

Primeiro tu vai criar um "Objeto", sabe onde declara? depois de Type:
  TArrayString = record
    S: array of string;
  end;


Dai tu vai declarar essas 2 coisas no private, tira o Aux: Array of string; lá do private:
  Palavra: array of string;
  Cont: Integer;


Depois declara a function:
function SeparaPalavras(Palavra: String; S: String = ','): TArrayString;


Depois substitui por isso:
var
  I: Integer;
  Aux: array of string;
begin
  SetLength(Result.S, Cont);
  SetLength(Aux, Cont);
  for I := 0 to Cont - 1 do
    begin
      if Pos(S, Palavra) > 0 then
        begin
          Aux[I] := Copy(Palavra, 1, Pos(S, Palavra) - 1);
          Palavra := Copy(Palavra, Pos(S, Palavra) + 1, Length(Palavra));
          Result.S[I] := Aux[I];
        end
      else
        begin
          Aux[I] := Palavra;
          Palavra := '';
          Result.S[I] := Aux[I];
        end;
    end;
end;


As chamadas de códigos ficaram assim:
  Cont := ContaOcorrencias(S, ',') + 1;

  SetLength(Palavra, Cont);

  TArrayString(Palavra) := TArrayString(SeparaPalavras(S, ','));

  for I := 0 to Cont - 1 do
    ShowMessage(Palavra[I]);




Att,
Thiago Irrazabal de Oliveira.
GOSTEI 0
Pedro Vieira

Pedro Vieira

30/10/2013

Na verdade preciso receber o resultado e comparar com uma string.

tipo :
 if resultado da busca = meu código begin
        end;


Assim vai funcionar?
GOSTEI 0
Thiago Irrazabal

Thiago Irrazabal

30/10/2013

Na verdade preciso receber o resultado e comparar com uma string.

tipo :
 if resultado da busca = meu código begin
        end;


Assim vai funcionar?


Vai mas tem que ser dentro do FOR
for I := 0 to Cont - 1 do
  if Trim(Palavra[I]) = teu código then
    //O RESTO DO CÓDIGO


Lembrando que o Trim eu coloquei porque ele está deixando um espaço na frente das palavras, para corrigir isso pode mudar na função também, dai não será necessário colocar o Trim no IF.
var
  I: Integer;
  Aux: array of string;
begin
  SetLength(Result.S, Cont);
  SetLength(Aux, Cont);
  for I := 0 to Cont - 1 do
    begin
      if Pos(S, Palavra) > 0 then
        begin
          Aux[I] := Trim(Copy(Palavra, 1, Pos(S, Palavra) - 1));
          Palavra := Copy(Palavra, Pos(S, Palavra) + 1, Length(Palavra));
          Result.S[I] := Aux[I];
        end
      else
        begin
          Aux[I] := Trim(Palavra);
          Palavra := '';
          Result.S[I] := Aux[I];
        end;
    end;
end;




Att,
Thiago Irrazabal de Oliveira.
GOSTEI 0
Thiago Irrazabal

Thiago Irrazabal

30/10/2013

Pensando bem esse array auxiliar é inútil, podemos tirar ele fora.

var
  I: Integer;
begin
  SetLength(Result.S, Cont);
  for I := 0 to Cont - 1 do
    begin
      if Pos(S, Palavra) > 0 then
        begin
          Result.S[I] := Trim(Copy(Palavra, 1, Pos(S, Palavra) - 1));
          Palavra := Copy(Palavra, Pos(S, Palavra) + 1, Length(Palavra));
        end
      else
        begin
          Result.S[I] := Trim(Palavra);
          Palavra := '';
        end;
    end;
end;




Att,
Thiago Irrazabal de Oliveira.
GOSTEI 0
Pedro Vieira

Pedro Vieira

30/10/2013

Só posso dizer DEUS LHE PAGUE....

Valeu funcionou 100%,

Abs
GOSTEI 0
Thiago Irrazabal

Thiago Irrazabal

30/10/2013

Disponha, qualquer dúvida estamos aí, abraço.




Att,
Thiago Irrazabal de Oliveira.
GOSTEI 0
POSTAR