Accueil > Manip’s > Delphi > RTF > Fusionner 2 RichEdit (RichEdit Merge)

Delphi

Fusionner 2 RichEdit (RichEdit Merge)

dimanche 17 mars 2013, par bluegyn_spip

S’il est facile de fusionner 2 Mémos, il est beaucoup plus difficile d’ajouter un texte enrichi à un autre, tout en conservant tous les enrichissements de l’un et de l’autre (Car le balisage RTF est d’une imbrication imbitable par le mortel lambda)

L’exemple pratique est d’insérer une Entête enrichie dans un courrier

La méthode simple consiste à utiliser le presse papier, en copiant le texte de l’entête, puis en le collant à l’endroit voulu dans le courrier.

COPIER

ENTETE =>

LoadFromFile

SetSocus

selectAll

CopyToClipBoard

COLLER

COURRIER =>

SetFocus

SelStart := ...

PasteFromClipBoard

La procédure est simple, mais l’exécution assez lourde car elle est visuelle.

L’inconvénient majeur, est que l’entête et le courrier doivent être visibles simultanément, car la méthode SetFocus nécessaire au copie collé ne peut se faire que sur des composants textuels visibles.

Une autre solution beaucoup plus élégante nous est donnée par Garlin Software Development Corp qui nous ouvre ses sources.

Sous la forme d’un composant assez simple dérivé de la Classe TRichEdit et qui fait appel à la gestion des flux mémoire TMemoryStream.

Qui consiste à rajouter au composant natif 2 fonctions :

RichEdit.Append ( Fichier.RTF ) ; qui ajoute le contenu du fichier Enrichi au richedit.
RicheEdit.Insert (Fichier.RTF ) ; qui insère le contenu du fichier RTF à l’endroit du curseur

Son écriture est courte mais complexe.

L’inconvénient est qu’il faut compiler ce composant, puisqu’on va l’utiliser à la place du RichEdit Nâtif.

Je fournis en annexe le code modifié pour le composant TJvRichEdit de la JediLibrairie que je préfère car il gère l’inclusion d’image (dont je me sers pour inclure ma signature en JPG)

Le code original est sur le site de l’auteur signalé par le lien joint, il dérive de l’ancêtre TRichEdit fourni avec Delphi

Ajouter le Composant GSRichEdit

1- Créer l’unité GSRichEdit.pas

Cliquer sur Fermer Tout

Afin d’éliminer tout code parasite

Fichier

Nouveau
- Unité Delphi
  
  Copier-Coller le code
de Unit GSRichEdit
à End.

Enregistrer le Source Pascal dans le dossier des Source & Librairies

GSRichEdit.pas

2- Installer le COMPOSANT

Penser à Fermer Tout !!!

Cliquer sur COMPOSANT

Installer un composant
Installer dans un nouveau Package

Nom de fichier

Localiser GSRichEdit.pas

Nom du Package = RTF

Terminer

3- Un nouvel Onglet GARLIN apparait dans la liste de composants

Il contient un GsRichEdit

Qui s’utilise comme un RichEdit, mais avec 2 fonctions supplémentaires

Append
Insert

La fonction GsRichEdit.Append ( RTF ), ne pose aucun souci d’écriture car elle se contente d’ajouter le fichier RTF à la suite du texte affiché dans le GsRichedit

La fonction GsRichEdit.Insert est plus délicate, car il faut placer le curseur à l’endroit de l’insertion

Soit manuellement (ce qui est simple)
Soit par programmation,
- grâce à la fonction

GsRichEdit.SelStart

- Associée au besoin à la fonction de recherche

SelStart := GsRichEdit.FindText(cherche, debut, fin, []) ;

NB :
Il faut bien sur penser à bien mettre le fichier Compilé dans le chemin de recherche des bibliothèques de Delphi

Voir en ligne : https://groups.google.com/forum/?fr...

unit GSJvRichEdit;

{ Copyright (c) 1998 - 1999, Garlin Software Development Corp.,
  Middletown, NJ, USA, All rights reserved.

  May be freely copied and used for all commercial and
  non-commercial purposes, except publishing in any form,
  as long as the above copyright statement, the rest of
  the text in this comment block and the Copyright
  const below are retained.

  revu 2013-03 / BlueGYN pour adaptation JvRichedit
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls,

  jvRichedit  { JC }

 ;

const
  copyright = 'Copyright © 1998 - 2001 Garlin Software Development Corp., '
    + 'Middletown, NJ, USA. '
    + 'All Rights Reserved';

type
  TGSJvRichEdit = class(TjvRichEdit)     { JC }

  protected { Protected declarations }
    function FetchText(AFilename: string): integer;
  public { Public declarations }
    function Append(AFilename: string): integer; virtual;
    function Insert(AFilename: string): integer; virtual;
  end;

procedure Register;

implementation

uses Richedit;

function EditStreamCallback(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): Longint; stdcall;
var
  theStream: TMemoryStream;
begin
  // dwCookie is Application-defined,
  // so we're passing the stream containing
  // the formatted text to be added.
  //
  theStream := TMemoryStream(dwCookie);
  Result := 0;

  with theStream do
  begin
    if (Size = position) then
    begin
      pcb := 0;
      Exit;
    end
    else if (Size - position) <= cb then
    begin
      pcb := Size;
      Read(pbBuff^, Size);
    end
    else
    begin
      pcb := cb;
      Read(pbBuff^, cb);
    end;
  end;
end;

function TGSJvRichEdit.FetchText(AFilename: string): integer;
var
  editStream: TEditStream;
  theStream: TMemoryStream;
begin
  // Bring the text to be appended or inserted into a TMemoryStream;
  //
  theStream := TMemoryStream.Create;
  try
    theStream.LoadFromFile(AFilename);
    theStream.Seek(0, soFromBeginning);

    // Set up the edit stream.
    //
    editStream.dwCookie := Longint(theStream);
    editStream.dwError := 0;
    editStream.pfnCallback := @EditStreamCallback;

    // Send the EM_STREAMIN message.
    //
    Result := SendMessage(Handle, EM_STREAMIN, SF_RTF or SFF_SELECTION,
      Longint(@editStream));
  finally
    theStream.Free;
  end;
end;

function TGSJvRichEdit.Append(AFilename: string): integer;
begin
  // Append a lines containing a single space to the end;
  Lines.Append(' ');

  // Position to end of text.
  //
  SelStart := SendMessage(Handle, EM_LINEINDEX, Lines.Count - 1, 0);
  SelLength := 1; // Select the space that we just added.

  Result := FetchText(AFilename);
end;

function TGSJvRichEdit.Insert(AFilename: string): integer;
begin
  Result := FetchText(AFilename);
end;

procedure Register;
begin
  RegisterComponents('Garlin', [TGSJvRichEdit]);       { JC }
end;

end.

Fusionner 2 RichEdit (RichEdit Merge)

Ajouter le Composant GSRichEdit

Manip’s

Dans la même rubrique