ReplaceDialog qui plante si...Résolu

Question

Bonjour à tous,

Voilà, un jour Delphiprog avait eu l'extrême gentillesse de me donner ce super code qui fonctionne impec.

Mais le hic se trouve si par exemple l'utilisateur base sa recherche sur une SEULE lettre, par exemple un "e" et qui demande - par exemple - de remplacer par "Ampoule' ; là alors arrive la boucle infernale !

Jai beau regarder les procédures dans les les sens ; avec mes modestes connaissances en Delphi je n'arrive pas à touver la faille.

Je ne poste pas mais je lis beaucoup ici.

Merci beaucoup de vos conseils et idées, car je patauge lamentablement  ;o(

unit Unit1;

interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    ReplaceDialog1: TReplaceDialog;
    Button1: TButton;
//  FindDialog1: TFindDialog;
    procedure BtnRemplaceClick(Sender: TObject);
    procedure ReplaceDialog1Replace(Sender: TObject);
    procedure DoReplace(OldText, NewText: string);
    procedure DoReplaceAll(OldText, NewText: string);
    procedure ReplaceDialog1Find(Sender: TObject);

  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
   begin
     with Sender as TReplaceDialog do
       if frReplace in Options then
       DoReplace(FindText, ReplaceText)
     else
  if frReplaceAll in Options then
   DoReplaceAll(FindText, ReplaceText);
end;

procedure TForm1.DoReplace(OldText, NewText: string);
  var
     SelPos: integer;
   begin
     { Exécute une recherche globale en tenant compte des majuscules/minuscules pour FindText dans Memo1 }
       SelPos := Pos(OldText, Memo1.Lines.Text);
     if SelPos > 0 then
   begin
    Memo1.SelStart := SelPos - 1;
    Memo1.SelLength := Length(OldText);
    { Remplace le texte sélectionné par ReplaceText }
     Memo1.SelText := ReplaceDialog1.ReplaceText;
       end
    else
   MessageDlg(Concat('Impossible de trouver "', ReplaceDialog1.FindText, '" dans Memo1.'), mtError, [mbOk], 0);
end;

procedure TForm1.DoReplaceAll(OldText, NewText: string);
   var
     SelPos: integer;
     SelCount: integer;
   begin
     SelPos := Pos(OldText, Memo1.Lines.Text);
       SelCount := 0;
      while SelPos > 0 do
    begin
      DoReplace(OldText, NewText);
      SelPos := Pos(OldText, Memo1.Lines.Text);
   inc(SelCount);
     end;
   ShowMessageFmt('%d occurence(s) remplacée(s) pour %s', [SelCount, OldText]);
end;

procedure TForm1.ReplaceDialog1Find(Sender: TObject);
   begin
     Memo1.SetFocus;
     Memo1.SelStart := Pos(ReplaceDialog1.FindText, Memo1.Lines.Text) - 1;
   Memo1.SelLength := Length(ReplaceDialog1.FindText);
end;

procedure TForm1.BtnRemplaceClick(Sender: TObject);
   begin
    ReplaceDialog1.Position := Point(Memo1.Left + Memo1.Width, Memo1.Top);
    ReplaceDialog1.Execute;
end;

END.

cs_Delphiprog · Accepted Answer

Le code donné a été un peu modifié, mais ce n'est pas la cause du problème, rassure-toi.
Voici un nouveau code qui simplifie le traitement :

unit UReplaceDemoMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, StrUtils;

type
  TReplaceDemoMainForm = class(TForm)
    ReplaceDialog1: TReplaceDialog;
    Memo1: TMemo;
    btnSearch: TButton;
    Panel1: TPanel;
    Panel2: TPanel;
    procedure btnSearchClick(Sender: TObject);
    procedure ReplaceDialog1Replace(Sender: TObject);
    procedure ReplaceDialog1Find(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    {Recherche l'occurence suivante de FindNext dans Memo et déplace la  sélection. }
    procedure GotoNext(Memo: TCustomMemo; OldText: string; Options: TFindOptions);
  end;

var
  ReplaceDemoMainForm: TReplaceDemoMainForm;

implementation

{$R *.dfm}

procedure TReplaceDemoMainForm.btnSearchClick(Sender: TObject);
begin
  //La sélection est supposée être le texte à rechercher
  if Memo1.SelLength > 0 then
    ReplaceDialog1.FindText := Memo1.SelText;
  ReplaceDialog1.Execute;
end;

procedure TReplaceDemoMainForm.ReplaceDialog1Replace(Sender: TObject);
var
  ReplaceFlags: TReplaceFlags;
begin
  ReplaceFlags := [];
  with Sender as TReplaceDialog do
  begin
    //Clic sur le bouton "Remplacer"
    if frReplace in Options then
    begin
      if not (frMatchCase in Options) then
        include(ReplaceFlags, rfIgnoreCase);
      StringReplace(Memo1.Lines.Text, FindText, ReplaceText, ReplaceFlags);
      exit;
    end;

    //Clic sur le bouton "Tout remplacer"
    if frReplaceAll in Options then
    begin
      //Remplacer toutes les occurences
      if frMatchCase in Options then
        Memo1.Lines.Text := AnsiReplaceStr(Memo1.Lines.Text, FindText, ReplaceText)
      else
        Memo1.Lines.Text := AnsiReplaceText(Memo1.Lines.Text, FindText, ReplaceText);
      exit;
    end;
  end;
end;

procedure TReplaceDemoMainForm.ReplaceDialog1Find(Sender: TObject);
begin
  with ReplaceDialog1 do
    //Rechercher l'occurence suivante ?
    if frFindNext in Options then
      GotoNext(Memo1, FindText, Options);
end;

procedure TReplaceDemoMainForm.FormCreate(Sender: TObject);
begin
  Memo1.Lines.LoadFromFile('UReplaceDemoMain.pas');
end;

procedure TReplaceDemoMainForm.GotoNext(Memo: TCustomMemo;
  OldText: string; Options: TFindOptions);
var
  { Position de départ de la sélection }
  SelPos: integer;
  { Sous-texte servant à la
  recherche de l'occurence suivante }
  SubText: string;
  { Position de départ pour une recherche du suivant }
  StartPos: integer;
const
  Alpha = ['a'..'z', 'A'..'Z'];
begin
  //déterminer le point de départ de la recherche
  StartPos := Memo.SelStart + Memo.SelLength + 1;
  //Rechercher dans le texte à partir du texte qui suit la sélection
  //ou dans tout le texte si aucune sélection
  SubText := Copy(Memo.Lines.Text, StartPos, Length(Memo.Lines.Text));
  //Faut-il tenir compte de la casse ?
  if frMatchCase in Options then
    SelPos := AnsiPos(OldText, SubText)
  else
    SelPos := AnsiPos(LowerCase(OldText), LowerCase(SubText));

  //Rechercher des mots entiers ?
  if frWholeWord in Options then
    if SelPos > 1 then
      {Vérifier que le caractère qui précéde ou celui qui suit
      n'est pas un caractère alphabétique}
      if (SubText[SelPos - 1] in Alpha)
        or (SubText[SelPos + Length(OldText)] in Alpha) then
        begin
           {Positionner la sélection après le mot trouvé}
           Memo.SelStart := StartPos + Length(OldText);
           Memo.SetFocus;
           Exit;
        end;

  if SelPos > 0 then
  begin
    Memo.SelStart := StartPos + SelPos - 2;
    Memo.SelLength := Length(OldText);
    Memo.SetFocus;
  end
  else
    ShowMessageFmt('"%s" non trouvé ou la ' + sLineBreak
                 + 'fin du texte a été atteinte', [OldText]);
end;

end.


La seule différence, c'est que l'on a perdu le comptage du nombre d'occurences trouvées lors des opérations de remplacement. Mais était-ce si important ?

Pour ceux qui veulent essayer, voici le code de la fiche de démo:

object ReplaceDemoMainForm: TReplaceDemoMainForm
  Left = 203
  Top = 162
  Width = 678
  Height = 480
  Caption = 'ReplaceDemoMainForm'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 488
    Top = 0
    Width = 182
    Height = 446
    Align = alRight
    TabOrder = 0
    object btnSearch: TButton
      Left = 16
      Top = 32
      Width = 145
      Height = 25
      Caption = '&Rechercher/Remplacer'
      TabOrder = 0
      OnClick = btnSearchClick
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 0
    Width = 488
    Height = 446
    Align = alClient
    TabOrder = 1
    object Memo1: TMemo
      Left = 16
      Top = 17
      Width = 452
      Height = 417
      ScrollBars = ssBoth
      TabOrder = 0
    end
  end
  object ReplaceDialog1: TReplaceDialog
    FindText = 'Memo1'
    Options = [frDown, frFindNext]
    OnFind = ReplaceDialog1Find
    OnReplace = ReplaceDialog1Replace
    Left = 392
    Top = 32
  end
end

Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.
May Delphi be with you

cs_Delphiprog · Answer

Ah oui, au fait, pourquoi ça plantait ?
Eh bien c'est simple : le "e" était remplacé par "ampoule" qui contenait aussi un "e" qui était remplacé...
Donc une boucle sans fin ou infernale si tu préfères. Mais le résultat est le même.
Pour remédier à cela, il faut actualiser correctement la position de départ pour la recherche de l'occurrence suivante.

Bonne continuation.  ;) 
Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.
May Delphi be with you

cs_Jean-Pierre · Answer

Delphiprog, un grand merci à toi et j'espère que je ne suis pas trop la cause de l'heure nocturne de ton postage !
(Une heure du mat' passée...) 

((J'ai des tas de choses à "récolter" dans tout le code - que tu as d'ailleurs super remanié - , afin d'apprendre d'autres astuces de codage ; une véritable mine d'or pour moi !))

Par contre, je n'ai pas réalisé un copier/coller tout bête afin de tenter de comprendre un tant soit peu le fonctionnement de toutes ces procédures.

Mais, snifff de snifff, le bouton "Remplacer" ne donne rien du tout. 

J'ai ajouté un "beep;" après le "begin" de cette procédure et ça beep si je clic sur ce fichu bouton "Remplacer" de ce Replacedialog.

Fauf que je regarde  encore ce que j'ai pu oublier dans ton code.

Merci encore, sans vouloir te cirer les pompes ;o) : j'admire ton aisance d'écriture en code Delphi.

Bon, je replonge dans le code pour voir quelle bêtise j'ai encore faite !

cs_Delphiprog · Answer

Flûte, j'ai oublié quelque chose dans ReplaceDialog1Replace : affecter le résultat du remplacement à Memo1.Lines.Text.
On mettra ça sur le compte de l'heure tardive... :approve) 

    if frReplace in Options then
    begin
      if not (frMatchCase in Options) then
        include(ReplaceFlags, rfIgnoreCase);
      Memo1.Lines.Text := StringReplace(Memo1.Lines.Text, FindText, ReplaceText, ReplaceFlags);
      exit;
    end;


Avec toutes mes excuses...  :blush) 
Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.
May Delphi be with you

cs_Delphiprog · Answer

Ce n'est décidément pas mon jour. Voilà ce que c'est que de se coucher tard.


    if frReplace in Options then
    begin
      if not (frMatchCase in Options) then
        include(ReplaceFlags, rfIgnoreCase);
      Memo1.Lines.Text := StringReplace(Memo1.Lines.Text, FindText, ReplaceText, ReplaceFlags);
      //---> sélectionner l'occurence suivante
      GotoNext(Memo1, FindText, Options);
      exit;
    end;


Bon, je vais aller me faire une petite sieste réparatrice. 
Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.
May Delphi be with you

cs_Jean-Pierre · Answer

Delphiprog, merci encore, ce n'est surtout pas à toi de t'excuser, c'est à moi, car je suis confus d'autant abuser de ta gentillesse et de tes compétences !

J'espère que tu as repris des forces et mangé beaucoup de chocolat  ;o)

Mais tu sais j'ai terriblement honte pour deux choses : 

1. De ma faute tu t'es couché très tard !
2. Tout désormais fonctionne impec, sauf... une toute petite chose :

Exemple, je place dans le Memo quatre 'toto' comme ceci :
toto
toto
toto 
toto

J'appelle le ReplaceDialog en le remplissant comme ceci :
"Rechercher" ---> toto
"Remplacer par..." ---> Albert

Je clique sur suivant afin de me placer sur le second toto

Si alors je clique sur "Remplacer", là c'est  le premier toto (du dessus) qui se trouve remplacé  ;o))

Bon, je vais me cacher dans un trou de souris, car j'ai très très honte de t'embêter comme ça. 

Encore merci d'avance si tu peux me peaufinner ce petit détail. 

Surtout ce soir, pour reprendre des forces, extinction des feux comme dans les poulaillers = très tôt  ;o)) 

Voici le récapitulatif, je crois,  de ta portion de code en question :
//Clic sur le bouton "Remplacer"                       //**********************************
if frReplace in Options then
begin
if not (frMatchCase in Options) then
include(ReplaceFlags, rfIgnoreCase);
Memo1.Lines.Text := StringReplace(Memo1.Lines.Text, FindText, ReplaceText, ReplaceFlags);
//---> sélectionner l'occurence suivante
GotoNext(Memo1, FindText, Options);
exit;
end;

cs_Jean-Pierre · Answer

Bonjour, 

Je cherche toujours le moyen de trouver une parade au petit blème exposé à mon message juste ci-dessus.

Autrement dit, comment remplacer le mot contenu dans la sélection par le mot contenu dans la case "Remplacer" ?

J'avais trouvé tout simplement un :

Memo1.SelText :=  ReplaceText; 

dans la portion suivante de code :

//Clic sur le bouton "Remplacer"                    
if frReplace in Options then
begin
 Memo1.SelText := ReplaceText;       // <-------------- ici
if not (frMatchCase in Options) then
include(ReplaceFlags, rfIgnoreCase);
Memo1.Lines.Text : = StringReplace(Memo1.Lines.Text, FindText, ReplaceText, ReplaceFlags);
//---> sélectionner l'occurence suivante
GotoNext(Memo1, FindText, Options);
exit;
end;


Mais une procédure doit interférer et faire remonter le curseur de souris.

Si vous avez des idées : merci.   

(Je débute en Delphi)

cs_Delphiprog · Answer

Bonsoir Jean-Pierre,

Effectivement, cette opération en suffit pas. Je te laisse lire les commentaires dans le code ci-dessous, en espérant qu'ils t'éclaireront suffisamment.

procedure TReplaceDemoMainForm.ReplaceDialog1Replace(Sender: TObject);
var
  ReplaceFlags: TReplaceFlags;
  BeforeSelText, FromSelText: string;
  OldSelStart: integer;
begin
  ReplaceFlags := [];

  {Distinguer le texte avant la sélection et celui à partir de}
  with Memo1 do
  begin
    BeforeSelText := Copy(Lines.Text, 1, SelStart - 1);
    FromSeltext := Copy(Lines.Text, SelStart, Length(Lines.Text));
    {Mémoriser l'emplacement de la sélection qui se trouve perdu
    après une opération de remplacement}
    OldSelStart := SelStart;
  end;

  with Sender as TReplaceDialog do
  begin
    {Clic sur le bouton "Remplacer"}
    if frReplace in Options then
    begin
      if not (frMatchCase in Options) then
        include(ReplaceFlags, rfIgnoreCase);
      {effectuer le remplacement seulement dans le texte qui
      suit la sélection}
      Memo1.Lines.Text :=
        BeforeSelText
        + StringReplace(FromSelText, FindText, ReplaceText, ReplaceFlags);
      {repositionnement du point de départ de la sélection}
      Memo1.SelStart := OldSelStart;
      GotoNext(Memo1, FindText, Options);
      exit;
    end;

    {Clic sur le bouton "Tout remplacer"}
    if frReplaceAll in Options then
    begin
      {Remplacer toutes les occurences}
      if frMatchCase in Options then
        Memo1.Lines.Text := AnsiReplaceStr(Memo1.Lines.Text, FindText, ReplaceText)
      else
        Memo1.Lines.Text := AnsiReplaceText(Memo1.Lines.Text, FindText, ReplaceText);
      exit;
    end;
  end;
end;


A dire vrai, ça paraissait plus facile que ça. Ma précipitation inhabituelle m'a fait commettre des erreurs.

Pour info, c'était la procédure GotoNext qui interférait. A chaque fois que l'on procède à un remplacement, la position de départ de la sélection était perdue. D'où une recherche à partir du début du texte !

Bon, je vais mettre en pratique tes conseils et déguster quelques plaquettes de chocolat.  :-p 
Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.
May Delphi be with you

cs_Jean-Pierre · Answer

Bonsoir  Delphiprog,

Je planchais comme toi sur le blème, mais avec mes très très faibles moyens en Delphi ; je te ferais voir demain ce que j'avais trouvé. 
C'est pas trop mal, l'inconvénient est que si je rappuie sur "Remplacer" et que le texte recherché n'existe plus = ça rajoute le mot de remplacement.

Là, mes yeux ont du mal à rester ouvert... j'ai pourtant hyper hâte de lancer ton nouveau code, mais le lit m'appelle !!!  ;o)

Je te remercie beaucoup.

A deux mains pour t'applaudir !

En attendant je risque d'en rêver  ;o)

Oui demain en soirée.

je te souhaite un grand et profond sommeil réparateur. 

D'ailleurs j'espère qu'à cette heure tu n'est pas devant l'écran.

@micalement
Jean-Pierre

cs_Jean-Pierre · Answer

Bonsoir,

Cher Delphiprog encore merci, je viens de placer ta nouvelle procédure toute remaniée afin de déguster ça et : 

C'est une merveille !

Quel soulagement, des fois c'est à devenir fou  ;o)

Je suis très heureux ; si jamais je peux te renvoyer l'ascenceur, sais-ton jamais, n'hésite pas.

Les commentaires sur ton code sont très instructifs, tu penses bien que je vais printer ça et souvent m'en inspirer.

J'ai pas encore eu trop le temps de bien tout tenter d'analyser dans ton code, mais il est certain que cele me servira comme appui pour d'autres idées.

Tiens, juste ci-dessous je te colles pour t'amuser ce qu'hier dans la nuit j'avais (modestement) pondu après des dizaines d'essais divers, en effet dès qu'une certaine ligne au dessous était neutralisée, le retour curseur devenait brusquement très docile  ;o)
 
...
//Clic sur le bouton "Remplacer"                       //**********************************
if frReplace in Options then
begin
Memo1.SelText := ReplaceText;    //     <---------- Ici en premier  
if not (frMatchCase in Options) then
include(ReplaceFlags, rfIgnoreCase);
                                                         // Ci-dessous en second afin de neutraliser le "saut haut" du curseur  
            //////////Memo1.Lines.Text := StringReplace(Memo1.Lines.Text, FindText, ReplaceText, ReplaceFlags);
            //---> sélectionner l'occurence suivante
GotoNext(Memo1, FindText, Options);
exit;
end;

//Clic sur le bouton "Tout remplacer"
if frReplaceAll in Options then
begin
...


Surtout cette fois au lit pas trop tard...  ;o)

Amicalement
Jean-Pierre

ReplaceDialog qui plante si...

10 réponses

Votre réponse

Discussions similaires