ReplaceDialog - como localizar e substituir palavras em uma memo usando este componente |
Top Previous Next |
|
// É necessário criar globalmente estas 2 vars:
var FimPesquisa, InicioPesquisa: Boolean;
// Exemplo completo de como usar o REPLACEDIALOG do Delphi.
// Esta função é usada em conjunto com o Dialog do Windows (ReplaceDialog) // Ela é que faz a magica // Passe o Memo1.Text no StrOri e a string a localizar no StrLoc // PosInicial = é de onde parte a pesquisa // DifMaieMin = é para diferencial maiusculas e minusculas. // ParaCima = vai da posicao inicial para cima. // CoincidirPalavra = encontra somente palavra inteira function Localizar(const StrOri, StrLoc: string; const PosInicial: Longint; DifMaieMin: Boolean = False; ParaCima: Boolean = False; CoincidirPalavra: Boolean = False): Longint; var I : Longint; Achou: Boolean;
// esta rotina confere de a letra anterior/posterior a palavra fecha com vazio ou não letra-numero. procedure ConferePalavraInteira; begin if Achou and CoincidirPalavra then begin if ((IfThen(I = 0, '', Copy(StrOri, I - 1 , 1)) <> '') and (Copy(StrOri, I - 1, 1)[1] in ['0'..'9','A'..'Z','a'..'z'])) or ((IfThen(I = 0, '', Copy(StrOri, I + Length(StrLoc), 1)) <> '') and (Copy(StrOri, I + Length(StrLoc), 1)[1] in ['0'..'9','A'..'Z','a'..'z'])) then Achou := False; end; end;
begin Result := -1; if ParaCima then // se for para cima ele faz o for (loop) diminuindo o valor. begin for I := PosInicial - Length(StrLoc) downto 0 do begin if DifMaieMin then // a var achou deve ser TRUE para sair do looping achando a string Achou := StrLoc = Copy(StrOri, I, Length(StrLoc)) else Achou := AnsiUpperCase(StrLoc) = AnsiUpperCase(Copy(StrOri, I, Length(StrLoc)));
ConferePalavraInteira;
if Achou then begin Result := I - 1; // contém a POSICAO do bicho. if Result < 0 then Result := 0; Break; end; end; end else // Normal, do cursor para baixo for I := PosInicial to (Length(StrOri) - Length(StrLoc) + 1) do begin if DifMaieMin then Achou := StrLoc = Copy(StrOri, I, Length(StrLoc)) else Achou := AnsiUpperCase(StrLoc) = AnsiUpperCase(Copy(StrOri, I, Length(StrLoc)));
ConferePalavraInteira;
if Achou then begin Result := I - 1; if Result < 0 then Result := 0; Break; end; end; end;
// botão que inicia o processo de substituir procedure TForm1.SubstituirBtnClick(Sender: TObject); begin ReplaceDialog1.FindText := Edit1.Text; ReplaceDialog1.ReplaceText := Edit2.Text; ReplaceDialog1.Options := [frDown,frShowHelp]; FimPesquisa := False; InicioPesquisa := True; ReplaceDialog1.Execute; end;
// outro evento da replaceDialog procedure TForm1.ReplaceDialog1Replace(Sender: TObject); var S: string; P: Integer; // usado para gravar uma posicao. nao remova pois dá bug ao pular alguns e substituir outros begin if InicioPesquisa then ReplaceDialog1Find(Self);
// se for o modo ALL então entra neste looping... if frReplaceAll in ReplaceDialog1.Options then begin while not FimPesquisa do begin ReplaceDialog1Find(Self); if not FimPesquisa then begin S := Memo1.Text; Delete(S, Memo1.SelStart + 1, Memo1.SelLength); Insert(ReplaceDialog1.ReplaceText, S, Memo1.SelStart + 1); Memo1.Text := S; end; end; // fecha a janelinha depois ReplaceDialog1.CloseDialog; Exit; end;
// pesquisa normal P := Memo1.SelStart; S := Memo1.Text; Delete(S, P + 1, Memo1.SelLength); Insert(ReplaceDialog1.ReplaceText, S, P + 1); Memo1.Text := S; Memo1.SelStart := P + 1; Memo1.SelLength := 0; ReplaceDialog1Find(Self); end;
// evento da ReplaceDialog para dar continuidade procedure TForm1.ReplaceDialog1Find(Sender: TObject); var P: Integer; begin InicioPesquisa := False; P := Localizar(Memo1.Text, ReplaceDialog1.FindText, Memo1.SelStart + Memo1.SelLength, frMatchCase in ReplaceDialog1.Options, not (frDown in ReplaceDialog1.Options), frWholeWord in ReplaceDialog1.Options); if P > -1 then begin Memo1.SelStart := P; Memo1.SelLength := Length(ReplaceDialog1.FindText); Memo1.SetFocus; end else begin ShowMessage('Fim da Pesquisa!'); FimPesquisa := True; end; end; . |