GARANTIR DESCONTO

Fórum Copiar string dentro de outra string #459862

30/10/2013

0

Delphi

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

Responder

Posts

30/10/2013

Thiago Irrazabal

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.
Responder

Gostei + 0

30/10/2013

Pedro Vieira

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...
Responder

Gostei + 0

30/10/2013

Thiago Irrazabal

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.
Responder

Gostei + 0

30/10/2013

Pedro Vieira

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

Abs
Responder

Gostei + 0

31/10/2013

Pedro Vieira

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?
Responder

Gostei + 0

31/10/2013

Thiago Irrazabal

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.
Responder

Gostei + 0

31/10/2013

Pedro Vieira

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
Responder

Gostei + 0

31/10/2013

Thiago Irrazabal

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.
Responder

Gostei + 0

31/10/2013

Deivison Melo

Verifique com o comando POS.

Exemplo:

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

Abração e bons códigos!!
Responder

Gostei + 0

31/10/2013

Pedro Vieira

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

Abs
Responder

Gostei + 0

31/10/2013

Thiago Irrazabal

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



Att,
Thiago Irrazabal de Oliveira.
Responder

Gostei + 0

31/10/2013

Pedro Vieira

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
Responder

Gostei + 0

31/10/2013

Thiago Irrazabal

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.
Responder

Gostei + 0

31/10/2013

Pedro Vieira

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

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


Assim vai funcionar?
Responder

Gostei + 0

31/10/2013

Thiago Irrazabal

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.
Responder

Gostei + 0

Mais tópicos

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

Aceitar